diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,1724 @@ +1.42.3 + +* [Fix the typechecking rule for `Optional` + `with`](https://github.com/dhall-lang/dhall-haskell/pull/2650) +* [Add `*WithIndex` instances for `Map`](https://github.com/dhall-lang/dhall-haskell/pull/2633) +* [`dhall package`: Add support for automatic sub-packags](https://github.com/dhall-lang/dhall-haskell/pull/2639) +* [`dhall to-directory-tree`: Add `binary-file` support](https://github.com/dhall-lang/dhall-haskell/pull/2641) +* [Support GHC 9.12.1](https://github.com/dhall-lang/dhall-haskell/pull/2649) +* [`dhall to-directory-tree`: create parents of files when using fixpoint representation](https://github.com/dhall-lang/dhall-haskell/pull/2653) + +1.42.2 + +* [Supports standard version 23.1.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v23.1.0) + * [Allow `Natural` and `Integer` literals in binary notation](https://github.com/dhall-lang/dhall-haskell/pull/2540) +* Fix macOS build [[#2561](https://github.com/dhall-lang/dhall-haskell/pull/2561)] / [[#2586](https://github.com/dhall-lang/dhall-haskell/pull/2586)] +* [`dhall to-directory-tree`: Fix support for empty `Map`s](https://github.com/dhall-lang/dhall-haskell/pull/2609) +* [`Dhall.TH`: Improve recompilation checking](https://github.com/dhall-lang/dhall-haskell/pull/2620) + * `Dhall.TH` utilities now use `addDependentFile` internally so that GHC will recompile if any Dhall dependencies change +* Performance improvements + * Optimize `Natural/fold`: [[#2585](https://github.com/dhall-lang/dhall-haskell/pull/2585)] / [[#2596](https://github.com/dhall-lang/dhall-haskell/pull/2596)] + * [Improve `Dhall.Map.traverseWithKey` performance](https://github.com/dhall-lang/dhall-haskell/pull/2589) + * The fold will now short-circuit if it reaches a fixed point + * [#2611](https://github.com/dhall-lang/dhall-haskell/pull/2611) +* Fixes and improvements to test suite + * [#2593](https://github.com/dhall-lang/dhall-haskell/pull/2593) +* Fixes and improvements to haddocks + * [#2546](https://github.com/dhall-lang/dhall-haskell/pull/2546) +* Fixes and improvements to code formatting + * [#2608](https://github.com/dhall-lang/dhall-haskell/pull/2608) + +1.42.1 + +* Add several new entrypoints to `Dhall` module [[#2534](https://github.com/dhall-lang/dhall-haskell/pull/2534)] / [[#2544](https://github.com/dhall-lang/dhall-haskell/pull/2544)] +* Build against latest versions of: + * [`ansi-terminal`](https://github.com/dhall-lang/dhall-haskell/pull/2521) + * [`optparse-applicative`](https://github.com/dhall-lang/dhall-haskell/pull/2543) + * [`optparse-generic`](https://github.com/dhall-lang/dhall-haskell/pull/2519) + * [`lens`](https://github.com/dhall-lang/dhall-haskell/pull/2539) + * `template-haskell` [[#2532](https://github.com/dhall-lang/dhall-haskell/pull/2532)] / [[#2542](https://github.com/dhall-lang/dhall-haskell/pull/2542)] + * [`unix-compat`](https://github.com/dhall-lang/dhall-haskell/pull/2532) +1.42.0 + +* [Supports standard version 23.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v23.0.0) + * [BREAKING CHANGE TO THE API AND LANGUAGE: Language support for `Bytes` literals](https://github.com/dhall-lang/dhall-haskell/pull/2499) + * This is a breaking change to the API due to adding new `Bytes` and `BytesLiteral` constructors to the `Expr` type + * This is a breaking change to the language now that `Bytes` is a reserved identifier + * [BREAKING CHANGE TO THE API AND LANGUAGE: New `{Date,Time,TimeZone}/show` builtins](https://github.com/dhall-lang/dhall-haskell/pull/2493) + * This is a breaking change to the API due to adding new `{Date,Time,TimeZone}Show` constructors to the `Expr` type + * This is a breaking change to the language now that `{Date,Time,TimeZone}/show` are not reserved identifiers +* [BREAKING CHANGE: `dhall lint` no longer sorts `let` bindings](https://github.com/dhall-lang/dhall-haskell/pull/2503) + * This had to be removed because the old behavior was not always correct + * The old behavior would sometimes change the behavior of a Dhall program or break the program + * Out of an abundance of caution we're disabling the feature until it can be properly fixed (which is't trivial) +* [BUG FIX: Fix pretty-printing of `Time` literals](https://github.com/dhall-lang/dhall-haskell/pull/2466) + * The pretty-printer was stripping leading zeros from the fractional component + of seconds +* [BUG FIX: Fix custom normalizers to work for things other than functions](https://github.com/dhall-lang/dhall-haskell/pull/2464) + * Before this change you could extend the language with custom functions, but + not custom values (e.g. `foo = 1`) +* [BUG FIX: Don't URL encode path components](https://github.com/dhall-lang/dhall-haskell/pull/2505) + * The pretty-printer was URL-encoding path components, which is not correct (according to the standard) + * URL path components are supposed to be already URL-encoded by the user and left undisturbed by the interpreter (which is now what it correctly does) +* New `dhall package` command: [#2478](https://github.com/dhall-lang/dhall-haskell/pull/2487), [#2508](https://github.com/dhall-lang/dhall-haskell/pull/2508) + * This command makes it easier to turn a directory full of Dhall expressions + into a dhall package (e.g. `package.dhall`) +* [Improved `dhall to-directory-tree` subcommand](https://github.com/dhall-lang/dhall-haskell/pull/2437) + * The `dhall to-directory-tree` subcommand now optionally supports specifying + metadata for generated paths + * For a worked example, see: https://github.com/dhall-lang/dhall-haskell/blob/main/dhall/examples/to-directory-tree.dhall +* `dhall freeze --cache --all` is now idempotent: [#2486](https://github.com/dhall-lang/dhall-haskell/pull/2486), [#2500](https://github.com/dhall-lang/dhall-haskell/pull/2500) + * Before this change a second run would fail due to attempting to resolve + the `missing` import it would generate +* [New Template Haskell options for adding strictness annotations to generated Haskell types](https://github.com/dhall-lang/dhall-haskell/pull/2504) +* [Template Haskell can now generate higher-kinded Haskell types from higher-kinded Dhall types](https://github.com/dhall-lang/dhall-haskell/pull/2506) +* [New `Dhall.Freeze` utilities for working with custom evaluators](https://github.com/dhall-lang/dhall-haskell/pull/2478) +* [Add `Data` instances for `Import` and various other types](https://github.com/dhall-lang/dhall-haskell/pull/2462) +* [Add `Eq` instances for `InvalidDecoder` and `ExtractError`](https://github.com/dhall-lang/dhall-haskell/pull/2482) + +1.41.2 + +* [BUG FIX: Fix `:hash` REPL command to α-normalize input](https://github.com/dhall-lang/dhall-haskell/pull/2420) +* [Add `{From,To}Dhall` instances for `DayOfWeek`](https://github.com/dhall-lang/dhall-haskell/pull/2413) +* [Add `{From,To}Dhall` instances for `ShortText`](https://github.com/dhall-lang/dhall-haskell/pull/2413) +* Performance improvements + * [#2423](https://github.com/dhall-lang/dhall-haskell/pull/2423) +* Fixes and improvements to haddocks + * [#2396](https://github.com/dhall-lang/dhall-haskell/pull/2396) +* Fixes and improvements to test suite + * [#2342](https://github.com/dhall-lang/dhall-haskell/pull/2382) + * [#2394](https://github.com/dhall-lang/dhall-haskell/pull/2394) +* Build against newer dependencies + * [`pretty-simple-4.1`](https://github.com/dhall-lang/dhall-haskell/pull/2408) + * [`aeson-2.1`](https://github.com/dhall-lang/dhall-haskell/pull/2424) + * [`vector-0.13`](https://github.com/dhall-lang/dhall-haskell/pull/2427) + * [`turtle-1.6`](https://github.com/dhall-lang/dhall-haskell/pull/2431) + +1.41.1 + +* [BUG FIX: Don't escape `?` path component when pretty-printing `with` expressions](https://github.com/dhall-lang/dhall-haskell/pull/2392) + +1.41.0 + +* [Support standard version 22.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v22.0.0) + * [Allow `with` expressions to update `Optional` values using `?`](https://github.com/dhall-lang/dhall-haskell/pull/2386) + * [Add `showConstructor` keyword](https://github.com/dhall-lang/dhall-haskell/pull/2384) +* [BUG FIX: Fix pretty-printing of time zones](https://github.com/dhall-lang/dhall-haskell/pull/2379) + * Timezones with a negative offset were previously being rendered with two + leading minus signs instead of one +* [BUG FIX: `dhall freeze --cache` to work with standard version 21.0.0](https://github.com/dhall-lang/dhall-haskell/pull/2350) + * `dhall freeze` will now use `missing sha256:…` for the first import so that + the latter import will be tried if the import is not in cache + * The old behavior is incompatible with standard version 21.0.0 because the + new behavior of the `?` operator doesn't fall back on hash mismatches +* [BUG FIX: Allow `with` expression to update a field named `Some`](https://github.com/dhall-lang/dhall-haskell/pull/2354) + * This fixes a discrepancy between the Haskell implementation and the standard + where the Haskell implementation would not permit + `{ Some = 0 } with Some = 1 ` +* [Fix `dhall {format,lint,freeze}` to preserve leading shebangs](https://github.com/dhall-lang/dhall-haskell/pull/2364) +* [Add `FromDhall` instances for `Int{8,16,32,64}`](https://github.com/dhall-lang/dhall-haskell/pull/2349) + +1.40.2 + +* [Supports standard version 21.1.0](https://github.com/dhall-lang/dhall-haskell/pull/2236) + * [The interpreter now supports customizing headers using a `headers.dhall` + configuration file](https://github.com/dhall-lang/dhall-haskell/pull/2236) + * [Generalize grammar for certain annotations](https://github.com/dhall-lang/dhall-haskell/pull/2320) + * [Add support for a trailing line comment without a newline](https://github.com/dhall-lang/dhall-haskell/pull/2309) +* [BUG FIX: `dhall repl` no longer ignores type annotations on `:let` commands](https://github.com/dhall-lang/dhall-haskell/pull/2297) + * Before this fix, `:let x : T = 3` would ignore the `: T` type annotation +* [BUG FIX: Don't accept a bar after an empty union](https://github.com/dhall-lang/dhall-haskell/pull/2338) + * Before this fix, the interpreter would accept something like `<>|`, which + is not valid according to the standard grammar +* New `FromDhall`/`ToDhall` instances for `Day`/`TimeOfDay`/`TimeZone` [#2294](https://github.com/dhall-lang/dhall-haskell/pull/2294) [#2300](https://github.com/dhall-lang/dhall-haskell/pull/2300) + * These types correspond to the recent temporal literals added to the + language +* [New `subExpressionsWith` `Traversal`](https://github.com/dhall-lang/dhall-haskell/pull/2302) +* [Add Template Haskell support for modifying field names in generated Haskell + types](https://github.com/dhall-lang/dhall-haskell/pull/2285) + * This adds a new `makeHaskellTypesWith` utility with takes a + `GenerateOptions` function argument for customizing the code-generation + logic + * This comes in handy when Dhall fields have names are reserved keywords in + Haskell code. You can now transform the Haskell field names to avoid + collisions +* [Support GHC 9.2](https://github.com/dhall-lang/dhall-haskell/pull/2328) +* Fixes and improvements to documentation + * [#2290](https://github.com/dhall-lang/dhall-haskell/pull/2290) +* Fixes and improvements to error messages + * [#2303](https://github.com/dhall-lang/dhall-haskell/pull/2303) + +1.40.1 + +* [BUG FIX: Fix equivalence check for `Date` / `Time` / `TimeZone`](https://github.com/dhall-lang/dhall-haskell/pull/2291) + * This fixes a serious bug in the recently introduced support for temporal + literals where they would fail to type-check when given a correct type + annotation or when they were checked against an existing type + * For example, `00:00:00 : Time` was failing to type-check + +1.40.0 + +* [Almost supports version 20.2.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v20.2.0) + * The main thing that is missing is support for the `headers.dhall` file + * [BREAKING CHANGE TO THE LANGUAGE: Add support for `Date` / `Time` / `TimeZone` ](https://github.com/dhall-lang/dhall-haskell/pull/2247) + * This is a breaking change because `Date`, `Time`, and `TimeZone` are + now reserved identifiers + * [Improved fallback behavior for `?`](https://github.com/dhall-lang/dhall-haskell/pull/2203) +* [BREAKING CHANGE TO THE LANGUAGE: Require whitespace before `with`](https://github.com/dhall-lang/dhall-haskell/pull/2213) + * The parser now requires whitespace before the `with` keyword, which brings + the Haskell implementation into closer compliance with the standard + * In practice this is a technically breaking change which will not affect + most programs +* [New `FromDhall` instances for `Predicate`, `Equivalence`, and `Op`](https://github.com/dhall-lang/dhall-haskell/pull/2278) +* [`dhall lint` will now sort `let` bindings with imports](https://github.com/dhall-lang/dhall-haskell/pull/2205) + * `dhall lint` now reorders `let` bindings to move imports to the top so + long as doing so does not change the behavior of the program +* Fixes and improvements to code formatting + * [#2280](https://github.com/dhall-lang/dhall-haskell/pull/2280) +* Fixes and improvements to error messages + * [#2244](https://github.com/dhall-lang/dhall-haskell/pull/2244) + * [#2238](https://github.com/dhall-lang/dhall-haskell/pull/2238) + +1.39.0 + +* [Supports version 20.2.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v20.2.0) + * [Add support for Unix shebangs](https://github.com/dhall-lang/dhall-haskell/pull/2175) +* [BREAKING CHANGE TO THE API: `dhall {format,freeze,lint}` now accept multiple + files](https://github.com/dhall-lang/dhall-haskell/pull/2169) + * The `--inplace` flag is no longer necessary and you can now specify + multiple files to update in place on the command line, like + `dhall format foo.dhall bar.dhall` + * The `--inplace` flag is still accepted, but does nothing, and will emit a + warning + * This is a breaking change to the API for formatting/freezing/linting files + because now you can specify multiple inputs instead of one input +* [BREAKING CHANGE: Pre-6.0.0 hashes are no longer supported](https://github.com/dhall-lang/dhall-haskell/pull/2190) + * The interpreter no longer provides backwards compatibility for integrity + checks computed before standard version 6.0.0 + * This is a breaking change to the API of the `Dhall.Binary` module, where + certain utilities are no longer parameterized on a `StandardVersion` + * This is also a breaking change to any Dhall code that depended on these + really old integrity checks +* [BUG FIX: Formatting `≡` now correctly preserves the original character set](https://github.com/dhall-lang/dhall-haskell/pull/2176) +* [BUG FIX: Don't panic on `Text/replace ""`](https://github.com/dhall-lang/dhall-haskell/pull/2184) +* [Quasiquotation support for Dhall](https://github.com/dhall-lang/dhall-haskell/pull/2198) + * You can now convert a Dhall expression to the corresponding syntax tree + using a quasiquoter like this: `[dhall| \x -> x + 2 ]` +* [New `Dhall.Marshal.{Encode,Decode}` modules](https://github.com/dhall-lang/dhall-haskell/pull/2193) + * These modules split up the `Dhall` module into two smaller modules for + encoding and decoding logic, respectively + * The `Dhall` module still re-exports the same functionality as before, so + this is not a breaking change +* [Support GHC 9.0.1](https://github.com/dhall-lang/dhall-haskell/pull/2154) +* Fixes and improvements to code formatting + * [Improve pretty-printing of `sha256`](https://github.com/dhall-lang/dhall-haskell/pull/2189) + +1.38.1 + +* [Add `INLINABLE` annotations in more places](https://github.com/dhall-lang/dhall-haskell/pull/2164) + * This may improve performance by enabling more specializations +* [Fix `hashable`-related test failures](https://github.com/dhall-lang/dhall-haskell/pull/2152) +* [Fix support for GHC 8.4.4](https://github.com/dhall-lang/dhall-haskell/pull/2143) + * … by using `GeneralizedNewtypeDeriving` (with a `z`) +* [Allow doctest-0.18](https://github.com/dhall-lang/dhall-haskell/pull/2148) +* [Allow bytestring-0.11](https://github.com/dhall-lang/dhall-haskell/pull/2144) + +1.38.0 + +* [BREAKING CHANGE: Detect preferred character set from input](https://github.com/dhall-lang/dhall-haskell/pull/2108) + * `dhall format` will now preserve the character set of the formatted file + by default. In other words, if the file uses ASCII punctuation then + `dhall format` will format the file using ASCII punctuation. + * If the file contains both ASCII and Unicode punctuation it will prefer + Unicode by default + * This is a breaking change because the `Lam` / `Pi` / `Combine` / + `CombineTypes`, and `Prefer` constructors now take an additional argument + to record which character set was used +* [BUG FIX: Fix CORS compliance check](https://github.com/dhall-lang/dhall-haskell/pull/2121) + * Previous versions were not correctly enforcing CORS compliance + * This implies that some imports that would have worked previously by + accident will now fail; specifically: an import from one domain + transitively importing something from another domain that has not opted + into CORS +* [Add `ToDhall (Fix f)` instance](https://github.com/dhall-lang/dhall-haskell/pull/2122) +* Fixes and improvements to error messages + * [#2130](https://github.com/dhall-lang/dhall-haskell/pull/2130) + +1.37.1 + +* [Fix performance regression for `with` expressions](https://github.com/dhall-lang/dhall-haskell/pull/2112) + +1.37.0 + +* [Supports version 20.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v20.0.0) + * [Implement revised `Text/replace` β-normalization](https://github.com/dhall-lang/dhall-haskell/pull/2072) + * [Allow `Text/replace ""` to support an abstract haystack](https://github.com/dhall-lang/dhall-haskell/pull/2084) + * [Support `if` expressions returning a type or kind](https://github.com/dhall-lang/dhall-haskell/pull/2080) +* BREAKING CHANGE TO THE API: [Improve error message for duplicate projection label](https://github.com/dhall-lang/dhall-haskell/pull/2097) + * This also makes the implementation more standards-compliant, by treating + a duplicate label as a type error instead of a parse error + * This is a breaking change since the `Project` constructor now stores a + `[Text]` instead of `Set Text` +* [Add `--cache` flag to `dhall hash`](https://github.com/dhall-lang/dhall-haskell/pull/2093) + * This flag adds the hashed expression to the cache when enabled +* [Deprecate `Inject` / `Interpret`](https://github.com/dhall-lang/dhall-haskell/pull/2099) + * You should instead use `ToDhall` / `FromDhall`, respectively +* Fixes and improvements to the haddocks: + * [#2098](https://github.com/dhall-lang/dhall-haskell/pull/2098) + * [#2100](https://github.com/dhall-lang/dhall-haskell/pull/2100) +* Fixes and improvements to error messages: + * [#2082](https://github.com/dhall-lang/dhall-haskell/pull/2082) + * [#2095](https://github.com/dhall-lang/dhall-haskell/pull/2095) +* Fixes and improvements to the parser: + * [#2083](https://github.com/dhall-lang/dhall-haskell/pull/2089) +* Fixes and improvements to the pretty printer: + * [#2083](https://github.com/dhall-lang/dhall-haskell/pull/2083) + * [#2101](https://github.com/dhall-lang/dhall-haskell/pull/2101) + +1.36.0 + +* [Supports version 19.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v19.0.0) + * BREAKING CHANGE TO THE API: [Add `Text/replace` built-in](https://github.com/dhall-lang/dhall-haskell/pull/2063) + * [Implement `with` without syntactic sugar](https://github.com/dhall-lang/dhall-haskell/pull/2055) +* [`dhall lint` will now add a `.dhall` extension to all Prelude imports](https://github.com/dhall-lang/dhall-haskell/pull/2061) + * The old extension-free Prelude imports are deprecated +* [Fix command-line completions for files](https://github.com/dhall-lang/dhall-haskell/pull/2016) +* [Improve Template Haskell support for record constructors](https://github.com/dhall-lang/dhall-haskell/pull/2070) +* Fixes and improvements to code formatting + * [#2037](https://github.com/dhall-lang/dhall-haskell/pull/2037) + * [#2048](https://github.com/dhall-lang/dhall-haskell/pull/2048) + * [#2069](https://github.com/dhall-lang/dhall-haskell/pull/2069) + +1.35.0 + +* [Supports version 18.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v18.0.0) + * [Implement more efficient `with` desugaring](https://github.com/dhall-lang/dhall-haskell/pull/1993) + * Chained `with` expressions will now be much more efficient +* [BREAKING CHANGE TO THE API: Preserve whitespace for `Lam` constructor](https://github.com/dhall-lang/dhall-haskell/pull/1980) + * This change extends the `Lam` constructor to preserve whitespace around + the variable binding + * The motivation for this change is to enable `dhall-docs` to support + jumping to definitions + * You can replace your existing `Lam` constructors with + `Dhall.Core.makeFunctionBinding` +* [BREAKING CHANGE TO THE API: Preserve whitespace for `Field` constructors](https://github.com/dhall-lang/dhall-haskell/pull/1991) + * This change extends the `Field` constructor to preserve whitespace around + the selected field + * The motivation for this change is to enable `dhall-docs` to support + jumping to definitions + * You can use `Dhall.Core.makeFieldSelection` and + `Dhall.Core.fieldSelectionLabel` to convert between the detailed and the + simple representation of the selected field. +* [Add `FromDhall` instances for `{Int,Word}{,8,16,32,64}`](https://github.com/dhall-lang/dhall-haskell/pull/2012) +* [Add `--output` option for `dhall text` subcommand](https://github.com/dhall-lang/dhall-haskell/pull/1974) +* [Add `Dhall.Crypto.toString`](https://github.com/dhall-lang/dhall-haskell/pull/1976) +* [Make the HTTP `Manager` configurable](https://github.com/dhall-lang/dhall-haskell/pull/2027) + * Several import-related functions now provide an alternative variants that + allows the user to supply a custom `Manager` + * You can use this to tweak HTTP request timeouts or use a different TLS + manager (e.g. one from `http-client-openssl`) +* Fixes and improvements to code formatting + * [#2000](https://github.com/dhall-lang/dhall-haskell/pull/2000) + * [#2021](https://github.com/dhall-lang/dhall-haskell/pull/2021) + + The formatter now preserves comments for record fields (both record types + and record literals) +* Fixes and improvements to documentation + * [#2011](https://github.com/dhall-lang/dhall-haskell/pull/2011) + * [#2013](https://github.com/dhall-lang/dhall-haskell/pull/2013) + * [#2014](https://github.com/dhall-lang/dhall-haskell/pull/2014) +* Fixes and improvements to test suite + * [#2020](https://github.com/dhall-lang/dhall-haskell/pull/2020) + +1.34.0 + +* [Supports version 17.1.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v17.1.0) + * [Add support for trailing commas](https://github.com/dhall-lang/dhall-haskell/pull/1885) +* BREAKING CHANGE to the API: [Support prefix comments on record key-value pairs](https://github.com/dhall-lang/dhall-haskell/pull/1908) + * The Dhall AST (i.e. `Expr`) now preserves some comments for record types + and record literals + * The impact of this change is that you will need to add + `Dhall.Syntax.makeRecordField` or `Dhall.Syntax.recordFieldValue` in a few + places wherever your Haskell assembles or disassembles record expressions + * The motivation of this change is two-fold: + * To eventually enable `dhall-docs` support for rendering record + comments as documentation + * To eventually enable support for preserving record-related comments + when formatting Dhall code +* BUG FIX: [Fix `with` expressions to permit functions on their left-hand side](https://github.com/dhall-lang/dhall-haskell/pull/1897) + * This was a case of the Haskell implementation not being compliant with the + standard grammar +* [Drop support for GHC 8.2](https://github.com/dhall-lang/dhall-haskell/pull/1949) +* [Add a new `dhall rewrite-with-schemas` command](https://github.com/dhall-lang/dhall-haskell/pull/1902) + * You can now simplify a Dhall expression using a schema record (e.g. a + `./schemas.dhall` record that a package might provide) + * This simplification replaces large anonymous records with an + equivalent use of a record completion when possible +* [Add `--transitive` flag to `dhall {format,lint,freeze}](https://github.com/dhall-lang/dhall-haskell/pull/1880) + * This flag lets you format/lint/freeze a file and all of its transitive + dependencies that are reachable via relative file imports +* [Move `man/dhall.1` to `data-files`](https://github.com/dhall-lang/dhall-haskell/pull/1921) + * This ensures that Cabal will install `dhall`'s `man` pages in the + correct directory +* Performance improvements + * [#1879](https://github.com/dhall-lang/dhall-haskell/pull/1879) +* Standards compliance + * [#1953](https://github.com/dhall-lang/dhall-haskell/pull/1953) + * [#1954](https://github.com/dhall-lang/dhall-haskell/pull/1954) + * [#1956](https://github.com/dhall-lang/dhall-haskell/pull/1956) + * [#1957](https://github.com/dhall-lang/dhall-haskell/pull/1957) + * [#1958](https://github.com/dhall-lang/dhall-haskell/pull/1958) +* Fixes and improvements to haddocks + * [#1881](https://github.com/dhall-lang/dhall-haskell/pull/1881) + * [#1955](https://github.com/dhall-lang/dhall-haskell/pull/1955) + +1.33.1 + +* [Multi-line REPL / support `repline-0.4.0.0`](https://github.com/dhall-lang/dhall-haskell/pull/1867) + * `dhall repl` supports a new `:paste` command that lets you input a command + by pasting one or more lines + +1.33.0 + +* [Supports version 17.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v17.0.0) + * BREAKING CHANGE: [URLs no longer support quoted path components](https://github.com/dhall-lang/dhall-haskell/pull/1812) + * BREAKING CHANGE: [`Optional/{fold,build}` are no longer built-ins](https://github.com/dhall-lang/dhall-haskell/pull/1802) + * [Record fields now permit empty labels](https://github.com/dhall-lang/dhall-haskell/pull/1812) +* BREAKING CHANGE: [Fail instead of hanging when deriving `FromDhall` for recursive types](https://github.com/dhall-lang/dhall-haskell/pull/1825) + * This is a breaking change as now the `expected` type returns an + `Expector (Expr Src Void)` (essentially an `Either`) instead of + `Expr Src Void` + * If you really don't want to handle the new error-related wrapper, you can + get the old behavior using a partial pattern match (which will be partial, + still an improvement over the previous behavior, which was hanging) +* BREAKING CHANGE: [Records can no longer contain attributes named after language keywords](https://github.com/dhall-lang/dhall-haskell/pull/1801) + * This is a bugfix, because the language standard disallows using + keywords as record labels. However, some users were relying on + this bug. + * If you need to use a keyword as a record label, enclose it in backticks: + ``{ `assert` = 1 }``. +* [Fix invalid cache entries](https://github.com/dhall-lang/dhall-haskell/pull/1793) + * The interpreter will now correct cached expressions that are incorrect + and warn you when this happens + * Specifically, if there is a hash mismatch from the cached expression the + interpreter will resolve the import again and fix the cache if the + resolved import matches the expected hash +* [Make `encodeExpression` polymorphic](https://github.com/dhall-lang/dhall-haskell/pull/1789) + * `encodeExpression` now has a more general type, which means that you + can use it to serialise expressions without imports (i.e. + ones of type `Expr Void Void`) +* [Add `--quiet` option for `dhall decode`](https://github.com/dhall-lang/dhall-haskell/pull/1803) +* [Add `--noted` flag for `dhall haskell-syntax-tree`](https://github.com/dhall-lang/dhall-haskell/pull/1843) +* Performance improvements: + * There were several performance improvements related to binary decoding, + which should improve cache lookup speed + * [#1807](https://github.com/dhall-lang/dhall-haskell/pull/1807) + * [#1809](https://github.com/dhall-lang/dhall-haskell/pull/1809) + * [#1857](https://github.com/dhall-lang/dhall-haskell/pull/1857) +* Improvements to error messages + * [#1824](https://github.com/dhall-lang/dhall-haskell/pull/1824) + * [#1849](https://github.com/dhall-lang/dhall-haskell/pull/1849) + * [#1851](https://github.com/dhall-lang/dhall-haskell/pull/1851) +* Fixes to haddocks + * [#1815](https://github.com/dhall-lang/dhall-haskell/pull/1815) + +1.32.0 + +* [Supports version 16.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v16.0.0) + * BREAKING CHANGE: Change the precedence of `with` and `===` + * The precedence change to `with` means that some old expressions that + were valid now require explicit parentheses + * BREAKING CHANGE: Use RFC7049bis encoding for `Double`s + * This is a breaking change because the hashes of expressions with small + `Double` literals will change now + * Add support for unions mixing terms and types + * For example, `< A : Bool | B : Type >` is legal now + * You can now write `someRecord with a.b.c = x` to update a nested + fields +* DEPRECATION: [Deprecate `Dhall.Parser.exprA`](https://github.com/dhall-lang/dhall-haskell/pull/1740) + * `Dhall.Parser` module will eventually drop support for parsing custom + import types + * This is necessary in order to fix several parsing bugs and improve + parsing error messages +* BUG FIX: [GHC Generics instance for `:+:` now uses `union`](https://github.com/dhall-lang/dhall-haskell/pull/1725) + * This fixes a few subtle bugs in how Dhall unions are marshalled into + Haskell types, and also improves the error messages +* Formatting improvements + * [Change formatting of `if` expressions](https://github.com/dhall-lang/dhall-haskell/pull/1767) + * [Change formatting for functions and their types](https://github.com/dhall-lang/dhall-haskell/pull/1759) + * [Prefer puns when formatting record completions](https://github.com/dhall-lang/dhall-haskell/pull/1736) +* [Convert union alternatives to directory tree](https://github.com/dhall-lang/dhall-haskell/pull/1757) + * `dhall to-directory-tree` now supports unions which are automatically + unwrapped +* [Fix `dhall freeze --cache` to better handle protected imports](https://github.com/dhall-lang/dhall-haskell/pull/1772) + * `dhall freeze --cache` will now also update imports that already have + integrity checks +* [Don't normalized partially saturated `{List,Natural}/fold`](https://github.com/dhall-lang/dhall-haskell/pull/1742) + * The behavior now matches the standard. Previously, the Haskell + implementation was not standards-compliant because it would normalize + these partially saturated built-ins + +1.31.1 + +* BUG FIX: [Allow whitespace after record pun entry](https://github.com/dhall-lang/dhall-haskell/pull/1733) + * The record pun feature introduced in the previous release did not + correctly parse record puns with trailing whitespace, which this change + fixes. +* [Expose `{default,}InputNormalizer`](https://github.com/dhall-lang/dhall-haskell/pull/1727) + * The previous version introduced a breaking change to the `autoWith` type + that required access to the implementation of `InputNormalizer`, which was + not exported. This change fixes that. +* Build against latest dependencies + * [`QuickCheck-2.14`](https://github.com/dhall-lang/dhall-haskell/pull/1721) + * [`haskell-lsp-0.21`](https://github.com/dhall-lang/dhall-haskell/pull/1730) + * [`repline-0.3` / `haskeline-0.8`](https://github.com/dhall-lang/dhall-haskell/pull/1717) + * [`template-haskell-2.16`](https://github.com/dhall-lang/dhall-haskell/pull/1719) +* [Prefer to format using record puns when possible](https://github.com/dhall-lang/dhall-haskell/pull/1729) + * `dhall format` will now reformat code to use record puns when applicable +* Fixes and improvements to error messages: + * [#1721](https://github.com/dhall-lang/dhall-haskell/pull/1724) + +1.31.0 + +* [Supports version 15.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v15.0.0) + * [Implement `with` keyword](https://github.com/dhall-lang/dhall-haskell/pull/1685) + * You can now write `someRecord with a.b.c = x` to update a nested + fields + * [Add support for record puns](https://github.com/dhall-lang/dhall-haskell/pull/1710) + * You can now write `{ x, y }` as a shorthand for `{ x = x, y = y }` +* BREAKING CHANGE TO THE API: [Auto-derive `Generic`/`FromDhall`/`ToDhall` with Template Haskell](https://github.com/dhall-lang/dhall-haskell/pull/1682) + * Now the `Dhall.TH.makeHaskell*` utilities will include these derived + instances in the generated declarations + * This is a breaking change since users were likely already generating these + instances separately, which will now conflict with the included instances +* BREAKING CHANGE TO THE API: [`From/ToDhall` no longer takes `InterpretOptions` argument](https://github.com/dhall-lang/dhall-haskell/pull/1696) + * The types of the `autoWith` and `injectWith` methods have changed to + take an `InputNormalizer` instead of an `InterpretOptions` + * Note that `InputNormalizer` is a subset of `InterpretOptions` + * This is a breaking change to how derived `FromDhall` / `ToDhall` instances + are customized to more closely match how other Haskell packages customize + derived instances (e.g. `aeson` with `FromJSON` / `ToJSON`) + * Previously you would customize the behavior globally by passing in + a top-level `InterpretOptions` record to `autoWith` + * Now you can customize the behavior locally on a per-instance basis + * This change enables the following change ... +* [Add `Dhall.Deriving` module for `deriving-via` helpers](https://github.com/dhall-lang/dhall-haskell/pull/1700) + * Now you can take advantage of the `-XDerivingVia` language extension to + customize derived `FromDhall`/`ToDhall` instances, like this: + * `deriving (FromDhall, ToDhall) via Codec (SetSingletonConstructors Bare) Name` +* BREAKING CHANGE TO THE LANGUAGE: [Match standard with respect to `using toMap`](https://github.com/dhall-lang/dhall-haskell/pull/1673) + * `https://example.com using toMap customHeaders` is now a parse error + and needs to be explicitly parenthesized as + `https://example.com using (toMap customHeaders)` + * The language standard had always required the parentheses, but the Haskell + implementation was not correctly matching the standard +* [Fix formatting of indented comments containing empty lines](https://github.com/dhall-lang/dhall-haskell/pull/1688) + * `dhall format` was previously not idempotent when formatting indented + comments with empty lines + * Specifically, the formatter kept indenting things further with each + format, which this change fixes +* [Fix pretty-printer to preserve original numeric literals](https://github.com/dhall-lang/dhall-haskell/pull/1674) + * Now `dhall format` will preserve numeric literals exactly how you wrote + them + * For example, `0xFF` will no longer be reformatted as `255` +* [Add `dhall to-directory-tree` support for `Map`s](https://github.com/dhall-lang/dhall-haskell/pull/1705) + * `Map`s are now converted to directories (just like records) +* [Add manpage](https://github.com/dhall-lang/dhall-haskell/pull/1677) + * ... mainly for the benefit of people packaging Dhall for various + distributions +* [Group commands in CLI](https://github.com/dhall-lang/dhall-haskell/pull/1692) + * The command-line `--help` output now groups commands into useful + sections +* [Fix numeric parsing for GHCJS](https://github.com/dhall-lang/dhall-haskell/pull/1681) + * The GHCJS backend for Dhall was failing to parse numbers, which this + change fixes +* Fixes and improvements to error messages: + * [#1656](https://github.com/dhall-lang/dhall-haskell/pull/1656) + * [#1698](https://github.com/dhall-lang/dhall-haskell/pull/1698) + * [#1702](https://github.com/dhall-lang/dhall-haskell/pull/1702) +* Fixes and improvements to the haddocks: + * [#1708](https://github.com/dhall-lang/dhall-haskell/pull/1708) + * [#1712](https://github.com/dhall-lang/dhall-haskell/pull/1712) + +1.30.0 + +* [Supports version 14.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v14.0.0) +* BREAKING CHANGE TO THE API: [Add `--check` flag to `dhall {lint,freeze}`](https://github.com/dhall-lang/dhall-haskell/pull/1636) + * You can now use the `--check` flag to verify that a file has already been + linted or frozen + * This is a breaking change to the types used by the `Dhall.Format` module +* BREAKING CHANGE TO THE LANGUAGE: [Disallow `Natural` literals with leading zeros](https://github.com/dhall-lang/dhall-haskell/pull/1658) + * Now a literal like `042` is no longer valid + * See the [changelog for standard version 14.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v14.0.0) for more details +* BUG FIX: [Fix parsing of `Double` literal trailing whitespace](https://github.com/dhall-lang/dhall-haskell/pull/1647) + * Certain expressions using `Double` literals would fail to parse, which this + change fixes +* BUG FIX: [Use `DeriveLift` instead of GHC Generics to derive `Lift` ](https://github.com/dhall-lang/dhall-haskell/pull/1640) + * This fixes a build failure on GHC 8.10 +* [Drop support for GHC 7.10.3](https://github.com/dhall-lang/dhall-haskell/pull/1649) + * GHC 8.0.2 is now the earliest supported version +* [Add support for dotted field syntax](https://github.com/dhall-lang/dhall-haskell/pull/1651) + * `{ x.y.z = 1 }` now legal syntax for nested fields + * See the [changelog for standard version 14.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v14.0.0) for more details +* [Add support for duplicate record fields](https://github.com/dhall-lang/dhall-haskell/pull/1643) + * This combines with the previous feature to let you write + `{ x.y = 1, x.z = True }`, which is equivalent to + `{ x = { y = 1, z = True } }` + * See the [changelog for standard version 14.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v14.0.0) for more details +* [Add `dhall lint` support for deprecating `Optional/{fold,build}`](https://github.com/dhall-lang/dhall-haskell/pull/1628) + * The `Optional/{fold,build}` built-ins are deprecated and can be implemented + in terms of other language features + * `Optional/fold` can be implemented in terms of `merge` (which now works on + `Optional` values) + * `Optional/build` could always be implemented using `Some`/`None` + * `dhall lint` now transforms the deprecated built-ins to use their + equivalent built-in-free versions +* [Support Template Haskell for multiple datatypes](https://github.com/dhall-lang/dhall-haskell/pull/1664) + * This extends the Template Haskell support added in the previous release to + work for datatypes that refer to one another +* [Add support for custom substitutions](https://github.com/dhall-lang/dhall-haskell/pull/1650) + * You can now add custom substitutions, which are like `let` bindings that + propagate to transitive imports +* [Small formatting fixes](https://github.com/dhall-lang/dhall-haskell/pull/1652) + +1.29.0 + +* [Supports version 13.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v13.0.0) +* BREAKING CHANGE: [Generate Haskell datatype declarations from Dhall types](https://github.com/dhall-lang/dhall-haskell/commit/b0280826790930d18a5498fb802120478fa11767#diff-a9729dccf50be61ce3d8c68c16f0fd50) + * You can now use the `makeHaskellTypeFromUnion` Template Haskell utility + to generate a Haskell datatype declaration from a Dhall union type + * This helps ensure that your Haskell types and Dhall types stay in sync, + when you want the Dhall type to be the source of truth + * This is a breaking change because the default `InterpretOptions` changed + the default handling of singleton constructors from `Wrapped` to `Smart` + * You can preserve the old behavior using: + `autoWith defaultInterpretOptions{ singletonConstructors = Wrapped }` +* BUG FIX: [Fix `dhall freeze --cache` and `dhall lint` to preserve `let`-related comments](https://github.com/dhall-lang/dhall-haskell/pull/1597) + * Now they match the behavior of `dhall format` with regard to preserving + these comments +* BUG FIX: [Fix escaping of significant leading whitespace when formatting code](https://github.com/dhall-lang/dhall-haskell/pull/1598) + * The formatter would sometimes unnecessarily escape significant leading + whitespace for the final line of multiline string literals, which this + change fixes +* BUG FIX: [Fix `dhall encode --json` for `Double` values](https://github.com/dhall-lang/dhall-haskell/issues/1350) +* NEW FEATURE: [`dhall to-directory-tree` command](https://github.com/dhall-lang/dhall-haskell/pull/1606) + * You can now generate a directory tree from a Dhall expression + * Specifically: + * records are converted to directories + * `Text` fields are converted to files named after the field + * `Optional` values are omitted if `None` + * Everything else is rejected +* NEW FEATURE: [Hexadecimal literals](https://github.com/dhall-lang/dhall-haskell/pull/1607) + * See the [changelog for standard version 13.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v13.0.0) for more details +* NEW FEATURE: [`merge` works on `Optional` values](https://github.com/dhall-lang/dhall-haskell/pull/1608) + * See the [changelog for standard version 13.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v13.0.0) for more details +* [Improve formatter](https://github.com/dhall-lang/dhall-haskell/pull/1609) + * `dhall format` will now render expressions nested inside record fields or + alternatives more compactly, including: + * Records + * Record completion expressions + * Expressions wrapped in `Some` + * Lists +* [Exclude the `using ...` suffix from imports listed by `dhall resolve`](https://github.com/dhall-lang/dhall-haskell/pull/1603) + * Specifically when using the `--{immediate,transitive}-dependencies` flags + +1.28.0 + +* [Supports version 12.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v12.0.0) +* BREAKING CHANGE: [Add `Integer/{clamp,negate}` built-ins](https://github.com/dhall-lang/dhall-haskell/pull/1486) + * This is a technically breaking change API since this adds a new + constructor to the `Expr` type + * This is also a technically breaking change to the language. See the [changelog for standard version 12.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v12.0.0) for more details +* BREAKING CHANGE: [Remove support for fusion](https://github.com/dhall-lang/dhall-haskell/pull/1478) + * This is also a technically breaking change to the language. See the [changelog for standard version 12.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v12.0.0) for more details +* BREAKING CHANGE: [Parse whitespace more precisely](https://github.com/dhall-lang/dhall-haskell/pull/1483) + * The Haskell implementation now matches the official grammar much more + closely, but as a result will now reject some programs that it used to + accept + * For example, `1:Natural` used to be valid and now is no longer valid as + the standard requires mandatory whitespace after the `:` + * Consult the [standard grammar](https://github.com/dhall-lang/dhall-lang/blob/master/standard/dhall.abnf) if you run into a new parsing error as a result of this change + * This is also a parsing performance regression (specifically for parsing + comments), but should not be noticeable in practice. See [#1512](https://github.com/dhall-lang/dhall-haskell/pull/1512) for more details +* BREAKING CHANGE: Rename `Type` to `Decoder` and `InputType` to `Encoder` [#1483](https://github.com/dhall-lang/dhall-haskell/pull/1485) / [#1489](https://github.com/dhall-lang/dhall-haskell/pull/1489) +* BUG FIX: [Fix `dhall format --check`](https://github.com/dhall-lang/dhall-haskell/pull/1462) + * Before this change `dhall format --check` would fail due to attempting to + read all of standard input in twice +* BUG FIX: [Fix `dhall freeze` to always re-freeze an import](https://github.com/dhall-lang/dhall-haskell/pull/1471) + * Before this fix, `dhall freeze` would not attempt to refreeze an already + frozen import +* [Permit spaces around completion operator](https://github.com/dhall-lang/dhall-haskell/pull/1532) + * See the [changelog for standard version 12.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v12.0.0) for more details +* [Make `missing` referentially transparent](https://github.com/dhall-lang/dhall-haskell/pull/1509) + * `missing` can now be imported transitively via a remote import + * Normally resolving `missing` would still still fail, except for + `missing as Location`, which is now a valid transitive import + * See the [changelog for standard version 12.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v12.0.0) for more details +* [Write cache files atomically](https://github.com/dhall-lang/dhall-haskell/pull/1544) + * This is a resilience improvement so that the cache is not left in a + corrupt state in the event of a power outage or exhausting disk/memory +* [New `Dhall.function` utility](https://github.com/dhall-lang/dhall-haskell/pull/1507) + * This is provides the same functionality as the `Interpret` instance for + `(->)`, except without the use of typeclasses +* [New `dhall haskell-syntax-tree` command](https://github.com/dhall-lang/dhall-haskell/pull/1553) + * This command displays the Haskell syntax tree of an expression + (primarily for debugging purposes) + * Note that this is highly-volatile and subject to change, so don't depend + on this programmatically. We may break the output of this command without + any notice. +* [Add `instance Show Ann`](https://github.com/dhall-lang/dhall-haskell/pull/1567) +* [Move normalization code from `Dhall.Core` to `Dhall.Normalize`](https://github.com/dhall-lang/dhall-haskell/pull/1452) + * Note that this is not a breaking change. The relocated utilities are + still re-exported from `Dhall.Core` +* [Fix `dhall resolve --transitive-dependencies` to list dependencies in "post-order"](https://github.com/dhall-lang/dhall-haskell/pull/1539) +* Performance improvements + * [#1500](https://github.com/dhall-lang/dhall-haskell/pull/1500) + * [#1522](https://github.com/dhall-lang/dhall-haskell/pull/1522) + * [#1568](https://github.com/dhall-lang/dhall-haskell/pull/1568) + * [#1580](https://github.com/dhall-lang/dhall-haskell/pull/1578) +* Fixes and improvements to code formatting + * [#1460](https://github.com/dhall-lang/dhall-haskell/pull/1460) + * [#1466](https://github.com/dhall-lang/dhall-haskell/pull/1466) + * [#1508](https://github.com/dhall-lang/dhall-haskell/pull/1508) + * [#1527](https://github.com/dhall-lang/dhall-haskell/pull/1527) + * [#1422](https://github.com/dhall-lang/dhall-haskell/pull/1422) + * [#1552](https://github.com/dhall-lang/dhall-haskell/pull/1552) + * [#1543](https://github.com/dhall-lang/dhall-haskell/pull/1543) + * [#1554](https://github.com/dhall-lang/dhall-haskell/pull/1554) + * [#1569](https://github.com/dhall-lang/dhall-haskell/pull/1569) +* Fixes and improvements to code linting + * [#1518](https://github.com/dhall-lang/dhall-haskell/pull/1518) + * [#1531](https://github.com/dhall-lang/dhall-haskell/pull/1531) +* Fixes and improvements to error messages + * [#1443](https://github.com/dhall-lang/dhall-haskell/pull/1443) + * [#1448](https://github.com/dhall-lang/dhall-haskell/pull/1448) + * [#1482](https://github.com/dhall-lang/dhall-haskell/pull/1482) + * [#1519](https://github.com/dhall-lang/dhall-haskell/pull/1519) + * [#1556](https://github.com/dhall-lang/dhall-haskell/pull/1556) + * [#1528](https://github.com/dhall-lang/dhall-haskell/pull/1528) +* Fixes and improvements to the parser + * [#1473](https://github.com/dhall-lang/dhall-haskell/pull/1473) + * [#1549](https://github.com/dhall-lang/dhall-haskell/pull/1549) + * [#1563](https://github.com/dhall-lang/dhall-haskell/pull/1563) + * [#1584](https://github.com/dhall-lang/dhall-haskell/pull/1584) +* Fixes and improvements to diffs + * [#1585](https://github.com/dhall-lang/dhall-haskell/pull/1585) +* Fixes and improvements to the REPL + * [#1573](https://github.com/dhall-lang/dhall-haskell/pull/1573) +* Fixes and improvements to documentation + * [#1530](https://github.com/dhall-lang/dhall-haskell/pull/1530) + +1.27.0 + +* [Supports version 11.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v11.0.0) +* BREAKING CHANGE: Rename `Inject`/`Interpret` to `ToDhall`/`FromDhall` + * This change `ConstraintKinds` to minimize disruption by keeping around + `Inject`/`Interpret` as synonyms for `ToDhall`/`FromDhall` + * In other words, constraints and derived instances using `Inject` or + `Interpret` will still work + * However, manual instances using `Inject` or `Interpret` won't work + unless you rename them to `ToDhall`/`FromDhall` or enable the + `TypeSynonymInstances` extension +* BREAKING CHANGE: Fix `Eq` instance for `Expr`s with special `Double`s + * This fixes the `Eq` instance for `Expr`s to match the standard regarding + `Double` comparisons + * Specifically: `NaN == NaN` and `-0.0 /= 0.0` + * This is a breaking change because the `DoubleLit` constructor of `Expr` + now stores a `DhallDouble` instead of a `Double` +* BREAKING CHANGE: [Add `--file` option for `dhall hash`](https://github.com/dhall-lang/dhall-haskell/pull/1445) + * This is a breaking change because it also removes the `Dhall.Hash` module, + which wasn't really carrying its own weight +* [Add support for leading separators](https://github.com/dhall-lang/dhall-haskell/pull/1355) + * See the [changelog for standard version 11.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v11.0.0) for more details +* [Add record completion operator](https://github.com/dhall-lang/dhall-haskell/pull/1375) + * See the [changelog for standard version 11.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v11.0.0) for more details +* [Add `dhall tags` subcommand](https://github.com/dhall-lang/dhall-haskell/pull/1398) + * This generates an ETags file from an input file or directory +* [Add `dhall lint` support for fixing malformed assertions](https://github.com/dhall-lang/dhall-haskell/pull/1353) + * `dhall lint` now fixes `let example = foo === bar` to be + `let example = assert : foo === bar` +* Normalize inferred types [#1337](https://github.com/dhall-lang/dhall-haskell/pull/1337) +* New `FromDhall`/`ToDhall` (previously `Interpret`/`Inject`) instances for: + * [`Void`](https://github.com/dhall-lang/dhall-haskell/pull/1382) + * `Map` [#1391](https://github.com/dhall-lang/dhall-haskell/pull/1391) / [#1412](https://github.com/dhall-lang/dhall-haskell/pull/1412) + * [`HashMap`](https://github.com/dhall-lang/dhall-haskell/pull/1426) + * [`Set` and `HashSet`](https://github.com/dhall-lang/dhall-haskell/pull/1405) + * [`()`](https://github.com/dhall-lang/dhall-haskell/pull/1388) +* [Add `--output` option to `dhall`](https://github.com/dhall-lang/dhall-haskell/pull/1399) +* [Move syntax things from `Dhall.Core` to a new `Dhall.Syntax` module](https://github.com/dhall-lang/dhall-haskell/pull/1440) + * This is not a breaking change. `Dhall.Core` still re-exports the same + API as before +* Performance improvements + * [#1362](https://github.com/dhall-lang/dhall-haskell/pull/1362) + * [#1366](https://github.com/dhall-lang/dhall-haskell/pull/1366) + * [#1368](https://github.com/dhall-lang/dhall-haskell/pull/1368) + * [#1397](https://github.com/dhall-lang/dhall-haskell/pull/1397) + * [#1401](https://github.com/dhall-lang/dhall-haskell/pull/1401) +* Fixes and improvements to code formatting + * [#1360](https://github.com/dhall-lang/dhall-haskell/pull/1360) + * [#1372](https://github.com/dhall-lang/dhall-haskell/pull/1372) + * [#1380](https://github.com/dhall-lang/dhall-haskell/pull/1380) + * [#1415](https://github.com/dhall-lang/dhall-haskell/pull/1415) + +1.26.1 + +* TECHNICALLY BREAKING CHANGES: [Simplify `⫽` within projection](https://github.com/dhall-lang/dhall-haskell/pull/1283) / [Simplify nested record projections](https://github.com/dhall-lang/dhall-haskell/pull/1307) + * These are technically breaking changes because you will need to update + integrity checks that protect code simplified in this way + * We're not bumping the major version since the likelihood that you're + affected is quite low +* BUG FIX: [Fix performance regression](https://github.com/dhall-lang/dhall-haskell/pull/1335) + * This change fixes the performance regression introduced in the previous + release (version 1.26.0) +* BUG FIX: [Prevent REPL from inserting inferred `Sort`s into context](https://github.com/dhall-lang/dhall-haskell/pull/1318) + * This protects the REPL from getting hosed if you define an expression + using `:let` that has an inferred type of `Sort` +* NEW FEATURE: Improved `Inject`/`Interpret` support for 1-field constructors - ([#1315](https://github.com/dhall-lang/dhall-haskell/pull/1315) / [#1321](https://github.com/dhall-lang/dhall-haskell/pull/1321)) + * This adds a new `singletonConstructors` field to `InterpretOptions` that + lets you control what Dhall type 1-field Haskell constructors correspond + to + * The default (`Wrapped`) is backwards compatible with the old behavior + * The `Smart` option is probably what you want: it will strip the + Haskell constructor from the Dhall type if the constructor has one + anonymous field + * The `Bare` option always strips 1-field Haskell constructors from the + Dhall type +* NEW FEATURE: `--censor` flag that disables source code display ([#1312](https://github.com/dhall-lang/dhall-haskell/pull/1312) / [#1329](https://github.com/dhall-lang/dhall-haskell/pull/1329)) + * Use this flag when you don't want sensitive `Text` literals showing up in + parsing or type-checking error messages +* [Format record fields more compactly if they fit on 1 line](https://github.com/dhall-lang/dhall-haskell/pull/1314) + * The formatter will now format record fields on a field-by-field basis to + avoid unnecessary vertical sprawl of formatted records + * Specifically, record fields that fit on one line will now be formatted + on one line +* [Add `--quiet` option to `dhall type`](https://github.com/dhall-lang/dhall-haskell/pull/1325) + * This lets you use `dhall type` in "check only" mode (e.g. for CI for + for development feedback) +* Improved GHCJS support - ([#1311](https://github.com/dhall-lang/dhall-haskell/pull/1311) / [#1330](https://github.com/dhall-lang/dhall-haskell/pull/1330)) +* [Fix all executables to accept `--version`](https://github.com/dhall-lang/dhall-haskell/pull/1334) + * Note that the `dhall version` subcommand is still supported, too +* [New `Dhall.Version` module](https://github.com/dhall-lang/dhall-haskell/pull/1332) +* [Don't normalize inferred types](https://github.com/dhall-lang/dhall-haskell/pull/1317) + * This fixes `dhall type` to more accurately follow the standard +* [Initial changes for GHC 8.8 support](https://github.com/dhall-lang/dhall-haskell/pull/1324) +* [Fix Haddock formatting for `dhallFromJSON`](https://github.com/dhall-lang/dhall-haskell/pull/1316) +* [Improved Windows caching support](https://github.com/dhall-lang/dhall-haskell/pull/1272) + * `dhall` will now prefer the `%LOCALAPPDATA%` directory for caching if it is + available +* [Warn about missing cache directories](https://github.com/dhall-lang/dhall-haskell/pull/1320) + +1.26.0 + +* [Supports version 10.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) +* BREAKING CHANGE TO THE LANGUAGE: [Remove old union literal syntax](https://github.com/dhall-lang/dhall-haskell/pull/1176) + * Union literals of the form `< x = e | ... >` are no longer valid + * For more details, see: [Migration: Deprecation of old union literal syntax](https://github.com/dhall-lang/dhall-lang/wiki/Migration%3A-Deprecation-of-old-union-literal-syntax) + * Also see the [changelog for standard version 10.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) for more details +* BREAKING CHANGE TO THE API: [Change `X` to be a type synonym for `Data.Void`](https://github.com/dhall-lang/dhall-haskell/pull/1172) + * This is a breaking change if you were previously pattern matching on the + `X` constructor. You can replace that with the use of `Data.Void.absurd` +* BREAKING CHANGE TO THE API: [Treat multi-`let`s as syntactic sugar](https://github.com/dhall-lang/dhall-haskell/pull/1242) + * This is a breaking change because the `Let` constructor now only stores + one `Binding` instead of a `NonEmpty` list of `Binding`s +* PERFORMANCE REGRESSION & TECHNICALLY BREAKING CHANGE TO THE LANGUAGE: [Dependent types](https://github.com/dhall-lang/dhall-haskell/pull/1164) + * You can now write functions from terms to types + * There is also now language support for tests of the form + `assert : x === y` + * This deteriorates the performance of large multi-`let` expressions + (See: [#1306](https://github.com/dhall-lang/dhall-haskell/issues/1306)) + * Splitting large multi-`let` expressions into smaller files may mitigate + the problem as a work-around for now + * Follow [#1129](https://github.com/dhall-lang/dhall-haskell/issues/1129) + for work to fix this performance regression + * This is also a technically breaking change because `assert` is now a + reserved keyword + * See the [changelog for standard version 10.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) for more details +* TECHNICALLY BREAKING CHANGE TO THE LANGUAGE: [Add `Natural/subtract` built-in](https://github.com/dhall-lang/dhall-haskell/pull/1133) + * The language now supports machine subtraction, which can be used to + support several other high-performance operations (like `Natural` + comparisons) + * This is a technically breaking change if you used `Natural/subtract` as an + identifier in your code + * See the [changelog for standard version 10.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) for more details +* TECHNICALLY BREAKING CHANGE TO THE LANGUAGE: [More simplifications for field selection](https://github.com/dhall-lang/dhall-haskell/pull/1174) + * Now the interpreter will more intelligently simplify certain field + projections + * For example: `λ(x : { a : Bool, b : Bool }) → (x ⫽ { c = 0 }).{ a, c }.c` + will now simplify to `λ(x : { a : Bool, b : Bool }) → 0 ` + * This is a technically breaking change because you will need to update + integrity checks that protect code simplified in this way + * See the [changelog for standard version 10.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) for more details +* TECHNICALLY BREAKING CHANGE TO THE LANGUAGE: [Simplify `⫽` when its arguments are equivalent](https://github.com/dhall-lang/dhall-haskell/pull/1196) + * This is a technically breaking change for the same reason: this will + perturb semantic integrity checks for affected code + * See the [changelog for standard version 10.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) for more details +* NEW FEATURE: [Restore support for records containing both types and terms](https://github.com/dhall-lang/dhall-haskell/pull/1173) + * In other words `{ foo = 1, bar = Bool }` is now valid again + * This means that you now can export a single package containing both types + and terms + * See the [changelog for standard version 10.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) for more details +* [`dhall format` now preserves `let` comments](https://github.com/dhall-lang/dhall-haskell/pull/1273) + * `dhall` format will now preserve comments in the following locations of + a `let` binding: + * `let {- HERE -} x {- HERE -} : {- HERE -} Bool = {- HERE -} True in x` + * This support handles both single-line and multi-line comments and also + takes care of correctly indenting/dedenting them + * Note that comments before the `let` keyword are still not preserved + (unless it is the beginning of the file) +* [Add API support for marshalling recursive types](https://github.com/dhall-lang/dhall-haskell/pull/1195) + * You can now marshal recursive types from Dhall into Haskell using the + newly-added utilities + * See also: [#1298](https://github.com/dhall-lang/dhall-haskell/pull/1298) +* [New `:help` command for `dhall repl`](https://github.com/dhall-lang/dhall-haskell/pull/1237) +* New `--no-cache` flag [#1290](https://github.com/dhall-lang/dhall-haskell/pull/1290) / [#1434](https://github.com/dhall-lang/dhall-haskell/pull/1434) / [#1436](https://github.com/dhall-lang/dhall-haskell/pull/1436) + * You can now disable use of the cache with this flag + * This comes in handy if you want to disable α-normalization for imports + protected by a semantic integrity check +* Bug fixes + * [Fix `isNormalized` for field selections](https://github.com/dhall-lang/dhall-haskell/pull/1210) + * [Simplify `Natural/subtract` when its arguments are equivalent](https://github.com/dhall-lang/dhall-haskell/pull/1220) + * [Fix `NaN` to be judgmentally equivalent to itself](https://github.com/dhall-lang/dhall-haskell/pull/1231) + * [Fix `Inject` instance for lists](https://github.com/dhall-lang/dhall-haskell/pull/1261) + * [Fix typechecking of `toMap`](https://github.com/dhall-lang/dhall-haskell/pull/1279) +* Performance optimizations + * [Optimize a few `Set` instances](https://github.com/dhall-lang/dhall-haskell/pull/1184) + * [Remove some redundant sorting during normalization](https://github.com/dhall-lang/dhall-haskell/pull/1228) +* Improvements to error messages + * [Improve error reporting for failed remote imports](https://github.com/dhall-lang/dhall-haskell/pull/1188) + * [Improve HTTP errors](https://github.com/dhall-lang/dhall-haskell/pull/1253) +* Improvements to formatting + * [Indent function arguments when formatting](https://github.com/dhall-lang/dhall-haskell/pull/1167) + * [Prefer unquoted URLs](https://github.com/dhall-lang/dhall-haskell/pull/1235) + * [Strip leading whitespace](https://github.com/dhall-lang/dhall-haskell/pull/1270) +* Improvements to diffs + * [Fix diffs for lists](https://github.com/dhall-lang/dhall-haskell/pull/1213) + * [Improve diff for non-empty lists](https://github.com/dhall-lang/dhall-haskell/pull/1244) + * [Small fixes to `dhall diff`](https://github.com/dhall-lang/dhall-haskell/pull/1263) +* Improvements to documentation + * [Fix documentation for `UnionInputType`](https://github.com/dhall-lang/dhall-haskell/pull/1230) + * [Document support for caching protected imports](https://github.com/dhall-lang/dhall-haskell/pull/1247) +* Improvements to command-line interface + * [Improve description of `dhall lint`](https://github.com/dhall-lang/dhall-haskell/pull/1264) + * [Change `dhall type` to resolve imports](https://github.com/dhall-lang/dhall-haskell/pull/1281) + +1.25.0 + +* Supports version 9.0.0 of the standard + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v9.0.0 +* BREAKING CHANGE: Remove support for old-style `List`-like `Optional` literals + * List-like `Optional` Literals (i.e. `[ 1 ] : Optional Natural`) are no + longer valid + * See: https://github.com/dhall-lang/dhall-haskell/pull/1002 +* BREAKING CHANGE: Add support for semi-semantic caching + * This change significantly improves the performance of imports + * This change also automatically caches imports without an integrity check + * This changes several types in `Dhall.Import` to support this new + feature + * See: https://github.com/dhall-lang/dhall-haskell/pull/1113 +* BREAKING CHANGE: Implement new Unicode braced escape sequence + * Escape sequences encoding surrogate pairs are no longer valid + * Instead, characters previously encoded as surrogate pairs can instead be + encoded as a braced sequence + * For example: "\uD834\uDD1E" must now be written as "\u{1D11E}" + * See: https://github.com/dhall-lang/dhall-haskell/pull/987 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1104 +* BREAKING CHANGE: Make the type of extract richer: + * `Dhall.extract` can now return a detailed error instead of just a `Maybe` + * This is a breaking chnage because the type of `extract` changed + * See: https://github.com/dhall-lang/dhall-haskell/pull/1011 +* BREAKING CHANGE: Add support for importing expressions `as Location` + * This is a breaking change because a new `Location` constructor was added + to `ImportMode` + * See: https://github.com/dhall-lang/dhall-haskell/pull/1019 +* BREAKING CHANGE: Switch `Var` to use an `Int` + * This is a performance improvement, but also a breaking change since the + `Integer` in the `Var` constructor was changed to an `Int` + * See: https://github.com/dhall-lang/dhall-haskell/pull/1044 +* BREAKING CHANGE: Add new `toMap` keyword + * This is a breaking change to the API because a new `ToMap` constructor + was added to the `Expr` type + * This is also a technically breaking change to the language because `toMap` + is now a reserved keyword, although most code should be unaffected in + practice + * See: https://github.com/dhall-lang/dhall-haskell/pull/1041 +* BREAKING CHANGE: Sort the fields of a record projection during normalization + * This is a technically breaking change to the language because any + expressions with an uninterpreted record projection will have a different + semantic integrity check. However, most could should be unaffected in + practice + * See: https://github.com/dhall-lang/dhall-haskell/pull/1111 +* BUG FIX: Fix substitution into record projection by type + * An expression like this one was being incorrectly rejected: + `let e = { a = 10, b = "Text" } let s = { a : Natural } in e.(s)`, which + this change fixes + * See: https://github.com/dhall-lang/dhall-haskell/pull/1012 +* BUG FIX: Reject record projection when there is a field type mismatch + * Record projection by type was previously not checking the expected + field types, which this change fixes + * See: https://github.com/dhall-lang/dhall-haskell/pull/1027 +* BUG FIX: Fix linting of unused let bindings + * Certain let bindings were not correctly detected as unused, which this + change fixes + * See: https://github.com/dhall-lang/dhall-haskell/pull/1001 +* BUG FIX: Fix `--file` option + * The `--file` option from the previous release did not work, due to not + computing relative paths correctly, which this change fixes + * See: https://github.com/dhall-lang/dhall-haskell/pull/1004 +* BUG FIX: Minor fix to `dhall diff` + * `dhall diff` was incorrectly displaying spurious differences for + identical lists that were function arguments, which this change fixes + * See: https://github.com/dhall-lang/dhall-haskell/pull/1006 +* BUG FIX: Allow `Sort` as type annotation + * This should have been implemented in the previous release as part of + supporting version 8.0.0 of the standard, but was missed + * See: https://github.com/dhall-lang/dhall-haskell/pull/1024 +* BUG FIX: `Dhall.Map`: Reflect original key ordering in `Ord` instance + * `Dhall.Map` now considers key order when comparing `Map`s, which it should + have done before, but didn't + * See: https://github.com/dhall-lang/dhall-haskell/pull/1050 +* BUG FIX: Consistently format multi-line strings + * The formatter now formats naked multi-line strings the same as nested + multi-line strings + * Specifically, naked multi-line strings can now be formatted on a single + (just like nested multi-line strings) + * See: https://github.com/dhall-lang/dhall-haskell/pull/1056 +* BUG FIX: Make `isNormalized` consistent with `normalize` + * See: https://github.com/dhall-lang/dhall-haskell/pull/1115 +* BUG FIX: Make `normalizeWithM` consistent with `normalize` + * See: https://github.com/dhall-lang/dhall-haskell/pull/1126 +* BUG FIX: Fix import alternatives to recover from type errors + * See: https://github.com/dhall-lang/dhall-haskell/pull/1152 +* Feature: Semi-semantic caching + * The Haskell implementation now implicitly caches *all* local imports, not + just imports frozen by integrity checks, so that you don't have to freeze + them when doing local development + * These cached imports are still correctly invalidated if they or any of + their dependencies change + * This new implicit cache is stored underneath `~/.cache/dhall-haskell` by + default + * See: https://github.com/dhall-lang/dhall-haskell/pull/1154 +* Feature: New `dhall text` subcommand + * This new subcommand supersedes the old `dhall-to-text` executable +* Feature: Add `instance Lift (Expr s a)` + * See: https://github.com/dhall-lang/dhall-haskell/pull/1119 +* Fixes and improvements to error messages: + * See: https://github.com/dhall-lang/dhall-haskell/pull/1030 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1137 +* Fixes and improvements to tests: + * See: https://github.com/dhall-lang/dhall-haskell/pull/1155 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1159 +* Performance improvements + * See: https://github.com/dhall-lang/dhall-haskell/pull/1036 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1051 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1048 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1057 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1065 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1066 + * See: https://github.com/dhall-lang/dhall-haskell/pull/1085 + +1.24.0 + +* Supports version 8.0.0 of the standard + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v8.0.0 +* BREAKING CHANGE: Allow tabs and blank lines in multi-line strings + * Blank lines are now ignored for the purpose of dedenting multiline strings + * Lines with leading tabs (or mixed tabs and spaces) are now dedented, too, + so long as they all share the same prefix + * This is technically a breaking change, but unlikely to affect programs + in practice, especially if they were formatted with `dhall format`. This + change mainly affects programs that were not indented correctly. + * See the changelog for standard version 8.0.0 for more details +* BREAKING CHANGE: Simplify bare interpolations + * Expressions like `λ(x : Text) → "${x}"` now simplify to `λ(x : Text) → x` + * This is a technically breaking change because it changes how these sorts + of expressions are serialized. This does not affect semantic integrity + checks and the new simplified expressions are extensionally equivalent to + their older counterpart expressions. + * See the changelog for standard version 8.0.0 for more details +* BREAKING CHANGE: Encode integrity check as multihash + * Semantic integrity checks are now encoded using the multihash spec + * This is a technically breaking change that does not perturb the hash for + user-facing semantic integrity checks. This only affects how expressions + with unresolved imports are serialized, but semantic integrity checks are + only computed for fully-resolved imports. + * See the changelog for standard version 8.0.0 for more details +* BUG FIX: Fix type-checker to reject invalid record type annotations + * e.g. `{ x = 1 } : { x : Text }` was not properly rejected by the type + checker + * See: https://github.com/dhall-lang/dhall-haskell/pull/965 +* BUG FIX: Custom header forwarding fixed + * Forwarding custom headers could previously fail in various ways, such as: + * Cyclic imports leading to endless network requests + * Resolving a non-existent import for the custom headers + * Resolving an existing but incorrect import for the custom headers + * This change fixes that by forwarding custom headers by value instead of + by reference + * See: https://github.com/dhall-lang/dhall-haskell/pull/967 +* BUG FIX: Fix GHCJS support + * `Natural/fold` was broken in version 1.22, which this change fixes + * Specifically, it would hang for `Natural` numbers greater than 1 + * See: https://github.com/dhall-lang/dhall-haskell/pull/985 +* BUG FIX: `dhall diff` no longer double-prints key-value separators + * See: https://github.com/dhall-lang/dhall-haskell/pull/952 +* Feature: Record projection by expression + * You can now project out a subset of record fields by the expected type + * `let t = { x : Natural } let p = { x = 1, y = 2 } in p.(t) = { x = 1 }` + * See the changelog for standard version 8.0.0 for more details +* Feature: Inline headers + * You no longer need to specify custom headers in a separate import. You + can now specify them inline within the same file. + * e.g.: `https://example.com/x using [ { header = "Foo", value = "Bar" } ]` + * See the changelog for standard version 8.0.0 for more details +* Feature: Allow `Sort` as a type annotation + * An expression such as `Kind → Kind : Sort` will now type-check + * `Sort` is still disallowed outside of a type annotation + * See the changelog for standard version 8.0.0 for more details +* Feature: Allow self-describe-cbor when decoding + * Dhall expressions serialized as CBOR can be tagged to describe themselves + as CBOR without affecting decoding + * See the changelog for standard version 8.0.0 for more details +* Feature: New `--file` option for `dhall` commands + * In other words, instead of `dhall <<< './some/file` you can now use + `dhall --file some/file` + * See: https://github.com/dhall-lang/dhall-haskell/pull/949 +* Feature: New `--cache` flag for `dhall freeze` command + * This automates the idiom used by the Prelude to optimistically cache + imports but gracefully degrade if the semantic integrity check fails + * See: https://github.com/dhall-lang/dhall-haskell/pull/980 +* Feature: Add `:clear` command to `dhall repl` + * This deletes previous bindings from the history so that they can be + garbage collected + * See: https://github.com/dhall-lang/dhall-haskell/pull/966 +* Feature: New `chunkExprs` `Traversal` added to `Dhall.Core` + * See: https://github.com/dhall-lang/dhall-haskell/pull/954 +* Feature: New `Dhall.Optics` module + * This re-exports some convenient @lens@ utilities used internally for + packages trying to avoid a @lens@ dependency + * See: https://github.com/dhall-lang/dhall-haskell/pull/986 +* More GHC 8.8 support + * See: https://github.com/dhall-lang/dhall-haskell/pull/961 + +1.23.0 + +* BREAKING CHANGE: Fix marshaling union literals + * 1.22.0 introduced two separate bugs in marshaling union literals between + Dhall and Haskell, which this release fixes: + * Dhall enums did not correctly map onto Haskell enums + * New-style union literals (i.e. `< A : T >.A x`) were not correctly + supported + * See: https://github.com/dhall-lang/dhall-haskell/pull/918 + * See: https://github.com/dhall-lang/dhall-haskell/pull/927 + * See: https://github.com/dhall-lang/dhall-haskell/pull/936 +* BUG FIX: Fix α-normalization + * Version 1.22.0 introduced a new faster evaluation algorithm, but the new + algorithm introduced two α-normalization regression, which this release + fixes + * The primary effect of this bug was that semantic integrity checks would + fail for expressions that contain an `if`/`then`/else` expression in their + normal form + * See: https://github.com/dhall-lang/dhall-haskell/pull/931 + * See: https://github.com/dhall-lang/dhall-haskell/pull/938 +* BUG FIX: Fix merging of sort-level record types + * The language standard requires that `{ a : Kind } ⩓ { b : Kind }` is + valid, which this change fixes + * See: https://github.com/dhall-lang/dhall-haskell/pull/891 +* BUG FIX: `dhall freeze` respects the `--ascii` flag + * See: https://github.com/dhall-lang/dhall-haskell/pull/934 +* BUG FIX: Don't autocomplete fields for record types + * This prevents the REPL from expanding `{ x : T }.` to `{ x : T }.x` + * See: https://github.com/dhall-lang/dhall-haskell/pull/937 +* Support `MonadFail`-related changes in GHC 8.8 + * See: https://github.com/dhall-lang/dhall-haskell/pull/912 +* Add `cross` flag to simplify cross-compilation + * This allows the `dhall` package to be built without using + `TemplateHaskell` + * See: https://github.com/dhall-lang/dhall-haskell/pull/928 +* Increase lines of context for error messages + * Error messages now provide at least 20 lines of context instead of 3 + before truncating large expressions + * See: https://github.com/dhall-lang/dhall-haskell/pull/916 +* Add line numbers to error messages + * The bottom of every Dhall type error includes the original source code, + which now has line numbers on the left margin + * See: https://github.com/dhall-lang/dhall-haskell/pull/919 +* Expand lower bounds on `megaparsec`/`transformers-compat` dependencies + * This is to support `dhall` on Debian Sid + * See: https://github.com/dhall-lang/dhall-haskell/pull/939 + +1.22.0 + +* Supports version 7.0.0 of the standard + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v7.0.0 +* BREAKING CHANGE: Add support for empty alternatives + * The `Union` type now has an optional (`Maybe`) type for each alternative + * See the changelog for standard version 7.0.0 for more details + * See: https://github.com/dhall-lang/dhall-haskell/pull/863 +* BREAKING CHANGE: Remove support for URL fragments + * The `URL` type no longer has a field for a URL fragment since the language + no longer supports fragments + * See the changelog for standard version 7.0.0 for more details + * See: https://github.com/dhall-lang/dhall-haskell/pull/851 +* BREAKING CHANGE: Remove deprecated `Path` type synonym + * See: https://github.com/dhall-lang/dhall-haskell/pull/858 +* BUG FIX: Correctly parse identifiers beginning with `http` + * i.e. `httpPort` was supposed to be a valid identifier name and now is + * See: https://github.com/dhall-lang/dhall-haskell/pull/870 +* BUG FIX: Fix `dhall encode` bug + * `dhall encode` bug was generating binary expressions that were valid + (i.e. they would decode correctly) but were non-standard (i.e. hashing + them would not match the hash you would normally get from a semantic + integrity check) + * Semantic integrity checks were not affected by this bug since they used + a slightly different code path that generated the correct binary input to + the hash. Only the `dhall decode` subcommand was affected + * See: https://github.com/dhall-lang/dhall-haskell/pull/859 +* BUG FIX: Fix for `Dhall.UnionType` + * This fixes some expressions that would previously fail to marshal into + Haskell, specifically those were the marshalling logic was built using + the `UnionType` utilities + * See: https://github.com/dhall-lang/dhall-haskell/pull/857 +* Feature: New `--alpha` flag to α-normalize command-line output + * See: https://github.com/dhall-lang/dhall-haskell/pull/855 +* Performance improvements + * The normalizer is now *much* faster + * See: https://github.com/dhall-lang/dhall-haskell/pull/876 + +1.21.0 + +* Supports version 6.0.0 of the language standard + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v6.0.0 +* BREAKING CHANGE: Remove the `constructors` keyword + * ... as standardized in version 6.0.0 of the language standard + * The deprecation cycle is over, so the keyword is no longer supported + * For more details, see: https://github.com/dhall-lang/dhall-lang/wiki/Migration%3A-Deprecation-of-constructors-keyword + * See: https://github.com/dhall-lang/dhall-haskell/pull/829 +* BREAKING CHANGE: CBOR-encode only special `Double`s as half-floats + * ... as standardized in version 6.0.0 of the language standard + * CBOR `Double`s except `Infinity`/`-Infinity`/`NaN`/`0.0` are now encoded in at + least 32 bits + * See: https://github.com/dhall-lang/dhall-haskell/pull/822 +* BREAKING CHANGE: Sort record and union fields when CBOR-encoding + * Fields and alternatives are now sorted when serialized + * This does not affect semantic integrity checks, which already sorted these + fields/alternatives before hashing expressions + * This does affect the serialization of expressions that have not been + normalized (e.g. uninterpreted expressions transmitted over the wire) + * See: https://github.com/dhall-lang/dhall-haskell/pull/835 +* BUG FIX: Fix non-exhaustive pattern match in `dhall lint` + * This fixes: `Irrefutable pattern failed for pattern Let (l' :| ls') d'` + * This bug would cause `dhall lint` to fail on some nested `let`/`in` + expressions + * See: https://github.com/dhall-lang/dhall-haskell/pull/780 + * See: https://github.com/dhall-lang/dhall-haskell/pull/784 +* BUG FIX: Don't fail if `$HOME` environment variable is unset + * The interpreter was incorrectly throwing an exception if `HOME` was unset + * The standard requires that implementations should handle the `HOME` + environment variable being missing + * See: https://github.com/dhall-lang/dhall-haskell/pull/789 +* Feature: Remove version tag from semantic integrity check + * ... as standardized in version 6.0.0 of the language standard + * This is not a breaking change because this change also includes + backwards-compatible support for semantic integrity checks produced by + older versions of the interpreter +* Feature: Support Unicode path components + * ... as standardized in version 6.0.0 of the language standard + * You can now use Unicode in path components if they are quoted + * i.e. `./families/"禺.dhall"` is now legal +* Feature: Add `Text/show` built-in + * ... as standardized in version 6.0.0 of the language standard + * You can now convert a `Text` literal to its equivalent Dhall source code + (which is itself a `Text` literal) + * This comes in handy when using Dhall code to generate JSON or Dhall code + * See: https://github.com/dhall-lang/dhall-haskell/pull/811 +* Feature: Add `--immediate-dependencies`/`--transitive-dependencies` flags for + `dhall resolve` + * You can now retrieve all of your immediate or transitive dependencies as a + textual list + * This simplifies integration with other command-line tools (such as file + watchers) + * See: https://github.com/dhall-lang/dhall-haskell/pull/795 + * See: https://github.com/dhall-lang/dhall-haskell/pull/803 +* Feature: `dhall freeze` now only freezes remote imports by default + * `dhall freeze` used to freeze all imports (including local imports and + environment variables) + * Now `dhall freeze` only freezes remote imports by default, which is what + most users want + * You can install freeze all imports using the `--all` flag + * See: https://github.com/dhall-lang/dhall-haskell/pull/808 +* Feature: `:save` and `:load` REPL state + * `:save` with no arguments now saves the REPL state to a `.dhall-repl-N` + file + * The file format is a list of `dhall repl` commands + * You can use `:load` to load the saved state back into the REPL + * See: https://github.com/dhall-lang/dhall-haskell/pull/807 +* Feature: Add `:hash` command to `dhall repl` + * This lets you conveniently hash expressions within the `dhall repl` + * See: https://github.com/dhall-lang/dhall-haskell/pull/806 +* Feature: Add `--check` flag to `dhall format` + * Use this to check if the input is already formatted + * Useful for continuous integration when you want to ensure that all code + under version control remains formatted + * See: https://github.com/dhall-lang/dhall-haskell/pull/810 +* Feature: Add `UnionInputType` builder for `InputType`s + * This is the union analog of `RecordInputType`, letting you build a + record explicitly instead of deriving the instance using GHC generics + * See: https://github.com/dhall-lang/dhall-haskell/pull/775 +* Feature: Add `:set`/`:unset` commands to `dhall repl` + * You can use these commands to set or unset command-line options + * Currently only setting/unsetting `--explain` is supported +* Standards-compliance fixes: + * See: https://github.com/dhall-lang/dhall-haskell/pull/779 + * See: https://github.com/dhall-lang/dhall-haskell/pull/804 + * See: https://github.com/dhall-lang/dhall-haskell/pull/833 +* Documentation fixes: + * See: https://github.com/dhall-lang/dhall-haskell/pull/792 + * See: https://github.com/dhall-lang/dhall-haskell/pull/825 +* Test fixes: + * See: https://github.com/dhall-lang/dhall-haskell/pull/782 + * See: https://github.com/dhall-lang/dhall-haskell/pull/836 +* Improved error messages: + * See: https://github.com/dhall-lang/dhall-haskell/pull/812 + * See: https://github.com/dhall-lang/dhall-haskell/pull/815 + * See: https://github.com/dhall-lang/dhall-haskell/pull/824 +* Formatting fixes: + * See: https://github.com/dhall-lang/dhall-haskell/pull/831 +* REPL fixes: + * See: https://github.com/dhall-lang/dhall-haskell/pull/837 + +1.20.1 + +* BUG FIX: Fix binary encoding to use correct standard version + * This fixes computed hashes to correctly match standard version 5.0.0 + * This is not marked as a breaking change since it is a bug fix. The + 1.20.0 release will be blacklisted on Hackage and users should upgrade + from 1.19.* directly to 1.20.1 + * See: https://github.com/dhall-lang/dhall-haskell/pull/771 + +1.20.0 + +* Supports version 5.0.0 of the language standard + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v5.0.0 +* BREAKING CHANGE TO THE LANGUAGE: Implement standardized support for multi-line + literals + * This updates the multi-line support to match the standard + * This is a breaking change because empty lines within the multi-line + literal now require leading whitespace whereas previously they did not + * This is also a breaking change because now a newline is required after + the opening `''` quotes whereas previously it was not required + * If you use `dhall format` then your multi-line literals already have the + necessary leading whitespace +* BREAKING CHANGE TO THE LANGUAGE: `constructors x = x` + * Now the `constructors` keyword behaves like an identity function, since + constructors can already be accessed as fields off the original union + type. + * This is a breaking change since any record of terms that contains a + `constructors` field will now be a forbidden mixed record of types and + terms. + * This is also a breaking change if you annotated the type of what used to + be a `constructors` record. + * `dhall lint` will now remove the obsolete `constructors` keyword for you + * See: https://github.com/dhall-lang/dhall-haskell/pull/693 + * See: https://github.com/dhall-lang/dhall-haskell/pull/701 +* BREAKING CHANGE TO THE API: Restore `Parent` constructor for `Local` type + * This more closely matches the standard and also enables `dhall format` to + produce a leading `../` for imports instead of `./../` + * See: https://github.com/dhall-lang/dhall-haskell/pull/718 +* BUG FIX: Fix type-checking bug for unions + * The first fix was that the inferred type was wrong for unions where + alternatives were types or kinds + * The second fix was that unions that mixed terms/types/kinds were not + properly rejected + * See: https://github.com/dhall-lang/dhall-haskell/pull/763 +* BUG FIX: Change how `dhall repl` handles prior definitions + * This changes the REPL to handle previous bindings as if they were + defined using a large `let` expression instead of adding them to the + context + * This fixes some type-checking false negatives + * See: https://github.com/dhall-lang/dhall-haskell/pull/729 +* Feature: Autocomplete for `dhall repl` + * You can now auto-complete record fields, union constructors, and + identifiers that are in scope + * See: https://github.com/dhall-lang/dhall-haskell/pull/727 +* Feature: GHCJS support + * `dhall` can now be built using GHCJS, although some features are still + not supported for GHCJS, such as: + * Semantic integrity checks + * Custom HTTP headers + * Also, HTTP imports only work for URLs that support CORS + * See: https://github.com/dhall-lang/dhall-haskell/pull/739 +* Feature: Add support for records of records of types + * You can now nest records of types + * See: https://github.com/dhall-lang/dhall-haskell/pull/700 +* Feature: Add `:quit` command for `dhall repl` + * See: https://github.com/dhall-lang/dhall-haskell/pull/719 +* Feature: Add `--json` flag for `dhall {encode,decode}` + * You can now produce/consume CBOR expressions via JSON instead of binary + * See: https://github.com/dhall-lang/dhall-haskell/pull/717 +* Feature: Add decoding logic for `as Text` + * You can now preserve the `as Text` qualifier on imports when serializing + them + * See: https://github.com/dhall-lang/dhall-haskell/pull/712 +* Prenormalize substituted expressions + * This is a performance improvement that reduces the time and memory + consumption when normalizing expressions + * See: https://github.com/dhall-lang/dhall-haskell/pull/765 + +1.19.1 + + +* BUG FIX: Fix serious `dhall lint` bug + * `dhall lint` would sometimes remove `let` expressions that were still + in use + * See: https://github.com/dhall-lang/dhall-haskell/pull/703 +* BUG FIX: Fix import caching efficiency bug + * Some imports were being wastefully fetched multiple times + * See: https://github.com/dhall-lang/dhall-haskell/pull/702 +* Feature: Generate dot graph to visualize import graph + * Use the `dhall resolve --dot` command + * See: https://github.com/dhall-lang/dhall-haskell/pull/698 + * See: https://github.com/dhall-lang/dhall-haskell/pull/713 +* Improve HTTP error messages + * See: https://github.com/dhall-lang/dhall-haskell/pull/710 + +1.19.0 + +* Supports version 4.0.0 of the language standard + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v4.0.0 +* BREAKING CHANGE TO THE LANGUAGE AND API: Prevent Hurkens' paradox + * This fixes a type-checking soundness bug which permitted infinite loops + * This is a breaking change because infinite loops are no longer possible + * This is also a breaking change because a record of types is now treated as + a kind instead of a type + * See: https://github.com/dhall-lang/dhall-haskell/pull/680 +* BREAKING CHANGE TO THE LANGUAGE AND API: `Double`s are now double-precision + floating point numbers + * This restricts the range of `Double`s to IEEE 754 double-precision + floating point + * This also implies that you can no longer convert `Scientific` values to + `Dhall` expressions (i.e. no `Inject` instance for `Scientific`) + * See: https://github.com/dhall-lang/dhall-haskell/pull/667 +* BREAKING CHANGE TO THE API: Preserve field order for record projection + * The API uses a new `Dhall.Set.Set` type instead of `Data.Set.Set` + * See: https://github.com/dhall-lang/dhall-haskell/pull/670 +* BREAKING CHANGE TO THE API: Add support for multi-`let` expressions + * This changes the `Let` constructor to now support storing multiple + bindings per `let` expression + * See: https://github.com/dhall-lang/dhall-haskell/pull/675 +* Access constructors as if they were fields of the union type + * In other words: `< Left : Bool | Right : Natural >.Left` + * See: https://github.com/dhall-lang/dhall-haskell/pull/657 +* Support GHC 8.6 + * See: https://github.com/dhall-lang/dhall-haskell/pull/669 +* Add support for quoted path components + * i.e. `/"foo"/bar/"baz qux"` or `https://example.com/foo/"bar?baz"?qux` + * See: https://github.com/dhall-lang/dhall-haskell/pull/690 +* Fix parsing of `//\\` operator + * See: https://github.com/dhall-lang/dhall-haskell/commit/9d0fd42d95ab69fa64da4afd8b60d69aca8e65a6 +* Preserve Unicode characters when formatting code + * See: https://github.com/dhall-lang/dhall-haskell/pull/679 +* Allow identifier names to begin with `Some` + * See: https://github.com/dhall-lang/dhall-haskell/pull/658 +* Add `subExpressions` `Traversal` + * See: https://github.com/dhall-lang/dhall-haskell/pull/660 +* Add `normalizeWithM` for monadic normalization + * See: https://github.com/dhall-lang/dhall-haskell/pull/371 +* Custom normalizers now take precedence over default normalization logic + * This allows one to override the implementation of built-in operators + * See: https://github.com/dhall-lang/dhall-haskell/pull/684 + +1.18.0 + +* Supports version 3.0.0 of the language standard: + * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v3.0.0 +* BREAKING CHANGE TO THE LANGUAGE AND API: New `Some`/`None` constructors for + `Optional` values + * Example: `[ Some 1, None Natural ]` + * This is a breaking change to the language because `Some` and `None` are + now reserved keywords + * This is a breaking change to the API because `Some` and `None` are new + constructors for the `Expr` type +* BREAKING CHANGE TO THE LANGUAGE AND API: Support for kind polymorphism + * This adds a new `Sort` constant above `Kind` in the hierarchy + * i.e. `Type : Kind : Sort` + * This is a breaking change to the language because `Sort` is now a + reserved keyword + * This is a breaking change to the API because `Sort` is a new + constructor for the `Expr` type +* BREAKING CHANGE TO THE API: New `Dhall.Map` module + * This replaces `InsOrdHashMap` in the API + * The primary motivation is to improve performance and to remove the + dependency on `insert-ordered-containers` +* BREAKING CHANGE TO THE API: Use standard version instead of protocol version + * The binary protocol is now versioned alongside the standard + * The `ProtocolVersion` type is renamed to `StandardVersion` and the + * `--protocol-version` option is renamed to `--standard-version` + * See: https://github.com/dhall-lang/dhall-haskell/pull/634 +* BUG FIX: Fix import chaining for custom header imports + * See: https://github.com/dhall-lang/dhall-haskell/pull/618 +* BUG FIX: Fix import chaining for imports protected by semantic integrity + checks + * See: https://github.com/dhall-lang/dhall-haskell/pull/584 +* BUG FIX: Record literals and types produced by `∧`/`⫽`/`⩓` are now sorted + * This ensures that β-normalization is idempotent + * See: https://github.com/dhall-lang/dhall-haskell/pull/572 +* BUG FIX: `dhall freeze` now correctly handles the starting file being + located outside the current working directory + * See: https://github.com/dhall-lang/dhall-haskell/commit/a22aa79d1957be9ecf166ea066e2a9a5b309e1ae +* BUG FIX: Fix parsing of IPv4-mapped IPv6 addresses + * See: https://github.com/dhall-lang/dhall-haskell/pull/632 +* FEATURE: New `--ascii` flag for ASCII output + * See: https://github.com/dhall-lang/dhall-haskell/pull/570 +* FEATURE: New `dhall encode` and `dhall decode` subcommands + * These allow you to transform Dhall source code to and from its binary + representation + * See: https://github.com/dhall-lang/dhall-haskell/pull/588 +* LARGE parsing performance improvements + * Parsing is about 10x-100x faster on most code + * See: https://github.com/dhall-lang/dhall-haskell/pull/591 + * See: https://github.com/dhall-lang/dhall-haskell/pull/592 + * See: https://github.com/dhall-lang/dhall-haskell/pull/597 + * See: https://github.com/dhall-lang/dhall-haskell/pull/601 + * See: https://github.com/dhall-lang/dhall-haskell/pull/602 + * See: https://github.com/dhall-lang/dhall-haskell/pull/604 + * See: https://github.com/dhall-lang/dhall-haskell/pull/606 +* Type-checking performance improvements: + * See: https://github.com/dhall-lang/dhall-haskell/pull/566 +* Normalization performance improvements: + * See: https://github.com/dhall-lang/dhall-haskell/pull/610 +* `dhall freeze` now caches the imports as it freezes them + * See: https://github.com/dhall-lang/dhall-haskell/pull/587 +* `dhall freeze` now refreezes imports with invalid semantic integrity checks + * See: https://github.com/dhall-lang/dhall-haskell/pull/637 +* `dhall freeze` now adds a trailing newline + * See: https://github.com/dhall-lang/dhall-haskell/pull/629 +* Build against `megaparsec-7.0.*` + * See: https://github.com/dhall-lang/dhall-haskell/pull/565 +* Support GHC 8.6 + * See: https://github.com/dhall-lang/dhall-haskell/pull/599 + * See: https://github.com/dhall-lang/dhall-haskell/pull/623 +* Support GHC all the way back to 7.10.3 + * See: https://github.com/dhall-lang/dhall-haskell/pull/595 + * See: https://github.com/dhall-lang/dhall-haskell/pull/621 +* Improvements to error messages: + * See: https://github.com/dhall-lang/dhall-haskell/pull/563 + * See: https://github.com/dhall-lang/dhall-haskell/pull/576 + * See: https://github.com/dhall-lang/dhall-haskell/pull/583 + * See: https://github.com/dhall-lang/dhall-haskell/pull/589 + + +1.17.0 + +* This release corresponds to version 2.0.0 of the language standard +* BREAKING CHANGE TO THE LANGUAGE AND API: Binary serialization support + * This is a breaking change to the hash for all semantic integrity checks + * The hash used by the semantic integrity check is now based on the + binary representation instead of a text representation of the + expression + * You can pin the new hashes by supplying the `--protocol-version 1.0` + option on the command line until you need support for newer language + features + * This also includes a breaking change to `ImportType` in the API +* BREAKING CHANGE TO THE LANGUAGE: Disallow combining records of terms and + types + * This is mainly for consistency and to improve type errors that would + have otherwise happened further downstream + * This should not affect the vast majority of code + * See: https://github.com/dhall-lang/dhall-haskell/pull/538 +* BUG FIX: Semantic integrity checks now work for imported expression using + the `constructors` keyword + * See: https://github.com/dhall-lang/dhall-haskell/pull/554 +* BUG FIX: Fix α-normalization of expressions with bound variables named `_` + * See: https://github.com/dhall-lang/dhall-haskell/pull/524 +* BUG FIX: Fix `isNormalized` to match `normalize` + * See: https://github.com/dhall-lang/dhall-haskell/pull/522 +* BUG FIX: `dhall lint` now correctly handles nested `let` expressions + * See: https://github.com/dhall-lang/dhall-haskell/pull/555 +* FEATURE: Imports protected by a semantic integrity check are now cached + * See: https://github.com/dhall-lang/dhall-haskell/pull/533 +* The default `dhall` command no longer outputs the type to `stderr` + * You can add back the type as a type annotation using the + `--annotate` switch + * See: https://github.com/dhall-lang/dhall-haskell/pull/544 +* New utilities for building `InputTypes` + * See: https://github.com/dhall-lang/dhall-haskell/pull/530 +* Improve parsing performance for long variable names + * See: https://github.com/dhall-lang/dhall-haskell/pull/526 +* More succinct type diffs for function types + * See: https://github.com/dhall-lang/dhall-haskell/pull/540 +* Identifier names can now begin with keywords + * i.e. `ifChanged` and `lettuce` are now legal identifiers + * See: https://github.com/dhall-lang/dhall-haskell/pull/551 + +1.16.1 + +* Fix test failure due to missing test data file + +1.16.0 + +* BREAKING CHANGE: Consolidate `input` family of functions + * These now take a record of options + * This also `_stack` field of the `Status` type from `[Import]` to + `NonEmpty Import` +* Permit `$` in quoted variable names + * See: https://github.com/dhall-lang/dhall-haskell/pull/510 + +1.15.1 + +* Fix infinite loop when formatting expressions containing `?` + * See: https://github.com/dhall-lang/dhall-haskell/pull/491 + +1.15.0 + +* BREAKING CHANGE TO THE API: Support alternative imports using new `?` operator + * This adds a new constructor which affects exhaustive pattern matches + * See: https://github.com/dhall-lang/dhall-haskell/pull/473 +* BREAKING CHANGE TO THE API: Add `Integer/toDouble` built-in function + * This adds a new constructor which affects exhaustive pattern matches + * See: https://github.com/dhall-lang/dhall-haskell/pull/434 +* BREAKING CHANGE TO THE API: Use strict `Text` instead of lazy `Text` + * See: https://github.com/dhall-lang/dhall-haskell/pull/455 +* BREAKING CHANGE TO THE API: Remove `Buildable` in favor of `Pretty` + * See: https://github.com/dhall-lang/dhall-haskell/pull/459 +* BREAKING CHANGE TO THE API: Removed the `Parent` constructor from `FilePrefix` + * Instead, use `Here` with a `".."` prefix. + * See: https://github.com/dhall-lang/dhall-haskell/pull/407 +* BUG FIX: Disallow duplicate fields in records + * See: https://github.com/dhall-lang/dhall-haskell/pull/430 +* BUG FIX: Fix stripping of leading whitespace in multi-line strings + * See: https://github.com/dhall-lang/dhall-haskell/pull/469 +* BUG FIX: Fix formatting field access of an import + * See: https://github.com/dhall-lang/dhall-haskell/pull/471 +* Add `dhall freeze` command + * See: https://github.com/dhall-lang/dhall-haskell/pull/486 +* Add `dhall diff` command + * See: https://github.com/dhall-lang/dhall-haskell/pull/442 +* Add `dhall lint` command + * See: https://github.com/dhall-lang/dhall-haskell/pull/484 +* Change `dhall-repl`/`dhall-hash`/`dhall-format` to `dhall` subcommands + * i.e. `dhall repl`/`dhall hash`/`dhall format` + * See: https://github.com/dhall-lang/dhall-haskell/pull/435 + * See: https://github.com/dhall-lang/dhall-haskell/pull/452 +* Add `with-http` cabal flag to disable support for remote imports + * See: https://github.com/dhall-lang/dhall-haskell/pull/482 +* Added `inputFrom` and `inputFromWith` + * These allow naming the file that the expression is coming from for better + error messages + * See: https://github.com/dhall-lang/dhall-haskell/pull/464 +* Performance improvements + * See: https://github.com/dhall-lang/dhall-haskell/pull/420 +* Tutorial recommends GitHub for Prelude instead of IPFS + * See: https://github.com/dhall-lang/dhall-haskell/pull/479 +* Pretty-print expressions in type errors + * See: https://github.com/dhall-lang/dhall-haskell/pull/429 +* Formatting improvements + * See: https://github.com/dhall-lang/dhall-haskell/pull/398 + * See: https://github.com/dhall-lang/dhall-haskell/pull/458 +* Diff improvements + * See: https://github.com/dhall-lang/dhall-haskell/pull/455 + * See: https://github.com/dhall-lang/dhall-haskell/pull/470 + * See: https://github.com/dhall-lang/dhall-haskell/pull/478 + +1.14.0 + +* BREAKING CHANGE TO THE LANGUAGE: Switch grammar of `Natural` and `Integer` + * `Natural` number literals are now unsigned and `Integer` literals always + require a sign + * This is a **VERY** disruptive change to most Dhall code in the wild but + was unanimously agreed upon here: + https://github.com/dhall-lang/dhall-lang/issues/138 + * See also: https://github.com/dhall-lang/dhall-haskell/pull/381 +* BREAKING CHANGE TO THE LANGUAGE: Drop support for importing directories + * Importing `dir/` used to resolve to `dir/@`, which is no longer supported + * See: https://github.com/dhall-lang/dhall-haskell/pull/384 +* BREAKING CHANGE TO THE LANGUAGE: Change to the grammar for imports + * File path components can no longer contain `#` or `?` characters + * URL imports must now contain at least one path component + * URL path components must match the grammar for file path components + * See: https://github.com/dhall-lang/dhall-haskell/pull/390 +* BREAKING CHANGE TO THE API: Rename `Path{,Mode,Hashed,Type}` to + `Import{,Mode,Hashed,Type}` + * In practice this change is not breaking for the most common use cases + since this also provides a `Path` type synonym for backwards compatibility + * See: https://github.com/dhall-lang/dhall-haskell/pull/376 +* BUG FIX: Fix α-equivalence bug when type-checking `merge` + * `merge` expressions would sometimes reject valid code due to a + type-checking bug + * See: https://github.com/dhall-lang/dhall-haskell/pull/394 +* Improve import caching + * See: https://github.com/dhall-lang/dhall-haskell/pull/388 + * See: https://github.com/dhall-lang/dhall-haskell/pull/392 +* Increase upper bound on `tasty` + * See: https://github.com/dhall-lang/dhall-haskell/pull/382 +* Fix lower bound on `insert-ordered-containers` + * See: https://github.com/dhall-lang/dhall-haskell/pull/377 + +1.13.1 + +* Increase upper bound on `ansi-terminal` and `megaparsec` + +1.13.0 + +* BUG FIX: Fix semantic integrity hashing support + * Both parsing and pretty-printing semantic hashes were broken since version + 1.11.0 + * See: https://github.com/dhall-lang/dhall-haskell/pull/345 +* BUG FIX: Allow leading whitespace in interpolated expresssions + * See: https://github.com/dhall-lang/dhall-haskell/pull/369 +* BUG FIX: Fix `deriving (Interpret)` for sum types + * The types of alternatives were not correctly included in the corresponding + Dhall type + * See: https://github.com/dhall-lang/dhall-haskell/pull/348 +* BREAKING CHANGE TO LANGUAGE: Records cannot store both types and terms + * Records can also not store type-level functions (like `List`) + * Records might be allowed to store type-level functions again in the + future + * This fixes a potential soundness bug + * The primarily practical consequence of this change is that if you are + hosting a "package" then you will need to split terms and types from your + package into different records for your users to import + * This also implies removing the `./Monoid` type-level function from the + `./Prelude/package.dhall` record + * See: https://github.com/dhall-lang/dhall-haskell/pull/335 +* BREAKING CHANGE TO THE API: Replace `trifecta` with `megaparsec` + * This change the API to use the `Parser` type from `megaparsec` + * This also slightly changes the type of `exprFromText` + * If you program using the type classes provided by the `parsers` library + then this is not a breaking change as that interface is preserved + * See: https://github.com/dhall-lang/dhall-haskell/pull/268 +* BREAKING CHANGE TO THE API: New `⩓` operator for merging record types + * Example: `{ foo : Text } ⩓ { bar : Bool } = { foo : Text, bar : Bool }` + * This is breaking because it adds a new constructor to the `Expr` type + * See: https://github.com/dhall-lang/dhall-haskell/pull/342 +* BREAKING CHANGE TO THE API: New support for projecting a subset of fields + * Example: `{ x = 1, y = 2, z = 3 }.{ x, y } = { x = 1, y = 2 }` + * This is breaking because it adds a new constructor to the `Expr` type + * See: https://github.com/dhall-lang/dhall-haskell/pull/350 +* API+UX feature: New support for pretty-printing diffs of Dhall expressions + * Error messages also use this feature to simplify large type mismatches + * There is also a new `Dhall.Diff` module + * See: https://github.com/dhall-lang/dhall-haskell/pull/336 +* Add `version`, `resolve`, `type`, and `normalize` sub-commands to interpreter + * See: https://github.com/dhall-lang/dhall-haskell/pull/352 +* Support GHC 7.10.3 + * See: https://github.com/dhall-lang/dhall-haskell/pull/340 +* `:type` command in `dhall-repl` now only displays the type + * Before it would also display the original expression + * See: https://github.com/dhall-lang/dhall-haskell/pull/344 +* Trim dependency tree + * See: https://github.com/dhall-lang/dhall-haskell/pull/351 + * See: https://github.com/dhall-lang/dhall-haskell/pull/268 + * See: https://github.com/dhall-lang/dhall-haskell/pull/355 + +1.12.0 + +* Additional changes to support GHC 8.4 + * See: https://github.com/dhall-lang/dhall-haskell/pull/331 +* BREAKING CHANGE TO API: Replace dependency on `text-format` with `formatting` + * This replace the `Data.Text.Buildable.Buildable` instances with + `Formatting.Buildable.Buildable` instances, which is why this is a + breaking change + * `text-format` is no longer maintained and blocking GHC 8.4 support + * See: https://github.com/dhall-lang/dhall-haskell/pull/330 + 1.11.1 * Support GHC 8.4 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,24 +1,27 @@ -Copyright (c) 2017 Gabriel Gonzalez +Copyright (c) 2020 Gabriella Gonzalez All rights reserved. -Redistribution and use in source and binary forms, with or without modification, -are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - * Neither the name of Gabriel Gonzalez nor the names of other contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON -ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Prelude/Bool/and b/Prelude/Bool/and deleted file mode 100644 --- a/Prelude/Bool/and +++ /dev/null @@ -1,18 +0,0 @@ -{- -The `and` function returns `False` if there are any `False` elements in the -`List` and returns `True` otherwise - -Examples: - -``` -./and [ True, False, True ] = False - -./and ([] : List Bool) = True -``` --} - let and - : List Bool → Bool - = λ(xs : List Bool) - → List/fold Bool xs Bool (λ(l : Bool) → λ(r : Bool) → l && r) True - -in and diff --git a/Prelude/Bool/build b/Prelude/Bool/build deleted file mode 100644 --- a/Prelude/Bool/build +++ /dev/null @@ -1,17 +0,0 @@ -{- -`build` is the inverse of `fold` - -Examples: - -``` -./build (λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) = True - -./build (λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) = False -``` --} - let build - : (∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) → Bool - = λ(f : ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) - → f Bool True False - -in build diff --git a/Prelude/Bool/even b/Prelude/Bool/even deleted file mode 100644 --- a/Prelude/Bool/even +++ /dev/null @@ -1,22 +0,0 @@ -{- -Returns `True` if there are an even number of `False` elements in the list and -returns `False` otherwise - -Examples: - -``` -./even [ False, True, False ] = True - -./even [ False, True ] = False - -./even [ False ] = False - -./even ([] : List Bool) = True -``` --} - let even - : List Bool → Bool - = λ(xs : List Bool) - → List/fold Bool xs Bool (λ(x : Bool) → λ(y : Bool) → x == y) True - -in even diff --git a/Prelude/Bool/fold b/Prelude/Bool/fold deleted file mode 100644 --- a/Prelude/Bool/fold +++ /dev/null @@ -1,20 +0,0 @@ -{- -`fold` is essentially the same as `if`/`then`/else` except as a function - -Examples: - -``` -./fold True Integer 0 1 = 0 - -./fold False Integer 0 1 = 1 -``` --} - let fold - : ∀(b : Bool) → ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool - = λ(b : Bool) - → λ(bool : Type) - → λ(true : bool) - → λ(false : bool) - → if b then true else false - -in fold diff --git a/Prelude/Bool/not b/Prelude/Bool/not deleted file mode 100644 --- a/Prelude/Bool/not +++ /dev/null @@ -1,12 +0,0 @@ -{- -Flip the value of a `Bool` - -Examples: - -``` -./not True = False - -./not False = True -``` --} -let not : Bool → Bool = λ(b : Bool) → b == False in not diff --git a/Prelude/Bool/odd b/Prelude/Bool/odd deleted file mode 100644 --- a/Prelude/Bool/odd +++ /dev/null @@ -1,22 +0,0 @@ -{- -Returns `True` if there are an odd number of `True` elements in the list and -returns `False` otherwise - -Examples: - -``` -./odd [ True, False, True ] = False - -./odd [ True, False ] = True - -./odd [ True ] = True - -./odd ([] : List Bool) = False -``` --} - let odd - : List Bool → Bool - = λ(xs : List Bool) - → List/fold Bool xs Bool (λ(x : Bool) → λ(y : Bool) → x != y) False - -in odd diff --git a/Prelude/Bool/or b/Prelude/Bool/or deleted file mode 100644 --- a/Prelude/Bool/or +++ /dev/null @@ -1,18 +0,0 @@ -{- -The `or` function returns `True` if there are any `True` elements in the `List` -and returns `False` otherwise - -Examples: - -``` -./or [ True, False, True ] = True - -./or ([] : List Bool) = False -``` --} - let or - : List Bool → Bool - = λ(xs : List Bool) - → List/fold Bool xs Bool (λ(l : Bool) → λ(r : Bool) → l || r) False - -in or diff --git a/Prelude/Bool/show b/Prelude/Bool/show deleted file mode 100644 --- a/Prelude/Bool/show +++ /dev/null @@ -1,13 +0,0 @@ -{- -Render a `Bool` as `Text` using the same representation as Dhall source code -(i.e. beginning with a capital letter) - -Examples: - -``` -./show True = "True" - -./show False = "False" -``` --} -let show : Bool → Text = λ(b : Bool) → if b then "True" else "False" in show diff --git a/Prelude/Double/show b/Prelude/Double/show deleted file mode 100644 --- a/Prelude/Double/show +++ /dev/null @@ -1,13 +0,0 @@ -{- -Render a `Double` as `Text` using the same representation as Dhall source -code (i.e. a decimal floating point number with a leading `-` sign if negative) - -Examples: - -``` -./show -3.1 = "-3.1" - -./show 0.4 = "0.4" -``` --} -let show : Double → Text = Double/show in show diff --git a/Prelude/Integer/show b/Prelude/Integer/show deleted file mode 100644 --- a/Prelude/Integer/show +++ /dev/null @@ -1,13 +0,0 @@ -{- -Render an `Integer` as `Text` using the same representation as Dhall source -code (i.e. a decimal number with a leading `-` sign if negative) - -Examples: - -``` -./show -3 = "-3" - -./show 0 = "0" -``` --} -let show : Integer → Text = Integer/show in show diff --git a/Prelude/List/all b/Prelude/List/all deleted file mode 100644 --- a/Prelude/List/all +++ /dev/null @@ -1,20 +0,0 @@ -{- -Returns `True` if the supplied function returns `True` for all elements in the -`List` - -Examples: - -``` -./all Natural Natural/even [ +2, +3, +5 ] = False - -./all Natural Natural/even ([] : List Natural) = True -``` --} - let all - : ∀(a : Type) → (a → Bool) → List a → Bool - = λ(a : Type) - → λ(f : a → Bool) - → λ(xs : List a) - → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x && r) True - -in all diff --git a/Prelude/List/any b/Prelude/List/any deleted file mode 100644 --- a/Prelude/List/any +++ /dev/null @@ -1,20 +0,0 @@ -{- -Returns `True` if the supplied function returns `True` for any element in the -`List` - -Examples: - -``` -./any Natural Natural/even [ +2, +3, +5 ] = True - -./any Natural Natural/even ([] : List Natural) = False -``` --} - let any - : ∀(a : Type) → (a → Bool) → List a → Bool - = λ(a : Type) - → λ(f : a → Bool) - → λ(xs : List a) - → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False - -in any diff --git a/Prelude/List/build b/Prelude/List/build deleted file mode 100644 --- a/Prelude/List/build +++ /dev/null @@ -1,32 +0,0 @@ -{- -`build` is the inverse of `fold` - -Examples: - -``` -./build -Text -( λ(list : Type) -→ λ(cons : Text → list → list) -→ λ(nil : list) -→ cons "ABC" (cons "DEF" nil) -) -= [ "ABC", "DEF" ] - -./build -Text -( λ(list : Type) -→ λ(cons : Text → list → list) -→ λ(nil : list) -→ nil -) -= [] : List Text -``` --} - let build - : ∀(a : Type) - → (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) - → List a - = List/build - -in build diff --git a/Prelude/List/concat b/Prelude/List/concat deleted file mode 100644 --- a/Prelude/List/concat +++ /dev/null @@ -1,42 +0,0 @@ -{- -Concatenate a `List` of `List`s into a single `List` - -Examples: - -``` -./concat Integer -[ [0, 1, 2] -, [3, 4] -, [5, 6, 7, 8] -] -= [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] - -./concat Integer -( [ [] : List Integer - , [] : List Integer - , [] : List Integer - ] -) -= [] : List Integer - -./concat Integer ([] : List (List Integer)) = [] : List Integer -``` --} - let concat - : ∀(a : Type) → List (List a) → List a - = λ(a : Type) - → λ(xss : List (List a)) - → List/build - a - ( λ(list : Type) - → λ(cons : a → list → list) - → λ(nil : list) - → List/fold - (List a) - xss - list - (λ(xs : List a) → λ(ys : list) → List/fold a xs list cons ys) - nil - ) - -in concat diff --git a/Prelude/List/concatMap b/Prelude/List/concatMap deleted file mode 100644 --- a/Prelude/List/concatMap +++ /dev/null @@ -1,28 +0,0 @@ -{- -Transform a list by applying a function to each element and flattening the -results - -Examples: - -``` -./concatMap Natural Natural (λ(n : Natural) → [n, n]) [+2, +3, +5] -= [ +2, +2, +3, +3, +5, +5 ] - -./concatMap Natural Natural (λ(n : Natural) → [n, n]) ([] : List Natural) -= [] : List Natural -``` --} - let concatMap - : ∀(a : Type) → ∀(b : Type) → (a → List b) → List a → List b - = λ(a : Type) - → λ(b : Type) - → λ(f : a → List b) - → λ(xs : List a) - → List/build - b - ( λ(list : Type) - → λ(cons : b → list → list) - → List/fold a xs list (λ(x : a) → List/fold b (f x) list cons) - ) - -in concatMap diff --git a/Prelude/List/filter b/Prelude/List/filter deleted file mode 100644 --- a/Prelude/List/filter +++ /dev/null @@ -1,30 +0,0 @@ -{- -Only keep elements of the list where the supplied function returns `True` - -Examples: - -``` -./filter Natural Natural/even [+2, +3, +5] -= [ +2 ] - -./filter Natural Natural/odd [+2, +3, +5] -= [ +3, +5 ] -``` --} - let filter - : ∀(a : Type) → (a → Bool) → List a → List a - = λ(a : Type) - → λ(f : a → Bool) - → λ(xs : List a) - → List/build - a - ( λ(list : Type) - → λ(cons : a → list → list) - → List/fold - a - xs - list - (λ(x : a) → λ(xs : list) → if f x then cons x xs else xs) - ) - -in filter diff --git a/Prelude/List/fold b/Prelude/List/fold deleted file mode 100644 --- a/Prelude/List/fold +++ /dev/null @@ -1,46 +0,0 @@ -{- -`fold` is the primitive function for consuming `List`s - -If you treat the list `[ x, y, z ]` as `cons x (cons y (cons z nil))`, then a -`fold` just replaces each `cons` and `nil` with something else - -Examples: - -``` - ./fold - Natural - [ +2, +3, +5 ] - Natural - (λ(x : Natural) → λ(y : Natural) → x + y) - +0 -= +10 - - λ(nil : Natural) -→ ./fold - Natural - [ +2, +3, +5 ] - Natural - (λ(x : Natural) → λ(y : Natural) → x + y) - nil -= λ(nil : Natural) → +2 + +3 + +5 + nil - - λ(list : Type) -→ λ(cons : Natural → list → list) -→ λ(nil : list) -→ ./fold Natural [ +2, +3, +5 ] list cons nil -= λ(list : Type) -→ λ(cons : Natural → list → list) -→ λ(nil : list) -→ cons +2 (cons +3 (cons +5 nil)) -``` --} - let fold - : ∀(a : Type) - → List a - → ∀(list : Type) - → ∀(cons : a → list → list) - → ∀(nil : list) - → list - = List/fold - -in fold diff --git a/Prelude/List/generate b/Prelude/List/generate deleted file mode 100644 --- a/Prelude/List/generate +++ /dev/null @@ -1,38 +0,0 @@ -{- -Build a list by calling the supplied function on all `Natural` numbers from `+0` -up to but not including the supplied `Natural` number - -Examples: - -``` -./generate +5 Bool Natural/even = [ True, False, True, False, True ] - -./generate +0 Bool Natural/even = [] : List Bool -``` --} - let generate - : Natural → ∀(a : Type) → (Natural → a) → List a - = λ(n : Natural) - → λ(a : Type) - → λ(f : Natural → a) - → List/build - a - ( λ(list : Type) - → λ(cons : a → list → list) - → List/fold - { index : Natural, value : {} } - ( List/indexed - {} - ( List/build - {} - ( λ(list : Type) - → λ(cons : {} → list → list) - → Natural/fold n list (cons {=}) - ) - ) - ) - list - (λ(x : { index : Natural, value : {} }) → cons (f x.index)) - ) - -in generate diff --git a/Prelude/List/head b/Prelude/List/head deleted file mode 100644 --- a/Prelude/List/head +++ /dev/null @@ -1,12 +0,0 @@ -{- -Retrieve the first element of the list - -Examples: - -``` -./head Integer [ 0, 1, 2 ] = [ 0 ] : Optional Integer - -./head Integer ([] : List Integer) = [] : Optional Integer -``` --} -let head : ∀(a : Type) → List a → Optional a = List/head in head diff --git a/Prelude/List/indexed b/Prelude/List/indexed deleted file mode 100644 --- a/Prelude/List/indexed +++ /dev/null @@ -1,21 +0,0 @@ -{- -Tag each element of the list with its index - -Examples: - -``` -./indexed Bool [ True, False, True ] -= [ { index = +0, value = True } - , { index = +1, value = False } - , { index = +2, value = True } - ] : List { index : Natural, value : Bool } - -./indexed Bool ([] : List Bool) -= [] : List { index : Natural, value : Bool } -``` --} - let indexed - : ∀(a : Type) → List a → List { index : Natural, value : a } - = List/indexed - -in indexed diff --git a/Prelude/List/iterate b/Prelude/List/iterate deleted file mode 100644 --- a/Prelude/List/iterate +++ /dev/null @@ -1,43 +0,0 @@ -{- -Generate a list of the specified length given a seed value and transition -function - -Examples: - -``` -./iterate +10 Natural (λ(x : Natural) → x * +2) +1 -= [ +1, +2, +4, +8, +16, +32, +64, +128, +256, +512 ] - -./iterate +0 Natural (λ(x : Natural) → x * +2) +1 -= [] : List Natural -``` --} - let iterate - : Natural → ∀(a : Type) → (a → a) → a → List a - = λ(n : Natural) - → λ(a : Type) - → λ(f : a → a) - → λ(x : a) - → List/build - a - ( λ(list : Type) - → λ(cons : a → list → list) - → List/fold - { index : Natural, value : {} } - ( List/indexed - {} - ( List/build - {} - ( λ(list : Type) - → λ(cons : {} → list → list) - → Natural/fold n list (cons {=}) - ) - ) - ) - list - ( λ(y : { index : Natural, value : {} }) - → cons (Natural/fold y.index a f x) - ) - ) - -in iterate diff --git a/Prelude/List/last b/Prelude/List/last deleted file mode 100644 --- a/Prelude/List/last +++ /dev/null @@ -1,12 +0,0 @@ -{- -Retrieve the last element of the list - -Examples: - -``` -./last Integer [ 0, 1, 2 ] = [ 2 ] : Optional Integer - -./last Integer ([] : List Integer) = [] : Optional Integer -``` --} -let last : ∀(a : Type) → List a → Optional a = List/last in last diff --git a/Prelude/List/length b/Prelude/List/length deleted file mode 100644 --- a/Prelude/List/length +++ /dev/null @@ -1,12 +0,0 @@ -{- -Returns the number of elements in a list - -Examples: - -``` -./length Integer [ 0, 1, 2 ] = +3 - -./length Integer ([] : List Integer) = +0 -``` --} -let length : ∀(a : Type) → List a → Natural = List/length in length diff --git a/Prelude/List/map b/Prelude/List/map deleted file mode 100644 --- a/Prelude/List/map +++ /dev/null @@ -1,27 +0,0 @@ -{- -Transform a list by applying a function to each element - -Examples: - -``` -./map Natural Bool Natural/even [ +2, +3, +5 ] -= [ True, False, False ] - -./map Natural Bool Natural/even ([] : List Natural) -= [] : List Bool -``` --} - let map - : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b - = λ(a : Type) - → λ(b : Type) - → λ(f : a → b) - → λ(xs : List a) - → List/build - b - ( λ(list : Type) - → λ(cons : b → list → list) - → List/fold a xs list (λ(x : a) → cons (f x)) - ) - -in map diff --git a/Prelude/List/null b/Prelude/List/null deleted file mode 100644 --- a/Prelude/List/null +++ /dev/null @@ -1,16 +0,0 @@ -{- -Returns `True` if the `List` is empty and `False` otherwise - -Examples: - -``` -./null Integer [ 0, 1, 2 ] = False - -./null Integer ([] : List Integer) = True -``` --} - let null - : ∀(a : Type) → List a → Bool - = λ(a : Type) → λ(xs : List a) → Natural/isZero (List/length a xs) - -in null diff --git a/Prelude/List/replicate b/Prelude/List/replicate deleted file mode 100644 --- a/Prelude/List/replicate +++ /dev/null @@ -1,24 +0,0 @@ -{- -Build a list by copying the given element the specified number of times - -Examples: - -``` -./replicate +9 Integer 1 = [ 1, 1, 1, 1, 1, 1, 1, 1, 1 ] - -./replicate +0 Integer 1 = [] : List Integer -``` --} - let replicate - : Natural → ∀(a : Type) → a → List a - = λ(n : Natural) - → λ(a : Type) - → λ(x : a) - → List/build - a - ( λ(list : Type) - → λ(cons : a → list → list) - → Natural/fold n list (cons x) - ) - -in replicate diff --git a/Prelude/List/reverse b/Prelude/List/reverse deleted file mode 100644 --- a/Prelude/List/reverse +++ /dev/null @@ -1,12 +0,0 @@ -{- -Reverse a list - -Examples: - -``` -./reverse Integer [ 0, 1, 2 ] = [ 2, 1, 0 ] : List Integer - -./reverse Integer ([] : List Integer) = [] : List Integer -``` --} -let reverse : ∀(a : Type) → List a → List a = List/reverse in reverse diff --git a/Prelude/List/shifted b/Prelude/List/shifted deleted file mode 100644 --- a/Prelude/List/shifted +++ /dev/null @@ -1,87 +0,0 @@ -{- -Combine a `List` of `List`s, offsetting the `index` of each element by the -number of elements in preceding lists - -Examples: - -``` -./shifted -Bool -[ [ { index = +0, value = True } - , { index = +1, value = True } - , { index = +2, value = True } - ] -, [ { index = +0, value = False } - , { index = +1, value = False } - ] -, [ { index = +0, value = True } - , { index = +1, value = True } - , { index = +2, value = True } - , { index = +3, value = True } - ] -] -= [ { index = +0, value = True } - , { index = +1, value = True } - , { index = +2, value = True } - , { index = +3, value = False } - , { index = +4, value = False } - , { index = +5, value = True } - , { index = +6, value = True } - , { index = +7, value = True } - , { index = +8, value = True } - ] - -./shifted Bool ([] : List (List { index : Natural, value : Bool })) -= [] : List { index : Natural, value : Bool } -``` --} - let shifted - : ∀(a : Type) - → List (List { index : Natural, value : a }) - → List { index : Natural, value : a } - = λ(a : Type) - → λ(kvss : List (List { index : Natural, value : a })) - → List/build - { index : Natural, value : a } - ( λ(list : Type) - → λ(cons : { index : Natural, value : a } → list → list) - → λ(nil : list) - → let result = - List/fold - (List { index : Natural, value : a }) - kvss - { count : Natural, diff : Natural → list } - ( λ(kvs : List { index : Natural, value : a }) - → λ(y : { count : Natural, diff : Natural → list }) - → let length = - List/length - { index : Natural, value : a } - kvs - - in { count = y.count + length - , diff = - λ(n : Natural) - → List/fold - { index : Natural, value : a } - kvs - list - ( λ ( kvOld - : { index : Natural, value : a } - ) - → λ(z : list) - → let kvNew = - { index = kvOld.index + n - , value = kvOld.value - } - - in cons kvNew z - ) - (y.diff (n + length)) - } - ) - { count = +0, diff = λ(_ : Natural) → nil } - - in result.diff +0 - ) - -in shifted diff --git a/Prelude/List/unzip b/Prelude/List/unzip deleted file mode 100644 --- a/Prelude/List/unzip +++ /dev/null @@ -1,55 +0,0 @@ -{- -Unzip a `List` into two separate `List`s - -Examples: - -``` -./unzip -Text -Bool -( [ { _1 = "ABC", _2 = True } - , { _1 = "DEF", _2 = False } - , { _1 = "GHI", _2 = True } - ] -) -= { _1 = [ "ABC", "DEF", "GHI" ] - , _2 = [ True, False, True ] - } - -./unzip Text Bool ([] : List { _1 : Text, _2 : Bool }) -= { _1 = [] : List Text, _2 = [] : List Bool } -``` --} - let unzip - : ∀(a : Type) - → ∀(b : Type) - → List { _1 : a, _2 : b } - → { _1 : List a, _2 : List b } - = λ(a : Type) - → λ(b : Type) - → λ(xs : List { _1 : a, _2 : b }) - → { _1 = - List/build - a - ( λ(list : Type) - → λ(cons : a → list → list) - → List/fold - { _1 : a, _2 : b } - xs - list - (λ(x : { _1 : a, _2 : b }) → cons x._1) - ) - , _2 = - List/build - b - ( λ(list : Type) - → λ(cons : b → list → list) - → List/fold - { _1 : a, _2 : b } - xs - list - (λ(x : { _1 : a, _2 : b }) → cons x._2) - ) - } - -in unzip diff --git a/Prelude/Monoid b/Prelude/Monoid deleted file mode 100644 --- a/Prelude/Monoid +++ /dev/null @@ -1,39 +0,0 @@ -{- -Any function `f` that is a `Monoid` must satisfy the following law: - -``` -t : Type -f : ./Monoid t -xs : List (List t) - -f (./List/concat t xs) = f (./map (List t) t f xs) -``` - -Examples: - -``` -./Bool/and - : ./Monoid Bool -./Bool/or - : ./Monoid Bool -./Bool/even - : ./Monoid Bool -./Bool/odd - : ./Monoid Bool -./List/concat - : ∀(a : Type) → ./Monoid (List a) -./List/shifted - : ∀(a : Type) → ./Monoid (List { index : Natural, value : a }) -./Natural/sum - : ./Monoid Natural -./Natural/product - : ./Monoid Natural -./Optional/head - : ∀(a : Type) → ./Monoid (Optional a) -./Optional/last - : ∀(a : Type) → ./Monoid (Optional a) -./Text/concat - : ./Monoid Text -``` --} -let Monoid : ∀(m : Type) → Type = λ(m : Type) → List m → m in Monoid diff --git a/Prelude/Natural/build b/Prelude/Natural/build deleted file mode 100644 --- a/Prelude/Natural/build +++ /dev/null @@ -1,33 +0,0 @@ -{- -`build` is the inverse of `fold` - -Examples: - -``` -./build -( λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ succ (succ (succ zero)) -) -= +3 - -./build -( λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ zero -) -= +0 -``` --} - let build - : ( ∀(natural : Type) - → ∀(succ : natural → natural) - → ∀(zero : natural) - → natural - ) - → Natural - = Natural/build - -in build diff --git a/Prelude/Natural/enumerate b/Prelude/Natural/enumerate deleted file mode 100644 --- a/Prelude/Natural/enumerate +++ /dev/null @@ -1,36 +0,0 @@ -{- -Generate a list of numbers from `+0` up to but not including the specified -number - -Examples: - -``` -./enumerate +10 = [ +0, +1, +2, +3, +4, +5, +6, +7, +8, +9 ] - -./enumerate +0 = [] : List Natural -``` --} - let enumerate - : Natural → List Natural - = λ(n : Natural) - → List/build - Natural - ( λ(list : Type) - → λ(cons : Natural → list → list) - → List/fold - { index : Natural, value : {} } - ( List/indexed - {} - ( List/build - {} - ( λ(list : Type) - → λ(cons : {} → list → list) - → Natural/fold n list (cons {=}) - ) - ) - ) - list - (λ(x : { index : Natural, value : {} }) → cons x.index) - ) - -in enumerate diff --git a/Prelude/Natural/even b/Prelude/Natural/even deleted file mode 100644 --- a/Prelude/Natural/even +++ /dev/null @@ -1,12 +0,0 @@ -{- -Returns `True` if a number if even and returns `False` otherwise - -Examples: - -``` -./even +3 = False - -./even +0 = True -``` --} -let even : Natural → Bool = Natural/even in even diff --git a/Prelude/Natural/fold b/Prelude/Natural/fold deleted file mode 100644 --- a/Prelude/Natural/fold +++ /dev/null @@ -1,33 +0,0 @@ -{- -`fold` is the primitive function for consuming `Natural` numbers - -If you treat the number `+3` as `succ (succ (succ zero))` then a `fold` just -replaces each `succ` and `zero` with something else - -Examples: - -``` -./fold +3 Natural (λ(x : Natural) → +5 * x) +1 = +125 - -λ(zero : Natural) → ./fold +3 Natural (λ(x : Natural) → +5 * x) zero -= λ(zero : Natural) → +5 * +5 * +5 * zero - - λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ ./fold +3 natural succ zero -= λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ succ (succ (succ zero)) -``` --} - let fold - : Natural - → ∀(natural : Type) - → ∀(succ : natural → natural) - → ∀(zero : natural) - → natural - = Natural/fold - -in fold diff --git a/Prelude/Natural/isZero b/Prelude/Natural/isZero deleted file mode 100644 --- a/Prelude/Natural/isZero +++ /dev/null @@ -1,12 +0,0 @@ -{- -Returns `True` if a number is `+0` and returns `False` otherwise - -Examples: - -``` -./isZero +2 = False - -./isZero +0 = True -``` --} -let isZero : Natural → Bool = Natural/isZero in isZero diff --git a/Prelude/Natural/odd b/Prelude/Natural/odd deleted file mode 100644 --- a/Prelude/Natural/odd +++ /dev/null @@ -1,12 +0,0 @@ -{- -Returns `True` if a number is odd and returns `False` otherwise - -Examples: - -``` -./odd +3 = True - -./odd +0 = False -``` --} -let odd : Natural → Bool = Natural/odd in odd diff --git a/Prelude/Natural/product b/Prelude/Natural/product deleted file mode 100644 --- a/Prelude/Natural/product +++ /dev/null @@ -1,22 +0,0 @@ -{- -Multiply all the numbers in a `List` - -Examples: - -``` -./product [ +2, +3, +5 ] = +30 - -./product ([] : List Natural) = +1 -``` --} - let product - : List Natural → Natural - = λ(xs : List Natural) - → List/fold - Natural - xs - Natural - (λ(l : Natural) → λ(r : Natural) → l * r) - +1 - -in product diff --git a/Prelude/Natural/show b/Prelude/Natural/show deleted file mode 100644 --- a/Prelude/Natural/show +++ /dev/null @@ -1,13 +0,0 @@ -{- -Render a `Natural` number as `Text` using the same representation as Dhall -source code (i.e. a decimal number with a leading `+` sign) - -Examples: - -``` -./show +3 = "+3" - -./show +0 = "+0" -``` --} -let show : Natural → Text = Natural/show in show diff --git a/Prelude/Natural/sum b/Prelude/Natural/sum deleted file mode 100644 --- a/Prelude/Natural/sum +++ /dev/null @@ -1,22 +0,0 @@ -{- -Add all the numbers in a `List` - -Examples: - -``` -./sum [ +2, +3, +5 ] = +10 - -./sum ([] : List Natural) = +0 -``` --} - let sum - : List Natural → Natural - = λ(xs : List Natural) - → List/fold - Natural - xs - Natural - (λ(l : Natural) → λ(r : Natural) → l + r) - +0 - -in sum diff --git a/Prelude/Natural/toInteger b/Prelude/Natural/toInteger deleted file mode 100644 --- a/Prelude/Natural/toInteger +++ /dev/null @@ -1,12 +0,0 @@ -{- -Convert a `Natural` number to the corresponding `Integer` - -Examples: - -``` -./toInteger +3 = 3 - -./toInteger +0 = 0 -``` --} -let toInteger : Natural → Integer = Natural/toInteger in toInteger diff --git a/Prelude/Optional/all b/Prelude/Optional/all deleted file mode 100644 --- a/Prelude/Optional/all +++ /dev/null @@ -1,20 +0,0 @@ -{- -Returns `False` if the supplied function returns `False` for a present element -and `True` otherwise: - -Examples: - -``` -./all Natural Natural/even ([ +3 ] : Optional Natural) = False - -./all Natural Natural/even ([] : Optional Natural) = True -``` --} - let all - : ∀(a : Type) → (a → Bool) → Optional a → Bool - = λ(a : Type) - → λ(f : a → Bool) - → λ(xs : Optional a) - → Optional/fold a xs Bool f True - -in all diff --git a/Prelude/Optional/any b/Prelude/Optional/any deleted file mode 100644 --- a/Prelude/Optional/any +++ /dev/null @@ -1,20 +0,0 @@ -{- -Returns `True` if the supplied function returns `True` for a present element and -`False` otherwise - -Examples: - -``` -./any Natural Natural/even ([ +2 ] : Optional Natural) = True - -./any Natural Natural/even ([] : Optional Natural) = False -``` --} - let any - : ∀(a : Type) → (a → Bool) → Optional a → Bool - = λ(a : Type) - → λ(f : a → Bool) - → λ(xs : Optional a) - → Optional/fold a xs Bool f False - -in any diff --git a/Prelude/Optional/build b/Prelude/Optional/build deleted file mode 100644 --- a/Prelude/Optional/build +++ /dev/null @@ -1,36 +0,0 @@ -{- -`build` is the inverse of `fold` - -Examples: - -``` -./build -Integer -( λ(optional : Type) -→ λ(just : Integer → optional) -→ λ(nothing : optional) -→ just 1 -) -= [ 1 ] : Optional Integer - -./build -Integer -( λ(optional : Type) -→ λ(just : Integer → optional) -→ λ(nothing : optional) -→ nothing -) -= [] : Optional Integer -``` --} - let build - : ∀(a : Type) - → ( ∀(optional : Type) - → ∀(just : a → optional) - → ∀(nothing : optional) - → optional - ) - → Optional a - = Optional/build - -in build diff --git a/Prelude/Optional/concat b/Prelude/Optional/concat deleted file mode 100644 --- a/Prelude/Optional/concat +++ /dev/null @@ -1,28 +0,0 @@ -{- -Flatten two `Optional` layers into a single `Optional` layer - -Examples: - -``` -./concat Integer ([ [ 1 ] : Optional Integer ] : Optional (Optional Integer)) -= [ 1 ] : Optional Integer - -./concat Integer ([ [] : Optional Integer ] : Optional (Optional Integer)) -= [] : Optional Integer - -./concat Integer ([] : Optional (Optional Integer)) -= [] : Optional Integer -``` --} - let concat - : ∀(a : Type) → Optional (Optional a) → Optional a - = λ(a : Type) - → λ(x : Optional (Optional a)) - → Optional/fold - (Optional a) - x - (Optional a) - (λ(y : Optional a) → y) - ([] : Optional a) - -in concat diff --git a/Prelude/Optional/filter b/Prelude/Optional/filter deleted file mode 100644 --- a/Prelude/Optional/filter +++ /dev/null @@ -1,32 +0,0 @@ -{- -Only keep an `Optional` element if the supplied function returns `True` - -Examples: - -``` -./filter Natural Natural/even ([ +2 ] : Optional Natural) -= [ +2 ] : Optional Natural - -./filter Natural Natural/odd ([ +2 ] : Optional Natural) -= [] : Optional Natural -``` --} - let filter - : ∀(a : Type) → (a → Bool) → Optional a → Optional a - = λ(a : Type) - → λ(f : a → Bool) - → λ(xs : Optional a) - → Optional/build - a - ( λ(optional : Type) - → λ(just : a → optional) - → λ(nil : optional) - → Optional/fold - a - xs - optional - (λ(x : a) → if f x then just x else nil) - nil - ) - -in filter diff --git a/Prelude/Optional/fold b/Prelude/Optional/fold deleted file mode 100644 --- a/Prelude/Optional/fold +++ /dev/null @@ -1,21 +0,0 @@ -{- -`fold` is the primitive function for consuming `Optional` values - -Examples: - -``` -./fold Integer ([ 2 ] : Optional Integer) Integer (λ(x : Integer) → x) 0 = 2 - -./fold Integer ([] : Optional Integer) Integer (λ(x : Integer) → x) 0 = 0 -``` --} - let fold - : ∀(a : Type) - → Optional a - → ∀(optional : Type) - → ∀(just : a → optional) - → ∀(nothing : optional) - → optional - = Optional/fold - -in fold diff --git a/Prelude/Optional/head b/Prelude/Optional/head deleted file mode 100644 --- a/Prelude/Optional/head +++ /dev/null @@ -1,38 +0,0 @@ -{- -Returns the first non-empty `Optional` value in a `List` - -Examples: - -``` -./head -Integer -[ [ ] : Optional Integer -, [ 1 ] : Optional Integer -, [ 2 ] : Optional Integer -] -= [ 1 ] : Optional Integer - -./head -Integer -[ [] : Optional Integer, [] : Optional Integer ] -= [] : Optional Integer - -./head Integer ([] : List (Optional Integer)) -= [] : Optional Integer -``` --} - let head - : ∀(a : Type) → List (Optional a) → Optional a - = λ(a : Type) - → λ(xs : List (Optional a)) - → List/fold - (Optional a) - xs - (Optional a) - ( λ(l : Optional a) - → λ(r : Optional a) - → Optional/fold a l (Optional a) (λ(x : a) → [ x ] : Optional a) r - ) - ([] : Optional a) - -in head diff --git a/Prelude/Optional/last b/Prelude/Optional/last deleted file mode 100644 --- a/Prelude/Optional/last +++ /dev/null @@ -1,38 +0,0 @@ -{- -Returns the last non-empty `Optional` value in a `List` - -Examples: - -``` -./last -Integer -[ [ ] : Optional Integer -, [ 1 ] : Optional Integer -, [ 2 ] : Optional Integer -] -= [ 2 ] : Optional Integer - -./last -Integer -[ [] : Optional Integer, [] : Optional Integer ] -= [] : Optional Integer - -./last Integer ([] : List (Optional Integer)) -= [] : Optional Integer -``` --} - let last - : ∀(a : Type) → List (Optional a) → Optional a - = λ(a : Type) - → λ(xs : List (Optional a)) - → List/fold - (Optional a) - xs - (Optional a) - ( λ(l : Optional a) - → λ(r : Optional a) - → Optional/fold a r (Optional a) (λ(x : a) → [ x ] : Optional a) l - ) - ([] : Optional a) - -in last diff --git a/Prelude/Optional/length b/Prelude/Optional/length deleted file mode 100644 --- a/Prelude/Optional/length +++ /dev/null @@ -1,18 +0,0 @@ -{- -Returns `+1` if the `Optional` value is present and `+0` if the value is absent - -Examples: - -``` -./length Integer ([ 2 ] : Optional Integer) = +1 - -./length Integer ([] : Optional Integer) = +0 -``` --} - let length - : ∀(a : Type) → Optional a → Natural - = λ(a : Type) - → λ(xs : Optional a) - → Optional/fold a xs Natural (λ(_ : a) → +1) +0 - -in length diff --git a/Prelude/Optional/map b/Prelude/Optional/map deleted file mode 100644 --- a/Prelude/Optional/map +++ /dev/null @@ -1,27 +0,0 @@ -{- -Transform an `Optional` value with a function - -Examples: - -``` -./map Natural Bool Natural/even ([ +3 ] : Optional Natural) -= [ False ] : Optional Bool - -./map Natural Bool Natural/even ([] : Optional Natural) -= [] : Optional Bool -``` --} - let map - : ∀(a : Type) → ∀(b : Type) → (a → b) → Optional a → Optional b - = λ(a : Type) - → λ(b : Type) - → λ(f : a → b) - → λ(o : Optional a) - → Optional/fold - a - o - (Optional b) - (λ(x : a) → [ f x ] : Optional b) - ([] : Optional b) - -in map diff --git a/Prelude/Optional/null b/Prelude/Optional/null deleted file mode 100644 --- a/Prelude/Optional/null +++ /dev/null @@ -1,18 +0,0 @@ -{- -Returns `True` if the `Optional` value is absent and `False` if present - -Examples: - -``` -./null Integer ([ 2 ] : Optional Integer) = False - -./null Integer ([] : Optional Integer) = True -``` --} - let null - : ∀(a : Type) → Optional a → Bool - = λ(a : Type) - → λ(xs : Optional a) - → Optional/fold a xs Bool (λ(_ : a) → False) True - -in null diff --git a/Prelude/Optional/toList b/Prelude/Optional/toList deleted file mode 100644 --- a/Prelude/Optional/toList +++ /dev/null @@ -1,23 +0,0 @@ -{- -Convert an `Optional` value into the equivalent `List` - -Examples: - -``` -./toList Integer ([ 1 ] : Optional Integer) = [ 1 ] - -./toList Integer ([] : Optional Integer) = [] : List Integer -``` --} - let toList - : ∀(a : Type) → Optional a → List a - = λ(a : Type) - → λ(o : Optional a) - → Optional/fold - a - o - (List a) - (λ(x : a) → ([ x ] : List a)) - ([] : List a) - -in toList diff --git a/Prelude/Optional/unzip b/Prelude/Optional/unzip deleted file mode 100644 --- a/Prelude/Optional/unzip +++ /dev/null @@ -1,41 +0,0 @@ -{- -Unzip an `Optional` value into two separate `Optional` values - -Examples: - -``` -./unzip -Text -Bool -([ { _1 = "ABC", _2 = True } ] : Optional { _1 : Text, _2 : Bool }) -= { _1 = [ "ABC" ] : Optional Text, _2 = [ True ] : Optional Bool } - -./unzip Text Bool ([] : Optional { _1 : Text, _2 : Bool }) -= { _1 = [] : Optional Text, _2 = [] : Optional Bool } -``` --} - let unzip - : ∀(a : Type) - → ∀(b : Type) - → Optional { _1 : a, _2 : b } - → { _1 : Optional a, _2 : Optional b } - = λ(a : Type) - → λ(b : Type) - → λ(xs : Optional { _1 : a, _2 : b }) - → { _1 = - Optional/fold - { _1 : a, _2 : b } - xs - (Optional a) - (λ(x : { _1 : a, _2 : b }) → [ x._1 ] : Optional a) - ([] : Optional a) - , _2 = - Optional/fold - { _1 : a, _2 : b } - xs - (Optional b) - (λ(x : { _1 : a, _2 : b }) → [ x._2 ] : Optional b) - ([] : Optional b) - } - -in unzip diff --git a/Prelude/Text/concat b/Prelude/Text/concat deleted file mode 100644 --- a/Prelude/Text/concat +++ /dev/null @@ -1,17 +0,0 @@ -{- -Concatenate all the `Text` values in a `List` - -Examples: - -``` -./concat [ "ABC", "DEF", "GHI" ] = "ABCDEFGHI" - -./concat ([] : List Text) = "" -``` --} - let concat - : List Text → Text - = λ(xs : List Text) - → List/fold Text xs Text (λ(x : Text) → λ(y : Text) → x ++ y) "" - -in concat diff --git a/Prelude/Text/concatMap b/Prelude/Text/concatMap deleted file mode 100644 --- a/Prelude/Text/concatMap +++ /dev/null @@ -1,21 +0,0 @@ -{- -Transform each value in a `List` into `Text` and concatenate the result - -Examples: - -``` -./concatMap Integer (λ(n : Integer) → "${Integer/show n} ") [ 0, 1, 2 ] -= "0 1 2 " - -./concatMap Integer (λ(n : Integer) → "${Integer/show n} ") ([] : List Integer) -= "" -``` --} - let concatMap - : ∀(a : Type) → (a → Text) → List a → Text - = λ(a : Type) - → λ(f : a → Text) - → λ(xs : List a) - → List/fold a xs Text (λ(x : a) → λ(y : Text) → f x ++ y) "" - -in concatMap diff --git a/Prelude/Text/concatMapSep b/Prelude/Text/concatMapSep deleted file mode 100644 --- a/Prelude/Text/concatMapSep +++ /dev/null @@ -1,45 +0,0 @@ -{- -Transform each value in a `List` to `Text` and then concatenate them with a -separator in between each value - -Examples: - -``` -./concatMapSep ", " Integer Integer/show [ 0, 1, 2 ] = "0, 1, 2" - -./concatMapSep ", " Integer Integer/show ([] : List Integer) = "" -``` --} - let concatMapSep - : ∀(separator : Text) → ∀(a : Type) → (a → Text) → List a → Text - = λ(separator : Text) - → λ(a : Type) - → λ(f : a → Text) - → λ(elements : List a) - → let status = - List/fold - a - elements - < Empty : {} | NonEmpty : Text > - ( λ(element : a) - → λ(status : < Empty : {} | NonEmpty : Text >) - → merge - { Empty = - λ(_ : {}) → < NonEmpty = f element | Empty : {} > - , NonEmpty = - λ(result : Text) - → < NonEmpty = f element ++ separator ++ result - | Empty : {} - > - } - status - : < Empty : {} | NonEmpty : Text > - ) - < Empty = {=} | NonEmpty : Text > - - in merge - { Empty = λ(_ : {}) → "", NonEmpty = λ(result : Text) → result } - status - : Text - -in concatMapSep diff --git a/Prelude/Text/concatSep b/Prelude/Text/concatSep deleted file mode 100644 --- a/Prelude/Text/concatSep +++ /dev/null @@ -1,42 +0,0 @@ -{- -Concatenate a `List` of `Text` values with a separator in between each value - -Examples: - -``` -./concatSep ", " [ "ABC", "DEF", "GHI" ] = "ABC, DEF, GHI" - -./concatSep ", " ([] : List Text) = "" -``` --} - let concatSep - : ∀(separator : Text) → ∀(elements : List Text) → Text - = λ(separator : Text) - → λ(elements : List Text) - → let status = - List/fold - Text - elements - < Empty : {} | NonEmpty : Text > - ( λ(element : Text) - → λ(status : < Empty : {} | NonEmpty : Text >) - → merge - { Empty = - λ(_ : {}) → < NonEmpty = element | Empty : {} > - , NonEmpty = - λ(result : Text) - → < NonEmpty = element ++ separator ++ result - | Empty : {} - > - } - status - : < Empty : {} | NonEmpty : Text > - ) - < Empty = {=} | NonEmpty : Text > - - in merge - { Empty = λ(_ : {}) → "", NonEmpty = λ(result : Text) → result } - status - : Text - -in concatSep diff --git a/benchmark/deep-nested-large-record/BigEnum.dhall b/benchmark/deep-nested-large-record/BigEnum.dhall new file mode 100644 --- /dev/null +++ b/benchmark/deep-nested-large-record/BigEnum.dhall @@ -0,0 +1,302 @@ +< A0 : {} +| A1 : {} +| A2 : {} +| A3 : {} +| A4 : {} +| A5 : {} +| A6 : {} +| A7 : {} +| A8 : {} +| A9 : {} +| A10 : {} +| A11 : {} +| A12 : {} +| A13 : {} +| A14 : {} +| A15 : {} +| A16 : {} +| A17 : {} +| A18 : {} +| A19 : {} +| A20 : {} +| A21 : {} +| A22 : {} +| A23 : {} +| A24 : {} +| A25 : {} +| A26 : {} +| A27 : {} +| A28 : {} +| A29 : {} +| A30 : {} +| A31 : {} +| A32 : {} +| A33 : {} +| A34 : {} +| A35 : {} +| A36 : {} +| A37 : {} +| A38 : {} +| A39 : {} +| A40 : {} +| A41 : {} +| A42 : {} +| A43 : {} +| A44 : {} +| A45 : {} +| A46 : {} +| A47 : {} +| A48 : {} +| A49 : {} +| A50 : {} +| A51 : {} +| A52 : {} +| A53 : {} +| A54 : {} +| A55 : {} +| A56 : {} +| A57 : {} +| A58 : {} +| A59 : {} +| A60 : {} +| A61 : {} +| A62 : {} +| A63 : {} +| A64 : {} +| A65 : {} +| A66 : {} +| A67 : {} +| A68 : {} +| A69 : {} +| A70 : {} +| A71 : {} +| A72 : {} +| A73 : {} +| A74 : {} +| A75 : {} +| A76 : {} +| A77 : {} +| A78 : {} +| A79 : {} +| A80 : {} +| A81 : {} +| A82 : {} +| A83 : {} +| A84 : {} +| A85 : {} +| A86 : {} +| A87 : {} +| A88 : {} +| A89 : {} +| A90 : {} +| A91 : {} +| A92 : {} +| A93 : {} +| A94 : {} +| A95 : {} +| A96 : {} +| A97 : {} +| A98 : {} +| A99 : {} +| A100 : {} +| A101 : {} +| A102 : {} +| A103 : {} +| A104 : {} +| A105 : {} +| A106 : {} +| A107 : {} +| A108 : {} +| A109 : {} +| A110 : {} +| A111 : {} +| A112 : {} +| A113 : {} +| A114 : {} +| A115 : {} +| A116 : {} +| A117 : {} +| A118 : {} +| A119 : {} +| A120 : {} +| A121 : {} +| A122 : {} +| A123 : {} +| A124 : {} +| A125 : {} +| A126 : {} +| A127 : {} +| A128 : {} +| A129 : {} +| A130 : {} +| A131 : {} +| A132 : {} +| A133 : {} +| A134 : {} +| A135 : {} +| A136 : {} +| A137 : {} +| A138 : {} +| A139 : {} +| A140 : {} +| A141 : {} +| A142 : {} +| A143 : {} +| A144 : {} +| A145 : {} +| A146 : {} +| A147 : {} +| A148 : {} +| A149 : {} +| A150 : {} +| A151 : {} +| A152 : {} +| A153 : {} +| A154 : {} +| A155 : {} +| A156 : {} +| A157 : {} +| A158 : {} +| A159 : {} +| A160 : {} +| A161 : {} +| A162 : {} +| A163 : {} +| A164 : {} +| A165 : {} +| A166 : {} +| A167 : {} +| A168 : {} +| A169 : {} +| A170 : {} +| A171 : {} +| A172 : {} +| A173 : {} +| A174 : {} +| A175 : {} +| A176 : {} +| A177 : {} +| A178 : {} +| A179 : {} +| A180 : {} +| A181 : {} +| A182 : {} +| A183 : {} +| A184 : {} +| A185 : {} +| A186 : {} +| A187 : {} +| A188 : {} +| A189 : {} +| A190 : {} +| A191 : {} +| A192 : {} +| A193 : {} +| A194 : {} +| A195 : {} +| A196 : {} +| A197 : {} +| A198 : {} +| A199 : {} +| A200 : {} +| A201 : {} +| A202 : {} +| A203 : {} +| A204 : {} +| A205 : {} +| A206 : {} +| A207 : {} +| A208 : {} +| A209 : {} +| A210 : {} +| A211 : {} +| A212 : {} +| A213 : {} +| A214 : {} +| A215 : {} +| A216 : {} +| A217 : {} +| A218 : {} +| A219 : {} +| A220 : {} +| A221 : {} +| A222 : {} +| A223 : {} +| A224 : {} +| A225 : {} +| A226 : {} +| A227 : {} +| A228 : {} +| A229 : {} +| A230 : {} +| A231 : {} +| A232 : {} +| A233 : {} +| A234 : {} +| A235 : {} +| A236 : {} +| A237 : {} +| A238 : {} +| A239 : {} +| A240 : {} +| A241 : {} +| A242 : {} +| A243 : {} +| A244 : {} +| A245 : {} +| A246 : {} +| A247 : {} +| A248 : {} +| A249 : {} +| A250 : {} +| A251 : {} +| A252 : {} +| A253 : {} +| A254 : {} +| A255 : {} +| A256 : {} +| A257 : {} +| A258 : {} +| A259 : {} +| A260 : {} +| A261 : {} +| A262 : {} +| A263 : {} +| A264 : {} +| A265 : {} +| A266 : {} +| A267 : {} +| A268 : {} +| A269 : {} +| A270 : {} +| A271 : {} +| A272 : {} +| A273 : {} +| A274 : {} +| A275 : {} +| A276 : {} +| A277 : {} +| A278 : {} +| A279 : {} +| A280 : {} +| A281 : {} +| A282 : {} +| A283 : {} +| A284 : {} +| A285 : {} +| A286 : {} +| A287 : {} +| A288 : {} +| A289 : {} +| A290 : {} +| A291 : {} +| A292 : {} +| A293 : {} +| A294 : {} +| A295 : {} +| A296 : {} +| A297 : {} +| A298 : {} +| A299 : {} +| A300 : {} +> diff --git a/benchmark/deep-nested-large-record/LittleEnum.dhall b/benchmark/deep-nested-large-record/LittleEnum.dhall new file mode 100644 --- /dev/null +++ b/benchmark/deep-nested-large-record/LittleEnum.dhall @@ -0,0 +1,4 @@ +< Foo : {} +| Bar : {} +| Baz : {} +> diff --git a/benchmark/deep-nested-large-record/Main.hs b/benchmark/deep-nested-large-record/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/deep-nested-large-record/Main.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Data.Void (Void) +import Test.Tasty.Bench + +import qualified Data.Sequence as Seq +import qualified Dhall.Core as Core +import qualified Dhall.Import as Import +import qualified Dhall.TypeCheck as TypeCheck + +dhallPreludeImport :: Core.Import +dhallPreludeImport = Core.Import + { Core.importMode = Core.Code + , Core.importHashed = Core.ImportHashed + { Core.hash = Nothing + , Core.importType = Core.Local Core.Here $ Core.File + { Core.directory = Core.Directory ["deep-nested-large-record", "benchmark"] + , Core.file = "prelude.dhall" + } + } + } + +issue412 :: Core.Expr s Void -> Benchmarkable +issue412 prelude = whnf TypeCheck.typeOf expr + where + expr + = Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude) + $ Core.ListLit Nothing + $ Seq.replicate 5 + $ Core.Var (Core.V "prelude" 0) `Core.Field` types `Core.Field` little `Core.Field` foo + types = Core.makeFieldSelection "types" + little = Core.makeFieldSelection "little" + foo = Core.makeFieldSelection "Foo" + +unionPerformance :: Core.Expr s Void -> Benchmarkable +unionPerformance prelude = whnf TypeCheck.typeOf expr + where + expr = + Core.Let + (Core.Binding + Nothing + "x" + Nothing + Nothing + Nothing + (Core.Let + (Core.Binding + Nothing + "big" + Nothing + Nothing + Nothing + (prelude `Core.Field` types `Core.Field` big) + ) + (Core.Prefer mempty Core.PreferFromSource "big" "big") + ) + ) + "x" + types = Core.makeFieldSelection "types" + big = Core.makeFieldSelection "Big" + +main :: IO () +main = + defaultMain + [ env prelude $ \p -> + bgroup "Prelude" + [ bench "issue 412" (issue412 p) + , bench "union performance" (unionPerformance p) + ] + ] + where prelude = Import.load (Core.Embed dhallPreludeImport) diff --git a/benchmark/deep-nested-large-record/prelude.dhall b/benchmark/deep-nested-large-record/prelude.dhall new file mode 100644 --- /dev/null +++ b/benchmark/deep-nested-large-record/prelude.dhall @@ -0,0 +1,5 @@ +{ types = + { Big = ./BigEnum.dhall + , Little = ./LittleEnum.dhall + } +} diff --git a/benchmark/parser/Main.hs b/benchmark/parser/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/parser/Main.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Exception (throw) +import Control.Monad (forM) +import Data.Map (Map) +import Data.Text (Text) +import Data.Void (Void) +import Test.Tasty.Bench + +import qualified Data.ByteString.Lazy +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Data.Text.IO +import qualified Dhall.Binary +import qualified Dhall.Core as Dhall +import qualified Dhall.Parser as Dhall +import qualified System.Directory as Directory + +type PreludeFiles = Map FilePath Text + +loadPreludeFiles :: IO PreludeFiles +loadPreludeFiles = loadDirectory "./dhall-lang/Prelude" + where + loadDirectory :: FilePath -> IO PreludeFiles + loadDirectory dir = + Directory.withCurrentDirectory dir $ do + files <- Directory.getCurrentDirectory >>= Directory.listDirectory + results <- forM files $ \file -> do + file' <- Directory.makeAbsolute file + doesExist <- Directory.doesFileExist file' + if doesExist + then loadFile file' + else loadDirectory file' + pure $ Map.unions results + + loadFile :: FilePath -> IO PreludeFiles + loadFile path = Map.singleton path <$> Data.Text.IO.readFile path + +benchParser :: PreludeFiles -> Benchmark +benchParser = + bgroup "exprFromText" + . Map.foldrWithKey (\name expr -> (benchExprFromText name expr :)) [] + +benchExprFromText :: String -> Text -> Benchmark +benchExprFromText name !expr = + bench name $ whnf (Dhall.exprFromText "(input)") expr + +benchExprFromBytes :: String -> Data.ByteString.Lazy.ByteString -> Benchmark +benchExprFromBytes name bs = bench name (nf f bs) + where + f bytes = + case Dhall.Binary.decodeExpression bytes of + Left exception -> error (show exception) + Right expression -> expression :: Dhall.Expr Void Dhall.Import + +benchNfExprFromText :: String -> Text -> Benchmark +benchNfExprFromText name !expr = + bench name $ nf (either throw id . Dhall.exprFromText "(input)") expr + +main :: IO () +main = do + prelude <- loadPreludeFiles + defaultMain + [ env issues $ \ ~(it, ib) -> + bgroup "Issue #108" + [ benchExprFromText "Text" it + , benchExprFromBytes "Binary" ib + ] + , env kubernetesExample $ + benchExprFromBytes "Kubernetes/Binary" + , benchExprFromText "Long variable names" (Text.replicate 1000000 "x") + , benchExprFromText "Large number of function arguments" (Text.replicate 10000 "x ") + , benchExprFromText "Long double-quoted strings" ("\"" <> Text.replicate 1000000 "x" <> "\"") + , benchExprFromText "Long single-quoted strings" ("''" <> Text.replicate 1000000 "x" <> "''") + , benchExprFromText "Whitespace" (Text.replicate 1000000 " " <> "x") + , benchExprFromText "Line comment" ("x -- " <> Text.replicate 1000000 " ") + , benchExprFromText "Block comment" ("x {- " <> Text.replicate 1000000 " " <> "-}") + , benchExprFromText "Deeply nested parentheses" "((((((((((((((((x))))))))))))))))" + , benchParser prelude + , env cpkgExample $ + benchNfExprFromText "CPkg/Text" + ] + where + cpkgExample = Data.Text.IO.readFile "benchmark/parser/examples/cpkg.dhall" + issue108Text = Data.Text.IO.readFile "benchmark/parser/examples/issue108.dhall" + issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/parser/examples/issue108.dhallb" + issues = (,) <$> issue108Text <*> issue108Bytes + kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/parser/examples/kubernetes.dhallb" diff --git a/benchmark/parser/examples/cpkg.dhall b/benchmark/parser/examples/cpkg.dhall new file mode 100644 # file too large to diff: benchmark/parser/examples/cpkg.dhall diff --git a/benchmark/parser/examples/issue108.dhall b/benchmark/parser/examples/issue108.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/issue108.dhall @@ -0,0 +1,63 @@ +λ ( xs : List { cores : Natural , host : Text , key : Text , mandatoryFeatures : +List Text , platforms : List < AArch64_Linux : {} | ARMv5tel_Linux : {} | +ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} | +PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD : +{} | X86_64_Linux : {} | X86_64_Solaris : {} > , speedFactor : Natural , +supportedFeatures : List Text , user : Optional Text } )→ List/fold { cores : +Natural , host : Text , key : Text , mandatoryFeatures : List Text , platforms : +List < AArch64_Linux : {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | +I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} | PowerPC_Linux : {} | +X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : +{} | X86_64_Solaris : {} > , speedFactor : Natural , supportedFeatures : List +Text , user : Optional Text } xs Text ( λ ( x : { cores : Natural , host : Text +, key : Text , mandatoryFeatures : List Text , platforms : List < AArch64_Linux +: {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : +{} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | +X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : +{} > , speedFactor : Natural , supportedFeatures : List Text , user : Optional +Text } ) → λ(y : Text) → +merge { None = x.host, Some = λ(user : Text) → "${user}@${x.host}" } x.user +++ " " ++ ( merge { Empty = λ(_ : {}) → "", +NonEmpty = λ(result : Text) → result } ( List/fold < AArch64_Linux : {} | +ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} | +MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin : +{} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : {} > x.platforms +< Empty : {} | NonEmpty : Text > ( λ ( element : < AArch64_Linux : {} | +ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} | +MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin : +{} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : {} > ) → +λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → < +NonEmpty : Text | Empty : {} >.NonEmpty ( merge { AArch64_Linux = λ(_ : {}) → +"aarch64-linux" , ARMv5tel_Linux = λ(_ : {}) → "armv5tel-linux" , ARMv7l_Linux = +λ(_ : {}) → "armv7l-linux" , I686_Cygwin = λ(_ : {}) → "i686-cygwin" , +I686_Linux = λ(_ : {}) → "i686-linux" , MIPS64el_Linux = λ(_ : {}) → +"mips64el-linux" , PowerPC_Linux = λ(_ : {}) → "powerpc-linux" , X86_64_Cygwin = +λ(_ : {}) → "x86_64-cygwin" , X86_64_Darwin = λ(_ : {}) → "x86_64-darwin" , +X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd" , X86_64_Linux = λ(_ : {}) → +"x86_64-linux" , X86_64_Solaris = λ(_ : {}) → "x86_64-solaris" } element ) , +NonEmpty = λ(result : Text) → < NonEmpty : Text | Empty : {} >.NonEmpty ( ( +merge { AArch64_Linux = λ(_ : {}) → "aarch64-linux" , ARMv5tel_Linux = λ(_ : {}) +→ "armv5tel-linux" , ARMv7l_Linux = λ(_ : {}) → "armv7l-linux" , I686_Cygwin = +λ(_ : {}) → "i686-cygwin" , I686_Linux = λ(_ : {}) → "i686-linux" , +MIPS64el_Linux = λ(_ : {}) → "mips64el-linux" , PowerPC_Linux = λ(_ : {}) → +"powerpc-linux" , X86_64_Cygwin = λ(_ : {}) → "x86_64-cygwin" , X86_64_Darwin = +λ(_ : {}) → "x86_64-darwin" , X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd" , +X86_64_Linux = λ(_ : {}) → "x86_64-linux" , X86_64_Solaris = λ(_ : {}) → +"x86_64-solaris" } element ) ++ "," ++ result ) } status : < Empty : {} | +NonEmpty : Text > ) (< Empty : {} | NonEmpty : Text >.Empty {=}) ) : Text ) ++ +" " ++ x.key ++ " " ++ Integer/show (Natural/toInteger x.cores) ++ " " ++ +Integer/show (Natural/toInteger x.speedFactor) ++ " " ++ ( merge { Empty = λ(_ : +{}) → "", NonEmpty = λ(result : Text) → result } ( List/fold Text +x.supportedFeatures < Empty : {} | NonEmpty : Text > ( λ(element : Text) → +λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → < +NonEmpty : Text | Empty : {} >.NonEmpty element , NonEmpty = λ(result : Text) → +< NonEmpty : Text | Empty : {} >.NonEmpty (element ++ "," ++ result) } status : +< Empty : {} | NonEmpty : Text > ) (< Empty : {} | NonEmpty : Text >.Empty {=}) +) : Text ) ++ " " ++ ( merge { Empty = λ(_ : {}) → "", NonEmpty = λ(result : +Text) → result } ( List/fold Text x.mandatoryFeatures < Empty : {} | NonEmpty : +Text > ( λ(element : Text) → λ(status : < Empty : {} | NonEmpty : Text >) → +merge { Empty = λ(_ : {}) → < NonEmpty : Text | Empty : {} >.NonEmpty element , +NonEmpty = λ(result : Text) → < NonEmpty : Text | Empty : {} >.NonEmpty +(element ++ "," ++ result) } status : < Empty : {} | NonEmpty : Text > ) (< +Empty : {} | NonEmpty : Text +>.Empty {=}) ) : Text ) ++ "\n" ++ y ) "" diff --git a/benchmark/parser/examples/issue108.dhallb b/benchmark/parser/examples/issue108.dhallb new file mode 100644 Binary files /dev/null and b/benchmark/parser/examples/issue108.dhallb differ diff --git a/benchmark/parser/examples/kubernetes.dhallb b/benchmark/parser/examples/kubernetes.dhallb new file mode 100644 # file too large to diff: benchmark/parser/examples/kubernetes.dhallb diff --git a/benchmark/parser/examples/normalize/ChurchEval.dhall b/benchmark/parser/examples/normalize/ChurchEval.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/ChurchEval.dhall @@ -0,0 +1,22 @@ + +let Nat = ∀(N : Type) → (N → N) → N → N +let n2 = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s z) +let n5 = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s (s (s (s z)))) + +let mul = + λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N (b N s) z + +let add = + λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N s (b N s z) + +let n10 = mul n2 n5 +let n100 = mul n10 n10 +let n1k = mul n10 n100 +let n10k = mul n100 n100 +let n100k = mul n10 n10k +let n1M = mul n10k n100 +let n5M = mul n1M n5 +let n10M = mul n1M n10 +let n20M = mul n10M n2 + +in n1M Natural (λ (x:Natural) → x + 1) 0 diff --git a/benchmark/parser/examples/normalize/FunCompose.dhall b/benchmark/parser/examples/normalize/FunCompose.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/FunCompose.dhall @@ -0,0 +1,18 @@ + +let compose + : ∀(a : Type) → ∀(b : Type) → ∀(c : Type) → (a → b) → (b → c) → a → c + = λ(A : Type) + → λ(B : Type) + → λ(C : Type) + → λ(f : A → B) + → λ(g : B → C) + → λ(x : A) + → g (f x) + +let composeN : ∀ (a : Type) → Natural → (a → a) → a → a + = λ (a : Type) + → λ (n : Natural) + → λ (f : a → a) + → Natural/fold n (a → a) (compose a a a f) (λ (x : a) → x) + +in composeN Natural 100000 (λ (x : Natural) → x + 1) 0 diff --git a/benchmark/parser/examples/normalize/ListBench.dhall b/benchmark/parser/examples/normalize/ListBench.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/ListBench.dhall @@ -0,0 +1,75 @@ + +let iterate + = λ(n : Natural) + → λ(a : Type) + → λ(f : a → a) + → λ(x : a) + → List/build + a + ( λ(list : Type) + → λ(cons : a → list → list) + → List/fold + { index : Natural, value : {} } + ( List/indexed + {} + ( List/build + {} + ( λ(list : Type) + → λ(cons : {} → list → list) + → Natural/fold n list (cons {=}) + ) + ) + ) + list + ( λ(y : { index : Natural, value : {} }) + → cons (Natural/fold y.index a f x) + ) + ) + +let countTo = + λ (x : Natural) + → iterate x Natural (λ (x : Natural) → x + 1) 0 + +let sum = + λ (xs : List Natural) + → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0 + + +let map + : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b + = λ(a : Type) + → λ(b : Type) + → λ(f : a → b) + → λ(xs : List a) + → List/build + b + ( λ(list : Type) + → λ(cons : b → list → list) + → List/fold a xs list (λ(x : a) → cons (f x)) + ) + +let any + : ∀(a : Type) → (a → Bool) → List a → Bool + = λ(a : Type) + → λ(f : a → Bool) + → λ(xs : List a) + → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False + +let filter + : ∀(a : Type) → (a → Bool) → List a → List a + = λ(a : Type) + → λ(f : a → Bool) + → λ(xs : List a) + → List/build + a + ( λ(list : Type) + → λ(cons : a → list → list) + → List/fold + a + xs + list + (λ(x : a) → λ(xs : list) → if f x then cons x xs else xs) + ) + +in sum (filter Natural Natural/even + (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000))) diff --git a/benchmark/parser/examples/normalize/ListBenchAlt.dhall b/benchmark/parser/examples/normalize/ListBenchAlt.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/ListBenchAlt.dhall @@ -0,0 +1,45 @@ + +let iterate = + λ(n : Natural) + → λ(a : Type) + → λ(f : a → a) + → λ(x : a) + → (Natural/fold n + (a → List a → {fst:a, snd:List a}) + (λ (hyp : a → List a → {fst:a, snd:List a}) → + λ (x : a) → λ (xs : List a) + → let tup = hyp x xs + in {fst = f (tup.fst), snd = tup.snd # [tup.fst]}) + (λ (x : a) → λ (xs : List a) → {fst=x, snd=xs}) + x ([] : List a)).snd + +let countTo = + λ (x : Natural) + → iterate x Natural (λ (x : Natural) → x + 1) 0 + +let sum = + λ (xs : List Natural) + → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0 + +let map + = λ(a : Type) + → λ(b : Type) + → λ(f : a → b) + → λ(xs : List a) + → List/fold a xs (List b) (λ (x : a) → λ (xs : List b) → [f x] # xs) ([] : List b) + +let any + = λ(a : Type) + → λ(f : a → Bool) + → λ(xs : List a) + → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False + +let filter + = λ(a : Type) + → λ(f : a → Bool) + → λ(xs : List a) + → List/fold a xs (List a) + (λ (x : a) → λ (xs : List a) → if f x then [x] # xs else xs) ([] : List a) + +in sum (filter Natural Natural/even + (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000))) diff --git a/dhall-format/Main.hs b/dhall-format/Main.hs deleted file mode 100644 --- a/dhall-format/Main.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeOperators #-} - -{-| Utility executable for pretty-printing Dhall code - - You typically want to use this to either: - - * improve the readability of Dhall code (either written or generated) - * automatically format your Dhall code to avoid stylistic debates - - Note that this does not yet support: - - * Preserving all comments - * Currently, this only preserves all leading comments and whitespace - up until the last newline preceding the code - * This lets you preserve a comment header but if you want to document - subexpressions then you will need to split them into a separate - file for now - * Preserving multi-line strings (this reduces them to ordinary strings) - - See the @Dhall.Tutorial@ module for example usage --} -module Main where - -import Control.Exception (SomeException) -import Control.Monad (when) -import Data.Monoid ((<>)) -import Data.Version (showVersion) -import Dhall.Parser (exprAndHeaderFromText) -import Dhall.Pretty (annToAnsiStyle, prettyExpr) -import Options.Generic (Generic, ParseRecord, Wrapped, type ()(..), (:::)) -import System.IO (stderr) -import System.Exit (exitFailure, exitSuccess) -import Text.Trifecta.Delta (Delta(..)) - -import qualified Paths_dhall as Meta - -import qualified Control.Exception -import qualified Data.Text.IO -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.IO -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty -import qualified Options.Generic -import qualified System.Console.ANSI -import qualified System.IO - -data Options w = Options - { version :: w ::: Bool "Display version and exit" - , inplace :: w ::: Maybe FilePath "Modify the specified file in-place" - } deriving (Generic) - -instance ParseRecord (Options Wrapped) - -opts :: Pretty.LayoutOptions -opts = - Pretty.defaultLayoutOptions - { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } - -main :: IO () -main = do - Options {..} <- Options.Generic.unwrapRecord "Formatter for the Dhall language" - when version $ do - putStrLn (showVersion Meta.version) - exitSuccess - - let handler e = do - let _ = e :: SomeException - System.IO.hSetEncoding System.IO.stderr System.IO.utf8 - System.IO.hPrint stderr e - System.Exit.exitFailure - - Control.Exception.handle handler (do - case inplace of - Just file -> do - strictText <- Data.Text.IO.readFile file - let lazyText = Data.Text.Lazy.fromStrict strictText - (header, expr) <- case exprAndHeaderFromText (Directed "(stdin)" 0 0 0 0) lazyText of - Left err -> Control.Exception.throwIO err - Right x -> return x - - let doc = Pretty.pretty header <> Pretty.pretty expr - System.IO.withFile file System.IO.WriteMode (\handle -> do - Pretty.renderIO handle (Pretty.layoutSmart opts doc) - Data.Text.IO.hPutStrLn handle "" ) - Nothing -> do - System.IO.hSetEncoding System.IO.stdin System.IO.utf8 - inText <- Data.Text.Lazy.IO.getContents - - (header, expr) <- case exprAndHeaderFromText (Directed "(stdin)" 0 0 0 0) inText of - Left err -> Control.Exception.throwIO err - Right x -> return x - - let doc = Pretty.pretty header <> prettyExpr expr - - supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout - - if supportsANSI - then - Pretty.renderIO - System.IO.stdout - (fmap annToAnsiStyle (Pretty.layoutSmart opts doc)) - else - Pretty.renderIO - System.IO.stdout - (Pretty.layoutSmart opts (Pretty.unAnnotate doc)) - Data.Text.IO.putStrLn "") diff --git a/dhall-hash/Main.hs b/dhall-hash/Main.hs deleted file mode 100644 --- a/dhall-hash/Main.hs +++ /dev/null @@ -1,87 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeOperators #-} - -module Main where - -import Control.Exception (SomeException) -import Control.Monad (when) -import Data.Version (showVersion) -import Dhall.Core (normalize) -import Dhall.Import (Imported(..), hashExpressionToCode, load) -import Dhall.Parser (Src, exprFromText) -import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X) -import Options.Generic (Generic, ParseRecord, Wrapped, type ()(..), (:::)) -import System.IO (stderr) -import System.Exit (exitFailure, exitSuccess) -import Text.Trifecta.Delta (Delta(..)) - -import qualified Paths_dhall as Meta - -import qualified Control.Exception -import qualified Data.Text.Lazy.IO -import qualified Dhall.TypeCheck -import qualified Options.Generic -import qualified System.IO - -data Options w = Options - { explain :: w ::: Bool "Explain error messages in more detail" - , version :: w ::: Bool "Display version and exit" - } deriving (Generic) - -instance ParseRecord (Options Wrapped) - -main :: IO () -main = do - Options {..} <- Options.Generic.unwrapRecord "Compiler for the Dhall language" - when version $ do - putStrLn (showVersion Meta.version) - exitSuccess - let handle = - Control.Exception.handle handler2 - . Control.Exception.handle handler1 - . Control.Exception.handle handler0 - where - handler0 e = do - let _ = e :: TypeError Src X - System.IO.hPutStrLn stderr "" - if explain - then Control.Exception.throwIO (DetailedTypeError e) - else do - Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" - Control.Exception.throwIO e - - handler1 (Imported ps e) = do - let _ = e :: TypeError Src X - System.IO.hPutStrLn stderr "" - if explain - then Control.Exception.throwIO (Imported ps (DetailedTypeError e)) - else do - Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" - Control.Exception.throwIO (Imported ps e) - - handler2 e = do - let _ = e :: SomeException - System.IO.hSetEncoding System.IO.stderr System.IO.utf8 - System.IO.hPrint stderr e - System.Exit.exitFailure - - handle (do - System.IO.hSetEncoding System.IO.stdin System.IO.utf8 - inText <- Data.Text.Lazy.IO.getContents - - expr <- case exprFromText (Directed "(stdin)" 0 0 0 0) inText of - Left err -> Control.Exception.throwIO err - Right expr -> return expr - - expr' <- load expr - - _ <- case Dhall.TypeCheck.typeOf expr' of - Left err -> Control.Exception.throwIO err - Right _ -> return () - - Data.Text.Lazy.IO.putStrLn (hashExpressionToCode (normalize expr')) ) diff --git a/dhall-lang/Prelude/Bool/and b/dhall-lang/Prelude/Bool/and new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/and @@ -0,0 +1,3 @@ + missing + sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d +? ./and.dhall diff --git a/dhall-lang/Prelude/Bool/and.dhall b/dhall-lang/Prelude/Bool/and.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/and.dhall @@ -0,0 +1,14 @@ +{-| +The `and` function returns `False` if there are any `False` elements in the +`List` and returns `True` otherwise +-} +let and + : List Bool → Bool + = λ(xs : List Bool) → + List/fold Bool xs Bool (λ(l : Bool) → λ(r : Bool) → l && r) True + +let example0 = assert : and [ True, False, True ] ≡ False + +let example1 = assert : and ([] : List Bool) ≡ True + +in and diff --git a/dhall-lang/Prelude/Bool/build b/dhall-lang/Prelude/Bool/build new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/build @@ -0,0 +1,3 @@ + missing + sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b +? ./build.dhall diff --git a/dhall-lang/Prelude/Bool/build.dhall b/dhall-lang/Prelude/Bool/build.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/build.dhall @@ -0,0 +1,16 @@ +--| `build` is the inverse of `fold` +let build + : (∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) → Bool + = λ(f : ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) → + f Bool True False + +let example0 = + assert + : build (λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) ≡ True + +let example1 = + assert + : build (λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) + ≡ False + +in build diff --git a/dhall-lang/Prelude/Bool/equal.dhall b/dhall-lang/Prelude/Bool/equal.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/equal.dhall @@ -0,0 +1,6 @@ +--| Returns `True` if both arguments are equal and returns `False` otherwise +let equal + : Bool -> Bool -> Bool + = \(x : Bool) -> \(y : Bool) -> x == y + +in equal diff --git a/dhall-lang/Prelude/Bool/even b/dhall-lang/Prelude/Bool/even new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/even @@ -0,0 +1,3 @@ + missing + sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5 +? ./even.dhall diff --git a/dhall-lang/Prelude/Bool/even.dhall b/dhall-lang/Prelude/Bool/even.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/even.dhall @@ -0,0 +1,20 @@ +{-| +Returns `True` if there are an even number of `False` elements in the list and +returns `False` otherwise. + +This function is the `Monoid` for the `==` operation. +-} +let even + : List Bool → Bool + = λ(xs : List Bool) → + List/fold Bool xs Bool (λ(x : Bool) → λ(y : Bool) → x == y) True + +let example0 = assert : even [ False, True, False ] ≡ True + +let example1 = assert : even [ False, True ] ≡ False + +let example2 = assert : even [ False ] ≡ False + +let example3 = assert : even ([] : List Bool) ≡ True + +in even diff --git a/dhall-lang/Prelude/Bool/fold b/dhall-lang/Prelude/Bool/fold new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/fold @@ -0,0 +1,3 @@ + missing + sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae +? ./fold.dhall diff --git a/dhall-lang/Prelude/Bool/fold.dhall b/dhall-lang/Prelude/Bool/fold.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/fold.dhall @@ -0,0 +1,14 @@ +--| `fold` is essentially the same as `if`/`then`/`else` except as a function +let fold + : ∀(b : Bool) → ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool + = λ(b : Bool) → + λ(bool : Type) → + λ(true : bool) → + λ(false : bool) → + if b then true else false + +let example0 = assert : fold True Natural 0 1 ≡ 0 + +let example1 = assert : fold False Natural 0 1 ≡ 1 + +in fold diff --git a/dhall-lang/Prelude/Bool/not b/dhall-lang/Prelude/Bool/not new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/not @@ -0,0 +1,3 @@ + missing + sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 +? ./not.dhall diff --git a/dhall-lang/Prelude/Bool/not.dhall b/dhall-lang/Prelude/Bool/not.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/not.dhall @@ -0,0 +1,10 @@ +--| Flip the value of a `Bool` +let not + : Bool → Bool + = λ(b : Bool) → b == False + +let example0 = assert : not True ≡ False + +let example1 = assert : not False ≡ True + +in not diff --git a/dhall-lang/Prelude/Bool/odd b/dhall-lang/Prelude/Bool/odd new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/odd @@ -0,0 +1,3 @@ + missing + sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999 +? ./odd.dhall diff --git a/dhall-lang/Prelude/Bool/odd.dhall b/dhall-lang/Prelude/Bool/odd.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/odd.dhall @@ -0,0 +1,20 @@ +{-| +Returns `True` if there are an odd number of `True` elements in the list and +returns `False` otherwise. + +This function is the `Monoid` for the `!=` operation. +-} +let odd + : List Bool → Bool + = λ(xs : List Bool) → + List/fold Bool xs Bool (λ(x : Bool) → λ(y : Bool) → x != y) False + +let example0 = assert : odd [ True, False, True ] ≡ False + +let example1 = assert : odd [ True, False ] ≡ True + +let example2 = assert : odd [ True ] ≡ True + +let example3 = assert : odd ([] : List Bool) ≡ False + +in odd diff --git a/dhall-lang/Prelude/Bool/or b/dhall-lang/Prelude/Bool/or new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/or @@ -0,0 +1,3 @@ + missing + sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4 +? ./or.dhall diff --git a/dhall-lang/Prelude/Bool/or.dhall b/dhall-lang/Prelude/Bool/or.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/or.dhall @@ -0,0 +1,14 @@ +{-| +The `or` function returns `True` if there are any `True` elements in the `List` +and returns `False` otherwise +-} +let or + : List Bool → Bool + = λ(xs : List Bool) → + List/fold Bool xs Bool (λ(l : Bool) → λ(r : Bool) → l || r) False + +let example0 = assert : or [ True, False, True ] ≡ True + +let example1 = assert : or ([] : List Bool) ≡ False + +in or diff --git a/dhall-lang/Prelude/Bool/package.dhall b/dhall-lang/Prelude/Bool/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/package.dhall @@ -0,0 +1,37 @@ +{ and = + missing + sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d + ? ./and.dhall +, build = + missing + sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b + ? ./build.dhall +, equal = + missing + sha256:f0dc047ca14644c2a979bb126f2a3c6659ec770c66bd7beb70ae4a9d05815709 + ? ./equal.dhall +, even = + missing + sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5 + ? ./even.dhall +, fold = + missing + sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae + ? ./fold.dhall +, not = + missing + sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 + ? ./not.dhall +, odd = + missing + sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999 + ? ./odd.dhall +, or = + missing + sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4 + ? ./or.dhall +, show = + missing + sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61 + ? ./show.dhall +} diff --git a/dhall-lang/Prelude/Bool/show b/dhall-lang/Prelude/Bool/show new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/show @@ -0,0 +1,3 @@ + missing + sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61 +? ./show.dhall diff --git a/dhall-lang/Prelude/Bool/show.dhall b/dhall-lang/Prelude/Bool/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Bool/show.dhall @@ -0,0 +1,13 @@ +{-| +Render a `Bool` as `Text` using the same representation as Dhall source code +(i.e. beginning with a capital letter) +-} +let show + : Bool → Text + = λ(b : Bool) → if b then "True" else "False" + +let example0 = assert : show True ≡ "True" + +let example1 = assert : show False ≡ "False" + +in show diff --git a/dhall-lang/Prelude/Date/package.dhall b/dhall-lang/Prelude/Date/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Date/package.dhall @@ -0,0 +1,5 @@ +{ show = + missing + sha256:8a0eb9732cbc3c8f161b7cb05b183493befacc4728d2d9b7ee1384f19106a5ff + ? ./show.dhall +} diff --git a/dhall-lang/Prelude/Date/show.dhall b/dhall-lang/Prelude/Date/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Date/show.dhall @@ -0,0 +1,15 @@ +{- +Render a `Date` as `Text` using the same representation as Dhall source code +(i.e. `YYYY-MM-DD`) +-} +let show + : Date → Text + = Date/show + +let example0 = assert : show 2000-09-02 ≡ "2000-09-02" + +let example1 = assert : show 9999-12-31 ≡ "9999-12-31" + +let example2 = assert : show 0000-01-01 ≡ "0000-01-01" + +in show diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/Type.dhall @@ -0,0 +1,5 @@ +{-| +A (total) set of access rights; See chmod(5) for an explanation of the flags. +For a partial set of of access rights see `Access`. +-} +{ execute : Bool, read : Bool, write : Bool } diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/intersect.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/intersect.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/intersect.dhall @@ -0,0 +1,69 @@ +{-| +@intersect a b@ intesects the flags of the two `Mask`s @a@ and @b@. This +resembles the bitwise "and", i.e. the value of a flag is 'True' if and only if +it is set to 'True' in both @a@ and @b@. As a consequence @intersect a rwx == a@ +and @intersect a none == none@ for all @a@. +-} +let Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall + +let intersect + : Mask -> Mask -> Mask + = \(m1 : Mask) -> + \(m2 : Mask) -> + { read = m1.read && m2.read + , write = m1.write && m2.write + , execute = m1.execute && m2.execute + } + +let example0 = + let r = + missing + sha256:26d7fc8df6194a8051946eac88d0d7fecce690bff6819e69b3c74edf65ac027a + ? ./r.dhall + + let w = + missing + sha256:9d10dfc672f61bbb2828c7be2121aae2502938c25adb47bb8cce3c40ba99821b + ? ./w.dhall + + let x = + missing + sha256:a966fd88c05a5912a6daa8409e0c9e396f0a4810b51def1e1f62a95e18235f10 + ? ./x.dhall + + let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall + + let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall + + in assert : intersect r (intersect w (intersect x rwx)) === none + +let example1 = + \(a : Mask) -> + let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall + + in assert + : intersect a rwx + === { execute = a.execute, read = a.read, write = a.write } + +let example2 = + \(a : Mask) -> + let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall + + in assert : intersect a none === none + +in intersect diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/invert.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/invert.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/invert.dhall @@ -0,0 +1,48 @@ +{-| +Inverts the flags set in a `Mask`. +-} +let Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall + +let Bool/not = + missing + sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 + ? ../../../Bool/not.dhall + +let invert + : Mask -> Mask + = \(m : Mask) -> + { read = Bool/not m.read + , write = Bool/not m.write + , execute = Bool/not m.execute + } + +let example0 = + let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall + + let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall + + in assert : invert rwx === none + +let example1 = + let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall + + let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall + + in assert : invert none === rwx + +in invert diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/none.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/none.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/none.dhall @@ -0,0 +1,4 @@ + { read = False, write = False, execute = False } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/package.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/package.dhall @@ -0,0 +1,53 @@ +{ Type = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall +, intersect = + missing + sha256:7c7dab3e305f43cba556e0778b5a797cf8e9b1d1a6c6f6fe0ea311c329919663 + ? ./intersect.dhall +, invert = + missing + sha256:8807fb02f694fe2117f8a7f794e5afbb967ec36eac3405184bf9232c33cdd830 + ? ./invert.dhall +, none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall +, r = + missing + sha256:26d7fc8df6194a8051946eac88d0d7fecce690bff6819e69b3c74edf65ac027a + ? ./r.dhall +, rw = + missing + sha256:c3cce19f462b841e64adafbdf2963699a0031f5fc08b041c8ad364483c544d8b + ? ./rw.dhall +, rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall +, rx = + missing + sha256:d9beaa853c0de6984c3e5b0e313b573942900f8024fd9aaad743d73df458dc5e + ? ./rx.dhall +, toAccess = + missing + sha256:78fe016f0273b2551c8590da71bf204cc26d6879c6b84622d4d8ad5624328438 + ? ./toAccess.dhall +, toAccessWith = + missing + sha256:814ab74ad292c121620a1f468837d4a5473323423bf68c1bceca69e7b3c59077 + ? ./toAccessWith.dhall +, union = + missing + sha256:b40c4cbb266991e3f764af075e9db544b59c16b3d9aa680c0cf6cb7552da191f + ? ./union.dhall +, w = + missing + sha256:9d10dfc672f61bbb2828c7be2121aae2502938c25adb47bb8cce3c40ba99821b + ? ./w.dhall +, x = + missing + sha256:a966fd88c05a5912a6daa8409e0c9e396f0a4810b51def1e1f62a95e18235f10 + ? ./x.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/r.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/r.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/r.dhall @@ -0,0 +1,4 @@ + { read = True, write = False, execute = False } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/rw.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/rw.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/rw.dhall @@ -0,0 +1,4 @@ + { read = True, write = True, execute = False } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/rwx.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/rwx.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/rwx.dhall @@ -0,0 +1,4 @@ + { read = True, write = True, execute = True } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/rx.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/rx.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/rx.dhall @@ -0,0 +1,4 @@ + { read = True, write = False, execute = True } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/toAccess.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/toAccess.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/toAccess.dhall @@ -0,0 +1,20 @@ +{-| +Convert a `Mask` value to an `Access` value. For a partial conversion see +`toAccessWith`. +-} +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ../Type.dhall + +let Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall + +let toAccess + : Mask -> Access + = \(m : Mask) -> + { execute = Some m.execute, read = Some m.read, write = Some m.write } + +in toAccess diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/toAccessWith.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/toAccessWith.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/toAccessWith.dhall @@ -0,0 +1,42 @@ +{-| +@toAccessWith x m@ converts some fields of a `Mask` @m@ to an `Access` setting: +If the respective field is set in the first `Mask` @x@, then the flag will be +set to the flags value given in @m@. Otherwise, the value set in @m@ is ignored +and the value of the flag in the result is `None`. + +For a motivation of this function see the documenation on `toModeWith`. +-} +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ../Type.dhall + +let Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall + +let toAccessWith + : Mask -> Mask -> Access + = \(set : Mask) -> + \(m : Mask) -> + { execute = if set.execute then Some m.execute else None Bool + , read = if set.read then Some m.read else None Bool + , write = if set.write then Some m.write else None Bool + } + +let example0 = + \(a : Mask) -> + let Access/none = + missing + sha256:955a2eed689139c811d4b9ef3dd8d0c484392b18c3bb8752c59fd69dbdaf4881 + ? ../none.dhall + + let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall + + in assert : toAccessWith none a === Access/none + +in toAccessWith diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/union.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/union.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/union.dhall @@ -0,0 +1,64 @@ +{-| +@union a b@ combines the flags of the two `Mask`s @a@ and @b@. This resembles +the bitwise "or", i.e. the value of a flag is 'True' if it is set to 'True' in +either @a@ and @b@. As a consequence @union a rwx == rwx@ and +@union a none == a@ for all @a@. +-} +let Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall + +let union + : Mask -> Mask -> Mask + = \(m1 : Mask) -> + \(m2 : Mask) -> + { read = m1.read || m2.read + , write = m1.write || m2.write + , execute = m1.execute || m2.execute + } + +let example0 = + let r = + missing + sha256:26d7fc8df6194a8051946eac88d0d7fecce690bff6819e69b3c74edf65ac027a + ? ./r.dhall + + let w = + missing + sha256:9d10dfc672f61bbb2828c7be2121aae2502938c25adb47bb8cce3c40ba99821b + ? ./w.dhall + + let x = + missing + sha256:a966fd88c05a5912a6daa8409e0c9e396f0a4810b51def1e1f62a95e18235f10 + ? ./x.dhall + + let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall + + in assert : union r (union w x) === rwx + +let example1 = + \(a : Mask) -> + let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ./rwx.dhall + + in assert : union a rwx === rwx + +let example1 = + \(a : Mask) -> + let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ./none.dhall + + in assert + : union a none + === { execute = a.execute, read = a.read, write = a.write } + +in union diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/w.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/w.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/w.dhall @@ -0,0 +1,4 @@ + { read = False, write = True, execute = False } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Mask/x.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Mask/x.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Mask/x.dhall @@ -0,0 +1,4 @@ + { read = False, write = False, execute = True } +: missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Access/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/Type.dhall @@ -0,0 +1,5 @@ +{-| +A (partial) set of access rights; See chmod(5) for an explanation of the flags. +For a total set of access rights see `Mask`. +-} +{ execute : Optional Bool, read : Optional Bool, write : Optional Bool } diff --git a/dhall-lang/Prelude/DirectoryTree/Access/equal.dhall b/dhall-lang/Prelude/DirectoryTree/Access/equal.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/equal.dhall @@ -0,0 +1,29 @@ +{-| +`equal` checks if two `Access` settings are equal. +-} +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ./Type.dhall + +let Bool/equal = + missing + sha256:f0dc047ca14644c2a979bb126f2a3c6659ec770c66bd7beb70ae4a9d05815709 + ? ../../Bool/equal.dhall + +let Optional/equal = + missing + sha256:5411888399fe9c6720f7f3b59caf5eff3e8e8c30402d09f34e46a4457649a35a + ? ../../Optional/equal.dhall + +let f + : Optional Bool -> Optional Bool -> Bool + = Optional/equal Bool Bool/equal + +let equal + : Access -> Access -> Bool + = \(a1 : Access) -> + \(a2 : Access) -> + f a1.execute a2.execute && f a1.read a2.read && f a1.write a2.write + +in equal diff --git a/dhall-lang/Prelude/DirectoryTree/Access/none.dhall b/dhall-lang/Prelude/DirectoryTree/Access/none.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/none.dhall @@ -0,0 +1,4 @@ + { read = None Bool, write = None Bool, execute = None Bool } +: missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Access/package.dhall b/dhall-lang/Prelude/DirectoryTree/Access/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/package.dhall @@ -0,0 +1,17 @@ +{ Mask = + missing + sha256:ed736de51ea15a2ef671eaa7219dfbf3138bb52acfd0ae17894acf2ec4b06369 + ? ./Mask/package.dhall +, Type = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ./Type.dhall +, equal = + missing + sha256:5fa90f55505780a7be942275d6bbb2b1f1fb7857364332ed732a0241c2165e53 + ? ./equal.dhall +, schema = + missing + sha256:7d33a584a42a5d92411d5ca623e27ccb397762905be86ecfd01b106719fae690 + ? ./schema.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Access/schema.dhall b/dhall-lang/Prelude/DirectoryTree/Access/schema.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Access/schema.dhall @@ -0,0 +1,12 @@ +{-| +A schema for blank access rights. +-} +{ Type = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ./Type.dhall +, default = + missing + sha256:955a2eed689139c811d4b9ef3dd8d0c484392b18c3bb8752c59fd69dbdaf4881 + ? ./none.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/BinaryFileEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/BinaryFileEntry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/BinaryFileEntry.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +in Entry Bytes diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/DirectoryEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/DirectoryEntry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/DirectoryEntry.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +in \(tree : Type) -> Entry (List tree) diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/Metadata.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/Metadata.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/Metadata.dhall @@ -0,0 +1,24 @@ +{-| +An `Entry` without content. That in turn implies that the type of the entry +(i.e. whether it is a file or a directory) is not (yet) fixed as well. +-} +let User = + missing + sha256:8b25916612d2c9b17130d16b55c6bdb085dd118e692f72bf351a83b1d0ac8833 + ? ../User/Type.dhall + +let Group = + missing + sha256:83e6e8846153d94abf6f879808c94f5cdba3f486cc9e392eb6124b1dc67368cf + ? ../Group/Type.dhall + +let Mode = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ../Mode/Type.dhall + +in { name : Text + , user : Optional User + , group : Optional Group + , mode : Optional Mode + } diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/TextFileEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/TextFileEntry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/TextFileEntry.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +in Entry Text diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/Type.dhall @@ -0,0 +1,6 @@ +let Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ./Metadata.dhall + +in \(content : Type) -> Metadata //\\ { content : content } diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/binary-file.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/binary-file.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/binary-file.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall + +in Entry Bytes diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/directory.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/directory.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/directory.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall + +in \(tree : Type) -> Entry (List tree) diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/entry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/entry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/entry.dhall @@ -0,0 +1,24 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +let User = + missing + sha256:8b25916612d2c9b17130d16b55c6bdb085dd118e692f72bf351a83b1d0ac8833 + ? ../User/Type.dhall + +let Group = + missing + sha256:83e6e8846153d94abf6f879808c94f5cdba3f486cc9e392eb6124b1dc67368cf + ? ../Group/Type.dhall + +let Mode = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ../Mode/Type.dhall + +in \(content : Type) -> + { Type = Entry content + , default = { user = None User, group = None Group, mode = None Mode } + } diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/package.dhall @@ -0,0 +1,37 @@ +{ BinaryFileEntry = + missing + sha256:f027db2893f6f38bbe6d868a91f22de530e85407237f00b147427c87d32bf55c + ? ./BinaryFileEntry.dhall +, DirectoryEntry = + missing + sha256:163a4536fdd05ce122d793ceda01d03fcffb29463817ae8b7b5601bf4a06ce6e + ? ./DirectoryEntry.dhall +, Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ./Metadata.dhall +, TextFileEntry = + missing + sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 + ? ./TextFileEntry.dhall +, Type = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall +, binary-file = + missing + sha256:bd49df43268c259e3d0bef995917c3ab517ae7b98bf1faac8f4a7e8a602e3465 + ? ./binary-file.dhall +, directory = + missing + sha256:0bee17310a21efa5b06f139b6731fdcee4f9e0245ef711c2b0127b8938dfed2e + ? ./directory.dhall +, entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall +, text-file = + missing + sha256:c5d76fd43216668d03df9945183fe7b3c55486aedcc77324c3372bd63e283b78 + ? ./text-file.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Entry/text-file.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/text-file.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/text-file.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall + +in Entry Text diff --git a/dhall-lang/Prelude/DirectoryTree/Group/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Group/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Group/Type.dhall @@ -0,0 +1,1 @@ +< GroupId : Natural | GroupName : Text > diff --git a/dhall-lang/Prelude/DirectoryTree/Group/id.dhall b/dhall-lang/Prelude/DirectoryTree/Group/id.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Group/id.dhall @@ -0,0 +1,6 @@ +let Group = + missing + sha256:83e6e8846153d94abf6f879808c94f5cdba3f486cc9e392eb6124b1dc67368cf + ? ./Type.dhall + +in Group.GroupId diff --git a/dhall-lang/Prelude/DirectoryTree/Group/name.dhall b/dhall-lang/Prelude/DirectoryTree/Group/name.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Group/name.dhall @@ -0,0 +1,6 @@ +let Group = + missing + sha256:83e6e8846153d94abf6f879808c94f5cdba3f486cc9e392eb6124b1dc67368cf + ? ./Type.dhall + +in Group.GroupName diff --git a/dhall-lang/Prelude/DirectoryTree/Group/package.dhall b/dhall-lang/Prelude/DirectoryTree/Group/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Group/package.dhall @@ -0,0 +1,13 @@ +{ Type = + missing + sha256:83e6e8846153d94abf6f879808c94f5cdba3f486cc9e392eb6124b1dc67368cf + ? ./Type.dhall +, id = + missing + sha256:2bf9e546f56a583243d419a652caba16ca4053df9ccb3c5b242506d86806944b + ? ./id.dhall +, name = + missing + sha256:51ac5c407f2939ab0c80bf2896d292ee6049bd8ba10acda0af327a3777f2205d + ? ./name.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/Type.dhall @@ -0,0 +1,10 @@ +{-| +A complete mode with all access rights specified explicitely. For an incomplete +mode where some access rights might not be set see `Mode`. +-} +let Access/Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ../../Access/Mask/Type.dhall + +in { user : Access/Mask, group : Access/Mask, other : Access/Mask } diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/all.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/all.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/all.dhall @@ -0,0 +1,9 @@ +{-| +Permissions with all flags set: rwxrwxrwx +-} +let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ../../Access/Mask/rwx.dhall + +in { user = rwx, group = rwx, other = rwx } diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/directory.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/directory.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/directory.dhall @@ -0,0 +1,17 @@ +{-| +Permissions commonly used for directories: rwxr-xr-x +-} +let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ../../Access/Mask/rwx.dhall + +let rx = + missing + sha256:d9beaa853c0de6984c3e5b0e313b573942900f8024fd9aaad743d73df458dc5e + ? ../../Access/Mask/rx.dhall + +in { user = rwx, group = rx, other = rx } + : missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/executable.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/executable.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/executable.dhall @@ -0,0 +1,17 @@ +{-| +Permissions commonly used for executable files: rwxr-xr-x +-} +let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ../../Access/Mask/rwx.dhall + +let rx = + missing + sha256:d9beaa853c0de6984c3e5b0e313b573942900f8024fd9aaad743d73df458dc5e + ? ../../Access/Mask/rx.dhall + +in { user = rwx, group = rx, other = rx } + : missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/file.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/file.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/file.dhall @@ -0,0 +1,17 @@ +{-| +Permissions commonly used for regular files: rw-r--r-- +-} +let r = + missing + sha256:26d7fc8df6194a8051946eac88d0d7fecce690bff6819e69b3c74edf65ac027a + ? ../../Access/Mask/r.dhall + +let rw = + missing + sha256:c3cce19f462b841e64adafbdf2963699a0031f5fc08b041c8ad364483c544d8b + ? ../../Access/Mask/rw.dhall + +in { user = rw, group = r, other = r } + : missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/group.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/group.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/group.dhall @@ -0,0 +1,14 @@ +{-| +Permissions with group flags set: ---rwx--- +-} +let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ../../Access/Mask/rwx.dhall + +let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ../../Access/Mask/none.dhall + +in { user = none, group = rwx, other = none } diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/intersect.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/intersect.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/intersect.dhall @@ -0,0 +1,24 @@ +{-| +Calculates the intersection of the access rights of two `Mask`s using +`Access/intersect`. +-} +let Mask = + missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall + +let Access/intersect = + missing + sha256:7c7dab3e305f43cba556e0778b5a797cf8e9b1d1a6c6f6fe0ea311c329919663 + ? ../../Access/Mask/intersect.dhall + +let intersect + : Mask -> Mask -> Mask + = \(m1 : Mask) -> + \(m2 : Mask) -> + { user = Access/intersect m1.user m2.user + , group = Access/intersect m1.group m2.group + , other = Access/intersect m1.other m2.other + } + +in intersect diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/invert.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/invert.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/invert.dhall @@ -0,0 +1,22 @@ +{-| +Inverts each access right set in a `Mask` using `Access/invert`. +-} +let Mask = + missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall + +let Access/invert = + missing + sha256:8807fb02f694fe2117f8a7f794e5afbb967ec36eac3405184bf9232c33cdd830 + ? ../../Access/Mask/invert.dhall + +let invert + : Mask -> Mask + = \(m : Mask) -> + { user = Access/invert m.user + , group = Access/invert m.group + , other = Access/invert m.other + } + +in invert diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/none.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/none.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/none.dhall @@ -0,0 +1,12 @@ +{-| +Permissions with no flags set: --------- +-} +let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ../../Access/Mask/none.dhall + +in { user = none, group = none, other = none } + : missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/other.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/other.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/other.dhall @@ -0,0 +1,14 @@ +{-| +Permissions with other flags set: ------rwx +-} +let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ../../Access/Mask/rwx.dhall + +let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ../../Access/Mask/none.dhall + +in { user = none, group = none, other = rwx } diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/package.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/package.dhall @@ -0,0 +1,41 @@ +{ Type = + missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall +, directory = + missing + sha256:a43f235f0caa25c7cabd89ac5d77e466e0c0ebf3339046993c18e481930243fd + ? ./directory.dhall +, executable = + missing + sha256:a43f235f0caa25c7cabd89ac5d77e466e0c0ebf3339046993c18e481930243fd + ? ./executable.dhall +, file = + missing + sha256:32d34228d48a707996272d1c9681171ddcd6651f72eeb3de9727d1c26ba99df3 + ? ./file.dhall +, intersect = + missing + sha256:146be962523ef619d3a250699f977b69c3e5f6c24b975453f351c0e807266fc8 + ? ./intersect.dhall +, invert = + missing + sha256:07a13d8c233d0a9fd6b3a11475987c10619072fec882c96bc5499bfb3c01e9b2 + ? ./invert.dhall +, none = + missing + sha256:7cac21e2b72cadf3ee0bf10680df4902ca73b6ee070219df5eac1a24cd66ccdf + ? ./none.dhall +, toMode = + missing + sha256:af2b0dab799374afa0a2f28551446760ff29f4697c200da0a8b0a8def7feee2a + ? ./toMode.dhall +, toModeWith = + missing + sha256:b92327bec9141cc1a55bc3f11ae2584af0883b94fe2513376fc40f1da5ade9b2 + ? ./toModeWith.dhall +, union = + missing + sha256:3bb32fc6ea21f661571e46d90e450e0340b2f2b65482ba7bd1a30514e1b39fc2 + ? ./union.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/toMode.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/toMode.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/toMode.dhall @@ -0,0 +1,28 @@ +{-| +Convert a `Mask` value to a `Mode` value. For a partial conversion see +`toModeWith`. +-} +let Mode = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ../Type.dhall + +let Mask = + missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall + +let Access/toAccess = + missing + sha256:78fe016f0273b2551c8590da71bf204cc26d6879c6b84622d4d8ad5624328438 + ? ../../Access/Mask/toAccess.dhall + +let toMode + : Mask -> Mode + = \(m : Mask) -> + { user = Some (Access/toAccess m.user) + , group = Some (Access/toAccess m.group) + , other = Some (Access/toAccess m.other) + } + +in toMode diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/toModeWith.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/toModeWith.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/toModeWith.dhall @@ -0,0 +1,149 @@ +{-| +@toModeWith x m@ converts some fields of a `Mask` @m@ to a `Mode`: If the +respective field is set in the first `Mask` @x@, then the flag will be set to +the flags value given in @m@. Otherwise, the value set in @m@ is ignored and the +value of the flag in the result is `None`. + +The function is motivated by the following use case: +Alice has her umask set to 022 and new files will have permissions set to +rw-r--r--. Bob has the umask set to 077, hence newly created files will have +rw------- permissions. Now Eve distributes Dhall code writing a file with the +following mode to the filesystem: +```dhall +let mask = ./other.dhall + +let permissions = ./all.dhall + +in +toModeWith mask permissions +``` +The written file will have rw-r--rwx permissions for Alice and rw----rwx +permissions for Bob as the `toModeWith mask` produces a `Mode` that will only +apply the permissions for the 'other' part. +-} +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ../../Access/Type.dhall + +let Access/Mask = + missing + sha256:c0fa7626b69e117086439a7b4ee15d1a80e16e38fe2ccc13f55e6dd26030b4df + ? ../../Access/Mask/Type.dhall + +let Mode = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ../Type.dhall + +let Mask = + missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall + +let Access/equal = + missing + sha256:5fa90f55505780a7be942275d6bbb2b1f1fb7857364332ed732a0241c2165e53 + ? ../../Access/equal.dhall + +let Access/toAccessWith = + missing + sha256:814ab74ad292c121620a1f468837d4a5473323423bf68c1bceca69e7b3c59077 + ? ../../Access/Mask/toAccessWith.dhall + +let f + : Access/Mask -> Access/Mask -> Optional Access + = \(set : Access/Mask) -> + \(m : Access/Mask) -> + let x = Access/toAccessWith set m + + in if Access/equal + { execute = None Bool, read = None Bool, write = None Bool } + x + then None Access + else Some x + +let toModeWith + : Mask -> Mask -> Mode + = \(set : Mask) -> + \(m : Mask) -> + { user = f set.user m.user + , group = f set.group m.group + , other = f set.other m.other + } + +let example0 = + \(a : Mask) -> + let none = + missing + sha256:7cac21e2b72cadf3ee0bf10680df4902ca73b6ee070219df5eac1a24cd66ccdf + ? ./none.dhall + + let Mode/none = + missing + sha256:0ed46da7e6acbdff9e4c9e27a9f2770075a7cd6cb6bb565765c62093df1b5563 + ? ../none.dhall + + in assert : toModeWith none a === Mode/none + +let example1 = + \(a : Mask) -> + let toMode = + missing + sha256:af2b0dab799374afa0a2f28551446760ff29f4697c200da0a8b0a8def7feee2a + ? ./toMode.dhall + + let all = + missing + sha256:758415eca8dfee675dfef93ace9af82abb36bb3319b8e6295537ed18f9b5d3dd + ? ./all.dhall + + in assert : toModeWith all a === toMode a + +let example2 = + let mask = + missing + sha256:94bf82678d8d1c4f370a96f3831d3ad4464fbee508ffb37e93a479a1d9ee25cf + ? ./other.dhall + + let permissions = + missing + sha256:758415eca8dfee675dfef93ace9af82abb36bb3319b8e6295537ed18f9b5d3dd + ? ./all.dhall + + let rwx = { read = Some True, write = Some True, execute = Some True } + + in assert + : toModeWith mask permissions + === { user = None Access, group = None Access, other = Some rwx } + +let example3 = + let union = + missing + sha256:3bb32fc6ea21f661571e46d90e450e0340b2f2b65482ba7bd1a30514e1b39fc2 + ? ./union.dhall + + let group = + missing + sha256:faa567630372f77bb5cd2fa4fe7cb4760d2f9f79e35df80917e6e0064decf7cf + ? ./group.dhall + + let other = + missing + sha256:94bf82678d8d1c4f370a96f3831d3ad4464fbee508ffb37e93a479a1d9ee25cf + ? ./other.dhall + + let permissions = + missing + sha256:758415eca8dfee675dfef93ace9af82abb36bb3319b8e6295537ed18f9b5d3dd + ? ./all.dhall + + let mask = union group other + + let rwx = { read = Some True, write = Some True, execute = Some True } + + in assert + : toModeWith mask permissions + === { user = None Access, group = Some rwx, other = Some rwx } + +in toModeWith diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/union.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/union.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/union.dhall @@ -0,0 +1,24 @@ +{-| +Calculates the union of the access rights set by both `Mask`s using +`Access/union`. +-} +let Mask = + missing + sha256:4f97762058f24053e03997565a78800a5a2586159deaa265a4ee84a3d94ad471 + ? ./Type.dhall + +let Access/union = + missing + sha256:b40c4cbb266991e3f764af075e9db544b59c16b3d9aa680c0cf6cb7552da191f + ? ../../Access/Mask/union.dhall + +let union + : Mask -> Mask -> Mask + = \(m1 : Mask) -> + \(m2 : Mask) -> + { user = Access/union m1.user m2.user + , group = Access/union m1.group m2.group + , other = Access/union m1.other m2.other + } + +in union diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Mask/user.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/user.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Mask/user.dhall @@ -0,0 +1,14 @@ +{-| +Permissions with all user flags set: rwx------ +-} +let rwx = + missing + sha256:cafda16b1ecc0d2f9a63f3aab229a02e18aebb054283c73e50517f1e3727cd27 + ? ../../Access/Mask/rwx.dhall + +let none = + missing + sha256:db6c3bb734bb3288441f2664379706052943eaba35c021326a600d41ca766925 + ? ../../Access/Mask/none.dhall + +in { user = rwx, group = none, other = none } diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/Type.dhall @@ -0,0 +1,10 @@ +{-| +An incomplete mode where some access rights might not be set explicitely. For a +complete mode with all access rights specified explicitely see `Mask`. +-} +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ../Access/Type.dhall + +in { user : Optional Access, group : Optional Access, other : Optional Access } diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/equal.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/equal.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/equal.dhall @@ -0,0 +1,34 @@ +{-| +`equal` checks if two `Mode`s are equal. +-} +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ../Access/Type.dhall + +let Mode = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ./Type.dhall + +let Access/equal = + missing + sha256:5fa90f55505780a7be942275d6bbb2b1f1fb7857364332ed732a0241c2165e53 + ? ../Access/equal.dhall + +let Optional/equal = + missing + sha256:5411888399fe9c6720f7f3b59caf5eff3e8e8c30402d09f34e46a4457649a35a + ? ../../Optional/equal.dhall + +let f + : Optional Access -> Optional Access -> Bool + = Optional/equal Access Access/equal + +let equal + : Mode -> Mode -> Bool + = \(m1 : Mode) -> + \(m2 : Mode) -> + f m1.user m2.user && f m1.group m2.group && f m1.other m2.other + +in equal diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/none.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/none.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/none.dhall @@ -0,0 +1,9 @@ +let Access = + missing + sha256:50689ae80f8c8dcd6e7af33fbc20ea871afb92ec87104253cdbae01f838f6c38 + ? ../Access/Type.dhall + +in { user = None Access, group = None Access, other = None Access } + : missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ./Type.dhall diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/package.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/package.dhall @@ -0,0 +1,17 @@ +{ Mask = + missing + sha256:ce2c7ac1b81c2184b906cdd07c79936ba0eaf0445f1e383f53fd18d688ee7044 + ? ./Mask/package.dhall +, Type = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ./Type.dhall +, equal = + missing + sha256:32fee2d3a56a2162d6c98fb63d47d31f98b352f22cc60c8b506011c9b5230e56 + ? ./equal.dhall +, schema = + missing + sha256:49f8eff9612d761c1bd424299b68317ad0f3ba325e4d22ec8acb550c2f1c0a40 + ? ./schema.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Mode/schema.dhall b/dhall-lang/Prelude/DirectoryTree/Mode/schema.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Mode/schema.dhall @@ -0,0 +1,12 @@ +{-| +A schema for a blank file mode. +-} +{ Type = + missing + sha256:f05819ec2145e7dabf4aa167338bee6d326aabd81355dcf0b078e358bd34ec60 + ? ./Type.dhall +, default = + missing + sha256:0ed46da7e6acbdff9e4c9e27a9f2770075a7cd6cb6bb565765c62093df1b5563 + ? ./none.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Tree/Make.dhall @@ -0,0 +1,20 @@ +let Directory = + missing + sha256:163a4536fdd05ce122d793ceda01d03fcffb29463817ae8b7b5601bf4a06ce6e + ? ../Entry/DirectoryEntry.dhall + +let BinaryFile = + missing + sha256:f027db2893f6f38bbe6d868a91f22de530e85407237f00b147427c87d32bf55c + ? ../Entry/BinaryFileEntry.dhall + +let TextFile = + missing + sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 + ? ../Entry/TextFileEntry.dhall + +in \(tree : Type) -> + { directory : Directory tree -> tree + , binary-file : BinaryFile -> tree + , file : TextFile -> tree + } diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Tree/Type.dhall @@ -0,0 +1,6 @@ +let Make = + missing + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b + ? ./Make.dhall + +in forall (tree : Type) -> forall (make : Make tree) -> List tree diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Tree/makeTree.dhall @@ -0,0 +1,32 @@ +{-| +@makeTree tree make parents x@ places the tree @x@ below the directory @parent@. +@parent@ is given as a list of 'Metadata' values where each of those will be +used to create the respective level of the directory tree. +-} +let Make = + missing + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b + ? ./Make.dhall + +let Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ../Entry/Metadata.dhall + +let makeTree + : forall (tree : Type) -> Make tree -> List Metadata -> tree -> tree + = \(tree : Type) -> + \(make : Make tree) -> + \(parents : List Metadata) -> + \(leaf : tree) -> + List/fold + Metadata + parents + tree + ( \(directory : Metadata) -> + \(result : tree) -> + make.directory (directory /\ { content = [ result ] }) + ) + leaf + +in makeTree diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreeFromList.dhall @@ -0,0 +1,42 @@ +{-| +@makeTreeFromList tree make parents xs@ places the trees @xs@ below the +directory @parent@. @parent@ is given as a non-empty list of 'Metadata' values +where each of those will be used to create the respective level of the directory +tree. +-} +let Make = + missing + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b + ? ./Make.dhall + +let Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ../Entry/Metadata.dhall + +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ../../NonEmpty/Type.dhall + +let makeTreesFromList = + missing + sha256:02fce5b194da66c2f98bd05af0a3bfdccf0b57d7971f17bcafee436652d9a88e + ? ./makeTreesFromList.dhall + +let makeTreeFromList + : forall (tree : Type) -> + Make tree -> + NonEmpty Metadata -> + List tree -> + tree + = \(tree : Type) -> + \(make : Make tree) -> + \(parents : NonEmpty Metadata) -> + \(leaves : List tree) -> + make.directory + ( parents.head + /\ { content = makeTreesFromList tree make parents.tail leaves } + ) + +in makeTreeFromList diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Tree/makeTreesFromList.dhall @@ -0,0 +1,36 @@ +{-| +@makeTreesFromList tree make parents xs@ places the trees @xs@ below the +directory @parent@. @parent@ is given as a list of 'Metadata' values where each +of those will be used to create the respective level of the directory tree. +-} +let Make = + missing + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b + ? ./Make.dhall + +let Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ../Entry/Metadata.dhall + +let makeTreesFromList + : forall (tree : Type) -> + Make tree -> + List Metadata -> + List tree -> + List tree + = \(tree : Type) -> + \(make : Make tree) -> + \(parents : List Metadata) -> + \(leaves : List tree) -> + List/fold + Metadata + parents + (List tree) + ( \(directory : Metadata) -> + \(content : List tree) -> + [ make.directory (directory /\ { content }) ] + ) + leaves + +in makeTreesFromList diff --git a/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall b/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Tree/package.dhall @@ -0,0 +1,21 @@ +{ Make = + missing + sha256:33c52c16f76b41c3635b57a38ce0286f1ad8b3163a3f07a3b41b808ac5bfeb5b + ? ./Make.dhall +, Type = + missing + sha256:60b4d351213c6d851d7b2163ada40290b3c492a27326a2066fdec1a3915fb33b + ? ./Type.dhall +, makeTree = + missing + sha256:2c1339fa63b4947864e1a6eede3c296288b53cf91a09d0d6881ae56790342e44 + ? ./makeTree.dhall +, makeTreeFromList = + missing + sha256:b894c9398e123d7262320684ac6301c2efe44d9d4f5a303b99d14e9be6b3150f + ? ./makeTreeFromList.dhall +, makeTreesFromList = + missing + sha256:02fce5b194da66c2f98bd05af0a3bfdccf0b57d7971f17bcafee436652d9a88e + ? ./makeTreesFromList.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/User/Type.dhall b/dhall-lang/Prelude/DirectoryTree/User/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/User/Type.dhall @@ -0,0 +1,1 @@ +< UserId : Natural | UserName : Text > diff --git a/dhall-lang/Prelude/DirectoryTree/User/id.dhall b/dhall-lang/Prelude/DirectoryTree/User/id.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/User/id.dhall @@ -0,0 +1,6 @@ +let User = + missing + sha256:8b25916612d2c9b17130d16b55c6bdb085dd118e692f72bf351a83b1d0ac8833 + ? ./Type.dhall + +in User.UserId diff --git a/dhall-lang/Prelude/DirectoryTree/User/name.dhall b/dhall-lang/Prelude/DirectoryTree/User/name.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/User/name.dhall @@ -0,0 +1,6 @@ +let User = + missing + sha256:8b25916612d2c9b17130d16b55c6bdb085dd118e692f72bf351a83b1d0ac8833 + ? ./Type.dhall + +in User.UserName diff --git a/dhall-lang/Prelude/DirectoryTree/User/package.dhall b/dhall-lang/Prelude/DirectoryTree/User/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/User/package.dhall @@ -0,0 +1,13 @@ +{ Type = + missing + sha256:8b25916612d2c9b17130d16b55c6bdb085dd118e692f72bf351a83b1d0ac8833 + ? ./Type.dhall +, id = + missing + sha256:b572ca9f08a04e8e472f1b6141fd71ff27cc7f22d1e72be50eba5f54798b5a6d + ? ./id.dhall +, name = + missing + sha256:9cfd68599bbd626d3f32c9caa3f09b358ecc08659ef2540b24a4b17b49027015 + ? ./name.dhall +} diff --git a/dhall-lang/Prelude/DirectoryTree/package.dhall b/dhall-lang/Prelude/DirectoryTree/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/package.dhall @@ -0,0 +1,25 @@ +{ Access = + missing + sha256:12f2ac90297a81c6e5a548bbf568fc7c93c906a6528432aa74faab6ec859de30 + ? ./Access/package.dhall +, Entry = + missing + sha256:795db8b6c2bc28fdff6fbcc832c5b4cb6931c1f62ffa84674280c24d4f2eacd8 + ? ./Entry/package.dhall +, Group = + missing + sha256:76a0d7e4606bdb91ab001b245cbd411939333b3fc3934ecbb5d41982d1ea001f + ? ./Group/package.dhall +, Mode = + missing + sha256:6687ff7703fe9abdc4af9b3404af3d1c7d21a523d10a0c0b57d102a0bd87843f + ? ./Mode/package.dhall +, Tree = + missing + sha256:6a64c27fa8a0c95830a4cc836651257235da0d985b7f93d11813cdb7a72e646b + ? ./Tree/package.dhall +, User = + missing + sha256:eee7762ea4769371278907a4e33b3808d88430dda32dfc0536dc9bb2bb49d46a + ? ./User/package.dhall +} diff --git a/dhall-lang/Prelude/Double/package.dhall b/dhall-lang/Prelude/Double/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Double/package.dhall @@ -0,0 +1,5 @@ +{ show = + missing + sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f + ? ./show.dhall +} diff --git a/dhall-lang/Prelude/Double/show b/dhall-lang/Prelude/Double/show new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Double/show @@ -0,0 +1,3 @@ + missing + sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f +? ./show.dhall diff --git a/dhall-lang/Prelude/Double/show.dhall b/dhall-lang/Prelude/Double/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Double/show.dhall @@ -0,0 +1,13 @@ +{-| +Render a `Double` as `Text` using the same representation as Dhall source +code (i.e. a decimal floating point number with a leading `-` sign if negative) +-} +let show + : Double → Text + = Double/show + +let example0 = assert : show -3.1 ≡ "-3.1" + +let example1 = assert : show 0.4 ≡ "0.4" + +in show diff --git a/dhall-lang/Prelude/Function/compose b/dhall-lang/Prelude/Function/compose new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/compose @@ -0,0 +1,3 @@ + missing + sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 +? ./compose.dhall diff --git a/dhall-lang/Prelude/Function/compose.dhall b/dhall-lang/Prelude/Function/compose.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/compose.dhall @@ -0,0 +1,17 @@ +--| Compose two functions into one. +let compose + : ∀(a : Type) → ∀(b : Type) → ∀(c : Type) → (a → b) → (b → c) → a → c + = λ(a : Type) → + λ(b : Type) → + λ(c : Type) → + λ(f : a → b) → + λ(g : b → c) → + λ(x : a) → + g (f x) + +let example0 = + assert + : compose Natural Natural Bool (λ(n : Natural) → n + n) Natural/even 3 + ≡ True + +in compose diff --git a/dhall-lang/Prelude/Function/composeList.dhall b/dhall-lang/Prelude/Function/composeList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/composeList.dhall @@ -0,0 +1,35 @@ +{-| +Composes a list of functions starting from the left. +-} +let compose = + missing + sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 + ? ./compose.dhall + +let identity = + missing + sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 + ? ./identity.dhall + +let composeList + : ∀(a : Type) → List (a → a) → a → a + = λ(a : Type) → + λ(functions : List (a → a)) → + List/fold (a → a) functions (a → a) (compose a a a) (identity a) + +let example0 = + assert + : composeList + Natural + [ λ(x : Natural) → x * 2, λ(x : Natural) → x + 1 ] + 1 + ≡ 3 + +let property0 = + λ(a : Type) → + λ(f : a → a) → + λ(g : a → a) → + λ(h : a → a) → + assert : composeList a [ f, g, h ] ≡ (λ(x : a) → h (g (f x))) + +in composeList diff --git a/dhall-lang/Prelude/Function/identity b/dhall-lang/Prelude/Function/identity new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/identity @@ -0,0 +1,3 @@ + missing + sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 +? ./identity.dhall diff --git a/dhall-lang/Prelude/Function/identity.dhall b/dhall-lang/Prelude/Function/identity.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/identity.dhall @@ -0,0 +1,10 @@ +--| The identity function simply returns its input +let identity + : ∀(a : Type) → ∀(x : a) → a + = λ(a : Type) → λ(x : a) → x + +let example0 = assert : identity Natural 1 ≡ 1 + +let example1 = assert : identity Bool ≡ (λ(x : Bool) → x) + +in identity diff --git a/dhall-lang/Prelude/Function/package.dhall b/dhall-lang/Prelude/Function/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/package.dhall @@ -0,0 +1,13 @@ +{ compose = + missing + sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 + ? ./compose.dhall +, composeList = + missing + sha256:2c6931544d8b5a5b14514098c07bd1813f67b16834588d056df3c0bc2e489937 + ? ./composeList.dhall +, identity = + missing + sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 + ? ./identity.dhall +} diff --git a/dhall-lang/Prelude/Integer/abs b/dhall-lang/Prelude/Integer/abs new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/abs @@ -0,0 +1,3 @@ + missing + sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1 +? ./abs.dhall diff --git a/dhall-lang/Prelude/Integer/abs.dhall b/dhall-lang/Prelude/Integer/abs.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/abs.dhall @@ -0,0 +1,15 @@ +--| Returns the absolute value of an `Integer`, i.e. its non-negative value. +let abs + : Integer → Natural + = λ(n : Integer) → + if Natural/isZero (Integer/clamp n) + then Integer/clamp (Integer/negate n) + else Integer/clamp n + +let example0 = assert : abs +7 ≡ 7 + +let example2 = assert : abs +0 ≡ 0 + +let example3 = assert : abs -3 ≡ 3 + +in abs diff --git a/dhall-lang/Prelude/Integer/add b/dhall-lang/Prelude/Integer/add new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/add @@ -0,0 +1,3 @@ + missing + sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b +? ./add.dhall diff --git a/dhall-lang/Prelude/Integer/add.dhall b/dhall-lang/Prelude/Integer/add.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/add.dhall @@ -0,0 +1,25 @@ +--| `add m n` computes `m + n`. +let Integer/subtract = + missing + sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda + ? ./subtract.dhall + +let add + : Integer → Integer → Integer + = λ(m : Integer) → λ(n : Integer) → Integer/subtract (Integer/negate m) n + +let example0 = assert : add +3 +5 ≡ +8 + +let example1 = assert : add -3 -5 ≡ -8 + +let example2 = assert : add -4 +4 ≡ +0 + +let example3 = assert : add -3 +5 ≡ +2 + +let example4 = assert : add +3 -5 ≡ -2 + +let example5 = assert : add +0 -3 ≡ -3 + +let example6 = assert : add +0 +3 ≡ +3 + +in add diff --git a/dhall-lang/Prelude/Integer/clamp b/dhall-lang/Prelude/Integer/clamp new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/clamp @@ -0,0 +1,3 @@ + missing + sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2 +? ./clamp.dhall diff --git a/dhall-lang/Prelude/Integer/clamp.dhall b/dhall-lang/Prelude/Integer/clamp.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/clamp.dhall @@ -0,0 +1,14 @@ +{-| +Convert an `Integer` to a `Natural` number, with negative numbers becoming zero. +-} +let clamp + : Integer → Natural + = Integer/clamp + +let example0 = assert : clamp +7 ≡ 7 + +let example2 = assert : clamp +0 ≡ 0 + +let example3 = assert : clamp -3 ≡ 0 + +in clamp diff --git a/dhall-lang/Prelude/Integer/equal b/dhall-lang/Prelude/Integer/equal new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/equal @@ -0,0 +1,3 @@ + missing + sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8 +? ./equal.dhall diff --git a/dhall-lang/Prelude/Integer/equal.dhall b/dhall-lang/Prelude/Integer/equal.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/equal.dhall @@ -0,0 +1,24 @@ +--| `equal` checks if two Integers are equal. +let Natural/equal = + missing + sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60 + ? ../Natural/equal.dhall + +let equal + : Integer → Integer → Bool + = λ(a : Integer) → + λ(b : Integer) → + Natural/equal (Integer/clamp a) (Integer/clamp b) + && Natural/equal + (Integer/clamp (Integer/negate a)) + (Integer/clamp (Integer/negate b)) + +let example0 = assert : equal +5 +5 ≡ True + +let example1 = assert : equal +5 +6 ≡ False + +let example2 = assert : equal +5 -5 ≡ False + +let example3 = assert : equal -5 -5 ≡ True + +in equal diff --git a/dhall-lang/Prelude/Integer/greaterThan b/dhall-lang/Prelude/Integer/greaterThan new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/greaterThan @@ -0,0 +1,3 @@ + missing + sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b +? ./greaterThan.dhall diff --git a/dhall-lang/Prelude/Integer/greaterThan.dhall b/dhall-lang/Prelude/Integer/greaterThan.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/greaterThan.dhall @@ -0,0 +1,30 @@ +--| `greaterThan` checks if one Integer is greater than another. +let Bool/not = + missing + sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 + ? ../Bool/not.dhall + +let lessThanEqual = + missing + sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc + ? ./lessThanEqual.dhall + +let greaterThan + : Integer → Integer → Bool + = λ(x : Integer) → λ(y : Integer) → Bool/not (lessThanEqual x y) + +let example0 = assert : greaterThan +5 +6 ≡ False + +let example1 = assert : greaterThan +5 +5 ≡ False + +let example2 = assert : greaterThan +5 +4 ≡ True + +let example3 = assert : greaterThan -5 +8 ≡ False + +let example4 = assert : greaterThan -5 -3 ≡ False + +let example5 = assert : greaterThan -3 -5 ≡ True + +let example6 = assert : greaterThan -3 -3 ≡ False + +in greaterThan diff --git a/dhall-lang/Prelude/Integer/greaterThanEqual b/dhall-lang/Prelude/Integer/greaterThanEqual new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/greaterThanEqual @@ -0,0 +1,3 @@ + missing + sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958 +? ./greaterThanEqual.dhall diff --git a/dhall-lang/Prelude/Integer/greaterThanEqual.dhall b/dhall-lang/Prelude/Integer/greaterThanEqual.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/greaterThanEqual.dhall @@ -0,0 +1,27 @@ +{-| +`greaterThanEqual` checks if one Integer is greater than or equal to another. +-} +let lessThanEqual = + missing + sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc + ? ./lessThanEqual.dhall + +let greaterThanEqual + : Integer → Integer → Bool + = λ(x : Integer) → λ(y : Integer) → lessThanEqual y x + +let example0 = assert : greaterThanEqual +5 +6 ≡ False + +let example1 = assert : greaterThanEqual +5 +5 ≡ True + +let example2 = assert : greaterThanEqual +5 +4 ≡ True + +let example3 = assert : greaterThanEqual -5 +8 ≡ False + +let example4 = assert : greaterThanEqual -5 -3 ≡ False + +let example5 = assert : greaterThanEqual -3 -5 ≡ True + +let example6 = assert : greaterThanEqual -3 -3 ≡ True + +in greaterThanEqual diff --git a/dhall-lang/Prelude/Integer/lessThan b/dhall-lang/Prelude/Integer/lessThan new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/lessThan @@ -0,0 +1,3 @@ + missing + sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0 +? ./lessThan.dhall diff --git a/dhall-lang/Prelude/Integer/lessThan.dhall b/dhall-lang/Prelude/Integer/lessThan.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/lessThan.dhall @@ -0,0 +1,25 @@ +--| `lessThan` checks if one Integer is less than another. +let greaterThan = + missing + sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b + ? ./greaterThan.dhall + +let lessThan + : Integer → Integer → Bool + = λ(x : Integer) → λ(y : Integer) → greaterThan y x + +let example0 = assert : lessThan +5 +6 ≡ True + +let example1 = assert : lessThan +5 +5 ≡ False + +let example2 = assert : lessThan +5 +4 ≡ False + +let example3 = assert : lessThan -5 +8 ≡ True + +let example4 = assert : lessThan -5 -3 ≡ True + +let example5 = assert : lessThan -3 -5 ≡ False + +let example6 = assert : lessThan -3 -3 ≡ False + +in lessThan diff --git a/dhall-lang/Prelude/Integer/lessThanEqual b/dhall-lang/Prelude/Integer/lessThanEqual new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/lessThanEqual @@ -0,0 +1,3 @@ + missing + sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc +? ./lessThanEqual.dhall diff --git a/dhall-lang/Prelude/Integer/lessThanEqual.dhall b/dhall-lang/Prelude/Integer/lessThanEqual.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/lessThanEqual.dhall @@ -0,0 +1,47 @@ +--| `lessThanEqual` checks if one Integer is less than or equal to another. +let Natural/greaterThanEqual = + missing + sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 + ? ../Natural/greaterThanEqual.dhall + +let Natural/lessThanEqual = + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ../Natural/lessThanEqual.dhall + +let nonPositive = + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b + ? ./nonPositive.dhall + +let nonNegative = + missing + sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 + ? ./nonNegative.dhall + +let lessThanEqual + : Integer → Integer → Bool + = λ(x : Integer) → + λ(y : Integer) → + if nonPositive x + then nonNegative y + || Natural/greaterThanEqual + (Integer/clamp (Integer/negate x)) + (Integer/clamp (Integer/negate y)) + else Natural/lessThanEqual (Integer/clamp x) (Integer/clamp y) + +let example0 = assert : lessThanEqual +5 +6 ≡ True + +let example1 = assert : lessThanEqual +5 +5 ≡ True + +let example2 = assert : lessThanEqual +5 +4 ≡ False + +let example3 = assert : lessThanEqual -5 +8 ≡ True + +let example4 = assert : lessThanEqual -5 -3 ≡ True + +let example5 = assert : lessThanEqual -3 -5 ≡ False + +let example6 = assert : lessThanEqual -3 -3 ≡ True + +in lessThanEqual diff --git a/dhall-lang/Prelude/Integer/multiply b/dhall-lang/Prelude/Integer/multiply new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/multiply @@ -0,0 +1,3 @@ + missing + sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d +? ./multiply.dhall diff --git a/dhall-lang/Prelude/Integer/multiply.dhall b/dhall-lang/Prelude/Integer/multiply.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/multiply.dhall @@ -0,0 +1,40 @@ +--| `multiply m n` computes `m * n`. +let nonPositive = + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b + ? ./nonPositive.dhall + +let multiplyNonNegative = + λ(x : Integer) → + λ(y : Integer) → + Natural/toInteger (Integer/clamp x * Integer/clamp y) + +let multiply + : Integer → Integer → Integer + = λ(m : Integer) → + λ(n : Integer) → + if nonPositive m + then if nonPositive n + then multiplyNonNegative (Integer/negate m) (Integer/negate n) + else Integer/negate (multiplyNonNegative (Integer/negate m) n) + else if nonPositive n + then Integer/negate (multiplyNonNegative m (Integer/negate n)) + else multiplyNonNegative m n + +let example0 = assert : multiply +3 +5 ≡ +15 + +let example1 = assert : multiply -3 +5 ≡ -15 + +let example2 = assert : multiply -3 -5 ≡ +15 + +let example3 = assert : multiply +0 +5 ≡ +0 + +let example4 = assert : multiply +5 +0 ≡ +0 + +let example5 = assert : multiply +0 +0 ≡ +0 + +let example6 = assert : multiply +1 +5 ≡ +5 + +let example7 = assert : multiply +3 -1 ≡ -3 + +in multiply diff --git a/dhall-lang/Prelude/Integer/negate b/dhall-lang/Prelude/Integer/negate new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/negate @@ -0,0 +1,3 @@ + missing + sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d +? ./negate.dhall diff --git a/dhall-lang/Prelude/Integer/negate.dhall b/dhall-lang/Prelude/Integer/negate.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/negate.dhall @@ -0,0 +1,12 @@ +--| Invert the sign of an `Integer`, with zero remaining unchanged. +let negate + : Integer → Integer + = Integer/negate + +let example0 = assert : negate -3 ≡ +3 + +let example2 = assert : negate +7 ≡ -7 + +let example3 = assert : negate +0 ≡ +0 + +in negate diff --git a/dhall-lang/Prelude/Integer/negative b/dhall-lang/Prelude/Integer/negative new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/negative @@ -0,0 +1,3 @@ + missing + sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570 +? ./negative.dhall diff --git a/dhall-lang/Prelude/Integer/negative.dhall b/dhall-lang/Prelude/Integer/negative.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/negative.dhall @@ -0,0 +1,21 @@ +{-| +Returns `True` for any `Integer` less than `+0`. + +`negative` is more efficient than `./lessThan +0` or `./lessThanEqual -1`. +-} +let positive = + missing + sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3 + ? ./positive.dhall + +let negative + : Integer → Bool + = λ(n : Integer) → positive (Integer/negate n) + +let example0 = assert : negative +1 ≡ False + +let example1 = assert : negative +0 ≡ False + +let example2 = assert : negative -1 ≡ True + +in negative diff --git a/dhall-lang/Prelude/Integer/nonNegative b/dhall-lang/Prelude/Integer/nonNegative new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/nonNegative @@ -0,0 +1,3 @@ + missing + sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 +? ./nonNegative.dhall diff --git a/dhall-lang/Prelude/Integer/nonNegative.dhall b/dhall-lang/Prelude/Integer/nonNegative.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/nonNegative.dhall @@ -0,0 +1,21 @@ +{-| +Returns `True` for `+0` and any positive `Integer`. + +`nonNegative` is more efficient than `./greaterThanEqual +0` or `./greaterThan -1`. +-} +let nonPositive = + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b + ? ./nonPositive.dhall + +let nonNegative + : Integer → Bool + = λ(n : Integer) → nonPositive (Integer/negate n) + +let example0 = assert : nonNegative +1 ≡ True + +let example1 = assert : nonNegative +0 ≡ True + +let example2 = assert : nonNegative -1 ≡ False + +in nonNegative diff --git a/dhall-lang/Prelude/Integer/nonPositive b/dhall-lang/Prelude/Integer/nonPositive new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/nonPositive @@ -0,0 +1,3 @@ + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b +? ./nonPositive.dhall diff --git a/dhall-lang/Prelude/Integer/nonPositive.dhall b/dhall-lang/Prelude/Integer/nonPositive.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/nonPositive.dhall @@ -0,0 +1,16 @@ +{-| +Returns `True` for `+0` and any negative `Integer`. + +`nonPositive` is more efficient than `./lessThanEqual +0` or `./lessThan +1`. +-} +let nonPositive + : Integer → Bool + = λ(n : Integer) → Natural/isZero (Integer/clamp n) + +let example0 = assert : nonPositive +1 ≡ False + +let example1 = assert : nonPositive +0 ≡ True + +let example2 = assert : nonPositive -1 ≡ True + +in nonPositive diff --git a/dhall-lang/Prelude/Integer/package.dhall b/dhall-lang/Prelude/Integer/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/package.dhall @@ -0,0 +1,73 @@ +{ abs = + missing + sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1 + ? ./abs.dhall +, add = + missing + sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b + ? ./add.dhall +, clamp = + missing + sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2 + ? ./clamp.dhall +, equal = + missing + sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8 + ? ./equal.dhall +, greaterThan = + missing + sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b + ? ./greaterThan.dhall +, greaterThanEqual = + missing + sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958 + ? ./greaterThanEqual.dhall +, lessThan = + missing + sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0 + ? ./lessThan.dhall +, lessThanEqual = + missing + sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc + ? ./lessThanEqual.dhall +, multiply = + missing + sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d + ? ./multiply.dhall +, negate = + missing + sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d + ? ./negate.dhall +, negative = + missing + sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570 + ? ./negative.dhall +, nonNegative = + missing + sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 + ? ./nonNegative.dhall +, nonPositive = + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b + ? ./nonPositive.dhall +, positive = + missing + sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3 + ? ./positive.dhall +, show = + missing + sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9 + ? ./show.dhall +, subtract = + missing + sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda + ? ./subtract.dhall +, toDouble = + missing + sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7 + ? ./toDouble.dhall +, toNatural = + missing + sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e + ? ./toNatural.dhall +} diff --git a/dhall-lang/Prelude/Integer/positive b/dhall-lang/Prelude/Integer/positive new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/positive @@ -0,0 +1,3 @@ + missing + sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3 +? ./positive.dhall diff --git a/dhall-lang/Prelude/Integer/positive.dhall b/dhall-lang/Prelude/Integer/positive.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/positive.dhall @@ -0,0 +1,26 @@ +{-| +Returns `True` for any `Integer` greater than `+0`. + +`positive` is more efficient than `./greaterThan +0` or `./greaterThanEqual +1`. +-} +let not = + missing + sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 + ? ../Bool/not.dhall + +let nonPositive = + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b + ? ./nonPositive.dhall + +let positive + : Integer → Bool + = λ(n : Integer) → not (nonPositive n) + +let example0 = assert : positive +1 ≡ True + +let example1 = assert : positive +0 ≡ False + +let example2 = assert : positive -1 ≡ False + +in positive diff --git a/dhall-lang/Prelude/Integer/show b/dhall-lang/Prelude/Integer/show new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/show @@ -0,0 +1,3 @@ + missing + sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9 +? ./show.dhall diff --git a/dhall-lang/Prelude/Integer/show.dhall b/dhall-lang/Prelude/Integer/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/show.dhall @@ -0,0 +1,14 @@ +{-| +Render an `Integer` as `Text` using the same representation as Dhall source +code (i.e. a decimal number with a leading `-` sign if negative and a leading +`+` sign if non-negative) +-} +let show + : Integer → Text + = Integer/show + +let example0 = assert : show -3 ≡ "-3" + +let example1 = assert : show +0 ≡ "+0" + +in show diff --git a/dhall-lang/Prelude/Integer/subtract b/dhall-lang/Prelude/Integer/subtract new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/subtract @@ -0,0 +1,3 @@ + missing + sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda +? ./subtract.dhall diff --git a/dhall-lang/Prelude/Integer/subtract.dhall b/dhall-lang/Prelude/Integer/subtract.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/subtract.dhall @@ -0,0 +1,54 @@ +--| `subtract m n` computes `n - m`. +let nonPositive = + missing + sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b + ? ./nonPositive.dhall + +let subtractNonNegative = + λ(xi : Integer) → + λ(yi : Integer) → + let xn = Integer/clamp xi + + let yn = Integer/clamp yi + + let dn = Natural/subtract xn yn + + in if Natural/isZero dn + then Integer/negate (Natural/toInteger (Natural/subtract yn xn)) + else Natural/toInteger dn + +let subtract + : Integer → Integer → Integer + = λ(m : Integer) → + λ(n : Integer) → + if nonPositive m + then if nonPositive n + then subtractNonNegative (Integer/negate n) (Integer/negate m) + else Natural/toInteger + (Integer/clamp (Integer/negate m) + Integer/clamp n) + else if nonPositive n + then Integer/negate + ( Natural/toInteger + (Integer/clamp m + Integer/clamp (Integer/negate n)) + ) + else subtractNonNegative m n + +let example0 = assert : subtract +3 +5 ≡ +2 + +let example1 = assert : subtract +4 +4 ≡ +0 + +let example2 = assert : subtract +5 +3 ≡ -2 + +let example3 = assert : subtract -3 -5 ≡ -2 + +let example4 = assert : subtract -4 -4 ≡ +0 + +let example5 = assert : subtract -5 -3 ≡ +2 + +let example6 = assert : subtract -3 +5 ≡ +8 + +let example7 = assert : subtract +3 -5 ≡ -8 + +let example8 = assert : subtract +0 -3 ≡ -3 + +in subtract diff --git a/dhall-lang/Prelude/Integer/toDouble b/dhall-lang/Prelude/Integer/toDouble new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/toDouble @@ -0,0 +1,3 @@ + missing + sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7 +? ./toDouble.dhall diff --git a/dhall-lang/Prelude/Integer/toDouble.dhall b/dhall-lang/Prelude/Integer/toDouble.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/toDouble.dhall @@ -0,0 +1,10 @@ +--| Convert an `Integer` to the corresponding `Double` +let toDouble + : Integer → Double + = Integer/toDouble + +let example0 = assert : toDouble -3 ≡ -3.0 + +let example1 = assert : toDouble +2 ≡ 2.0 + +in toDouble diff --git a/dhall-lang/Prelude/Integer/toNatural b/dhall-lang/Prelude/Integer/toNatural new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/toNatural @@ -0,0 +1,3 @@ + missing + sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e +? ./toNatural.dhall diff --git a/dhall-lang/Prelude/Integer/toNatural.dhall b/dhall-lang/Prelude/Integer/toNatural.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Integer/toNatural.dhall @@ -0,0 +1,20 @@ +{-| +Convert an `Integer` to an `Optional Natural`, with negative numbers becoming `None Natural`. +-} +let nonNegative = + missing + sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 + ? ./nonNegative.dhall + +let toNatural + : Integer → Optional Natural + = λ(n : Integer) → + if nonNegative n then Some (Integer/clamp n) else None Natural + +let example0 = assert : toNatural +7 ≡ Some 7 + +let example2 = assert : toNatural +0 ≡ Some 0 + +let example3 = assert : toNatural -3 ≡ None Natural + +in toNatural diff --git a/dhall-lang/Prelude/JSON/Format b/dhall-lang/Prelude/JSON/Format new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Format @@ -0,0 +1,3 @@ + missing + sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac +? ./Format.dhall diff --git a/dhall-lang/Prelude/JSON/Format.dhall b/dhall-lang/Prelude/JSON/Format.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Format.dhall @@ -0,0 +1,7 @@ +{-| +An internal type used by `./renderAs` to select the output format. + +You should not need to use this type directly, simply use `./render` +or `./renderYAML` as appropriate. +-} +< YAML | JSON > diff --git a/dhall-lang/Prelude/JSON/Nesting b/dhall-lang/Prelude/JSON/Nesting new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Nesting @@ -0,0 +1,3 @@ + missing + sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 +? ./Nesting.dhall diff --git a/dhall-lang/Prelude/JSON/Nesting.dhall b/dhall-lang/Prelude/JSON/Nesting.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Nesting.dhall @@ -0,0 +1,35 @@ +{-| +This type is used as part of `dhall-json`'s support for preserving alternative +names + +For example, this Dhall code: + +``` +let Example = < Left : { foo : Natural } | Right : { bar : Bool } > + +let Nesting = < Inline | Nested : Text > + +in { field = + "name" + , nesting = + Nesting.Inline + , contents = + Example.Left { foo = 2 } + } +``` + +... generates this JSON: + +``` +{ + "foo": 2, + "name": "Left" +} +``` + +-} +let Nesting + : Type + = < Inline | Nested : Text > + +in Nesting diff --git a/dhall-lang/Prelude/JSON/Tagged b/dhall-lang/Prelude/JSON/Tagged new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Tagged @@ -0,0 +1,3 @@ + missing + sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 +? ./Tagged.dhall diff --git a/dhall-lang/Prelude/JSON/Tagged.dhall b/dhall-lang/Prelude/JSON/Tagged.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Tagged.dhall @@ -0,0 +1,74 @@ +{-| +This is a convenient type-level function when using `dhall-to-json`'s support +for preserving alternative names + +For example, this code: + +``` +let map = ../List/map + +let Provisioner = + < shell : + { inline : List Text } + | file : + { source : Text, destination : Text } + > + +let Tagged = ./Tagged + +let Nesting = ./Nesting + +let wrap + : Provisioner → Tagged Provisioner + = λ(x : Provisioner) → + { field = "type", nesting = Nesting.Nested "params", contents = x } + +in { provisioners = + map + Provisioner + (Tagged Provisioner) + wrap + [ Provisioner.shell { inline = [ "echo foo" ] } + , Provisioner.file + { source = "app.tar.gz", destination = "/tmp/app.tar.gz" } + ] + } +``` + +... produces this JSON: + +``` +{ + "provisioners": [ + { + "params": { + "inline": [ + "echo foo" + ] + }, + "type": "shell" + }, + { + "params": { + "destination": "/tmp/app.tar.gz", + "source": "app.tar.gz" + }, + "type": "file" + } + ] +} +``` + +-} +let Tagged + : Type → Type + = λ(a : Type) → + { field : Text + , nesting : + missing + sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting.dhall + , contents : a + } + +in Tagged diff --git a/dhall-lang/Prelude/JSON/Type b/dhall-lang/Prelude/JSON/Type new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Type @@ -0,0 +1,3 @@ + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 +? ./Type.dhall diff --git a/dhall-lang/Prelude/JSON/Type.dhall b/dhall-lang/Prelude/JSON/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/Type.dhall @@ -0,0 +1,63 @@ +{-| +Dhall encoding of an arbitrary JSON value + +For example, the following JSON value: + +``` +[ { "foo": null, "bar": [ 1.0, true ] } ] +``` + +... corresponds to the following Dhall expression: + +``` +λ(JSON : Type) → +λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , null : JSON + , double : Double → JSON + , integer : Integer → JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.object + [ { mapKey = "foo", mapValue = json.null } + , { mapKey = "bar" + , mapValue = json.array [ json.double 1.0, json.bool True ] + } + ] +``` + + You do not need to create these values directly, though. You can use + the utilities exported by `./package.dhall` to create values of this type, + such as: + +``` +let JSON = ./package.dhall + +in JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar" + , mapValue = JSON.array [ JSON.double 1.0, JSON.bool True ] + } + ] +``` + +-} +let JSON/Type + : Type + = ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + +in JSON/Type diff --git a/dhall-lang/Prelude/JSON/array b/dhall-lang/Prelude/JSON/array new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/array @@ -0,0 +1,3 @@ + missing + sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8 +? ./array.dhall diff --git a/dhall-lang/Prelude/JSON/array.dhall b/dhall-lang/Prelude/JSON/array.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/array.dhall @@ -0,0 +1,41 @@ +{-| +Create a JSON array from a `List` of JSON values + +``` +let JSON = ./package.dhall +in JSON.render (JSON.array [ JSON.double 1.0, JSON.bool True ]) += "[ 1.0, true ]" + +let JSON/Type = ./Type +let JSON = ./package.dhall +in JSON.render (JSON.array ([] : List JSON/Type)) += "[ ]" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let array + : List JSON → JSON + = λ(x : List JSON) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.array (List/map JSON@1 JSON (λ(j : JSON@1) → j JSON json) x) + +in array diff --git a/dhall-lang/Prelude/JSON/bool b/dhall-lang/Prelude/JSON/bool new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/bool @@ -0,0 +1,3 @@ + missing + sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39 +? ./bool.dhall diff --git a/dhall-lang/Prelude/JSON/bool.dhall b/dhall-lang/Prelude/JSON/bool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/bool.dhall @@ -0,0 +1,35 @@ +{-| +Create a JSON bool from a Dhall `Bool` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.bool True) += "true" + +let JSON = ./package.dhall +in JSON.render (JSON.bool False) += "false" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let bool + : Bool → JSON + = λ(x : Bool) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.bool x + +in bool diff --git a/dhall-lang/Prelude/JSON/core.dhall b/dhall-lang/Prelude/JSON/core.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/core.dhall @@ -0,0 +1,70 @@ +{-| +A record of functions useful for constructing `JSON` values. + +This is only a subset of what `package.dhall` exports. If you are not writing a +JSON prelude function, you should use the `package.dhall` file instead. + +It is used internally by `render`, `renderYAML` and `omitNullFields` instead of +`package.dhall` to avoid import cycles. +-} +{ Type = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall +, Tagged = + missing + sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 + ? ./Tagged.dhall +, Nesting = + missing + sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting.dhall +, keyText = + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc + ? ./keyText.dhall +, keyValue = + missing + sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c + ? ./keyValue.dhall +, string = + missing + sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e + ? ./string.dhall +, number = + missing + sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 + ? ./number.dhall +, double = + missing + sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 + ? ./double.dhall +, integer = + missing + sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40 + ? ./integer.dhall +, natural = + missing + sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5 + ? ./natural.dhall +, object = + missing + sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac + ? ./object.dhall +, array = + missing + sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8 + ? ./array.dhall +, bool = + missing + sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39 + ? ./bool.dhall +, null = + missing + sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8 + ? ./null.dhall +, renderInteger = + missing + sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c + ? ./renderInteger.dhall +} diff --git a/dhall-lang/Prelude/JSON/double b/dhall-lang/Prelude/JSON/double new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/double @@ -0,0 +1,3 @@ + missing + sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 +? ./double.dhall diff --git a/dhall-lang/Prelude/JSON/double.dhall b/dhall-lang/Prelude/JSON/double.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/double.dhall @@ -0,0 +1,35 @@ +{-| +Create a JSON number from a Dhall `Double` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.double 42.0) += "42.0" + +let JSON = ./package.dhall +in JSON.render (JSON.double -1.5e-10) += "-1.5e-10" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let double + : Double → JSON + = λ(x : Double) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.double x + +in double diff --git a/dhall-lang/Prelude/JSON/integer b/dhall-lang/Prelude/JSON/integer new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/integer @@ -0,0 +1,3 @@ + missing + sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40 +? ./integer.dhall diff --git a/dhall-lang/Prelude/JSON/integer.dhall b/dhall-lang/Prelude/JSON/integer.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/integer.dhall @@ -0,0 +1,35 @@ +{-| +Create a JSON number from a Dhall `Integer` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.integer -1) += "-1" + +let JSON = ./package.dhall +in JSON.render (JSON.integer +2) += "+2" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let integer + : Integer → JSON + = λ(x : Integer) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.integer x + +in integer diff --git a/dhall-lang/Prelude/JSON/keyText b/dhall-lang/Prelude/JSON/keyText new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/keyText @@ -0,0 +1,3 @@ + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc +? ./keyText.dhall diff --git a/dhall-lang/Prelude/JSON/keyText.dhall b/dhall-lang/Prelude/JSON/keyText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/keyText.dhall @@ -0,0 +1,3 @@ + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc +? ../Map/keyText.dhall diff --git a/dhall-lang/Prelude/JSON/keyValue b/dhall-lang/Prelude/JSON/keyValue new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/keyValue @@ -0,0 +1,3 @@ + missing + sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c +? ./keyValue.dhall diff --git a/dhall-lang/Prelude/JSON/keyValue.dhall b/dhall-lang/Prelude/JSON/keyValue.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/keyValue.dhall @@ -0,0 +1,3 @@ + missing + sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c +? ../Map/keyValue.dhall diff --git a/dhall-lang/Prelude/JSON/natural b/dhall-lang/Prelude/JSON/natural new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/natural @@ -0,0 +1,3 @@ + missing + sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5 +? ./natural.dhall diff --git a/dhall-lang/Prelude/JSON/natural.dhall b/dhall-lang/Prelude/JSON/natural.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/natural.dhall @@ -0,0 +1,31 @@ +{-| +Create a JSON number from a Dhall `Natural` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.natural 42) += "42" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let natural + : Natural → JSON + = λ(x : Natural) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.integer (Natural/toInteger x) + +in natural diff --git a/dhall-lang/Prelude/JSON/null b/dhall-lang/Prelude/JSON/null new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/null @@ -0,0 +1,3 @@ + missing + sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8 +? ./null.dhall diff --git a/dhall-lang/Prelude/JSON/null.dhall b/dhall-lang/Prelude/JSON/null.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/null.dhall @@ -0,0 +1,30 @@ +{-| +Create a JSON null + +``` +let JSON = ./package.dhall +in JSON.render JSON.null += "null" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let null + : JSON + = λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.null + +in null diff --git a/dhall-lang/Prelude/JSON/number b/dhall-lang/Prelude/JSON/number new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/number @@ -0,0 +1,3 @@ + missing + sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 +? ./number.dhall diff --git a/dhall-lang/Prelude/JSON/number.dhall b/dhall-lang/Prelude/JSON/number.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/number.dhall @@ -0,0 +1,28 @@ +{-| +Create a JSON number from a Dhall `Double` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.number 42.0) += "42.0" + +let JSON = ./package.dhall +in JSON.render (JSON.number -1.5e-10) += "-1.5e-10" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let double = + missing + sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 + ? ./double.dhall + +let number + : Double → JSON + = double + +in number diff --git a/dhall-lang/Prelude/JSON/object b/dhall-lang/Prelude/JSON/object new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/object @@ -0,0 +1,3 @@ + missing + sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac +? ./object.dhall diff --git a/dhall-lang/Prelude/JSON/object.dhall b/dhall-lang/Prelude/JSON/object.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/object.dhall @@ -0,0 +1,55 @@ +{-| +Create a JSON object from a Dhall `Map` + +``` +let JSON = ./package.dhall +in JSON.render + ( JSON.object + [ { mapKey = "foo", mapValue = JSON.double 1.0 } + , { mapKey = "bar", mapValue = JSON.bool True } + ] + ) += "{ \"foo\": 1.0, \"bar\": true }" + +let JSON/Type = ./Type +let JSON = ./package.dhall +in JSON.render + (JSON.object ([] : List { mapKey : Text, mapValue : JSON/Type })) += "{ }" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let object + : List { mapKey : Text, mapValue : JSON } → JSON + = λ(x : List { mapKey : Text, mapValue : JSON }) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.object + ( List/map + { mapKey : Text, mapValue : JSON@1 } + { mapKey : Text, mapValue : JSON } + ( λ(kv : { mapKey : Text, mapValue : JSON@1 }) → + { mapKey = kv.mapKey, mapValue = kv.mapValue JSON json } + ) + x + ) + +in object diff --git a/dhall-lang/Prelude/JSON/omitNullFields b/dhall-lang/Prelude/JSON/omitNullFields new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/omitNullFields @@ -0,0 +1,3 @@ + missing + sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0 +? ./omitNullFields.dhall diff --git a/dhall-lang/Prelude/JSON/omitNullFields.dhall b/dhall-lang/Prelude/JSON/omitNullFields.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/omitNullFields.dhall @@ -0,0 +1,145 @@ +{-| +This utility omits all `null` record fields, which is often the idiomatic way +for a configuration to encode absent fields +-} +let JSON = + missing + sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 + ? ./core.dhall + +let List/concatMap = + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 + ? ../List/concatMap.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let omitNullFields + : JSON.Type → JSON.Type + = λ(old : JSON.Type) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + let result = + old + { value : JSON, isNull : Bool } + { string = + λ(x : Text) → { value = json.string x, isNull = False } + , double = + λ(x : Double) → { value = json.double x, isNull = False } + , integer = + λ(x : Integer) → { value = json.integer x, isNull = False } + , object = + λ ( keyValues + : List + { mapKey : Text + , mapValue : { value : JSON, isNull : Bool } + } + ) → + let value = + json.object + ( List/concatMap + { mapKey : Text + , mapValue : { value : JSON, isNull : Bool } + } + { mapKey : Text, mapValue : JSON } + ( λ ( keyValue + : { mapKey : Text + , mapValue : + { value : JSON, isNull : Bool } + } + ) → + if keyValue.mapValue.isNull + then [] : List + { mapKey : Text + , mapValue : JSON + } + else [ keyValue.{ mapKey } + ∧ { mapValue = + keyValue.mapValue.value + } + ] + ) + keyValues + ) + + in { value, isNull = False } + , array = + λ(xs : List { value : JSON, isNull : Bool }) → + let value = + json.array + ( List/map + { value : JSON, isNull : Bool } + JSON + ( λ(x : { value : JSON, isNull : Bool }) → + x.value + ) + xs + ) + + in { value, isNull = False } + , bool = λ(x : Bool) → { value = json.bool x, isNull = False } + , null = { value = json.null, isNull = True } + } + + in result.value + +let property = + λ(a : Text) → + λ(b : Double) → + λ(c : Bool) → + assert + : omitNullFields + ( JSON.object + ( toMap + { string = JSON.string a + , double = JSON.double b + , bool = JSON.bool c + , null = JSON.null + } + ) + ) + ≡ JSON.object + ( toMap + { string = JSON.string a + , double = JSON.double b + , bool = JSON.bool c + } + ) + +let example = + assert + : omitNullFields + ( JSON.object + ( toMap + { array = + JSON.array [ JSON.object (toMap { null = JSON.null }) ] + } + ) + ) + ≡ JSON.object + ( toMap + { array = + JSON.array + [ JSON.object + ([] : List { mapKey : Text, mapValue : JSON.Type }) + ] + } + ) + +let example = + assert + : omitNullFields (JSON.array [ JSON.null ]) ≡ JSON.array [ JSON.null ] + +in omitNullFields diff --git a/dhall-lang/Prelude/JSON/package.dhall b/dhall-lang/Prelude/JSON/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/package.dhall @@ -0,0 +1,29 @@ + { render = + missing + sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836 + ? ./render.dhall + , renderCompact = + missing + sha256:e6c8809fbe193fddd430f94350d69cefd45e7aaf8bd379e51b750fde75008562 + ? ./renderCompact.dhall + , renderYAML = + missing + sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478 + ? ./renderYAML.dhall + , omitNullFields = + missing + sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0 + ? ./omitNullFields.dhall + , tagInline = + missing + sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4 + ? ./tagInline.dhall + , tagNested = + missing + sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f + ? ./tagNested.dhall + } +∧ ( missing + sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 + ? ./core.dhall + ) diff --git a/dhall-lang/Prelude/JSON/render b/dhall-lang/Prelude/JSON/render new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/render @@ -0,0 +1,3 @@ + missing + sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836 +? ./render.dhall diff --git a/dhall-lang/Prelude/JSON/render.dhall b/dhall-lang/Prelude/JSON/render.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/render.dhall @@ -0,0 +1,52 @@ +{-| +Render a `JSON` value as `Text` + +This is useful for debugging `JSON` values or for tests. For anything +more sophisticated you should use `dhall-to-json` or `dhall-to-yaml` +-} +let JSON = + missing + sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 + ? ./core.dhall + +let renderAs = + missing + sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471 + ? ./renderAs.dhall + +let Format = + missing + sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac + ? ./Format.dhall + +let render + : JSON.Type → Text + = renderAs Format.JSON + +let example0 = + let data = + assert + : render + ( JSON.array + [ JSON.bool True + , JSON.string "Hello" + , JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar", mapValue = JSON.double 1.0 } + ] + ] + ) + ≡ '' + [ + true, + "Hello", + { + "foo": null, + "bar": 1.0 + } + ] + '' + + in True + +in render diff --git a/dhall-lang/Prelude/JSON/renderAs b/dhall-lang/Prelude/JSON/renderAs new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/renderAs @@ -0,0 +1,3 @@ + missing + sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471 +? ./renderAs.dhall diff --git a/dhall-lang/Prelude/JSON/renderAs.dhall b/dhall-lang/Prelude/JSON/renderAs.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/renderAs.dhall @@ -0,0 +1,458 @@ +--| Render a `JSON` value as `Text` in either JSON or YAML format. +let JSON = + missing + sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 + ? ./core.dhall + +let Function/identity = + missing + sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 + ? ../Function/identity.dhall + +let Text/concatMap = + missing + sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f + ? ../Text/concatMap.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ../NonEmpty/Type.dhall + +let NonEmpty/toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ../NonEmpty/toList.dhall + +let NonEmpty/concat = + missing + sha256:6d55181938c06c6b806877028f6a241912e9c0935d9a10dd958775bf21e0f64d + ? ../NonEmpty/concat.dhall + +let NonEmpty/map = + missing + sha256:93d53afe874bb2eed946c21ca5ada3c9716b7d00e6d8edfaba6484cd9c5a00bd + ? ../NonEmpty/map.dhall + +let NonEmpty/singleton = + missing + sha256:c9197aabe97695f7ca66f7419bf172d806b2c915594a8fc0d2ff6495db496ff2 + ? ../NonEmpty/singleton.dhall + +let List/uncons + : ∀(a : Type) → List a → Optional (NonEmpty a) + = {- This version uses the `ls` argument only once to prevent cache blowups at the price + of performing two passes over the list: + A first one to reverse it, a second one with `List/fold` to determine + the head element. + See https://github.com/dhall-lang/dhall-lang/pull/1015#issuecomment-633381024 + for some context regarding the caching issue. + -} + λ(a : Type) → + λ(ls : List a) → + List/fold + a + (List/reverse a ls) + (Optional (NonEmpty a)) + ( λ(x : a) → + λ(acc : Optional (NonEmpty a)) → + merge + { None = Some (NonEmpty/singleton a x) + , Some = + λ(ne : NonEmpty a) → Some (ne ⫽ { tail = ne.tail # [ x ] }) + } + acc + ) + (None (NonEmpty a)) + +let NonEmpty/mapHead + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + ls ⫽ { head = fn ls.head } + +let NonEmpty/mapTail + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + ls ⫽ { tail = List/map a a fn ls.tail } + +let NonEmpty/prepend + : ∀(a : Type) → a → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(prefix : a) → + λ(ls : NonEmpty a) → + { head = prefix, tail = NonEmpty/toList a ls } + +let NonYtpme + : Type → Type + = λ(a : Type) → { init : List a, last : a } + +let List/unsnoc + : ∀(a : Type) → List a → Optional (NonYtpme a) + = λ(a : Type) → + λ(ls : List a) → + List/fold + a + ls + (Optional (NonYtpme a)) + ( λ(x : a) → + λ(acc : Optional (NonYtpme a)) → + merge + { None = Some { init = [] : List a, last = x } + , Some = + λ(ny : NonYtpme a) → Some (ny ⫽ { init = [ x ] # ny.init }) + } + acc + ) + (None (NonYtpme a)) + +let NonEmpty/mapLast + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + merge + { Some = λ(x : NonYtpme a) → ls ⫽ { tail = x.init # [ fn x.last ] } + , None = NonEmpty/singleton a (fn ls.head) + } + (List/unsnoc a ls.tail) + +let NonEmpty/mapLeading + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + merge + { Some = + λ(x : NonYtpme a) → + { head = fn ls.head + , tail = List/map a a fn x.init # [ x.last ] + } + , None = ls + } + (List/unsnoc a ls.tail) + +let Lines + : Type + = NonEmpty Text + +let Block + : Type + = < Simple : Text | Complex : Lines > + +let Block/toLines + : Block → Lines + = λ(block : Block) → + merge + { Simple = NonEmpty/singleton Text + , Complex = Function/identity Lines + } + block + +let manyBlocks + : ∀(a : Type) → Text → (NonEmpty a → Lines) → List a → Block + = λ(a : Type) → + λ(ifEmpty : Text) → + λ(render : NonEmpty a → Lines) → + λ(inputs : List a) → + merge + { Some = λ(inputs : NonEmpty a) → Block.Complex (render inputs) + , None = Block.Simple ifEmpty + } + (List/uncons a inputs) + +let blockToText + : Block → Text + = λ(block : Block) → + Text/concatMap + Text + (λ(line : Text) → line ++ "\n") + (NonEmpty/toList Text (Block/toLines block)) + +let addPrefix = λ(prefix : Text) → λ(line : Text) → prefix ++ line + +let addIndent = addPrefix " " + +let indentTail = NonEmpty/mapTail Text addIndent + +let Format = + missing + sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac + ? ./Format.dhall + +let ObjectField = { mapKey : Text, mapValue : Block } + +let -- Essentially the same thing as `Text/show`, except that this does not + -- escape `$` + escape = + List/fold + (Text → Text) + [ Text/replace "\"" "\\\"" + , Text/replace "\b" "\\b" + , Text/replace "\f" "\\f" + , Text/replace "\n" "\\n" + , Text/replace "\r" "\\r" + , Text/replace "\t" "\\t" + , Text/replace "\\" "\\\\" + ] + Text + (λ(replace : Text → Text) → λ(text : Text) → replace text) + +let renderJSONStruct = + λ(prefix : Text) → + λ(suffix : Text) → + λ(blocks : NonEmpty Lines) → + let indent = List/map Text Text addIndent + + let appendComma + : Lines → Lines + = NonEmpty/mapLast Text (λ(line : Text) → line ++ ",") + + let blocks = NonEmpty/mapLeading Lines appendComma blocks + + let block = NonEmpty/concat Text blocks + + in merge + { None = + NonEmpty/singleton Text "${prefix} ${block.head} ${suffix}" + , Some = + λ(ny : NonYtpme Text) → + { head = prefix + , tail = + indent ([ block.head ] # ny.init # [ ny.last ]) + # [ suffix ] + } + } + (List/unsnoc Text block.tail) + +let renderObject = + λ(format : Format) → + λ(fields : NonEmpty ObjectField) → + let keystr = λ(field : ObjectField) → "\"${escape field.mapKey}\":" + + let prefixKeyOnFirst = + λ(field : ObjectField) → + NonEmpty/mapHead + Text + (addPrefix "${keystr field} ") + (Block/toLines field.mapValue) + + let prependKeyLine = + λ(field : ObjectField) → + NonEmpty/prepend + Text + (keystr field) + (Block/toLines field.mapValue) + + let renderYAMLField = + λ(field : ObjectField) → + merge + { Simple = + λ(line : Text) → + NonEmpty/singleton Text "${keystr field} ${line}" + , Complex = λ(_ : Lines) → indentTail (prependKeyLine field) + } + field.mapValue + + in merge + { JSON = + renderJSONStruct + "{" + "}" + (NonEmpty/map ObjectField Lines prefixKeyOnFirst fields) + , YAML = + NonEmpty/concat + Text + (NonEmpty/map ObjectField Lines renderYAMLField fields) + } + format + +let renderYAMLArrayField = + λ(block : Block) → + NonEmpty/mapHead + Text + (addPrefix "- ") + (indentTail (Block/toLines block)) + +let renderArray = + λ(format : Format) → + λ(fields : NonEmpty Block) → + merge + { JSON = + renderJSONStruct + "[" + "]" + (NonEmpty/map Block Lines Block/toLines fields) + , YAML = + NonEmpty/concat + Text + (NonEmpty/map Block Lines renderYAMLArrayField fields) + } + format + +let renderAs + : Format → JSON.Type → Text + = λ(format : Format) → + λ(json : JSON.Type) → + blockToText + ( json + Block + { string = λ(x : Text) → Block.Simple "\"${escape x}\"" + , double = λ(x : Double) → Block.Simple (Double/show x) + , integer = λ(x : Integer) → Block.Simple (JSON.renderInteger x) + , object = manyBlocks ObjectField "{}" (renderObject format) + , array = manyBlocks Block "[]" (renderArray format) + , bool = + λ(x : Bool) → Block.Simple (if x then "true" else "false") + , null = Block.Simple "null" + } + ) + +let example0 = + let data = + JSON.array + [ JSON.bool True + , JSON.string "Hello" + , JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar", mapValue = JSON.double 1.0 } + ] + ] + + let yaml = + assert + : renderAs Format.YAML data + ≡ '' + - true + - "Hello" + - "foo": null + "bar": 1.0 + '' + + let json = + assert + : renderAs Format.JSON data + ≡ '' + [ + true, + "Hello", + { + "foo": null, + "bar": 1.0 + } + ] + '' + + in True + +let example1 = + let data = + JSON.object + [ { mapKey = "zero", mapValue = JSON.array ([] : List JSON.Type) } + , { mapKey = "one", mapValue = JSON.array [ JSON.string "a" ] } + , { mapKey = "two" + , mapValue = JSON.array [ JSON.string "a", JSON.string "b" ] + } + ] + + let yaml = + assert + : renderAs Format.YAML data + ≡ '' + "zero": [] + "one": + - "a" + "two": + - "a" + - "b" + '' + + let json = + assert + : renderAs Format.JSON data + ≡ '' + { + "zero": [], + "one": [ "a" ], + "two": [ + "a", + "b" + ] + } + '' + + in True + +let example2 = + let data = + JSON.object + [ { mapKey = "zero" + , mapValue = + JSON.object + (toMap {=} : List { mapKey : Text, mapValue : JSON.Type }) + } + , { mapKey = "one" + , mapValue = JSON.object (toMap { a = JSON.null }) + } + , { mapKey = "two" + , mapValue = + JSON.object (toMap { a = JSON.null, b = JSON.null }) + } + ] + + let yaml = + assert + : renderAs Format.YAML data + ≡ '' + "zero": {} + "one": + "a": null + "two": + "a": null + "b": null + '' + + let json = + assert + : renderAs Format.JSON data + ≡ '' + { + "zero": {}, + "one": { "a": null }, + "two": { + "a": null, + "b": null + } + } + '' + + in True + +let example3 = + let specialCharacters = + '' + "\${"\b\f"} + ${"\r"} $'' + + let data = + JSON.object + [ { mapKey = specialCharacters + , mapValue = JSON.string specialCharacters + } + ] + + in assert + : renderAs Format.JSON data + ≡ '' + { "\"\\\b\f\n\r\t$": "\"\\\b\f\n\r\t$" } + '' + +in renderAs diff --git a/dhall-lang/Prelude/JSON/renderCompact.dhall b/dhall-lang/Prelude/JSON/renderCompact.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/renderCompact.dhall @@ -0,0 +1,61 @@ +--| This renders JSON on a single line +let JSON = + missing + sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 + ? ./core.dhall + +let Text/concatMapSep = + missing + sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840 + ? ../Text/concatMapSep + +let renderInteger = + missing + sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c + ? ./renderInteger.dhall + +let renderCompact + : JSON.Type → Text + = λ(j : JSON.Type) → + j + Text + { string = Text/show + , double = Double/show + , integer = renderInteger + , object = + λ(x : List { mapKey : Text, mapValue : Text }) → + let body = + Text/concatMapSep + "," + { mapKey : Text, mapValue : Text } + ( λ(e : { mapKey : Text, mapValue : Text }) → + " ${Text/show e.mapKey}: ${e.mapValue}" + ) + x + + in "{${body} }" + , array = + λ(x : List Text) → + let body = Text/concatMapSep "," Text (λ(y : Text) → " ${y}") x + + in "[${body} ]" + , bool = λ(x : Bool) → if x then "true" else "false" + , null = "null" + } + +let example = + assert + : renderCompact + ( JSON.array + [ JSON.bool True + , JSON.string "Hello" + , JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar", mapValue = JSON.double 1.1 } + , { mapKey = "baz", mapValue = JSON.integer +2 } + ] + ] + ) + ≡ "[ true, \"Hello\", { \"foo\": null, \"bar\": 1.1, \"baz\": 2 } ]" + +in renderCompact diff --git a/dhall-lang/Prelude/JSON/renderInteger.dhall b/dhall-lang/Prelude/JSON/renderInteger.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/renderInteger.dhall @@ -0,0 +1,23 @@ +{-| +Render an `Integer` value as a `JSON number`, according to the JSON standard, in +which a number may not start with a plus sign (`+`). +-} +let Integer/nonNegative = + missing + sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 + ? ../Integer/nonNegative.dhall + +let renderInteger + : Integer → Text + = λ(integer : Integer) → + if Integer/nonNegative integer + then Natural/show (Integer/clamp integer) + else Integer/show integer + +let positive = assert : renderInteger +1 ≡ "1" + +let zero = assert : renderInteger +0 ≡ "0" + +let negative = assert : renderInteger -1 ≡ "-1" + +in renderInteger diff --git a/dhall-lang/Prelude/JSON/renderYAML b/dhall-lang/Prelude/JSON/renderYAML new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/renderYAML @@ -0,0 +1,3 @@ + missing + sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478 +? ./renderYAML.dhall diff --git a/dhall-lang/Prelude/JSON/renderYAML.dhall b/dhall-lang/Prelude/JSON/renderYAML.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/renderYAML.dhall @@ -0,0 +1,49 @@ +{-| +Render a `JSON` value as `Text` in YAML format. + +The generated YAML text will only contain escaped object keys and +string values and might therefore not be very human readable. + +However, it is useful for debugging `JSON` values or for tests. +For anything more sophisticated you should use `dhall-to-json` or +`dhall-to-yaml`. +-} +let JSON = + missing + sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 + ? ./core.dhall + +let renderAs = + missing + sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471 + ? ./renderAs.dhall + +let Format = + missing + sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac + ? ./Format.dhall + +let renderYAML + : JSON.Type → Text + = renderAs Format.YAML + +let example0 = + assert + : renderYAML + ( JSON.array + [ JSON.bool True + , JSON.string "Hello" + , JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar", mapValue = JSON.double 1.0 } + ] + ] + ) + ≡ '' + - true + - "Hello" + - "foo": null + "bar": 1.0 + '' + +in renderYAML diff --git a/dhall-lang/Prelude/JSON/string b/dhall-lang/Prelude/JSON/string new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/string @@ -0,0 +1,3 @@ + missing + sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e +? ./string.dhall diff --git a/dhall-lang/Prelude/JSON/string.dhall b/dhall-lang/Prelude/JSON/string.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/string.dhall @@ -0,0 +1,35 @@ +{-| +Create a JSON string from Dhall `Text` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.string "ABC $ \" 🙂") += "\"ABC \\u0024 \\\" 🙂\"" + +let JSON = ./package.dhall +in JSON.render (JSON.string "") += "\"\"" +``` +-} +let JSON = + missing + sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 + ? ./Type.dhall + +let string + : Text → JSON + = λ(x : Text) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.string x + +in string diff --git a/dhall-lang/Prelude/JSON/tagInline b/dhall-lang/Prelude/JSON/tagInline new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/tagInline @@ -0,0 +1,3 @@ + missing + sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4 +? ./tagInline.dhall diff --git a/dhall-lang/Prelude/JSON/tagInline.dhall b/dhall-lang/Prelude/JSON/tagInline.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/tagInline.dhall @@ -0,0 +1,29 @@ +--| Prepare a union value for JSON- or YAML-encoding with the inline layout +let Nesting = + missing + sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting.dhall + +let Tagged = + missing + sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 + ? ./Tagged.dhall + +let tagInline + : Text → ∀(a : Type) → a → Tagged a + = λ(tagFieldName : Text) → + λ(a : Type) → + λ(contents : a) → + { nesting = Nesting.Inline, field = tagFieldName, contents } + +let example0 = + let Example = < Left : { foo : Natural } | Right : { bar : Bool } > + + in assert + : tagInline "name" Example (Example.Left { foo = 2 }) + ≡ { field = "name" + , nesting = Nesting.Inline + , contents = Example.Left { foo = 2 } + } + +in tagInline diff --git a/dhall-lang/Prelude/JSON/tagNested b/dhall-lang/Prelude/JSON/tagNested new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/tagNested @@ -0,0 +1,3 @@ + missing + sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f +? ./tagNested.dhall diff --git a/dhall-lang/Prelude/JSON/tagNested.dhall b/dhall-lang/Prelude/JSON/tagNested.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/JSON/tagNested.dhall @@ -0,0 +1,33 @@ +--| Prepare a union value for JSON- or YAML-encoding with the nested layout +let Nesting = + missing + sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting.dhall + +let Tagged = + missing + sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 + ? ./Tagged.dhall + +let tagNested + : Text → Text → ∀(a : Type) → a → Tagged a + = λ(contentsFieldName : Text) → + λ(tagFieldName : Text) → + λ(a : Type) → + λ(contents : a) → + { nesting = Nesting.Nested contentsFieldName + , field = tagFieldName + , contents + } + +let example0 = + let Example = < Left : { foo : Natural } | Right : { bar : Bool } > + + in assert + : tagNested "value" "name" Example (Example.Left { foo = 2 }) + ≡ { field = "name" + , nesting = Nesting.Nested "value" + , contents = Example.Left { foo = 2 } + } + +in tagNested diff --git a/dhall-lang/Prelude/List/all b/dhall-lang/Prelude/List/all new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/all @@ -0,0 +1,3 @@ + missing + sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15 +? ./all.dhall diff --git a/dhall-lang/Prelude/List/all.dhall b/dhall-lang/Prelude/List/all.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/all.dhall @@ -0,0 +1,16 @@ +{-| +Returns `True` if the supplied function returns `True` for all elements in the +`List` +-} +let all + : ∀(a : Type) → (a → Bool) → List a → Bool + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : List a) → + List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x && r) True + +let example0 = assert : all Natural Natural/even [ 2, 3, 5 ] ≡ False + +let example1 = assert : all Natural Natural/even ([] : List Natural) ≡ True + +in all diff --git a/dhall-lang/Prelude/List/any b/dhall-lang/Prelude/List/any new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/any @@ -0,0 +1,3 @@ + missing + sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8 +? ./any.dhall diff --git a/dhall-lang/Prelude/List/any.dhall b/dhall-lang/Prelude/List/any.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/any.dhall @@ -0,0 +1,16 @@ +{-| +Returns `True` if the supplied function returns `True` for any element in the +`List` +-} +let any + : ∀(a : Type) → (a → Bool) → List a → Bool + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : List a) → + List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False + +let example0 = assert : any Natural Natural/even [ 2, 3, 5 ] ≡ True + +let example1 = assert : any Natural Natural/even ([] : List Natural) ≡ False + +in any diff --git a/dhall-lang/Prelude/List/build b/dhall-lang/Prelude/List/build new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/build @@ -0,0 +1,3 @@ + missing + sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42 +? ./build.dhall diff --git a/dhall-lang/Prelude/List/build.dhall b/dhall-lang/Prelude/List/build.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/build.dhall @@ -0,0 +1,30 @@ +--| `build` is the inverse of `fold` +let build + : ∀(a : Type) → + (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) → + List a + = List/build + +let example0 = + assert + : build + Text + ( λ(list : Type) → + λ(cons : Text → list → list) → + λ(nil : list) → + cons "ABC" (cons "DEF" nil) + ) + ≡ [ "ABC", "DEF" ] + +let example1 = + assert + : build + Text + ( λ(list : Type) → + λ(cons : Text → list → list) → + λ(nil : list) → + nil + ) + ≡ ([] : List Text) + +in build diff --git a/dhall-lang/Prelude/List/concat b/dhall-lang/Prelude/List/concat new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/concat @@ -0,0 +1,3 @@ + missing + sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b +? ./concat.dhall diff --git a/dhall-lang/Prelude/List/concat.dhall b/dhall-lang/Prelude/List/concat.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/concat.dhall @@ -0,0 +1,34 @@ +--| Concatenate a `List` of `List`s into a single `List` +let concat + : ∀(a : Type) → List (List a) → List a + = λ(a : Type) → + λ(xss : List (List a)) → + List/build + a + ( λ(list : Type) → + λ(cons : a → list → list) → + λ(nil : list) → + List/fold + (List a) + xss + list + (λ(xs : List a) → λ(ys : list) → List/fold a xs list cons ys) + nil + ) + +let example0 = + assert + : concat Natural [ [ 0, 1, 2 ], [ 3, 4 ], [ 5, 6, 7, 8 ] ] + ≡ [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] + +let example1 = + assert + : concat + Natural + [ [] : List Natural, [] : List Natural, [] : List Natural ] + ≡ ([] : List Natural) + +let example2 = + assert : concat Natural ([] : List (List Natural)) ≡ ([] : List Natural) + +in concat diff --git a/dhall-lang/Prelude/List/concatMap b/dhall-lang/Prelude/List/concatMap new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/concatMap @@ -0,0 +1,3 @@ + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 +? ./concatMap.dhall diff --git a/dhall-lang/Prelude/List/concatMap.dhall b/dhall-lang/Prelude/List/concatMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/concatMap.dhall @@ -0,0 +1,32 @@ +{-| +Transform a list by applying a function to each element and flattening the +results +-} +let concatMap + : ∀(a : Type) → ∀(b : Type) → (a → List b) → List a → List b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → List b) → + λ(xs : List a) → + List/build + b + ( λ(list : Type) → + λ(cons : b → list → list) → + List/fold a xs list (λ(x : a) → List/fold b (f x) list cons) + ) + +let example0 = + assert + : concatMap Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ] + ≡ [ 2, 2, 3, 3, 5, 5 ] + +let example1 = + assert + : concatMap + Natural + Natural + (λ(n : Natural) → [ n, n ]) + ([] : List Natural) + ≡ ([] : List Natural) + +in concatMap diff --git a/dhall-lang/Prelude/List/default b/dhall-lang/Prelude/List/default new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/default @@ -0,0 +1,3 @@ + missing + sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379 +? ./default.dhall diff --git a/dhall-lang/Prelude/List/default.dhall b/dhall-lang/Prelude/List/default.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/default.dhall @@ -0,0 +1,15 @@ +{-| +Unpack an `Optional` containing a `List`, defaulting to an empty list when the +`Optional` is `None` +-} +let default + : ∀(a : Type) → Optional (List a) → List a + = λ(a : Type) → + λ(o : Optional (List a)) → + merge { Some = λ(l : List a) → l, None = [] : List a } o + +let example0 = assert : default Bool (None (List Bool)) ≡ ([] : List Bool) + +let example1 = assert : default Bool (Some [ True ]) ≡ [ True ] + +in default diff --git a/dhall-lang/Prelude/List/drop b/dhall-lang/Prelude/List/drop new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/drop @@ -0,0 +1,3 @@ + missing + sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf +? ./drop.dhall diff --git a/dhall-lang/Prelude/List/drop.dhall b/dhall-lang/Prelude/List/drop.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/drop.dhall @@ -0,0 +1,28 @@ +--| Remove first `n` elements of a list +let Natural/greaterThanEqual = + missing + sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 + ? ../Natural/greaterThanEqual.dhall + +let drop + : ∀(n : Natural) → ∀(a : Type) → List a → List a + = λ(n : Natural) → + λ(a : Type) → + λ(xs : List a) → + List/fold + { index : Natural, value : a } + (List/indexed a xs) + (List a) + ( λ(x : { index : Natural, value : a }) → + λ(xs : List a) → + if Natural/greaterThanEqual x.index n + then [ x.value ] # xs + else xs + ) + ([] : List a) + +let example = assert : drop 2 Natural [ 2, 3, 5 ] ≡ [ 5 ] + +let example = assert : drop 5 Natural [ 2, 3, 5 ] ≡ ([] : List Natural) + +in drop diff --git a/dhall-lang/Prelude/List/empty b/dhall-lang/Prelude/List/empty new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/empty @@ -0,0 +1,3 @@ + missing + sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147 +? ./empty.dhall diff --git a/dhall-lang/Prelude/List/empty.dhall b/dhall-lang/Prelude/List/empty.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/empty.dhall @@ -0,0 +1,8 @@ +--| An empty list of the given type +let empty + : ∀(a : Type) → List a + = λ(a : Type) → [] : List a + +let example0 = assert : empty Bool ≡ ([] : List Bool) + +in empty diff --git a/dhall-lang/Prelude/List/filter b/dhall-lang/Prelude/List/filter new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/filter @@ -0,0 +1,3 @@ + missing + sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6 +? ./filter.dhall diff --git a/dhall-lang/Prelude/List/filter.dhall b/dhall-lang/Prelude/List/filter.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/filter.dhall @@ -0,0 +1,22 @@ +--| Only keep elements of the list where the supplied function returns `True` +let filter + : ∀(a : Type) → (a → Bool) → List a → List a + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : List a) → + List/build + a + ( λ(list : Type) → + λ(cons : a → list → list) → + List/fold + a + xs + list + (λ(x : a) → λ(xs : list) → if f x then cons x xs else xs) + ) + +let example0 = assert : filter Natural Natural/even [ 2, 3, 5 ] ≡ [ 2 ] + +let example1 = assert : filter Natural Natural/odd [ 2, 3, 5 ] ≡ [ 3, 5 ] + +in filter diff --git a/dhall-lang/Prelude/List/filterMap.dhall b/dhall-lang/Prelude/List/filterMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/filterMap.dhall @@ -0,0 +1,45 @@ +--| Transform a list by applying a function to each element and omitting None results. +let List/concatMap = + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 + ? ./concatMap.dhall + +let Optional/toList = + missing + sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4 + ? ../Optional/toList.dhall + +let filterMap + : ∀(a : Type) → ∀(b : Type) → (a → Optional b) → List a → List b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → Optional b) → + List/concatMap a b (λ(x : a) → Optional/toList b (f x)) + +let example0 = + assert + : filterMap + (List Natural) + Natural + (List/head Natural) + [ [ 1 ], [] : List Natural, [ 3, 4 ] ] + ≡ [ 1, 3 ] + +let example1 = + let Example = < Left : Bool | Right : Natural > + + in assert + : filterMap + Example + Natural + ( λ(x : Example) → + merge + { Left = λ(_ : Bool) → None Natural + , Right = λ(n : Natural) → Some n + } + x + ) + [ Example.Left False, Example.Right 2, Example.Left True ] + ≡ [ 2 ] + +in filterMap diff --git a/dhall-lang/Prelude/List/fold b/dhall-lang/Prelude/List/fold new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/fold @@ -0,0 +1,3 @@ + missing + sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814 +? ./fold.dhall diff --git a/dhall-lang/Prelude/List/fold.dhall b/dhall-lang/Prelude/List/fold.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/fold.dhall @@ -0,0 +1,43 @@ +{-| +`fold` is the primitive function for consuming `List`s + +If you treat the list `[ x, y, z ]` as `cons x (cons y (cons z nil))`, then a +`fold` just replaces each `cons` and `nil` with something else +-} +let fold + : ∀(a : Type) → + List a → + ∀(list : Type) → + ∀(cons : a → list → list) → + ∀(nil : list) → + list + = List/fold + +let example0 = + assert + : fold + Natural + [ 2, 3, 5 ] + Text + (λ(x : Natural) → λ(y : Text) → Natural/show x ++ y) + "0" + ≡ "2350" + +let example1 = + λ(nil : Text) → + assert + : fold + Natural + [ 2, 3, 5 ] + Text + (λ(x : Natural) → λ(y : Text) → Natural/show x ++ y) + nil + ≡ "2" ++ ("3" ++ ("5" ++ nil)) + +let example2 = + λ(cons : Natural → Text → Text) → + λ(nil : Text) → + assert + : fold Natural [ 2, 3, 5 ] Text cons nil ≡ cons 2 (cons 3 (cons 5 nil)) + +in fold diff --git a/dhall-lang/Prelude/List/foldLeft.dhall b/dhall-lang/Prelude/List/foldLeft.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/foldLeft.dhall @@ -0,0 +1,60 @@ +{-| +`foldLeft` is like `List/fold` except that the accumulation starts from the left + +If you treat the list `[ x, y, z ]` as `cons (cons (cons nil x) y) z`, then +`foldLeft` just replaces each `cons` and `nil` with something else +-} +let foldLeft + : ∀(a : Type) → + List a → + ∀(list : Type) → + ∀(cons : list → a → list) → + ∀(nil : list) → + list + = λ(a : Type) → + λ(xs : List a) → + λ(list : Type) → + λ(cons : list → a → list) → + λ(nil : list) → + List/fold + a + xs + (list → list) + (λ(x : a) → λ(f : list → list) → λ(l : list) → f (cons l x)) + (λ(l : list) → l) + nil + +let example0 = + assert + : foldLeft + Natural + [ 2, 3, 5 ] + Text + (λ(x : Text) → λ(y : Natural) → x ++ Natural/show y) + "0" + ≡ "0235" + +let example1 = + assert + : ( λ(nil : Text) → + foldLeft + Natural + [ 2, 3, 5 ] + Text + (λ(x : Text) → λ(y : Natural) → x ++ Natural/show y) + nil + ) + ≡ (λ(nil : Text) → nil ++ "2" ++ "3" ++ "5") + +let example2 = + assert + : ( λ(cons : Text → Natural → Text) → + λ(nil : Text) → + foldLeft Natural [ 2, 3, 5 ] Text cons nil + ) + ≡ ( λ(cons : Text → Natural → Text) → + λ(nil : Text) → + cons (cons (cons nil 2) 3) 5 + ) + +in foldLeft diff --git a/dhall-lang/Prelude/List/generate b/dhall-lang/Prelude/List/generate new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/generate @@ -0,0 +1,3 @@ + missing + sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4 +? ./generate.dhall diff --git a/dhall-lang/Prelude/List/generate.dhall b/dhall-lang/Prelude/List/generate.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/generate.dhall @@ -0,0 +1,35 @@ +{-| +Build a list by calling the supplied function on all `Natural` numbers from `0` +up to but not including the supplied `Natural` number +-} +let generate + : Natural → ∀(a : Type) → (Natural → a) → List a + = λ(n : Natural) → + λ(a : Type) → + λ(f : Natural → a) → + List/build + a + ( λ(list : Type) → + λ(cons : a → list → list) → + List/fold + { index : Natural, value : {} } + ( List/indexed + {} + ( List/build + {} + ( λ(list : Type) → + λ(cons : {} → list → list) → + Natural/fold n list (cons {=}) + ) + ) + ) + list + (λ(x : { index : Natural, value : {} }) → cons (f x.index)) + ) + +let example0 = + assert : generate 5 Bool Natural/even ≡ [ True, False, True, False, True ] + +let example1 = assert : generate 0 Bool Natural/even ≡ ([] : List Bool) + +in generate diff --git a/dhall-lang/Prelude/List/head b/dhall-lang/Prelude/List/head new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/head @@ -0,0 +1,3 @@ + missing + sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026 +? ./head.dhall diff --git a/dhall-lang/Prelude/List/head.dhall b/dhall-lang/Prelude/List/head.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/head.dhall @@ -0,0 +1,10 @@ +--| Retrieve the first element of the list +let head + : ∀(a : Type) → List a → Optional a + = List/head + +let example0 = assert : head Natural [ 0, 1, 2 ] ≡ Some 0 + +let example1 = assert : head Natural ([] : List Natural) ≡ None Natural + +in head diff --git a/dhall-lang/Prelude/List/index b/dhall-lang/Prelude/List/index new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/index @@ -0,0 +1,3 @@ + missing + sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 +? ./index.dhall diff --git a/dhall-lang/Prelude/List/index.dhall b/dhall-lang/Prelude/List/index.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/index.dhall @@ -0,0 +1,18 @@ +--| Retrieve an element from a `List` using its 0-based index +let drop = + missing + sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf + ? ./drop.dhall + +let index + : Natural → ∀(a : Type) → List a → Optional a + = λ(n : Natural) → λ(a : Type) → λ(xs : List a) → List/head a (drop n a xs) + +let property = + λ(n : Natural) → λ(a : Type) → assert : index n a ([] : List a) ≡ None a + +let example0 = assert : index 1 Natural [ 2, 3, 5 ] ≡ Some 3 + +let example1 = assert : index 1 Natural ([] : List Natural) ≡ None Natural + +in index diff --git a/dhall-lang/Prelude/List/indexed b/dhall-lang/Prelude/List/indexed new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/indexed @@ -0,0 +1,3 @@ + missing + sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f +? ./indexed.dhall diff --git a/dhall-lang/Prelude/List/indexed.dhall b/dhall-lang/Prelude/List/indexed.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/indexed.dhall @@ -0,0 +1,19 @@ +--| Tag each element of the list with its index +let indexed + : ∀(a : Type) → List a → List { index : Natural, value : a } + = List/indexed + +let example0 = + assert + : indexed Bool [ True, False, True ] + ≡ [ { index = 0, value = True } + , { index = 1, value = False } + , { index = 2, value = True } + ] + +let example1 = + assert + : indexed Bool ([] : List Bool) + ≡ ([] : List { index : Natural, value : Bool }) + +in indexed diff --git a/dhall-lang/Prelude/List/iterate b/dhall-lang/Prelude/List/iterate new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/iterate @@ -0,0 +1,3 @@ + missing + sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26 +? ./iterate.dhall diff --git a/dhall-lang/Prelude/List/iterate.dhall b/dhall-lang/Prelude/List/iterate.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/iterate.dhall @@ -0,0 +1,42 @@ +{-| +Generate a list of the specified length given a seed value and transition +function +-} +let iterate + : Natural → ∀(a : Type) → (a → a) → a → List a + = λ(n : Natural) → + λ(a : Type) → + λ(f : a → a) → + λ(x : a) → + List/build + a + ( λ(list : Type) → + λ(cons : a → list → list) → + List/fold + { index : Natural, value : {} } + ( List/indexed + {} + ( List/build + {} + ( λ(list : Type) → + λ(cons : {} → list → list) → + Natural/fold n list (cons {=}) + ) + ) + ) + list + ( λ(y : { index : Natural, value : {} }) → + cons (Natural/fold y.index a f x) + ) + ) + +let example0 = + assert + : iterate 10 Natural (λ(x : Natural) → x * 2) 1 + ≡ [ 1, 2, 4, 8, 16, 32, 64, 128, 256, 512 ] + +let example1 = + assert + : iterate 0 Natural (λ(x : Natural) → x * 2) 1 ≡ ([] : List Natural) + +in iterate diff --git a/dhall-lang/Prelude/List/last b/dhall-lang/Prelude/List/last new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/last @@ -0,0 +1,3 @@ + missing + sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d +? ./last.dhall diff --git a/dhall-lang/Prelude/List/last.dhall b/dhall-lang/Prelude/List/last.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/last.dhall @@ -0,0 +1,10 @@ +--| Retrieve the last element of the list +let last + : ∀(a : Type) → List a → Optional a + = List/last + +let example0 = assert : last Natural [ 0, 1, 2 ] ≡ Some 2 + +let example1 = assert : last Natural ([] : List Natural) ≡ None Natural + +in last diff --git a/dhall-lang/Prelude/List/length b/dhall-lang/Prelude/List/length new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/length @@ -0,0 +1,3 @@ + missing + sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461 +? ./length.dhall diff --git a/dhall-lang/Prelude/List/length.dhall b/dhall-lang/Prelude/List/length.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/length.dhall @@ -0,0 +1,10 @@ +--| Returns the number of elements in a list +let length + : ∀(a : Type) → List a → Natural + = List/length + +let example0 = assert : length Natural [ 0, 1, 2 ] ≡ 3 + +let example1 = assert : length Natural ([] : List Natural) ≡ 0 + +in length diff --git a/dhall-lang/Prelude/List/map b/dhall-lang/Prelude/List/map new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/map @@ -0,0 +1,3 @@ + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 +? ./map.dhall diff --git a/dhall-lang/Prelude/List/map.dhall b/dhall-lang/Prelude/List/map.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/map.dhall @@ -0,0 +1,23 @@ +--| Transform a list by applying a function to each element +let map + : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → b) → + λ(xs : List a) → + List/build + b + ( λ(list : Type) → + λ(cons : b → list → list) → + List/fold a xs list (λ(x : a) → cons (f x)) + ) + +let example0 = + assert + : map Natural Bool Natural/even [ 2, 3, 5 ] ≡ [ True, False, False ] + +let example1 = + assert + : map Natural Bool Natural/even ([] : List Natural) ≡ ([] : List Bool) + +in map diff --git a/dhall-lang/Prelude/List/mapMaybe.dhall b/dhall-lang/Prelude/List/mapMaybe.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/mapMaybe.dhall @@ -0,0 +1,37 @@ +--| Apply a function across a list, keeping only the `Some` results. +let List/unpackOptionals = + missing + sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4 + ? ./unpackOptionals.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ./map.dhall + +let mapMaybe + : ∀(a : Type) → ∀(b : Type) → (a → Optional b) → List a → List b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → Optional b) → + λ(xs : List a) → + List/unpackOptionals b (List/map a (Optional b) f xs) + +let property = + λ(a : Type) → + λ(b : Type) → + λ(f : a → Optional b) → + assert : mapMaybe a b f ([] : List a) ≡ ([] : List b) + +let example0 = + assert + : mapMaybe + Natural + Text + ( λ(n : Natural) → + if Natural/isZero n then None Text else Some (Natural/show n) + ) + [ 0, 1, 2, 3 ] + ≡ [ "1", "2", "3" ] + +in mapMaybe diff --git a/dhall-lang/Prelude/List/mapWithIndex.dhall b/dhall-lang/Prelude/List/mapWithIndex.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/mapWithIndex.dhall @@ -0,0 +1,41 @@ +--| Transform a list by applying a function to each element with its index +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ./map.dhall + +let List/mapWithIndex + : ∀(a : Type) → ∀(b : Type) → (Natural → a → b) → List a → List b + = λ(a : Type) → + λ(b : Type) → + λ(f : Natural → a → b) → + λ(xs : List a) → + List/map + { index : Natural, value : a } + b + (λ(i : { index : Natural, value : a }) → f i.index i.value) + (List/indexed a xs) + +let List/empty = + missing + sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147 + ? ./empty.dhall + +let List/replicate = + missing + sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 + ? ./replicate.dhall + +let example0 = + assert + : List/mapWithIndex + Text + (List Text) + ( λ(index : Natural) → + λ(value : Text) → + List/replicate index Text value + ) + [ "A", "B", "C" ] + ≡ [ List/empty Text, [ "B" ], [ "C", "C" ] ] + +in List/mapWithIndex diff --git a/dhall-lang/Prelude/List/null b/dhall-lang/Prelude/List/null new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/null @@ -0,0 +1,3 @@ + missing + sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80 +? ./null.dhall diff --git a/dhall-lang/Prelude/List/null.dhall b/dhall-lang/Prelude/List/null.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/null.dhall @@ -0,0 +1,10 @@ +--| Returns `True` if the `List` is empty and `False` otherwise +let null + : ∀(a : Type) → List a → Bool + = λ(a : Type) → λ(xs : List a) → Natural/isZero (List/length a xs) + +let example0 = assert : null Natural [ 0, 1, 2 ] ≡ False + +let example1 = assert : null Natural ([] : List Natural) ≡ True + +in null diff --git a/dhall-lang/Prelude/List/package.dhall b/dhall-lang/Prelude/List/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/package.dhall @@ -0,0 +1,125 @@ +{ all = + missing + sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15 + ? ./all.dhall +, any = + missing + sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8 + ? ./any.dhall +, build = + missing + sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42 + ? ./build.dhall +, concat = + missing + sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b + ? ./concat.dhall +, concatMap = + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 + ? ./concatMap.dhall +, default = + missing + sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379 + ? ./default.dhall +, drop = + missing + sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf + ? ./drop.dhall +, empty = + missing + sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147 + ? ./empty.dhall +, filter = + missing + sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6 + ? ./filter.dhall +, filterMap = + missing + sha256:94b7ed4204d1c79aaf55527ef51024e7085b8dd2896952cffbd12d8f95e16f46 + ? ./filterMap.dhall +, fold = + missing + sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814 + ? ./fold.dhall +, foldLeft = + missing + sha256:3c6ab57950fe644906b7bbdef0b9523440b6ee17773ebb8cbd41ffacb8bfab61 + ? ./foldLeft.dhall +, generate = + missing + sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4 + ? ./generate.dhall +, head = + missing + sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026 + ? ./head.dhall +, index = + missing + sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 + ? ./index.dhall +, indexed = + missing + sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f + ? ./indexed.dhall +, iterate = + missing + sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26 + ? ./iterate.dhall +, last = + missing + sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d + ? ./last.dhall +, length = + missing + sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461 + ? ./length.dhall +, map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ./map.dhall +, mapMaybe = + missing + sha256:6f3c4f8c94577b46e7d30f8df7e82a269b0ad0a7e18c0f0370f243fd1127e77f + ? ./mapMaybe.dhall +, mapWithIndex = + missing + sha256:98599e0b55c5d3ae75264ba90657c6f68c7ce32834bd12b215acaea711eed6eb + ? ./mapWithIndex.dhall +, null = + missing + sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80 + ? ./null.dhall +, partition = + missing + sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03 + ? ./partition.dhall +, replicate = + missing + sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 + ? ./replicate.dhall +, reverse = + missing + sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d + ? ./reverse.dhall +, shifted = + missing + sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe + ? ./shifted.dhall +, take = + missing + sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa + ? ./take.dhall +, unpackOptionals = + missing + sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4 + ? ./unpackOptionals.dhall +, unzip = + missing + sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9 + ? ./unzip.dhall +, zip = + missing + sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da + ? ./zip.dhall +} diff --git a/dhall-lang/Prelude/List/partition b/dhall-lang/Prelude/List/partition new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/partition @@ -0,0 +1,3 @@ + missing + sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03 +? ./partition.dhall diff --git a/dhall-lang/Prelude/List/partition.dhall b/dhall-lang/Prelude/List/partition.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/partition.dhall @@ -0,0 +1,31 @@ +{-| +`partition` divides a `List` of elements into those that satisfy a predicate +and those that do not +-} +let Partition + : Type → Type + = λ(a : Type) → { true : List a, false : List a } + +let partition + : ∀(a : Type) → (a → Bool) → List a → Partition a + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : List a) → + List/fold + a + xs + (Partition a) + ( λ(x : a) → + λ(p : Partition a) → + if f x + then { true = [ x ] # p.true, false = p.false } + else { true = p.true, false = [ x ] # p.false } + ) + { true = [] : List a, false = [] : List a } + +let example0 = + assert + : partition Natural Natural/even [ 0, 1, 2, 3 ] + ≡ { true = [ 0, 2 ], false = [ 1, 3 ] } + +in partition diff --git a/dhall-lang/Prelude/List/replicate b/dhall-lang/Prelude/List/replicate new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/replicate @@ -0,0 +1,3 @@ + missing + sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 +? ./replicate.dhall diff --git a/dhall-lang/Prelude/List/replicate.dhall b/dhall-lang/Prelude/List/replicate.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/replicate.dhall @@ -0,0 +1,18 @@ +--| Build a list by copying the given element the specified number of times +let replicate + : Natural → ∀(a : Type) → a → List a + = λ(n : Natural) → + λ(a : Type) → + λ(x : a) → + List/build + a + ( λ(list : Type) → + λ(cons : a → list → list) → + Natural/fold n list (cons x) + ) + +let example0 = assert : replicate 9 Natural 1 ≡ [ 1, 1, 1, 1, 1, 1, 1, 1, 1 ] + +let example1 = assert : replicate 0 Natural 1 ≡ ([] : List Natural) + +in replicate diff --git a/dhall-lang/Prelude/List/reverse b/dhall-lang/Prelude/List/reverse new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/reverse @@ -0,0 +1,3 @@ + missing + sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d +? ./reverse.dhall diff --git a/dhall-lang/Prelude/List/reverse.dhall b/dhall-lang/Prelude/List/reverse.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/reverse.dhall @@ -0,0 +1,11 @@ +--| Reverse a list +let reverse + : ∀(a : Type) → List a → List a + = List/reverse + +let example0 = assert : reverse Natural [ 0, 1, 2 ] ≡ [ 2, 1, 0 ] + +let example1 = + assert : reverse Natural ([] : List Natural) ≡ ([] : List Natural) + +in reverse diff --git a/dhall-lang/Prelude/List/shifted b/dhall-lang/Prelude/List/shifted new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/shifted @@ -0,0 +1,3 @@ + missing + sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe +? ./shifted.dhall diff --git a/dhall-lang/Prelude/List/shifted.dhall b/dhall-lang/Prelude/List/shifted.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/shifted.dhall @@ -0,0 +1,83 @@ +{-| +Combine a `List` of `List`s, offsetting the `index` of each element by the +number of elements in preceding lists +-} +let shifted + : ∀(a : Type) → + List (List { index : Natural, value : a }) → + List { index : Natural, value : a } + = λ(a : Type) → + λ(kvss : List (List { index : Natural, value : a })) → + List/build + { index : Natural, value : a } + ( λ(list : Type) → + λ(cons : { index : Natural, value : a } → list → list) → + λ(nil : list) → + let result = + List/fold + (List { index : Natural, value : a }) + kvss + { count : Natural, diff : Natural → list } + ( λ(kvs : List { index : Natural, value : a }) → + λ(y : { count : Natural, diff : Natural → list }) → + let length = + List/length { index : Natural, value : a } kvs + + in { count = y.count + length + , diff = + λ(n : Natural) → + List/fold + { index : Natural, value : a } + kvs + list + ( λ ( kvOld + : { index : Natural, value : a } + ) → + λ(z : list) → + let kvNew = + { index = kvOld.index + n + , value = kvOld.value + } + + in cons kvNew z + ) + (y.diff (n + length)) + } + ) + { count = 0, diff = λ(_ : Natural) → nil } + + in result.diff 0 + ) + +let example0 = + assert + : shifted + Bool + [ [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = True } + ] + , [ { index = 0, value = False }, { index = 1, value = False } ] + , [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = True } + ] + ] + ≡ [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = False } + , { index = 4, value = False } + , { index = 5, value = True } + , { index = 6, value = True } + , { index = 7, value = True } + , { index = 8, value = True } + ] + +let example1 = + assert + : shifted Bool ([] : List (List { index : Natural, value : Bool })) + ≡ ([] : List { index : Natural, value : Bool }) + +in shifted diff --git a/dhall-lang/Prelude/List/take b/dhall-lang/Prelude/List/take new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/take @@ -0,0 +1,3 @@ + missing + sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa +? ./take.dhall diff --git a/dhall-lang/Prelude/List/take.dhall b/dhall-lang/Prelude/List/take.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/take.dhall @@ -0,0 +1,26 @@ +--| Truncate a list to the first `n` elements +let Natural/lessThan = + missing + sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c + ? ../Natural/lessThan.dhall + +let take + : ∀(n : Natural) → ∀(a : Type) → List a → List a + = λ(n : Natural) → + λ(a : Type) → + λ(xs : List a) → + List/fold + { index : Natural, value : a } + (List/indexed a xs) + (List a) + ( λ(x : { index : Natural, value : a }) → + λ(xs : List a) → + if Natural/lessThan x.index n then [ x.value ] # xs else xs + ) + ([] : List a) + +let example = assert : take 2 Natural [ 2, 3, 5 ] ≡ [ 2, 3 ] + +let example = assert : take 5 Natural [ 2, 3, 5 ] ≡ [ 2, 3, 5 ] + +in take diff --git a/dhall-lang/Prelude/List/unpackOptionals b/dhall-lang/Prelude/List/unpackOptionals new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/unpackOptionals @@ -0,0 +1,3 @@ + missing + sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4 +? ./unpackOptionals.dhall diff --git a/dhall-lang/Prelude/List/unpackOptionals.dhall b/dhall-lang/Prelude/List/unpackOptionals.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/unpackOptionals.dhall @@ -0,0 +1,31 @@ +--| Unpack Optionals in a List, omitting None items. +let List/filterMap = + missing + sha256:94b7ed4204d1c79aaf55527ef51024e7085b8dd2896952cffbd12d8f95e16f46 + ? ./filterMap.dhall + +let unpackOptionals + : ∀(a : Type) → ∀(l : List (Optional a)) → List a + = λ(a : Type) → List/filterMap (Optional a) a (λ(x : Optional a) → x) + +let property1 = + λ(a : Type) → λ(x : a) → assert : unpackOptionals a [ Some x ] ≡ [ x ] + +let property2 = + λ(a : Type) → assert : unpackOptionals a [ None a ] ≡ ([] : List a) + +let example0 = + assert + : unpackOptionals Natural [ Some 1, None Natural, Some 3 ] ≡ [ 1, 3 ] + +let example1 = + assert + : unpackOptionals Natural ([] : List (Optional Natural)) + ≡ ([] : List Natural) + +let example2 = + assert + : unpackOptionals Natural [ None Natural, None Natural ] + ≡ ([] : List Natural) + +in unpackOptionals diff --git a/dhall-lang/Prelude/List/unzip b/dhall-lang/Prelude/List/unzip new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/unzip @@ -0,0 +1,3 @@ + missing + sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9 +? ./unzip.dhall diff --git a/dhall-lang/Prelude/List/unzip.dhall b/dhall-lang/Prelude/List/unzip.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/unzip.dhall @@ -0,0 +1,50 @@ +--| Unzip a `List` into two separate `List`s +let unzip + : ∀(a : Type) → + ∀(b : Type) → + List { _1 : a, _2 : b } → + { _1 : List a, _2 : List b } + = λ(a : Type) → + λ(b : Type) → + λ(xs : List { _1 : a, _2 : b }) → + { _1 = + List/build + a + ( λ(list : Type) → + λ(cons : a → list → list) → + List/fold + { _1 : a, _2 : b } + xs + list + (λ(x : { _1 : a, _2 : b }) → cons x._1) + ) + , _2 = + List/build + b + ( λ(list : Type) → + λ(cons : b → list → list) → + List/fold + { _1 : a, _2 : b } + xs + list + (λ(x : { _1 : a, _2 : b }) → cons x._2) + ) + } + +let example0 = + assert + : unzip + Text + Bool + [ { _1 = "ABC", _2 = True } + , { _1 = "DEF", _2 = False } + , { _1 = "GHI", _2 = True } + ] + ≡ { _1 = [ "ABC", "DEF", "GHI" ], _2 = [ True, False, True ] } + +let example1 = + assert + : unzip Text Bool ([] : List { _1 : Text, _2 : Bool }) + ≡ { _1 = [] : List Text, _2 = [] : List Bool } + +in unzip diff --git a/dhall-lang/Prelude/List/zip b/dhall-lang/Prelude/List/zip new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/zip @@ -0,0 +1,3 @@ + missing + sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da +? ./zip.dhall diff --git a/dhall-lang/Prelude/List/zip.dhall b/dhall-lang/Prelude/List/zip.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/List/zip.dhall @@ -0,0 +1,58 @@ +{-| +Zip two `List` into a single `List` + +The resulting `List` will have the length of the shortest of its arguments. +-} +let List/index = + missing + sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 + ? ./index.dhall + +let zip + : ∀(a : Type) → List a → ∀(b : Type) → List b → List { _1 : a, _2 : b } + = λ(a : Type) → + λ(xs : List a) → + λ(b : Type) → + λ(ys : List b) → + let ixs = List/indexed a xs + + in List/build + { _1 : a, _2 : b } + ( λ(list : Type) → + λ(cons : { _1 : a, _2 : b } → list → list) → + λ(nil : list) → + List/fold + { index : Natural, value : a } + ixs + list + ( λ(ix : { index : Natural, value : a }) → + λ(rest : list) → + merge + { None = rest + , Some = + λ(y : b) → cons { _1 = ix.value, _2 = y } rest + } + (List/index ix.index b ys) + ) + nil + ) + +let example0 = + assert + : zip Text [ "ABC", "DEF", "GHI" ] Natural [ 1, 2, 3 ] + ≡ [ { _1 = "ABC", _2 = 1 } + , { _1 = "DEF", _2 = 2 } + , { _1 = "GHI", _2 = 3 } + ] + +let example1 = + assert + : zip Text [ "ABC" ] Bool ([] : List Bool) + ≡ ([] : List { _1 : Text, _2 : Bool }) + +let example2 = + assert + : zip Text [ "ABC", "DEF", "GHI" ] Natural [ 1 ] + ≡ [ { _1 = "ABC", _2 = 1 } ] + +in zip diff --git a/dhall-lang/Prelude/Location/Type b/dhall-lang/Prelude/Location/Type new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Location/Type @@ -0,0 +1,3 @@ + missing + sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529 +? ./Type.dhall diff --git a/dhall-lang/Prelude/Location/Type.dhall b/dhall-lang/Prelude/Location/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Location/Type.dhall @@ -0,0 +1,15 @@ +--| This is the union type returned when you import something `as Location` +let Location + : Type + = < Environment : Text | Local : Text | Missing | Remote : Text > + +let example0 = + assert + : missing as Location + ≡ < Environment : Text + | Local : Text + | Missing + | Remote : Text + >.Missing + +in Location diff --git a/dhall-lang/Prelude/Location/package.dhall b/dhall-lang/Prelude/Location/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Location/package.dhall @@ -0,0 +1,5 @@ +{ Type = + missing + sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529 + ? ./Type.dhall +} diff --git a/dhall-lang/Prelude/Map/Entry b/dhall-lang/Prelude/Map/Entry new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/Entry @@ -0,0 +1,3 @@ + missing + sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 +? ./Entry.dhall diff --git a/dhall-lang/Prelude/Map/Entry.dhall b/dhall-lang/Prelude/Map/Entry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/Entry.dhall @@ -0,0 +1,6 @@ +--| The type of each key-value pair in a `Map` +let Entry + : Type → Type → Type + = λ(k : Type) → λ(v : Type) → { mapKey : k, mapValue : v } + +in Entry diff --git a/dhall-lang/Prelude/Map/Type b/dhall-lang/Prelude/Map/Type new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/Type @@ -0,0 +1,3 @@ + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed +? ./Type.dhall diff --git a/dhall-lang/Prelude/Map/Type.dhall b/dhall-lang/Prelude/Map/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/Type.dhall @@ -0,0 +1,25 @@ +{-| +This is the canonical way to encode a dynamic list of key-value pairs. + +Tools (such as `dhall-to-json`/`dhall-to-yaml` will recognize values of this +type and convert them to maps/dictionaries/hashes in the target language + +For example, `dhall-to-json` converts a Dhall value like this: + +``` +[ { mapKey = "foo", mapValue = 1 } +, { mapKey = "bar", mapValue = 2 } +] : ./Map Text Natural +``` + +... to a JSON value like this: + +``` +{ "foo": 1, "bar", 2 } +``` +-} +let Map + : Type → Type → Type + = λ(k : Type) → λ(v : Type) → List { mapKey : k, mapValue : v } + +in Map diff --git a/dhall-lang/Prelude/Map/empty b/dhall-lang/Prelude/Map/empty new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/empty @@ -0,0 +1,3 @@ + missing + sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52 +? ./empty.dhall diff --git a/dhall-lang/Prelude/Map/empty.dhall b/dhall-lang/Prelude/Map/empty.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/empty.dhall @@ -0,0 +1,14 @@ +--| An empty `Map` of the given key and value types +let Map = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type.dhall + +let empty + : ∀(k : Type) → ∀(v : Type) → Map k v + = λ(k : Type) → λ(v : Type) → [] : Map k v + +let example0 = + assert : empty Text Bool ≡ ([] : List { mapKey : Text, mapValue : Bool }) + +in empty diff --git a/dhall-lang/Prelude/Map/keyText b/dhall-lang/Prelude/Map/keyText new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/keyText @@ -0,0 +1,3 @@ + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc +? ./keyText.dhall diff --git a/dhall-lang/Prelude/Map/keyText.dhall b/dhall-lang/Prelude/Map/keyText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/keyText.dhall @@ -0,0 +1,15 @@ +{-| +Builds a key-value record such that a `List` of them will be converted to a +homogeneous record by dhall-to-json and dhall-to-yaml. + +Both key and value are fixed to `Text`. + +Take a look at `./keyValue` for a polymorphic version. +-} +let keyText = + λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } + +let example0 = + assert : keyText "foo" "bar" ≡ { mapKey = "foo", mapValue = "bar" } + +in keyText diff --git a/dhall-lang/Prelude/Map/keyValue b/dhall-lang/Prelude/Map/keyValue new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/keyValue @@ -0,0 +1,3 @@ + missing + sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c +? ./keyValue.dhall diff --git a/dhall-lang/Prelude/Map/keyValue.dhall b/dhall-lang/Prelude/Map/keyValue.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/keyValue.dhall @@ -0,0 +1,17 @@ +{-| +Builds a key-value record such that a List of them will be converted to a +homogeneous record by dhall-to-json and dhall-to-yaml. +-} +let keyValue = + λ(v : Type) → + λ(key : Text) → + λ(value : v) → + { mapKey = key, mapValue = value } + +let example0 = + assert : keyValue Natural "foo" 2 ≡ { mapKey = "foo", mapValue = 2 } + +let example1 = + assert : keyValue Text "bar" "baz" ≡ { mapKey = "bar", mapValue = "baz" } + +in keyValue diff --git a/dhall-lang/Prelude/Map/keys b/dhall-lang/Prelude/Map/keys new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/keys @@ -0,0 +1,3 @@ + missing + sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7 +? ./keys.dhall diff --git a/dhall-lang/Prelude/Map/keys.dhall b/dhall-lang/Prelude/Map/keys.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/keys.dhall @@ -0,0 +1,39 @@ +--| Get all of the keys of a `Map` as a `List` +let Map = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type.dhall + +let Entry = + missing + sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 + ? ./Entry.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map + +let keys + : ∀(k : Type) → ∀(v : Type) → Map k v → List k + = λ(k : Type) → + λ(v : Type) → + List/map (Entry k v) k (λ(x : Entry k v) → x.mapKey) + +let example0 = + assert + : keys + Text + Natural + [ { mapKey = "A", mapValue = 2 } + , { mapKey = "B", mapValue = 3 } + , { mapKey = "C", mapValue = 5 } + ] + ≡ [ "A", "B", "C" ] + +let example1 = + assert + : keys Text Natural ([] : List { mapKey : Text, mapValue : Natural }) + ≡ ([] : List Text) + +in keys diff --git a/dhall-lang/Prelude/Map/map b/dhall-lang/Prelude/Map/map new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/map @@ -0,0 +1,3 @@ + missing + sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0 +? ./map.dhall diff --git a/dhall-lang/Prelude/Map/map.dhall b/dhall-lang/Prelude/Map/map.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/map.dhall @@ -0,0 +1,58 @@ +--| Transform a `Map` by applying a function to each value +let Map = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type.dhall + +let Entry = + missing + sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 + ? ./Entry.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let map + : ∀(k : Type) → ∀(a : Type) → ∀(b : Type) → (a → b) → Map k a → Map k b + = λ(k : Type) → + λ(a : Type) → + λ(b : Type) → + λ(f : a → b) → + λ(m : Map k a) → + List/map + (Entry k a) + (Entry k b) + ( λ(before : Entry k a) → + { mapKey = before.mapKey, mapValue = f before.mapValue } + ) + m + +let example0 = + assert + : map + Text + Natural + Bool + Natural/even + [ { mapKey = "A", mapValue = 2 } + , { mapKey = "B", mapValue = 3 } + , { mapKey = "C", mapValue = 5 } + ] + ≡ [ { mapKey = "A", mapValue = True } + , { mapKey = "B", mapValue = False } + , { mapKey = "C", mapValue = False } + ] + +let example1 = + assert + : map + Text + Natural + Bool + Natural/even + ([] : List { mapKey : Text, mapValue : Natural }) + ≡ ([] : List { mapKey : Text, mapValue : Bool }) + +in map diff --git a/dhall-lang/Prelude/Map/mapMaybe.dhall b/dhall-lang/Prelude/Map/mapMaybe.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/mapMaybe.dhall @@ -0,0 +1,56 @@ +--| Apply a function across the values of a `Map k v`, dropping +-- entries whose values return `None`. +let Map/empty = + missing + sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52 + ? ./empty.dhall + +let Map/unpackOptionals = + missing + sha256:66c3e6f6f81418cf99342e1dba739617c01af4b27c1ca5e2e1d7bce64a522e22 + ? ./unpackOptionals.dhall + +let Map/map = + missing + sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0 + ? ./map.dhall + +let Map/Type = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type.dhall + +let mapMaybe + : ∀(k : Type) → + ∀(a : Type) → + ∀(b : Type) → + (a → Optional b) → + Map/Type k a → + Map/Type k b + = λ(k : Type) → + λ(a : Type) → + λ(b : Type) → + λ(f : a → Optional b) → + λ(m : Map/Type k a) → + Map/unpackOptionals k b (Map/map k a (Optional b) f m) + +let property = + λ(k : Type) → + λ(a : Type) → + λ(b : Type) → + λ(f : a → Optional b) → + assert : mapMaybe k a b f (Map/empty k a) ≡ Map/empty k b + +let example0 = + assert + : mapMaybe + Text + Natural + Text + ( λ(n : Natural) → + if Natural/isZero n then None Text else Some (Natural/show n) + ) + (toMap { foo = 2, bar = 0 }) + ≡ toMap { foo = "2" } + +in mapMaybe diff --git a/dhall-lang/Prelude/Map/package.dhall b/dhall-lang/Prelude/Map/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/package.dhall @@ -0,0 +1,41 @@ +{ Type = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type +, Entry = + missing + sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 + ? ./Entry +, empty = + missing + sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52 + ? ./empty +, keyText = + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc + ? ./keyText +, keyValue = + missing + sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c + ? ./keyValue +, keys = + missing + sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7 + ? ./keys +, map = + missing + sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0 + ? ./map +, mapMaybe = + missing + sha256:4ea58b720d7af38cef3ef07bef36e476caeed21032cd4a9dc733868a74d9a521 + ? ./mapMaybe.dhall +, unpackOptionals = + missing + sha256:66c3e6f6f81418cf99342e1dba739617c01af4b27c1ca5e2e1d7bce64a522e22 + ? ./unpackOptionals.dhall +, values = + missing + sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8 + ? ./values +} diff --git a/dhall-lang/Prelude/Map/unpackOptionals.dhall b/dhall-lang/Prelude/Map/unpackOptionals.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/unpackOptionals.dhall @@ -0,0 +1,41 @@ +--| Turn a `Map k (Optional v)` into a `Map k v` by dropping all +-- entries with value `None`. +let List/concatMap = + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 + ? ../List/concatMap.dhall + +let Map/Entry = + missing + sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 + ? ./Entry.dhall + +let Map/Type = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type.dhall + +let unpackOptionals + : ∀(k : Type) → ∀(v : Type) → Map/Type k (Optional v) → Map/Type k v + = λ(k : Type) → + λ(v : Type) → + List/concatMap + (Map/Entry k (Optional v)) + (Map/Entry k v) + ( λ(e : Map/Entry k (Optional v)) → + merge + { None = [] : Map/Type k v + , Some = λ(v : v) → [ { mapKey = e.mapKey, mapValue = v } ] + } + e.mapValue + ) + +let example0 = + assert + : unpackOptionals + Text + Text + (toMap { foo = Some "bar", baz = None Text }) + ≡ toMap { foo = "bar" } + +in unpackOptionals diff --git a/dhall-lang/Prelude/Map/values b/dhall-lang/Prelude/Map/values new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/values @@ -0,0 +1,3 @@ + missing + sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8 +? ./values.dhall diff --git a/dhall-lang/Prelude/Map/values.dhall b/dhall-lang/Prelude/Map/values.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Map/values.dhall @@ -0,0 +1,39 @@ +--| Get all of the values of a `Map` as a `List` +let Map = + missing + sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type.dhall + +let Entry = + missing + sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 + ? ./Entry.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let values + : ∀(k : Type) → ∀(v : Type) → Map k v → List v + = λ(k : Type) → + λ(v : Type) → + List/map (Entry k v) v (λ(x : Entry k v) → x.mapValue) + +let example0 = + assert + : values + Text + Natural + [ { mapKey = "A", mapValue = 2 } + , { mapKey = "B", mapValue = 3 } + , { mapKey = "C", mapValue = 5 } + ] + ≡ [ 2, 3, 5 ] + +let example1 = + assert + : values Text Natural ([] : List { mapKey : Text, mapValue : Natural }) + ≡ ([] : List Natural) + +in values diff --git a/dhall-lang/Prelude/Monoid b/dhall-lang/Prelude/Monoid new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Monoid @@ -0,0 +1,3 @@ + missing + sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af +? ./Monoid.dhall diff --git a/dhall-lang/Prelude/Monoid.dhall b/dhall-lang/Prelude/Monoid.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Monoid.dhall @@ -0,0 +1,43 @@ +{-| +Any function `f` that is a `Monoid` must satisfy the following law: + +``` +t : Type +f : ./Monoid t +xs : List (List t) + +f (./List/concat t xs) = f (./map (List t) t f xs) +``` + +Examples: + +``` +./Bool/and + : ./Monoid Bool +./Bool/or + : ./Monoid Bool +./Bool/even + : ./Monoid Bool +./Bool/odd + : ./Monoid Bool +./List/concat + : ∀(a : Type) → ./Monoid (List a) +./List/shifted + : ∀(a : Type) → ./Monoid (List { index : Natural, value : a }) +./Natural/sum + : ./Monoid Natural +./Natural/product + : ./Monoid Natural +./Optional/head + : ∀(a : Type) → ./Monoid (Optional a) +./Optional/last + : ∀(a : Type) → ./Monoid (Optional a) +./Text/concat + : ./Monoid Text +``` +-} +let Monoid + : ∀(m : Type) → Type + = λ(m : Type) → List m → m + +in Monoid diff --git a/dhall-lang/Prelude/Natural/build b/dhall-lang/Prelude/Natural/build new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/build @@ -0,0 +1,3 @@ + missing + sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c +? ./build.dhall diff --git a/dhall-lang/Prelude/Natural/build.dhall b/dhall-lang/Prelude/Natural/build.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/build.dhall @@ -0,0 +1,31 @@ +--| `build` is the inverse of `fold` +let build + : ( ∀(natural : Type) → + ∀(succ : natural → natural) → + ∀(zero : natural) → + natural + ) → + Natural + = Natural/build + +let example0 = + assert + : build + ( λ(natural : Type) → + λ(succ : natural → natural) → + λ(zero : natural) → + succ (succ (succ zero)) + ) + ≡ 3 + +let example1 = + assert + : build + ( λ(natural : Type) → + λ(succ : natural → natural) → + λ(zero : natural) → + zero + ) + ≡ 0 + +in build diff --git a/dhall-lang/Prelude/Natural/enumerate b/dhall-lang/Prelude/Natural/enumerate new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/enumerate @@ -0,0 +1,3 @@ + missing + sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3 +? ./enumerate.dhall diff --git a/dhall-lang/Prelude/Natural/enumerate.dhall b/dhall-lang/Prelude/Natural/enumerate.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/enumerate.dhall @@ -0,0 +1,32 @@ +{-| +Generate a list of numbers from `0` up to but not including the specified +number +-} +let enumerate + : Natural → List Natural + = λ(n : Natural) → + List/build + Natural + ( λ(list : Type) → + λ(cons : Natural → list → list) → + List/fold + { index : Natural, value : {} } + ( List/indexed + {} + ( List/build + {} + ( λ(list : Type) → + λ(cons : {} → list → list) → + Natural/fold n list (cons {=}) + ) + ) + ) + list + (λ(x : { index : Natural, value : {} }) → cons x.index) + ) + +let example0 = assert : enumerate 10 ≡ [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] + +let example1 = assert : enumerate 0 ≡ ([] : List Natural) + +in enumerate diff --git a/dhall-lang/Prelude/Natural/equal b/dhall-lang/Prelude/Natural/equal new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/equal @@ -0,0 +1,3 @@ + missing + sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60 +? ./equal.dhall diff --git a/dhall-lang/Prelude/Natural/equal.dhall b/dhall-lang/Prelude/Natural/equal.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/equal.dhall @@ -0,0 +1,17 @@ +--| `equal` checks if two Naturals are equal. +let lessThanEqual = + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual.dhall + +let equal + : Natural → Natural → Bool + = λ(a : Natural) → λ(b : Natural) → lessThanEqual a b && lessThanEqual b a + +let example0 = assert : equal 5 5 ≡ True + +let example1 = assert : equal 5 6 ≡ False + +let property0 = λ(n : Natural) → assert : equal n n ≡ True + +in equal diff --git a/dhall-lang/Prelude/Natural/even b/dhall-lang/Prelude/Natural/even new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/even @@ -0,0 +1,3 @@ + missing + sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66 +? ./even.dhall diff --git a/dhall-lang/Prelude/Natural/even.dhall b/dhall-lang/Prelude/Natural/even.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/even.dhall @@ -0,0 +1,10 @@ +--| Returns `True` if a number if even and returns `False` otherwise +let even + : Natural → Bool + = Natural/even + +let example0 = assert : even 3 ≡ False + +let example1 = assert : even 0 ≡ True + +in even diff --git a/dhall-lang/Prelude/Natural/fold b/dhall-lang/Prelude/Natural/fold new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/fold @@ -0,0 +1,3 @@ + missing + sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06 +? ./fold.dhall diff --git a/dhall-lang/Prelude/Natural/fold.dhall b/dhall-lang/Prelude/Natural/fold.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/fold.dhall @@ -0,0 +1,28 @@ +{-| +`fold` is the primitive function for consuming `Natural` numbers + +If you treat the number `3` as `succ (succ (succ zero))` then a `fold` just +replaces each `succ` and `zero` with something else +-} +let fold + : Natural → + ∀(natural : Type) → + ∀(succ : natural → natural) → + ∀(zero : natural) → + natural + = Natural/fold + +let example0 = assert : fold 3 Text (λ(x : Text) → "A" ++ x) "B" ≡ "AAAB" + +let example1 = + λ(zero : Text) → + assert + : fold 3 Text (λ(x : Text) → "A" ++ x) zero + ≡ "A" ++ ("A" ++ ("A" ++ zero)) + +let example2 = + λ(succ : Text → Text) → + λ(zero : Text) → + assert : fold 3 Text succ zero ≡ succ (succ (succ zero)) + +in fold diff --git a/dhall-lang/Prelude/Natural/greaterThan b/dhall-lang/Prelude/Natural/greaterThan new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/greaterThan @@ -0,0 +1,3 @@ + missing + sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c +? ./greaterThan.dhall diff --git a/dhall-lang/Prelude/Natural/greaterThan.dhall b/dhall-lang/Prelude/Natural/greaterThan.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/greaterThan.dhall @@ -0,0 +1,21 @@ +--| `greaterThan` checks if one Natural is strictly greater than another. +let lessThan = + missing + sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c + ? ./lessThan.dhall + +let greaterThan + : Natural → Natural → Bool + = λ(x : Natural) → λ(y : Natural) → lessThan y x + +let example0 = assert : greaterThan 5 6 ≡ False + +let example1 = assert : greaterThan 5 5 ≡ False + +let example2 = assert : greaterThan 5 4 ≡ True + +let property0 = λ(n : Natural) → assert : greaterThan 0 n ≡ False + +let property1 = λ(n : Natural) → assert : greaterThan n n ≡ False + +in greaterThan diff --git a/dhall-lang/Prelude/Natural/greaterThanEqual b/dhall-lang/Prelude/Natural/greaterThanEqual new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/greaterThanEqual @@ -0,0 +1,3 @@ + missing + sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 +? ./greaterThanEqual.dhall diff --git a/dhall-lang/Prelude/Natural/greaterThanEqual.dhall b/dhall-lang/Prelude/Natural/greaterThanEqual.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/greaterThanEqual.dhall @@ -0,0 +1,23 @@ +{-| +`greaterThanEqual` checks if one Natural is greater than or equal to another. +-} +let lessThanEqual = + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual.dhall + +let greaterThanEqual + : Natural → Natural → Bool + = λ(x : Natural) → λ(y : Natural) → lessThanEqual y x + +let example0 = assert : greaterThanEqual 5 6 ≡ False + +let example1 = assert : greaterThanEqual 5 5 ≡ True + +let example2 = assert : greaterThanEqual 5 4 ≡ True + +let property0 = λ(n : Natural) → assert : greaterThanEqual n 0 ≡ True + +let property1 = λ(n : Natural) → assert : greaterThanEqual n n ≡ True + +in greaterThanEqual diff --git a/dhall-lang/Prelude/Natural/isZero b/dhall-lang/Prelude/Natural/isZero new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/isZero @@ -0,0 +1,3 @@ + missing + sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1 +? ./isZero.dhall diff --git a/dhall-lang/Prelude/Natural/isZero.dhall b/dhall-lang/Prelude/Natural/isZero.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/isZero.dhall @@ -0,0 +1,10 @@ +--| Returns `True` if a number is `0` and returns `False` otherwise +let isZero + : Natural → Bool + = Natural/isZero + +let example0 = assert : isZero 2 ≡ False + +let example1 = assert : isZero 0 ≡ True + +in isZero diff --git a/dhall-lang/Prelude/Natural/lessThan b/dhall-lang/Prelude/Natural/lessThan new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/lessThan @@ -0,0 +1,3 @@ + missing + sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c +? ./lessThan.dhall diff --git a/dhall-lang/Prelude/Natural/lessThan.dhall b/dhall-lang/Prelude/Natural/lessThan.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/lessThan.dhall @@ -0,0 +1,26 @@ +--| `lessThan` checks if one Natural is strictly less than another. +let greaterThanEqual = + missing + sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 + ? ./greaterThanEqual.dhall + +let Bool/not = + missing + sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 + ? ../Bool/not.dhall + +let lessThan + : Natural → Natural → Bool + = λ(x : Natural) → λ(y : Natural) → Bool/not (greaterThanEqual x y) + +let example0 = assert : lessThan 5 6 ≡ True + +let example1 = assert : lessThan 5 5 ≡ False + +let example2 = assert : lessThan 5 4 ≡ False + +let property0 = λ(n : Natural) → assert : lessThan n 0 ≡ False + +let property1 = λ(n : Natural) → assert : lessThan n n ≡ False + +in lessThan diff --git a/dhall-lang/Prelude/Natural/lessThanEqual b/dhall-lang/Prelude/Natural/lessThanEqual new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/lessThanEqual @@ -0,0 +1,3 @@ + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 +? ./lessThanEqual.dhall diff --git a/dhall-lang/Prelude/Natural/lessThanEqual.dhall b/dhall-lang/Prelude/Natural/lessThanEqual.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/lessThanEqual.dhall @@ -0,0 +1,16 @@ +--| `lessThanEqual` checks if one Natural is less than or equal to another. +let lessThanEqual + : Natural → Natural → Bool + = λ(x : Natural) → λ(y : Natural) → Natural/isZero (Natural/subtract y x) + +let example0 = assert : lessThanEqual 5 6 ≡ True + +let example1 = assert : lessThanEqual 5 5 ≡ True + +let example2 = assert : lessThanEqual 5 4 ≡ False + +let property0 = λ(n : Natural) → assert : lessThanEqual 0 n ≡ True + +let property1 = λ(n : Natural) → assert : lessThanEqual n n ≡ True + +in lessThanEqual diff --git a/dhall-lang/Prelude/Natural/listMax b/dhall-lang/Prelude/Natural/listMax new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/listMax @@ -0,0 +1,3 @@ + missing + sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472 +? ./listMax.dhall diff --git a/dhall-lang/Prelude/Natural/listMax.dhall b/dhall-lang/Prelude/Natural/listMax.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/listMax.dhall @@ -0,0 +1,30 @@ +{-| +`listMax` returns the largest element of a `List` or `None Natural` if the +`List` is empty +-} +let max = + missing + sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7 + ? ./max.dhall + +let Optional/map = + missing + sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa + ? ../Optional/map.dhall + +let listMax + : List Natural → Optional Natural + = λ(xs : List Natural) → + Optional/map + Natural + Natural + (λ(n : Natural) → List/fold Natural xs Natural max n) + (List/head Natural xs) + +let example0 = assert : listMax [ 1, 2 ] ≡ Some 2 + +let example1 = assert : listMax ([] : List Natural) ≡ None Natural + +let property0 = λ(n : Natural) → assert : listMax [ n ] ≡ Some n + +in listMax diff --git a/dhall-lang/Prelude/Natural/listMin b/dhall-lang/Prelude/Natural/listMin new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/listMin @@ -0,0 +1,3 @@ + missing + sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6 +? ./listMin.dhall diff --git a/dhall-lang/Prelude/Natural/listMin.dhall b/dhall-lang/Prelude/Natural/listMin.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/listMin.dhall @@ -0,0 +1,34 @@ +{-| +`listMin` returns the smallest element of a `List` or `None Natural` if the +`List` is empty +-} +let min = + missing + sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710 + ? ./min.dhall + +let Optional/map = + missing + sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa + ? ../Optional/map.dhall + +let listMin + : List Natural → Optional Natural + = λ(xs : List Natural) → + Optional/map + Natural + Natural + ( λ(n : Natural) → + if Natural/isZero n then n else List/fold Natural xs Natural min n + ) + (List/head Natural xs) + +let example0 = assert : listMin [ 0, 1 ] ≡ Some 0 + +let example1 = assert : listMin ([] : List Natural) ≡ None Natural + +let example2 = assert : listMin [ 3, 2, 1 ] ≡ Some 1 + +let property0 = λ(n : Natural) → assert : listMin [ n ] ≡ Some n + +in listMin diff --git a/dhall-lang/Prelude/Natural/max b/dhall-lang/Prelude/Natural/max new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/max @@ -0,0 +1,3 @@ + missing + sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7 +? ./max.dhall diff --git a/dhall-lang/Prelude/Natural/max.dhall b/dhall-lang/Prelude/Natural/max.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/max.dhall @@ -0,0 +1,19 @@ +--| `max a b` returns the larger of `a` or `b` +let lessThanEqual = + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual.dhall + +let max + : Natural → Natural → Natural + = λ(a : Natural) → λ(b : Natural) → if lessThanEqual a b then b else a + +let example0 = assert : max 1 2 ≡ 2 + +let example1 = assert : max 2 1 ≡ 2 + +let property0 = λ(n : Natural) → assert : max n n ≡ n + +let property1 = λ(n : Natural) → assert : max 0 n ≡ n + +in max diff --git a/dhall-lang/Prelude/Natural/min b/dhall-lang/Prelude/Natural/min new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/min @@ -0,0 +1,3 @@ + missing + sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710 +? ./min.dhall diff --git a/dhall-lang/Prelude/Natural/min.dhall b/dhall-lang/Prelude/Natural/min.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/min.dhall @@ -0,0 +1,17 @@ +--| `min a b` returns the smaller of `a` or `b` +let lessThanEqual = + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual.dhall + +let min + : Natural → Natural → Natural + = λ(a : Natural) → λ(b : Natural) → if lessThanEqual a b then a else b + +let example0 = assert : min 1 2 ≡ 1 + +let example1 = assert : min 2 1 ≡ 1 + +let property0 = λ(n : Natural) → assert : min n n ≡ n + +in min diff --git a/dhall-lang/Prelude/Natural/odd b/dhall-lang/Prelude/Natural/odd new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/odd @@ -0,0 +1,3 @@ + missing + sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5 +? ./odd.dhall diff --git a/dhall-lang/Prelude/Natural/odd.dhall b/dhall-lang/Prelude/Natural/odd.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/odd.dhall @@ -0,0 +1,10 @@ +--| Returns `True` if a number is odd and returns `False` otherwise +let odd + : Natural → Bool + = Natural/odd + +let example0 = assert : odd 3 ≡ True + +let example1 = assert : odd 0 ≡ False + +in odd diff --git a/dhall-lang/Prelude/Natural/package.dhall b/dhall-lang/Prelude/Natural/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/package.dhall @@ -0,0 +1,89 @@ +{ build = + missing + sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c + ? ./build.dhall +, enumerate = + missing + sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3 + ? ./enumerate.dhall +, even = + missing + sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66 + ? ./even.dhall +, fold = + missing + sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06 + ? ./fold.dhall +, isZero = + missing + sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1 + ? ./isZero.dhall +, odd = + missing + sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5 + ? ./odd.dhall +, product = + missing + sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6 + ? ./product.dhall +, sum = + missing + sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037 + ? ./sum.dhall +, show = + missing + sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21 + ? ./show.dhall +, toDouble = + missing + sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81 + ? ./toDouble.dhall +, toInteger = + missing + sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f + ? ./toInteger.dhall +, lessThan = + missing + sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c + ? ./lessThan.dhall +, lessThanEqual = + missing + sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual.dhall +, equal = + missing + sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60 + ? ./equal.dhall +, greaterThanEqual = + missing + sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 + ? ./greaterThanEqual.dhall +, greaterThan = + missing + sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c + ? ./greaterThan.dhall +, min = + missing + sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710 + ? ./min.dhall +, max = + missing + sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7 + ? ./max.dhall +, listMin = + missing + sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6 + ? ./listMin.dhall +, listMax = + missing + sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472 + ? ./listMax.dhall +, sort = + missing + sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260 + ? ./sort.dhall +, subtract = + missing + sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745 + ? ./subtract.dhall +} diff --git a/dhall-lang/Prelude/Natural/product b/dhall-lang/Prelude/Natural/product new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/product @@ -0,0 +1,3 @@ + missing + sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6 +? ./product.dhall diff --git a/dhall-lang/Prelude/Natural/product.dhall b/dhall-lang/Prelude/Natural/product.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/product.dhall @@ -0,0 +1,11 @@ +--| Multiply all the numbers in a `List` +let product + : List Natural → Natural + = λ(xs : List Natural) → + List/fold Natural xs Natural (λ(l : Natural) → λ(r : Natural) → l * r) 1 + +let example0 = assert : product [ 2, 3, 5 ] ≡ 30 + +let example1 = assert : product ([] : List Natural) ≡ 1 + +in product diff --git a/dhall-lang/Prelude/Natural/show b/dhall-lang/Prelude/Natural/show new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/show @@ -0,0 +1,3 @@ + missing + sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21 +? ./show.dhall diff --git a/dhall-lang/Prelude/Natural/show.dhall b/dhall-lang/Prelude/Natural/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/show.dhall @@ -0,0 +1,13 @@ +{-| +Render a `Natural` number as `Text` using the same representation as Dhall +source code (i.e. a decimal number) +-} +let show + : Natural → Text + = Natural/show + +let example0 = assert : show 3 ≡ "3" + +let example1 = assert : show 0 ≡ "0" + +in show diff --git a/dhall-lang/Prelude/Natural/sort b/dhall-lang/Prelude/Natural/sort new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/sort @@ -0,0 +1,3 @@ + missing + sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260 +? ./sort.dhall diff --git a/dhall-lang/Prelude/Natural/sort.dhall b/dhall-lang/Prelude/Natural/sort.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/sort.dhall @@ -0,0 +1,61 @@ +--| `sort` sorts a `List` of `Natural`s in ascending order +let greaterThanEqual = + missing + sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 + ? ./greaterThanEqual.dhall + +let listMin = + missing + sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6 + ? ./listMin.dhall + +let List/partition = + missing + sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03 + ? ../List/partition.dhall + +let Accumulator = { sorted : List Natural, rest : List Natural } + +let partitionMinima = + λ(xs : List Natural) → + merge + { Some = + λ(m : Natural) → List/partition Natural (greaterThanEqual m) xs + , None = { true = [] : List Natural, false = [] : List Natural } + } + (listMin xs) + +let test0 = + assert + : partitionMinima [ 2, 1, 1, 3 ] ≡ { true = [ 1, 1 ], false = [ 2, 3 ] } + +let step = + λ(x : Accumulator) → + let p = partitionMinima x.rest + + in { sorted = x.sorted # p.true, rest = p.false } + +let test1 = + assert + : step { sorted = [ 1, 1 ], rest = [ 2, 3 ] } + ≡ { sorted = [ 1, 1, 2 ], rest = [ 3 ] } + +let sort + : List Natural → List Natural + = λ(xs : List Natural) → + let x = + Natural/fold + (List/length Natural xs) + Accumulator + step + { sorted = [] : List Natural, rest = xs } + + in x.sorted + +let example0 = assert : sort ([] : List Natural) ≡ ([] : List Natural) + +let example1 = assert : sort [ 1 ] ≡ [ 1 ] + +let example2 = assert : sort [ 3, 2, 1, 3, 2, 1 ] ≡ [ 1, 1, 2, 2, 3, 3 ] + +in sort diff --git a/dhall-lang/Prelude/Natural/subtract b/dhall-lang/Prelude/Natural/subtract new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/subtract @@ -0,0 +1,3 @@ + missing + sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745 +? ./subtract.dhall diff --git a/dhall-lang/Prelude/Natural/subtract.dhall b/dhall-lang/Prelude/Natural/subtract.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/subtract.dhall @@ -0,0 +1,18 @@ +--| `subtract m n` computes `n - m`, truncating to `0` if `m > n` +let subtract + : Natural → Natural → Natural + = Natural/subtract + +let example0 = assert : subtract 1 2 ≡ 1 + +let example1 = assert : subtract 1 1 ≡ 0 + +let example2 = assert : subtract 2 1 ≡ 0 + +let property0 = λ(n : Natural) → assert : subtract 0 n ≡ n + +let property1 = λ(n : Natural) → assert : subtract n 0 ≡ 0 + +let property2 = λ(n : Natural) → assert : subtract n n ≡ 0 + +in subtract diff --git a/dhall-lang/Prelude/Natural/sum b/dhall-lang/Prelude/Natural/sum new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/sum @@ -0,0 +1,3 @@ + missing + sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037 +? ./sum.dhall diff --git a/dhall-lang/Prelude/Natural/sum.dhall b/dhall-lang/Prelude/Natural/sum.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/sum.dhall @@ -0,0 +1,11 @@ +--| Add all the numbers in a `List` +let sum + : List Natural → Natural + = λ(xs : List Natural) → + List/fold Natural xs Natural (λ(l : Natural) → λ(r : Natural) → l + r) 0 + +let example = assert : sum [ 2, 3, 5 ] ≡ 10 + +let example = assert : sum ([] : List Natural) ≡ 0 + +in sum diff --git a/dhall-lang/Prelude/Natural/toDouble b/dhall-lang/Prelude/Natural/toDouble new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/toDouble @@ -0,0 +1,3 @@ + missing + sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81 +? ./toDouble.dhall diff --git a/dhall-lang/Prelude/Natural/toDouble.dhall b/dhall-lang/Prelude/Natural/toDouble.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/toDouble.dhall @@ -0,0 +1,10 @@ +--| Convert a `Natural` number to the corresponding `Double` +let toDouble + : Natural → Double + = λ(n : Natural) → Integer/toDouble (Natural/toInteger n) + +let example0 = assert : toDouble 3 ≡ 3.0 + +let example1 = assert : toDouble 0 ≡ 0.0 + +in toDouble diff --git a/dhall-lang/Prelude/Natural/toInteger b/dhall-lang/Prelude/Natural/toInteger new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/toInteger @@ -0,0 +1,3 @@ + missing + sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f +? ./toInteger.dhall diff --git a/dhall-lang/Prelude/Natural/toInteger.dhall b/dhall-lang/Prelude/Natural/toInteger.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/toInteger.dhall @@ -0,0 +1,10 @@ +--| Convert a `Natural` number to the corresponding `Integer` +let toInteger + : Natural → Integer + = Natural/toInteger + +let example0 = assert : toInteger 3 ≡ +3 + +let example1 = assert : toInteger 0 ≡ +0 + +in toInteger diff --git a/dhall-lang/Prelude/NonEmpty/Type.dhall b/dhall-lang/Prelude/NonEmpty/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/Type.dhall @@ -0,0 +1,9 @@ +{-| +A `NonEmpty` list has at least one element and supports many of the same +operations as `List`s +-} +let NonEmpty + : Type → Type + = λ(a : Type) → { head : a, tail : List a } + +in NonEmpty diff --git a/dhall-lang/Prelude/NonEmpty/all.dhall b/dhall-lang/Prelude/NonEmpty/all.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/all.dhall @@ -0,0 +1,34 @@ +{-| +Returns `True` if the supplied function returns `True` for all elements in the +`NonEmpty` list +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let NonEmpty/toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ./toList.dhall + +let all + : ∀(a : Type) → (a → Bool) → NonEmpty a → Bool + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : NonEmpty a) → + List/fold + a + (NonEmpty/toList a xs) + Bool + (λ(x : a) → λ(r : Bool) → f x && r) + True + +let example0 = + assert : all Natural Natural/even { head = 2, tail = [ 3, 5 ] } ≡ False + +let example1 = + assert + : all Natural Natural/even { head = 2, tail = [] : List Natural } ≡ True + +in all diff --git a/dhall-lang/Prelude/NonEmpty/any.dhall b/dhall-lang/Prelude/NonEmpty/any.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/any.dhall @@ -0,0 +1,34 @@ +{-| +Returns `True` if the supplied function returns `True` for any element in the +`NonEmpty` list +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let NonEmpty/toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ./toList.dhall + +let any + : ∀(a : Type) → (a → Bool) → NonEmpty a → Bool + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : NonEmpty a) → + List/fold + a + (NonEmpty/toList a xs) + Bool + (λ(x : a) → λ(r : Bool) → f x || r) + False + +let example0 = + assert : any Natural Natural/even { head = 2, tail = [ 3, 5 ] } ≡ True + +let example1 = + assert + : any Natural Natural/even { head = 3, tail = [] : List Natural } ≡ False + +in any diff --git a/dhall-lang/Prelude/NonEmpty/concat.dhall b/dhall-lang/Prelude/NonEmpty/concat.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/concat.dhall @@ -0,0 +1,61 @@ +{-| +Concatenate a `NonEmpty` list of `NonEmpty` lists into a single `NonEmpty` +list +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let NonEmpty/toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ./toList.dhall + +let List/concatMap = + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 + ? ../List/concatMap.dhall + +let concat + : ∀(a : Type) → NonEmpty (NonEmpty a) → NonEmpty a + = λ(a : Type) → + λ(xss : NonEmpty (NonEmpty a)) → + { head = xss.head.head + , tail = + xss.head.tail + # List/concatMap (NonEmpty a) a (NonEmpty/toList a) xss.tail + } + +let example0 = + assert + : concat + Natural + { head = { head = 0, tail = [ 1, 2 ] } + , tail = + [ { head = 3, tail = [ 4 ] }, { head = 5, tail = [ 6, 7, 8 ] } ] + } + ≡ { head = 0, tail = [ 1, 2, 3, 4, 5, 6, 7, 8 ] } + +let example1 = + assert + : concat + Natural + { head = { head = 0, tail = [] : List Natural } + , tail = + [ { head = 1, tail = [] : List Natural } + , { head = 2, tail = [] : List Natural } + ] + } + ≡ { head = 0, tail = [ 1, 2 ] : List Natural } + +let example2 = + assert + : concat + Natural + { head = { head = 0, tail = [] : List Natural } + , tail = [] : List (NonEmpty Natural) + } + ≡ { head = 0, tail = [] : List Natural } + +in concat diff --git a/dhall-lang/Prelude/NonEmpty/concatMap.dhall b/dhall-lang/Prelude/NonEmpty/concatMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/concatMap.dhall @@ -0,0 +1,56 @@ +{-| +Transform a `NonEmpty` list by applying a function to each element and +flattening the results +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let NonEmpty/toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ./toList.dhall + +let List/concatMap = + missing + sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 + ? ../List/concatMap.dhall + +let concatMap + : ∀(a : Type) → ∀(b : Type) → (a → NonEmpty b) → NonEmpty a → NonEmpty b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → NonEmpty b) → + λ(xs : NonEmpty a) → + let ys = f xs.head + + in { head = ys.head + , tail = + ys.tail + # List/concatMap + a + b + (λ(x : a) → NonEmpty/toList b (f x)) + xs.tail + } + +let example0 = + assert + : concatMap + Natural + Natural + (λ(n : Natural) → { head = n, tail = [ n ] }) + { head = 2, tail = [ 3, 5 ] } + ≡ { head = 2, tail = [ 2, 3, 3, 5, 5 ] } + +let example1 = + assert + : concatMap + Natural + Natural + (λ(n : Natural) → { head = n, tail = [ n ] }) + { head = 2, tail = [] : List Natural } + ≡ { head = 2, tail = [ 2 ] } + +in concatMap diff --git a/dhall-lang/Prelude/NonEmpty/head.dhall b/dhall-lang/Prelude/NonEmpty/head.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/head.dhall @@ -0,0 +1,13 @@ +--| Retrieve the first element of the `NonEmpty` list +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let head + : ∀(a : Type) → NonEmpty a → a + = λ(a : Type) → λ(xs : NonEmpty a) → xs.head + +let example = assert : head Natural { head = 0, tail = [ 1, 2 ] } ≡ 0 + +in head diff --git a/dhall-lang/Prelude/NonEmpty/index.dhall b/dhall-lang/Prelude/NonEmpty/index.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/index.dhall @@ -0,0 +1,33 @@ +--| Retrieve an element from a `NonEmpty` list using its 0-based index +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let List/index = + missing + sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 + ? ../List/index.dhall + +let index + : Natural → ∀(a : Type) → NonEmpty a → Optional a + = λ(n : Natural) → + λ(a : Type) → + λ(xs : NonEmpty a) → + if Natural/isZero n + then Some xs.head + else List/index (Natural/subtract 1 n) a xs.tail + +let property = + λ(n : Natural) → + λ(a : Type) → + λ(xs : NonEmpty a) → + assert : index 0 a xs ≡ Some xs.head + +let example0 = assert : index 1 Natural { head = 2, tail = [ 3, 5 ] } ≡ Some 3 + +let example1 = + assert + : index 1 Natural { head = 2, tail = [] : List Natural } ≡ None Natural + +in index diff --git a/dhall-lang/Prelude/NonEmpty/indexed.dhall b/dhall-lang/Prelude/NonEmpty/indexed.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/indexed.dhall @@ -0,0 +1,41 @@ +--| Tag each element of the `NonEmpty` list with its index +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let indexed + : ∀(a : Type) → NonEmpty a → NonEmpty { index : Natural, value : a } + = λ(a : Type) → + λ(xs : NonEmpty a) → + { head = { index = 0, value = xs.head } + , tail = + List/map + { index : Natural, value : a } + { index : Natural, value : a } + ( λ(ix : { index : Natural, value : a }) → + { index = ix.index + 1, value = ix.value } + ) + (List/indexed a xs.tail) + } + +let example0 = + assert + : indexed Bool { head = True, tail = [ False, True ] } + ≡ { head = { index = 0, value = True } + , tail = [ { index = 1, value = False }, { index = 2, value = True } ] + } + +let example1 = + assert + : indexed Bool { head = True, tail = [] : List Bool } + ≡ { head = { index = 0, value = True } + , tail = [] : List { index : Natural, value : Bool } + } + +in indexed diff --git a/dhall-lang/Prelude/NonEmpty/last.dhall b/dhall-lang/Prelude/NonEmpty/last.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/last.dhall @@ -0,0 +1,17 @@ +--| Retrieve the last element of the `NonEmpty` list +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let last + : ∀(a : Type) → NonEmpty a → a + = λ(a : Type) → + λ(xs : NonEmpty a) → + merge { Some = λ(x : a) → x, None = xs.head } (List/last a xs.tail) + +let example0 = assert : last Natural { head = 0, tail = [ 1, 2 ] } ≡ 2 + +let example1 = assert : last Natural { head = 0, tail = [] : List Natural } ≡ 0 + +in last diff --git a/dhall-lang/Prelude/NonEmpty/length.dhall b/dhall-lang/Prelude/NonEmpty/length.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/length.dhall @@ -0,0 +1,16 @@ +--| Returns the number of elements in a `NonEmpty` list +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let length + : ∀(a : Type) → NonEmpty a → Natural + = λ(a : Type) → λ(xs : NonEmpty a) → List/length a xs.tail + 1 + +let example0 = assert : length Natural { head = 0, tail = [ 1, 2 ] } ≡ 3 + +let example1 = + assert : length Natural { head = 0, tail = [] : List Natural } ≡ 1 + +in length diff --git a/dhall-lang/Prelude/NonEmpty/make.dhall b/dhall-lang/Prelude/NonEmpty/make.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/make.dhall @@ -0,0 +1,18 @@ +{-| +Create a `NonEmpty` list using a function instead of a record + +This might come in handy if you want to decouple the `NonEmpty` list +construction from the specific names of the fields. +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let make + : ∀(a : Type) → ∀(head : a) → ∀(tail : List a) → NonEmpty a + = λ(a : Type) → λ(head : a) → λ(tail : List a) → { head, tail } + +let example = assert : make Natural 1 [ 2, 3 ] ≡ { head = 1, tail = [ 2, 3 ] } + +in make diff --git a/dhall-lang/Prelude/NonEmpty/map.dhall b/dhall-lang/Prelude/NonEmpty/map.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/map.dhall @@ -0,0 +1,30 @@ +--| Transform a `NonEmpty` list by applying a function to each element +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let map + : ∀(a : Type) → ∀(b : Type) → (a → b) → NonEmpty a → NonEmpty b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → b) → + λ(xs : NonEmpty a) → + { head = f xs.head, tail = List/map a b f xs.tail } + +let example0 = + assert + : map Natural Bool Natural/even { head = 2, tail = [ 3, 5 ] } + ≡ { head = True, tail = [ False, False ] } + +let example1 = + assert + : map Natural Bool Natural/even { head = 2, tail = [] : List Natural } + ≡ { head = True, tail = [] : List Bool } + +in map diff --git a/dhall-lang/Prelude/NonEmpty/package.dhall b/dhall-lang/Prelude/NonEmpty/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/package.dhall @@ -0,0 +1,73 @@ +{ Type = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall +, all = + missing + sha256:f2f9389d94f4deb5b918b2e50c1093b57e00b37ddd3ab2b43959993b1cb519b6 + ? ./all.dhall +, any = + missing + sha256:7662b665840e41b12a28190eec3aaab9201fcb90c00a8ec3666d549e1020992f + ? ./any.dhall +, concat = + missing + sha256:6d55181938c06c6b806877028f6a241912e9c0935d9a10dd958775bf21e0f64d + ? ./concat.dhall +, concatMap = + missing + sha256:fc33fa9449dc8f74dd8c8be379b7b7c4b0433e2b65650370d81d9a7111a590e2 + ? ./concatMap.dhall +, head = + missing + sha256:6b9551c97b89fe666d2e03392a4af5e87abfdbdb0aa0e29fc4b3aa1b318474e7 + ? ./head.dhall +, index = + missing + sha256:0ba2fcc9227fab10676cd61b47a18d779818a19c16727c7cc4b4c78e114fd663 + ? ./index.dhall +, indexed = + missing + sha256:9dae2c1fecd142df837e98769b5bbdd0bfe25c35a93af1064b4e62f9c780ae6b + ? ./indexed.dhall +, last = + missing + sha256:f83115492b6e408d0b662a68440620f7f3df07b56e7ed66dab77a6e65b121250 + ? ./last.dhall +, length = + missing + sha256:eef3b857a164487cfdb960e3298c4731970b7a430011289cba35a9ad722ac989 + ? ./length.dhall +, make = + missing + sha256:549de393673c4773c80a50ea578ea50d7f2c4c2eda31956e73fabc4e486f3b1e + ? ./make.dhall +, map = + missing + sha256:93d53afe874bb2eed946c21ca5ada3c9716b7d00e6d8edfaba6484cd9c5a00bd + ? ./map.dhall +, reverse = + missing + sha256:a6d810cdd3badffd4e7ca82091609a855cffac900c82d7ff3724463fbc2d5ff2 + ? ./reverse.dhall +, shifted = + missing + sha256:36156973d6916aed10cfd8c59be7c019516bf0a2c47b499a17a8ef0611e1c189 + ? ./shifted.dhall +, singleton = + missing + sha256:c9197aabe97695f7ca66f7419bf172d806b2c915594a8fc0d2ff6495db496ff2 + ? ./singleton.dhall +, toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ./toList.dhall +, unzip = + missing + sha256:d0b925bea32a29aad5cb48a84e8ef8cff750308afe1dd20b24eca19e4e999abc + ? ./unzip.dhall +, zip = + missing + sha256:073f8b4808b6d1db84964f772f6291e6ea193602163438db43fa282c560c01e4 + ? ./zip.dhall +} diff --git a/dhall-lang/Prelude/NonEmpty/reverse.dhall b/dhall-lang/Prelude/NonEmpty/reverse.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/reverse.dhall @@ -0,0 +1,35 @@ +--| Reverse a `NonEmpty` list +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let List/drop = + missing + sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf + ? ../List/drop.dhall + +let reverse + : ∀(a : Type) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(xs : NonEmpty a) → + let ys = List/reverse a xs.tail + + in merge + { Some = + λ(y : a) → { head = y, tail = List/drop 1 a ys # [ xs.head ] } + , None = { head = xs.head, tail = [] : List a } + } + (List/head a ys) + +let example = + assert + : reverse Natural { head = 0, tail = [ 1, 2 ] } + ≡ { head = 2, tail = [ 1, 0 ] } + +let example1 = + assert + : reverse Natural { head = 0, tail = [] : List Natural } + ≡ { head = 0, tail = [] : List Natural } + +in reverse diff --git a/dhall-lang/Prelude/NonEmpty/shifted.dhall b/dhall-lang/Prelude/NonEmpty/shifted.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/shifted.dhall @@ -0,0 +1,101 @@ +{-| +Combine a `NonEmpty` list of `NonEmpty` lists, offsetting the `index` of each +element by the number of elements in preceding lists +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let NonEmpty/toList = + missing + sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 + ? ./toList.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let List/shifted = + missing + sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe + ? ../List/shifted.dhall + +let shifted + : ∀(a : Type) → + NonEmpty (NonEmpty { index : Natural, value : a }) → + NonEmpty { index : Natural, value : a } + = λ(a : Type) → + λ(kvss : NonEmpty (NonEmpty { index : Natural, value : a })) → + { head = kvss.head.head + , tail = + List/shifted + a + ( [ kvss.head.tail ] + # List/map + (NonEmpty { index : Natural, value : a }) + (List { index : Natural, value : a }) + ( λ(kvs : NonEmpty { index : Natural, value : a }) → + List/map + { index : Natural, value : a } + { index : Natural, value : a } + ( λ(kv : { index : Natural, value : a }) → + { index = kv.index + 1, value = kv.value } + ) + (NonEmpty/toList { index : Natural, value : a } kvs) + ) + kvss.tail + ) + } + +let example0 = + assert + : shifted + Bool + { head = + { head = { index = 0, value = True } + , tail = + [ { index = 1, value = True }, { index = 2, value = True } ] + } + , tail = + [ { head = { index = 0, value = False } + , tail = [ { index = 1, value = False } ] + } + , { head = { index = 0, value = True } + , tail = + [ { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = True } + ] + } + ] + } + ≡ { head = { index = 0, value = True } + , tail = + [ { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = False } + , { index = 4, value = False } + , { index = 5, value = True } + , { index = 6, value = True } + , { index = 7, value = True } + , { index = 8, value = True } + ] + } + +let example1 = + assert + : shifted + Bool + { head = + { head = { index = 0, value = True } + , tail = [] : List { index : Natural, value : Bool } + } + , tail = [] : List (NonEmpty { index : Natural, value : Bool }) + } + ≡ { head = { index = 0, value = True } + , tail = [] : List { index : Natural, value : Bool } + } + +in shifted diff --git a/dhall-lang/Prelude/NonEmpty/singleton.dhall b/dhall-lang/Prelude/NonEmpty/singleton.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/singleton.dhall @@ -0,0 +1,14 @@ +--| Create a `NonEmpty` list with just one element +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let singleton + : ∀(a : Type) → a → NonEmpty a + = λ(a : Type) → λ(x : a) → { head = x, tail = [] : List a } + +let example = + assert : singleton Natural 2 ≡ { head = 2, tail = [] : List Natural } + +in singleton diff --git a/dhall-lang/Prelude/NonEmpty/toList.dhall b/dhall-lang/Prelude/NonEmpty/toList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/toList.dhall @@ -0,0 +1,17 @@ +--| Convert a `NonEmpty` list into the equivalent `List` +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let toList + : ∀(a : Type) → NonEmpty a → List a + = λ(a : Type) → λ(xs : NonEmpty a) → [ xs.head ] # xs.tail + +let example0 = + assert : toList Natural { head = 2, tail = [ 3, 5 ] } ≡ [ 2, 3, 5 ] + +let example1 = + assert : toList Natural { head = 2, tail = [] : List Natural } ≡ [ 2 ] + +in toList diff --git a/dhall-lang/Prelude/NonEmpty/unzip.dhall b/dhall-lang/Prelude/NonEmpty/unzip.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/unzip.dhall @@ -0,0 +1,58 @@ +--| Unzip a `NonEmpty` list into two separate `NonEmpty` lists +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let NonEmpty/map = + missing + sha256:93d53afe874bb2eed946c21ca5ada3c9716b7d00e6d8edfaba6484cd9c5a00bd + ? ./map.dhall + +let unzip + : ∀(a : Type) → + ∀(b : Type) → + NonEmpty { _1 : a, _2 : b } → + { _1 : NonEmpty a, _2 : NonEmpty b } + = λ(a : Type) → + λ(b : Type) → + λ(xs : NonEmpty { _1 : a, _2 : b }) → + { _1 = + NonEmpty/map + { _1 : a, _2 : b } + a + (λ(x : { _1 : a, _2 : b }) → x._1) + xs + , _2 = + NonEmpty/map + { _1 : a, _2 : b } + b + (λ(x : { _1 : a, _2 : b }) → x._2) + xs + } + +let example0 = + assert + : unzip + Text + Bool + { head = { _1 = "ABC", _2 = True } + , tail = [ { _1 = "DEF", _2 = False }, { _1 = "GHI", _2 = True } ] + } + ≡ { _1 = { head = "ABC", tail = [ "DEF", "GHI" ] } + , _2 = { head = True, tail = [ False, True ] } + } + +let example1 = + assert + : unzip + Text + Bool + { head = { _1 = "ABC", _2 = True } + , tail = [] : List { _1 : Text, _2 : Bool } + } + ≡ { _1 = { head = "ABC", tail = [] : List Text } + , _2 = { head = True, tail = [] : List Bool } + } + +in unzip diff --git a/dhall-lang/Prelude/NonEmpty/zip.dhall b/dhall-lang/Prelude/NonEmpty/zip.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/NonEmpty/zip.dhall @@ -0,0 +1,63 @@ +{-| +Zip two `NonEmpty` lists into a single `NonEmpty` + +The resulting `NonEmpty` will have the length of the shortest of its arguments. +-} +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ./Type.dhall + +let List/zip = + missing + sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da + ? ../List/zip.dhall + +let zip + : ∀(a : Type) → + NonEmpty a → + ∀(b : Type) → + NonEmpty b → + NonEmpty { _1 : a, _2 : b } + = λ(a : Type) → + λ(xs : NonEmpty a) → + λ(b : Type) → + λ(ys : NonEmpty b) → + { head = { _1 = xs.head, _2 = ys.head } + , tail = List/zip a xs.tail b ys.tail + } + +let example0 = + assert + : zip + Text + { head = "ABC", tail = [ "DEF", "GHI" ] } + Natural + { head = 1, tail = [ 2, 3 ] } + ≡ { head = { _1 = "ABC", _2 = 1 } + , tail = [ { _1 = "DEF", _2 = 2 }, { _1 = "GHI", _2 = 3 } ] + } + +let example1 = + assert + : zip + Text + { head = "ABC", tail = [ "DEF" ] } + Bool + { head = True, tail = [] : List Bool } + ≡ { head = { _1 = "ABC", _2 = True } + , tail = [] : List { _1 : Text, _2 : Bool } + } + +let example2 = + assert + : zip + Text + { head = "ABC", tail = [] : List Text } + Natural + { head = 1, tail = [ 2 ] } + ≡ { head = { _1 = "ABC", _2 = 1 } + , tail = [] : List { _1 : Text, _2 : Natural } + } + +in zip diff --git a/dhall-lang/Prelude/Operator/package.dhall b/dhall-lang/Prelude/Operator/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Operator/package.dhall @@ -0,0 +1,85 @@ +{- +Note: This package does not use one file per function because the operator +names contain symbols such as `*` that may cause problems. +-} +let {- + `+` m n + + computes `m + n` + -} `+` + : Natural → Natural → Natural + = λ(m : Natural) → λ(n : Natural) → m + n + +let example1 = assert : `+` 2 1 ≡ 3 + +let {- + `*` m n + + computes `m * n` + -} `*` + : Natural → Natural → Natural + = λ(m : Natural) → λ(n : Natural) → m * n + +let example2 = assert : `*` 21 2 ≡ 42 + +let {- + `++` m n + + computes `m ++ n` + -} `++` + : Text → Text → Text + = λ(m : Text) → λ(n : Text) → m ++ n + +let example3 = assert : `++` "Hello" "Dhall" ≡ "HelloDhall" + +let {- + `#` Type m n + + computes `m # n` + -} `#` + : ∀(type : Type) → List type → List type → List type + = λ(type : Type) → λ(m : List type) → λ(n : List type) → m # n + +let example4 = assert : `#` Natural [ 1, 2 ] [ 3 ] ≡ [ 1, 2, 3 ] + +let {- + `==` m n + + computes `m == n` + -} `==` + : Bool → Bool → Bool + = λ(m : Bool) → λ(n : Bool) → m == n + +let example5 = assert : `==` True False ≡ False + +let {- + `!=` m n + + computes `m != n` + -} `!=` + : Bool → Bool → Bool + = λ(m : Bool) → λ(n : Bool) → m != n + +let example6 = assert : `!=` True False ≡ True + +let {- + `&&` m n + + computes `m && n` + -} `&&` + : Bool → Bool → Bool + = λ(m : Bool) → λ(n : Bool) → m && n + +let example7 = assert : `&&` False True ≡ False + +let {- + `||` m n + + computes `m || n` + -} `||` + : Bool → Bool → Bool + = λ(m : Bool) → λ(n : Bool) → m || n + +let example8 = assert : `||` False True ≡ True + +in { `+`, `*`, `++`, `#`, `==`, `!=`, `&&`, `||` } diff --git a/dhall-lang/Prelude/Optional/all b/dhall-lang/Prelude/Optional/all new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/all @@ -0,0 +1,3 @@ + missing + sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695 +? ./all.dhall diff --git a/dhall-lang/Prelude/Optional/all.dhall b/dhall-lang/Prelude/Optional/all.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/all.dhall @@ -0,0 +1,16 @@ +{-| +Returns `False` if the supplied function returns `False` for a present element +and `True` otherwise: +-} +let all + : ∀(a : Type) → (a → Bool) → Optional a → Bool + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : Optional a) → + merge { Some = f, None = True } xs + +let example0 = assert : all Natural Natural/even (Some 3) ≡ False + +let example1 = assert : all Natural Natural/even (None Natural) ≡ True + +in all diff --git a/dhall-lang/Prelude/Optional/any b/dhall-lang/Prelude/Optional/any new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/any @@ -0,0 +1,3 @@ + missing + sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435 +? ./any.dhall diff --git a/dhall-lang/Prelude/Optional/any.dhall b/dhall-lang/Prelude/Optional/any.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/any.dhall @@ -0,0 +1,16 @@ +{-| +Returns `True` if the supplied function returns `True` for a present element and +`False` otherwise +-} +let any + : ∀(a : Type) → (a → Bool) → Optional a → Bool + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : Optional a) → + merge { Some = f, None = False } xs + +let example0 = assert : any Natural Natural/even (Some 2) ≡ True + +let example1 = assert : any Natural Natural/even (None Natural) ≡ False + +in any diff --git a/dhall-lang/Prelude/Optional/build b/dhall-lang/Prelude/Optional/build new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/build @@ -0,0 +1,3 @@ + missing + sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1 +? ./build.dhall diff --git a/dhall-lang/Prelude/Optional/build.dhall b/dhall-lang/Prelude/Optional/build.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/build.dhall @@ -0,0 +1,41 @@ +--| `build` is the inverse of `fold` +let build + : ∀(a : Type) → + ( ∀(optional : Type) → + ∀(some : a → optional) → + ∀(none : optional) → + optional + ) → + Optional a + = λ(a : Type) → + λ ( build + : ∀(optional : Type) → + ∀(some : a → optional) → + ∀(none : optional) → + optional + ) → + build (Optional a) (λ(x : a) → Some x) (None a) + +let example0 = + assert + : build + Natural + ( λ(optional : Type) → + λ(some : Natural → optional) → + λ(none : optional) → + some 1 + ) + ≡ Some 1 + +let example1 = + assert + : build + Natural + ( λ(optional : Type) → + λ(some : Natural → optional) → + λ(none : optional) → + none + ) + ≡ None Natural + +in build diff --git a/dhall-lang/Prelude/Optional/concat b/dhall-lang/Prelude/Optional/concat new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/concat @@ -0,0 +1,3 @@ + missing + sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a +? ./concat.dhall diff --git a/dhall-lang/Prelude/Optional/concat.dhall b/dhall-lang/Prelude/Optional/concat.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/concat.dhall @@ -0,0 +1,14 @@ +--| Flatten two `Optional` layers into a single `Optional` layer +let concat + : ∀(a : Type) → Optional (Optional a) → Optional a + = λ(a : Type) → + λ(x : Optional (Optional a)) → + merge { Some = λ(y : Optional a) → y, None = None a } x + +let example0 = assert : concat Natural (Some (Some 1)) ≡ Some 1 + +let example1 = assert : concat Natural (Some (None Natural)) ≡ None Natural + +let example2 = assert : concat Natural (None (Optional Natural)) ≡ None Natural + +in concat diff --git a/dhall-lang/Prelude/Optional/concatMap.dhall b/dhall-lang/Prelude/Optional/concatMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/concatMap.dhall @@ -0,0 +1,23 @@ +--| Transform the value with a function and flatten the resulting `Optional` +let concatMap + : ∀(a : Type) → ∀(b : Type) → (a → Optional b) → Optional a → Optional b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → Optional b) → + λ(o : Optional a) → + merge { Some = f, None = None b } o + +let exampleFun + : Natural → Optional Natural + = λ(n : Natural) → if Natural/even n then Some (n + 1) else None Natural + +let example0 = + assert : concatMap Natural Natural exampleFun (Some 1) ≡ None Natural + +let example1 = assert : concatMap Natural Natural exampleFun (Some 2) ≡ Some 3 + +let example2 = + assert + : concatMap Natural Natural exampleFun (None Natural) ≡ None Natural + +in concatMap diff --git a/dhall-lang/Prelude/Optional/default b/dhall-lang/Prelude/Optional/default new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/default @@ -0,0 +1,3 @@ + missing + sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad +? ./default.dhall diff --git a/dhall-lang/Prelude/Optional/default.dhall b/dhall-lang/Prelude/Optional/default.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/default.dhall @@ -0,0 +1,13 @@ +--| Unpack an `Optional`, returning the default when it's `None`. +let default + : ∀(a : Type) → a → Optional a → a + = λ(a : Type) → + λ(default : a) → + λ(o : Optional a) → + merge { Some = λ(x : a) → x, None = default } o + +let example0 = assert : default Bool False (None Bool) ≡ False + +let example1 = assert : default Bool False (Some True) ≡ True + +in default diff --git a/dhall-lang/Prelude/Optional/equal.dhall b/dhall-lang/Prelude/Optional/equal.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/equal.dhall @@ -0,0 +1,24 @@ +let Optional/fold = + missing + sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf + ? ./fold.dhall + +let Optional/null = + missing + sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc + ? ./null.dhall + +let equal + : forall (a : Type) -> (a -> a -> Bool) -> Optional a -> Optional a -> Bool + = \(a : Type) -> + \(compare : a -> a -> Bool) -> + \(ox : Optional a) -> + \(oy : Optional a) -> + Optional/fold + a + ox + Bool + (\(x : a) -> Optional/fold a oy Bool (compare x) False) + (Optional/null a oy) + +in equal diff --git a/dhall-lang/Prelude/Optional/filter b/dhall-lang/Prelude/Optional/filter new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/filter @@ -0,0 +1,3 @@ + missing + sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83 +? ./filter.dhall diff --git a/dhall-lang/Prelude/Optional/filter.dhall b/dhall-lang/Prelude/Optional/filter.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/filter.dhall @@ -0,0 +1,29 @@ +--| Only keep an `Optional` element if the supplied function returns `True` +let filter + : ∀(a : Type) → (a → Bool) → Optional a → Optional a + = λ(a : Type) → + λ(f : a → Bool) → + λ(xs : Optional a) → + ( λ(a : Type) → + λ ( build + : ∀(optional : Type) → + ∀(some : a → optional) → + ∀(none : optional) → + optional + ) → + build (Optional a) (λ(x : a) → Some x) (None a) + ) + a + ( λ(optional : Type) → + λ(some : a → optional) → + λ(none : optional) → + merge + { Some = λ(x : a) → if f x then some x else none, None = none } + xs + ) + +let example0 = assert : filter Natural Natural/even (Some 2) ≡ Some 2 + +let example1 = assert : filter Natural Natural/odd (Some 2) ≡ None Natural + +in filter diff --git a/dhall-lang/Prelude/Optional/fold b/dhall-lang/Prelude/Optional/fold new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/fold @@ -0,0 +1,3 @@ + missing + sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf +? ./fold.dhall diff --git a/dhall-lang/Prelude/Optional/fold.dhall b/dhall-lang/Prelude/Optional/fold.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/fold.dhall @@ -0,0 +1,20 @@ +--| `fold` is the primitive function for consuming `Optional` values +let fold + : ∀(a : Type) → + Optional a → + ∀(optional : Type) → + ∀(some : a → optional) → + ∀(none : optional) → + optional + = λ(a : Type) → + λ(o : Optional a) → + λ(optional : Type) → + λ(some : a → optional) → + λ(none : optional) → + merge { Some = some, None = none } o + +let example0 = assert : fold Natural (Some 2) Text Natural/show "0" ≡ "2" + +let example1 = assert : fold Natural (None Natural) Text Natural/show "0" ≡ "0" + +in fold diff --git a/dhall-lang/Prelude/Optional/head b/dhall-lang/Prelude/Optional/head new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/head @@ -0,0 +1,3 @@ + missing + sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c +? ./head.dhall diff --git a/dhall-lang/Prelude/Optional/head.dhall b/dhall-lang/Prelude/Optional/head.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/head.dhall @@ -0,0 +1,24 @@ +--| Returns the first non-empty `Optional` value in a `List` +let head + : ∀(a : Type) → List (Optional a) → Optional a + = λ(a : Type) → + λ(xs : List (Optional a)) → + List/fold + (Optional a) + xs + (Optional a) + ( λ(l : Optional a) → + λ(r : Optional a) → + merge { Some = λ(x : a) → Some x, None = r } l + ) + (None a) + +let example0 = assert : head Natural [ None Natural, Some 1, Some 2 ] ≡ Some 1 + +let example1 = + assert : head Natural [ None Natural, None Natural ] ≡ None Natural + +let example2 = + assert : head Natural ([] : List (Optional Natural)) ≡ None Natural + +in head diff --git a/dhall-lang/Prelude/Optional/last b/dhall-lang/Prelude/Optional/last new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/last @@ -0,0 +1,3 @@ + missing + sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707 +? ./last.dhall diff --git a/dhall-lang/Prelude/Optional/last.dhall b/dhall-lang/Prelude/Optional/last.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/last.dhall @@ -0,0 +1,24 @@ +--| Returns the last non-empty `Optional` value in a `List` +let last + : ∀(a : Type) → List (Optional a) → Optional a + = λ(a : Type) → + λ(xs : List (Optional a)) → + List/fold + (Optional a) + xs + (Optional a) + ( λ(l : Optional a) → + λ(r : Optional a) → + merge { Some = λ(x : a) → Some x, None = l } r + ) + (None a) + +let example0 = assert : last Natural [ None Natural, Some 1, Some 2 ] ≡ Some 2 + +let example1 = + assert : last Natural [ None Natural, None Natural ] ≡ None Natural + +let example2 = + assert : last Natural ([] : List (Optional Natural)) ≡ None Natural + +in last diff --git a/dhall-lang/Prelude/Optional/length b/dhall-lang/Prelude/Optional/length new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/length @@ -0,0 +1,3 @@ + missing + sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85 +? ./length.dhall diff --git a/dhall-lang/Prelude/Optional/length.dhall b/dhall-lang/Prelude/Optional/length.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/length.dhall @@ -0,0 +1,14 @@ +{-| +Returns `1` if the `Optional` value is present and `0` if the value is absent +-} +let length + : ∀(a : Type) → Optional a → Natural + = λ(a : Type) → + λ(xs : Optional a) → + merge { Some = λ(_ : a) → 1, None = 0 } xs + +let example0 = assert : length Natural (Some 2) ≡ 1 + +let example1 = assert : length Natural (None Natural) ≡ 0 + +in length diff --git a/dhall-lang/Prelude/Optional/map b/dhall-lang/Prelude/Optional/map new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/map @@ -0,0 +1,3 @@ + missing + sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa +? ./map.dhall diff --git a/dhall-lang/Prelude/Optional/map.dhall b/dhall-lang/Prelude/Optional/map.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/map.dhall @@ -0,0 +1,14 @@ +--| Transform an `Optional` value with a function +let map + : ∀(a : Type) → ∀(b : Type) → (a → b) → Optional a → Optional b + = λ(a : Type) → + λ(b : Type) → + λ(f : a → b) → + λ(o : Optional a) → + merge { Some = λ(x : a) → Some (f x), None = None b } o + +let example0 = assert : map Natural Bool Natural/even (Some 3) ≡ Some False + +let example1 = assert : map Natural Bool Natural/even (None Natural) ≡ None Bool + +in map diff --git a/dhall-lang/Prelude/Optional/null b/dhall-lang/Prelude/Optional/null new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/null @@ -0,0 +1,3 @@ + missing + sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc +? ./null.dhall diff --git a/dhall-lang/Prelude/Optional/null.dhall b/dhall-lang/Prelude/Optional/null.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/null.dhall @@ -0,0 +1,12 @@ +--| Returns `True` if the `Optional` value is absent and `False` if present +let null + : ∀(a : Type) → Optional a → Bool + = λ(a : Type) → + λ(xs : Optional a) → + merge { Some = λ(_ : a) → False, None = True } xs + +let example0 = assert : null Natural (Some 2) ≡ False + +let example1 = assert : null Natural (None Natural) ≡ True + +in null diff --git a/dhall-lang/Prelude/Optional/package.dhall b/dhall-lang/Prelude/Optional/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/package.dhall @@ -0,0 +1,65 @@ +{ all = + missing + sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695 + ? ./all.dhall +, any = + missing + sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435 + ? ./any.dhall +, build = + missing + sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1 + ? ./build.dhall +, concat = + missing + sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a + ? ./concat.dhall +, concatMap = + missing + sha256:c06ae93e900a99299c9b4ec4912ca5395a0103ea88292205b08dd7e345632818 + ? ./concatMap.dhall +, default = + missing + sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad + ? ./default.dhall +, equal = + missing + sha256:5411888399fe9c6720f7f3b59caf5eff3e8e8c30402d09f34e46a4457649a35a + ? ./equal.dhall +, filter = + missing + sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83 + ? ./filter.dhall +, fold = + missing + sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf + ? ./fold.dhall +, head = + missing + sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c + ? ./head.dhall +, last = + missing + sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707 + ? ./last.dhall +, length = + missing + sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85 + ? ./length.dhall +, map = + missing + sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa + ? ./map.dhall +, null = + missing + sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc + ? ./null.dhall +, toList = + missing + sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4 + ? ./toList.dhall +, unzip = + missing + sha256:d016c01ba91657a2f35609aa29087963d0f506bab0f41d5e8b7cd289dff39708 + ? ./unzip.dhall +} diff --git a/dhall-lang/Prelude/Optional/toList b/dhall-lang/Prelude/Optional/toList new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/toList @@ -0,0 +1,3 @@ + missing + sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4 +? ./toList.dhall diff --git a/dhall-lang/Prelude/Optional/toList.dhall b/dhall-lang/Prelude/Optional/toList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/toList.dhall @@ -0,0 +1,12 @@ +--| Convert an `Optional` value into the equivalent `List` +let toList + : ∀(a : Type) → Optional a → List a + = λ(a : Type) → + λ(o : Optional a) → + merge { Some = λ(x : a) → [ x ] : List a, None = [] : List a } o + +let example0 = assert : toList Natural (Some 1) ≡ [ 1 ] + +let example1 = assert : toList Natural (None Natural) ≡ ([] : List Natural) + +in toList diff --git a/dhall-lang/Prelude/Optional/unzip b/dhall-lang/Prelude/Optional/unzip new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/unzip @@ -0,0 +1,3 @@ + missing + sha256:d016c01ba91657a2f35609aa29087963d0f506bab0f41d5e8b7cd289dff39708 +? ./unzip.dhall diff --git a/dhall-lang/Prelude/Optional/unzip.dhall b/dhall-lang/Prelude/Optional/unzip.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Optional/unzip.dhall @@ -0,0 +1,30 @@ +--| Unzip an `Optional` value into two separate `Optional` values +let unzip + : ∀(a : Type) → + ∀(b : Type) → + Optional { _1 : a, _2 : b } → + { _1 : Optional a, _2 : Optional b } + = λ(a : Type) → + λ(b : Type) → + λ(xs : Optional { _1 : a, _2 : b }) → + { _1 = + merge + { Some = λ(x : { _1 : a, _2 : b }) → Some x._1, None = None a } + xs + , _2 = + merge + { Some = λ(x : { _1 : a, _2 : b }) → Some x._2, None = None b } + xs + } + +let example0 = + assert + : unzip Text Bool (Some { _1 = "ABC", _2 = True }) + ≡ { _1 = Some "ABC", _2 = Some True } + +let example1 = + assert + : unzip Text Bool (None { _1 : Text, _2 : Bool }) + ≡ { _1 = None Text, _2 = None Bool } + +in unzip diff --git a/dhall-lang/Prelude/Text/concat b/dhall-lang/Prelude/Text/concat new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concat @@ -0,0 +1,3 @@ + missing + sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 +? ./concat.dhall diff --git a/dhall-lang/Prelude/Text/concat.dhall b/dhall-lang/Prelude/Text/concat.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concat.dhall @@ -0,0 +1,11 @@ +--| Concatenate all the `Text` values in a `List` +let concat + : List Text → Text + = λ(xs : List Text) → + List/fold Text xs Text (λ(x : Text) → λ(y : Text) → x ++ y) "" + +let example0 = assert : concat [ "ABC", "DEF", "GHI" ] ≡ "ABCDEFGHI" + +let example1 = assert : concat ([] : List Text) ≡ "" + +in concat diff --git a/dhall-lang/Prelude/Text/concatMap b/dhall-lang/Prelude/Text/concatMap new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concatMap @@ -0,0 +1,3 @@ + missing + sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f +? ./concatMap.dhall diff --git a/dhall-lang/Prelude/Text/concatMap.dhall b/dhall-lang/Prelude/Text/concatMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concatMap.dhall @@ -0,0 +1,22 @@ +--| Transform each value in a `List` into `Text` and concatenate the result +let concatMap + : ∀(a : Type) → (a → Text) → List a → Text + = λ(a : Type) → + λ(f : a → Text) → + λ(xs : List a) → + List/fold a xs Text (λ(x : a) → λ(y : Text) → f x ++ y) "" + +let example0 = + assert + : concatMap Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ] + ≡ "0 1 2 " + +let example1 = + assert + : concatMap + Natural + (λ(n : Natural) → "${Natural/show n} ") + ([] : List Natural) + ≡ "" + +in concatMap diff --git a/dhall-lang/Prelude/Text/concatMapSep b/dhall-lang/Prelude/Text/concatMapSep new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concatMapSep @@ -0,0 +1,3 @@ + missing + sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840 +? ./concatMapSep.dhall diff --git a/dhall-lang/Prelude/Text/concatMapSep.dhall b/dhall-lang/Prelude/Text/concatMapSep.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concatMapSep.dhall @@ -0,0 +1,38 @@ +{-| +Transform each value in a `List` to `Text` and then concatenate them with a +separator in between each value +-} +let Status = < Empty | NonEmpty : Text > + +let concatMapSep + : ∀(separator : Text) → ∀(a : Type) → (a → Text) → List a → Text + = λ(separator : Text) → + λ(a : Type) → + λ(f : a → Text) → + λ(elements : List a) → + let status = + List/fold + a + elements + Status + ( λ(x : a) → + λ(status : Status) → + merge + { Empty = Status.NonEmpty (f x) + , NonEmpty = + λ(result : Text) → + Status.NonEmpty (f x ++ separator ++ result) + } + status + ) + Status.Empty + + in merge { Empty = "", NonEmpty = λ(result : Text) → result } status + +let example0 = + assert : concatMapSep ", " Natural Natural/show [ 0, 1, 2 ] ≡ "0, 1, 2" + +let example1 = + assert : concatMapSep ", " Natural Natural/show ([] : List Natural) ≡ "" + +in concatMapSep diff --git a/dhall-lang/Prelude/Text/concatSep b/dhall-lang/Prelude/Text/concatSep new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concatSep @@ -0,0 +1,3 @@ + missing + sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58 +? ./concatSep.dhall diff --git a/dhall-lang/Prelude/Text/concatSep.dhall b/dhall-lang/Prelude/Text/concatSep.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/concatSep.dhall @@ -0,0 +1,31 @@ +--| Concatenate a `List` of `Text` values with a separator in between each value +let Status = < Empty | NonEmpty : Text > + +let concatSep + : ∀(separator : Text) → ∀(elements : List Text) → Text + = λ(separator : Text) → + λ(elements : List Text) → + let status = + List/fold + Text + elements + Status + ( λ(element : Text) → + λ(status : Status) → + merge + { Empty = Status.NonEmpty element + , NonEmpty = + λ(result : Text) → + Status.NonEmpty (element ++ separator ++ result) + } + status + ) + Status.Empty + + in merge { Empty = "", NonEmpty = λ(result : Text) → result } status + +let example0 = assert : concatSep ", " [ "ABC", "DEF", "GHI" ] ≡ "ABC, DEF, GHI" + +let example1 = assert : concatSep ", " ([] : List Text) ≡ "" + +in concatSep diff --git a/dhall-lang/Prelude/Text/default b/dhall-lang/Prelude/Text/default new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/default @@ -0,0 +1,3 @@ + missing + sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf +? ./default.dhall diff --git a/dhall-lang/Prelude/Text/default.dhall b/dhall-lang/Prelude/Text/default.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/default.dhall @@ -0,0 +1,10 @@ +--| Unwrap an `Optional` `Text` value, defaulting `None` to `""` +let default + : Optional Text → Text + = λ(o : Optional Text) → merge { Some = λ(t : Text) → t, None = "" } o + +let example0 = assert : default (Some "ABC") ≡ "ABC" + +let example1 = assert : default (None Text) ≡ "" + +in default diff --git a/dhall-lang/Prelude/Text/defaultMap b/dhall-lang/Prelude/Text/defaultMap new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/defaultMap @@ -0,0 +1,3 @@ + missing + sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588 +? ./defaultMap.dhall diff --git a/dhall-lang/Prelude/Text/defaultMap.dhall b/dhall-lang/Prelude/Text/defaultMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/defaultMap.dhall @@ -0,0 +1,13 @@ +--| Transform the value in an `Optional` into `Text`, defaulting `None` to `""` +let defaultMap + : ∀(a : Type) → (a → Text) → Optional a → Text + = λ(a : Type) → + λ(f : a → Text) → + λ(o : Optional a) → + merge { Some = f, None = "" } o + +let example0 = assert : defaultMap Natural Natural/show (Some 0) ≡ "0" + +let example1 = assert : defaultMap Natural Natural/show (None Natural) ≡ "" + +in defaultMap diff --git a/dhall-lang/Prelude/Text/lowerASCII.dhall b/dhall-lang/Prelude/Text/lowerASCII.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/lowerASCII.dhall @@ -0,0 +1,56 @@ +{-| +Lowercase all ASCII characters + +Note that this will also lowercase decomposed Unicode characters that contain +codepoints in the ASCII range +-} +let lowerASCII + : Text → Text + = List/fold + (Text → Text) + [ Text/replace "A" "a" + , Text/replace "B" "b" + , Text/replace "C" "c" + , Text/replace "D" "d" + , Text/replace "E" "e" + , Text/replace "F" "f" + , Text/replace "G" "g" + , Text/replace "H" "h" + , Text/replace "I" "i" + , Text/replace "J" "j" + , Text/replace "K" "k" + , Text/replace "L" "l" + , Text/replace "M" "m" + , Text/replace "N" "n" + , Text/replace "O" "o" + , Text/replace "P" "p" + , Text/replace "Q" "q" + , Text/replace "R" "r" + , Text/replace "S" "s" + , Text/replace "T" "t" + , Text/replace "U" "u" + , Text/replace "V" "v" + , Text/replace "W" "w" + , Text/replace "X" "x" + , Text/replace "Y" "y" + , Text/replace "Z" "z" + ] + Text + (λ(replacement : Text → Text) → replacement) + +let example0 = assert : lowerASCII "ABCdef" ≡ "abcdef" + +let -- This does not lowercase precomposed Unicode characters + -- + -- • The `Á` in the following example is U+00C1 + example1 = + assert : lowerASCII "Á" ≡ "Á" + +let -- … but this does lowercase decomposed Unicode characters + -- + -- • The `Á` in the following example is U+0041 U+0301 + -- • The `á` in the following example is U+0061 U+0301 + example1 = + assert : lowerASCII "Á" ≡ "á" + +in lowerASCII diff --git a/dhall-lang/Prelude/Text/package.dhall b/dhall-lang/Prelude/Text/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/package.dhall @@ -0,0 +1,53 @@ +{ concat = + missing + sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 + ? ./concat.dhall +, concatMap = + missing + sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f + ? ./concatMap.dhall +, concatMapSep = + missing + sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840 + ? ./concatMapSep.dhall +, concatSep = + missing + sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58 + ? ./concatSep.dhall +, default = + missing + sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf + ? ./default.dhall +, defaultMap = + missing + sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588 + ? ./defaultMap.dhall +, lowerASCII = + missing + sha256:26b076651120b907e869396bd3dc16271f2e12433062b2f26f296968a69515e7 + ? ./lowerASCII.dhall +, replace = + missing + sha256:7d132df0e091a43817bba8afa06d1bb487ee51c091430404ad6f8c78bc0328a6 + ? ./replace.dhall +, replicate = + missing + sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f + ? ./replicate.dhall +, shell-escape = + missing + sha256:d53521b3f478cb18a7d63730bc0e3153c2124b70d6ac9a1f610ce7db67cfc7a2 + ? ./shell-escape.dhall +, show = + missing + sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784 + ? ./show.dhall +, spaces = + missing + sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc + ? ./spaces.dhall +, upperASCII = + missing + sha256:45ae4fbd814b0474e65c28a4ee92b23b979892fa5bb73730bc99675ae790ca29 + ? ./upperASCII.dhall +} diff --git a/dhall-lang/Prelude/Text/replace.dhall b/dhall-lang/Prelude/Text/replace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/replace.dhall @@ -0,0 +1,14 @@ +{- +Replace a section of `Text` with another inside a `Text` literal. +-} +let replace + : ∀(needle : Text) → ∀(replacement : Text) → ∀(haystack : Text) → Text + = Text/replace + +let example0 = assert : replace "-" "_" "foo-bar" ≡ "foo_bar" + +let example1 = assert : replace "💣" "💥" "💣💣💣" ≡ "💥💥💥" + +let example2 = assert : replace "👨" "👩" "👨‍👩‍👧‍👦" ≡ "👩‍👩‍👧‍👦" + +in replace diff --git a/dhall-lang/Prelude/Text/replicate b/dhall-lang/Prelude/Text/replicate new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/replicate @@ -0,0 +1,3 @@ + missing + sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f +? ./replicate.dhall diff --git a/dhall-lang/Prelude/Text/replicate.dhall b/dhall-lang/Prelude/Text/replicate.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/replicate.dhall @@ -0,0 +1,20 @@ +--| Build a Text by copying the given Text the specified number of times +let concat = + missing + sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 + ? ./concat.dhall + +let List/replicate = + missing + sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 + ? ../List/replicate.dhall + +let replicate + : Natural → Text → Text + = λ(num : Natural) → λ(text : Text) → concat (List/replicate num Text text) + +let example0 = assert : replicate 3 "foo" ≡ "foofoofoo" + +let property = λ(text : Text) → assert : replicate 0 text ≡ "" + +in replicate diff --git a/dhall-lang/Prelude/Text/shell-escape.dhall b/dhall-lang/Prelude/Text/shell-escape.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/shell-escape.dhall @@ -0,0 +1,16 @@ +{-| +Escape a Text value such that it can be used safely in shells. +The escaping is done by replacing all `'` with `'"'"'` and wraps that string in +single quotes. + +This works for all POSIX-compliant shells and some other shells like csh. +-} +let shell-escape + : Text -> Text + = \(xs : Text) -> "'${Text/replace "'" "'\"'\"'" xs}'" + +let example0 = assert : shell-escape "foo" === "'foo'" + +let example1 = assert : shell-escape "foo'bar" === "'foo'\"'\"'bar'" + +in shell-escape diff --git a/dhall-lang/Prelude/Text/show b/dhall-lang/Prelude/Text/show new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/show @@ -0,0 +1,3 @@ + missing + sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784 +? ./show.dhall diff --git a/dhall-lang/Prelude/Text/show.dhall b/dhall-lang/Prelude/Text/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/show.dhall @@ -0,0 +1,19 @@ +{- +Render a `Text` literal as its own representation as Dhall source code (i.e. a +double-quoted string literal) +-} +let show + : Text → Text + = Text/show + +let example0 = assert : show "ABC" ≡ "\"ABC\"" + +let example1 = + assert + : show + '' + ${"\u0000"} $ \ + ${" "}☺'' + ≡ "\"\\u0000 \\u0024 \\\\ \\n ☺\"" + +in show diff --git a/dhall-lang/Prelude/Text/spaces b/dhall-lang/Prelude/Text/spaces new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/spaces @@ -0,0 +1,3 @@ + missing + sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc +? ./spaces.dhall diff --git a/dhall-lang/Prelude/Text/spaces.dhall b/dhall-lang/Prelude/Text/spaces.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/spaces.dhall @@ -0,0 +1,20 @@ +{-| +Return a Text with the number of spaces specified. + +This function is particularly helpful when trying to generate Text where +whitespace is significant, i.e. with nested indentation. +-} +let replicate = + missing + sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f + ? ./replicate.dhall + +let spaces + : Natural → Text + = λ(a : Natural) → replicate a " " + +let example0 = assert : spaces 1 ≡ " " + +let example1 = assert : spaces 0 ≡ "" + +in spaces diff --git a/dhall-lang/Prelude/Text/upperASCII.dhall b/dhall-lang/Prelude/Text/upperASCII.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/upperASCII.dhall @@ -0,0 +1,56 @@ +{-| +Uppercase all ASCII characters + +Note that this will also uppercase decomposed Unicode characters that contain +codepoints in the ASCII range +-} +let upperASCII + : Text → Text + = List/fold + (Text → Text) + [ Text/replace "a" "A" + , Text/replace "b" "B" + , Text/replace "c" "C" + , Text/replace "d" "D" + , Text/replace "e" "E" + , Text/replace "f" "F" + , Text/replace "g" "G" + , Text/replace "h" "H" + , Text/replace "i" "I" + , Text/replace "j" "J" + , Text/replace "k" "K" + , Text/replace "l" "L" + , Text/replace "m" "M" + , Text/replace "n" "N" + , Text/replace "o" "O" + , Text/replace "p" "P" + , Text/replace "q" "Q" + , Text/replace "r" "R" + , Text/replace "s" "S" + , Text/replace "t" "T" + , Text/replace "u" "U" + , Text/replace "v" "V" + , Text/replace "w" "W" + , Text/replace "x" "X" + , Text/replace "y" "Y" + , Text/replace "z" "Z" + ] + Text + (λ(replacement : Text → Text) → replacement) + +let example0 = assert : upperASCII "ABCdef" ≡ "ABCDEF" + +let -- This does not uppercase precomposed Unicode characters + -- + -- • The `á` in the following example is U+00E1 + example1 = + assert : upperASCII "á" ≡ "á" + +let -- … but this does uppercase decomposed Unicode characters + -- + -- • The `Á` in the following example is U+0041 U+0301 + -- • The `á` in the following example is U+0061 U+0301 + example1 = + assert : upperASCII "á" ≡ "Á" + +in upperASCII diff --git a/dhall-lang/Prelude/Time/package.dhall b/dhall-lang/Prelude/Time/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Time/package.dhall @@ -0,0 +1,5 @@ +{ show = + missing + sha256:8cabfe35dd0ee25ca65708105e860cbf4b789e0d73134aa905580799e2a46719 + ? ./show.dhall +} diff --git a/dhall-lang/Prelude/Time/show.dhall b/dhall-lang/Prelude/Time/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Time/show.dhall @@ -0,0 +1,15 @@ +{- +Render a `Time` as `Text` using the same representation as Dhall source code +(i.e. `hh:mm:ss`) +-} +let show + : Time → Text + = Time/show + +let example0 = assert : show 03:15:47.90 ≡ "03:15:47.90" + +let example1 = assert : show 00:00:00 ≡ "00:00:00" + +let example2 = assert : show 11:59:59 ≡ "11:59:59" + +in show diff --git a/dhall-lang/Prelude/TimeZone/package.dhall b/dhall-lang/Prelude/TimeZone/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/TimeZone/package.dhall @@ -0,0 +1,5 @@ +{ show = + missing + sha256:d183361f1c4c656bad3b170ec8b8d6705f564faebf94e4ef10c76061104ff061 + ? ./show.dhall +} diff --git a/dhall-lang/Prelude/TimeZone/show.dhall b/dhall-lang/Prelude/TimeZone/show.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/TimeZone/show.dhall @@ -0,0 +1,15 @@ +{- +Render a `TimeZone` as `Text` using the same representation as Dhall source code +(i.e. `±HH:MM`) +-} +let show + : TimeZone → Text + = TimeZone/show + +let example0 = assert : show +07:00 ≡ "+07:00" + +let example1 = assert : show +00:00 ≡ "+00:00" + +let example2 = assert : show -05:00 ≡ "-05:00" + +in show diff --git a/dhall-lang/Prelude/XML/Type b/dhall-lang/Prelude/XML/Type new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/Type @@ -0,0 +1,3 @@ + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 +? ./Type.dhall diff --git a/dhall-lang/Prelude/XML/Type.dhall b/dhall-lang/Prelude/XML/Type.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/Type.dhall @@ -0,0 +1,65 @@ +{-| +Dhall encoding of an arbitrary XML element + +For example, the following XML element: + +``` +baz +``` + +... corresponds to the following Dhall expression: + + +``` +λ(XML : Type) + → λ ( xml + : { text : + Text → XML + , rawText : + Text → XML + , element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + } + ) + → xml.element + { attributes = + [ { mapKey = "n", mapValue = "1" } ] + , content = + [ xml.element + { attributes = + [] : List { mapKey : Text, mapValue : Text } + , content = + [ xml.text "baz" ] + , name = + "bar" + } + ] + , name = + "foo" + } +``` +-} +let XML/Type + : Type + = ∀(XML : Type) → + ∀ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + XML + +in XML/Type diff --git a/dhall-lang/Prelude/XML/attribute b/dhall-lang/Prelude/XML/attribute new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/attribute @@ -0,0 +1,3 @@ + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc +? ./attribute.dhall diff --git a/dhall-lang/Prelude/XML/attribute.dhall b/dhall-lang/Prelude/XML/attribute.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/attribute.dhall @@ -0,0 +1,6 @@ +--| Builds a key-value record with a Text key and value. +let attribute + : Text → Text → { mapKey : Text, mapValue : Text } + = λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } + +in attribute diff --git a/dhall-lang/Prelude/XML/element b/dhall-lang/Prelude/XML/element new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/element @@ -0,0 +1,3 @@ + missing + sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 +? ./element.dhall diff --git a/dhall-lang/Prelude/XML/element.dhall b/dhall-lang/Prelude/XML/element.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/element.dhall @@ -0,0 +1,59 @@ +{-| +Create an XML element value. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "foo" + , attributes = XML.emptyAttributes + , content = + [ XML.leaf { name = "bar", attributes = [ XML.attribute "n" "1" ] } + , XML.leaf { name = "baz", attributes = [ XML.attribute "n" "2" ] } + ] + } + ) + += "" +``` +-} +let XML = + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 + ? ./Type.dhall + +let List/map = + missing + sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 + ? ../List/map.dhall + +let Args = + { attributes : List { mapKey : Text, mapValue : Text } + , name : Text + , content : List XML + } + : Type + +let element + : Args → XML + = λ(elem : Args) → + λ(XML : Type) → + λ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + xml.element + { attributes = elem.attributes + , name = elem.name + , content = List/map XML@1 XML (λ(x : XML@1) → x XML xml) elem.content + } + +in element diff --git a/dhall-lang/Prelude/XML/emptyAttributes b/dhall-lang/Prelude/XML/emptyAttributes new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/emptyAttributes @@ -0,0 +1,3 @@ + missing + sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5 +? ./emptyAttributes.dhall diff --git a/dhall-lang/Prelude/XML/emptyAttributes.dhall b/dhall-lang/Prelude/XML/emptyAttributes.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/emptyAttributes.dhall @@ -0,0 +1,2 @@ +--| Create an empty XML attribute List. +[] : List { mapKey : Text, mapValue : Text } diff --git a/dhall-lang/Prelude/XML/leaf b/dhall-lang/Prelude/XML/leaf new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/leaf @@ -0,0 +1,3 @@ + missing + sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506 +? ./leaf.dhall diff --git a/dhall-lang/Prelude/XML/leaf.dhall b/dhall-lang/Prelude/XML/leaf.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/leaf.dhall @@ -0,0 +1,30 @@ +{-| +Create an XML element value without child elements. + +``` +let XML = ./package.dhall + +in XML.render (XML.leaf { name = "foobar", attributes = XML.emptyAttributes }) + += "" +``` +-} +let XML = + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 + ? ./Type.dhall + +let element = + missing + sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 + ? ./element.dhall + +let leaf + : { attributes : List { mapKey : Text, mapValue : Text }, name : Text } → + XML + = λ ( elem + : { attributes : List { mapKey : Text, mapValue : Text }, name : Text } + ) → + element (elem ⫽ { content = [] : List XML }) + +in leaf diff --git a/dhall-lang/Prelude/XML/package.dhall b/dhall-lang/Prelude/XML/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/package.dhall @@ -0,0 +1,33 @@ +{ Type = + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 + ? ./Type.dhall +, attribute = + missing + sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc + ? ./attribute.dhall +, render = + missing + sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66 + ? ./render.dhall +, element = + missing + sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 + ? ./element.dhall +, leaf = + missing + sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506 + ? ./leaf.dhall +, text = + missing + sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab + ? ./text.dhall +, rawText = + missing + sha256:2af9d72c151677d4110039e361b7e9faaf2947e6c9d29aa72aea351ad797e05d + ? ./rawText.dhall +, emptyAttributes = + missing + sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5 + ? ./emptyAttributes.dhall +} diff --git a/dhall-lang/Prelude/XML/rawText.dhall b/dhall-lang/Prelude/XML/rawText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/rawText.dhall @@ -0,0 +1,40 @@ +{-| +Create a Text value to be inserted into an XML element as content with no +character escaping. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "location" + , attributes = XML.emptyAttributes + , content = [ XML.rawText "" ] + } + ) += "" +``` +-} +let XML = + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 + ? ./Type.dhall + +let rawText + : Text → XML + = λ(d : Text) → + λ(XML : Type) → + λ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + xml.rawText d + +in rawText diff --git a/dhall-lang/Prelude/XML/render b/dhall-lang/Prelude/XML/render new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/render @@ -0,0 +1,3 @@ + missing + sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66 +? ./render.dhall diff --git a/dhall-lang/Prelude/XML/render.dhall b/dhall-lang/Prelude/XML/render.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/render.dhall @@ -0,0 +1,140 @@ +{-| +Render an `XML` value as `Text` + +For indentation and schema validation, see the `xmllint` utility +bundled with libxml2. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "foo" + , attributes = [ XML.attribute "a" "x", XML.attribute "b" (Natural/show 2) ] + , content = [ XML.leaf { name = "bar", attributes = XML.emptyAttributes } ] + } + ) += "" +``` + +-} +let XML = + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 + ? ./Type.dhall + +let Text/concatMap = + missing + sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f + ? ../Text/concatMap.dhall + +let Text/concat = + missing + sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 + ? ../Text/concat.dhall + +let element = + missing + sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 + ? ./element.dhall + +let text = + missing + sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab + ? ./text.dhall + +let emptyAttributes = + missing + sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5 + ? ./emptyAttributes.dhall + +let Attr = { mapKey : Text, mapValue : Text } + +let esc = λ(x : Text) → λ(y : Text) → Text/replace x "&${y};" + +let `escape&` = esc "&" "amp" + +let `escape<` = esc "<" "lt" + +let `escape>` = esc ">" "gt" + +let `escape'` = esc "'" "apos" + +let `escape"` = esc "\"" "quot" + +let escapeCommon = λ(text : Text) → `escape<` (`escape&` text) + +let escapeAttr = λ(text : Text) → `escape"` (`escape'` (escapeCommon text)) + +let escapeText = λ(text : Text) → `escape>` (escapeCommon text) + +let renderAttr = λ(x : Attr) → " ${x.mapKey}=\"${escapeAttr x.mapValue}\"" + +let render + : XML → Text + = λ(x : XML) → + x + Text + { text = escapeText + , rawText = λ(t : Text) → t + , element = + λ ( elem + : { attributes : List { mapKey : Text, mapValue : Text } + , content : List Text + , name : Text + } + ) → + let attribs = Text/concatMap Attr renderAttr elem.attributes + + in "<${elem.name}${attribs}" + ++ ( if Natural/isZero (List/length Text elem.content) + then "/>" + else ">${Text/concat elem.content}" + ) + } + +let simple = + λ(name : Text) → + λ(content : List XML) → + element { name, attributes = emptyAttributes, content } + +let example0 = + assert + : render + ( simple + "note" + [ simple "to" [ text "Tove" ] + , simple "from" [ text "Jani" ] + , simple "heading" [ text "Reminder" ] + , simple "body" [ text "Don't forget me this weekend!" ] + ] + ) + ≡ Text/replace + "\n" + "" + '' + + Tove + Jani + Reminder + Don't forget me this weekend! + + '' + +let example1 = + assert + : render + ( element + { name = "escape" + , attributes = toMap { attribute = "<>'\"&" } + , content = [ text "<>'\"&" ] + } + ) + ≡ Text/replace + "\n" + "" + '' + <>'"& + '' + +in render diff --git a/dhall-lang/Prelude/XML/text b/dhall-lang/Prelude/XML/text new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/text @@ -0,0 +1,3 @@ + missing + sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab +? ./text.dhall diff --git a/dhall-lang/Prelude/XML/text.dhall b/dhall-lang/Prelude/XML/text.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/XML/text.dhall @@ -0,0 +1,39 @@ +{-| +Create a Text value to be inserted into an XML element as content. + +``` +let XML = ./package.dhall + +in XML.render + ( XML.element + { name = "location" + , attributes = XML.emptyAttributes + , content = [ XML.text "/foo/bar" ] + } + ) += "/foo/bar" +``` +-} +let XML = + missing + sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 + ? ./Type.dhall + +let text + : Text → XML + = λ(d : Text) → + λ(XML : Type) → + λ ( xml + : { text : Text → XML + , rawText : Text → XML + , element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + } + ) → + xml.text d + +in text diff --git a/dhall-lang/Prelude/package.dhall b/dhall-lang/Prelude/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/package.dhall @@ -0,0 +1,73 @@ +{ Bool = + missing + sha256:dde2b9b71afdd26878c06e90cd2cde4488063457d5fbe30e02baed3bec5eede6 + ? ./Bool/package.dhall +, Date = + missing + sha256:fc0c5efc924fa99aa8e5dea5d78c3dc1a24cb550028342b90149ea78cb5ca873 + ? ./Date/package.dhall +, Double = + missing + sha256:b8d20ab3216083622ae371fb42a6732bc67bb2d66e84989c8ddba7556a336cf7 + ? ./Double/package.dhall +, Function = + missing + sha256:f4ca848f69034f9d7a74e12c556c3a3396966c1de3a9427a102d1aff4580192f + ? ./Function/package.dhall +, Integer = + missing + sha256:d1a572ca3a764781496847e4921d7d9a881c18ffcfac6ae28d0e5299066938a0 + ? ./Integer/package.dhall +, JSON = + missing + sha256:5f98b7722fd13509ef448b075e02b9ff98312ae7a406cf53ed25012dbc9990ac + ? ./JSON/package.dhall +, List = + missing + sha256:26d1b4cd800219d8b67043c638926aa6e5517ea74a0bd3e371974514621bca04 + ? ./List/package.dhall +, Location = + missing + sha256:0eb4e4a60814018009c720f6820aaa13cf9491eb1b09afb7b832039c6ee4d470 + ? ./Location/package.dhall +, Map = + missing + sha256:c5e79a9de642644a09b96a2ec3147c5d8662b7926f09610e751c0c0f6ed0b30a + ? ./Map/package.dhall +, Monoid = + missing + sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af + ? ./Monoid.dhall +, Natural = + missing + sha256:ee9ed2b28a417ed4e9a0c284801b928bf91b3fbdc1a68616347678c1821f1ddf + ? ./Natural/package.dhall +, NonEmpty = + missing + sha256:c24686a230a4b3cd51e5a57cd4510b4f8242f813d7823d41bac5954e7af56f7a + ? ./NonEmpty/package.dhall +, Operator = + missing + sha256:861f724704a7b4755c96f173e54d03f314492a2d046723404c31ff612b7bf2e6 + ? ./Operator/package.dhall +, Optional = + missing + sha256:74331dfe59c09db65edc7ec4498bff92473c8c06d92752f9470d26e25f91320c + ? ./Optional/package.dhall +, Text = + missing + sha256:79b671a70ac459b799a53bbb8a383cc8b81b40421745c54bf0fb1143168cbd6f + ? ./Text/package.dhall +, Time = + missing + sha256:6715c4c71a113429fef8b94e4561a93c288942dad9dfd75ac545de96c5b5652a + ? ./Time/package.dhall +, TimeZone = + missing + sha256:c17fd403c637856f34c8287168b92974e8c1a3a7331967f75276d179057084fd + ? ./TimeZone/package.dhall +, XML = + missing + sha256:2e111f0952087d42072b059f0bf4c95861a46bffa67ad4c8c39086edf405f32e + ? ./XML/package.dhall +} diff --git a/dhall-lang/tests/alpha-normalization/success/regression/preludeBoolFoldA.dhall b/dhall-lang/tests/alpha-normalization/success/regression/preludeBoolFoldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/regression/preludeBoolFoldA.dhall @@ -0,0 +1,6 @@ +-- For https://github.com/dhall-lang/dhall-haskell/issues/929 + λ(b : Bool) +→ λ(bool : Type) +→ λ(true : bool) +→ λ(false : bool) +→ if b then true else false diff --git a/dhall-lang/tests/alpha-normalization/success/regression/preludeBoolFoldB.dhall b/dhall-lang/tests/alpha-normalization/success/regression/preludeBoolFoldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/regression/preludeBoolFoldB.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → λ(_ : Type) → λ(_ : _) → λ(_ : _@1) → if _@3 then _@1 else _ diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingUnderscoreA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingUnderscoreA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingUnderscoreA.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → _ diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingUnderscoreB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingUnderscoreB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingUnderscoreB.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → _ diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingXA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingXA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingXB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionBindingXB.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → _ diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(_ : Natural) → x diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXB.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → λ(_ : Natural) → _@1 diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXA.dhall @@ -0,0 +1,1 @@ +\(x: Bool) -> \(x: Bool) -> x && x@1 diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXB.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → λ(_ : Bool) → _ && _@1 diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXFreeA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXFreeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXFreeA.dhall @@ -0,0 +1,4 @@ +{- + This test has free variables, so it doesn't typecheck +-} +\(x: Bool) -> \(x: Bool) -> [x, x@0, x@1, x@2, x@3] diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXFreeB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXFreeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXXFreeB.dhall @@ -0,0 +1,1 @@ +\(_: Bool) -> \(_: Bool) -> [_, _, _@1, x, x@1] diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXYA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXYA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXYA.dhall @@ -0,0 +1,1 @@ +\(x: Bool) -> \(y: Bool) -> x && y diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXYB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXYB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionNestedBindingXYB.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → λ(_ : Bool) → _@1 && _ diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingUnderscoreA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingUnderscoreA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingUnderscoreA.dhall @@ -0,0 +1,1 @@ +Bool → Natural diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingUnderscoreB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingUnderscoreB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingUnderscoreB.dhall @@ -0,0 +1,1 @@ +Bool → Natural diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingXA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingXA.dhall @@ -0,0 +1,1 @@ +∀(x : Type) → x diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingXB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeBindingXB.dhall @@ -0,0 +1,1 @@ +Type → _ diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeNestedBindingXA.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeNestedBindingXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeNestedBindingXA.dhall @@ -0,0 +1,1 @@ +∀(x : Type) → Type → x diff --git a/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeNestedBindingXB.dhall b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeNestedBindingXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/alpha-normalization/success/unit/FunctionTypeNestedBindingXB.dhall @@ -0,0 +1,1 @@ +Type → Type → _@1 diff --git a/dhall-lang/tests/binary-decode/failure/unit/ApplyNoArgs.dhallb b/dhall-lang/tests/binary-decode/failure/unit/ApplyNoArgs.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/ApplyNoArgs.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/LambdaExplicitlyNamedUnderscore.dhallb b/dhall-lang/tests/binary-decode/failure/unit/LambdaExplicitlyNamedUnderscore.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/LambdaExplicitlyNamedUnderscore.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/ListOneWithAnnotation.dhallb b/dhall-lang/tests/binary-decode/failure/unit/ListOneWithAnnotation.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/ListOneWithAnnotation.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/NaturalNegativeOne.dhallb b/dhall-lang/tests/binary-decode/failure/unit/NaturalNegativeOne.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/failure/unit/NaturalNegativeOne.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/binary-decode/failure/unit/OperatorOrTooFewArgs.dhallb b/dhall-lang/tests/binary-decode/failure/unit/OperatorOrTooFewArgs.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/OperatorOrTooFewArgs.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/OperatorOrTooManyArgs.dhallb b/dhall-lang/tests/binary-decode/failure/unit/OperatorOrTooManyArgs.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/OperatorOrTooManyArgs.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/OperatorUnknownOpcode.dhallb b/dhall-lang/tests/binary-decode/failure/unit/OperatorUnknownOpcode.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/OperatorUnknownOpcode.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/PiExplicitlyNamedUnderscore.dhallb b/dhall-lang/tests/binary-decode/failure/unit/PiExplicitlyNamedUnderscore.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/PiExplicitlyNamedUnderscore.dhallb differ diff --git a/dhall-lang/tests/binary-decode/failure/unit/VariableExplicitlyNamedUnderscore.dhallb b/dhall-lang/tests/binary-decode/failure/unit/VariableExplicitlyNamedUnderscore.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/failure/unit/VariableExplicitlyNamedUnderscore.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/AnnotationA.dhallb b/dhall-lang/tests/binary-decode/success/unit/AnnotationA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/AnnotationA.dhallb @@ -0,0 +1,1 @@ +ƒ‚gNatural diff --git a/dhall-lang/tests/binary-decode/success/unit/AnnotationB.dhall b/dhall-lang/tests/binary-decode/success/unit/AnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/AnnotationB.dhall @@ -0,0 +1,1 @@ +5 : Natural diff --git a/dhall-lang/tests/binary-decode/success/unit/ApplicationA.dhallb b/dhall-lang/tests/binary-decode/success/unit/ApplicationA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/ApplicationA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/ApplicationB.dhall b/dhall-lang/tests/binary-decode/success/unit/ApplicationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ApplicationB.dhall @@ -0,0 +1,1 @@ +Natural/show _ diff --git a/dhall-lang/tests/binary-decode/success/unit/ApplicationMultipleA.dhallb b/dhall-lang/tests/binary-decode/success/unit/ApplicationMultipleA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/ApplicationMultipleA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/ApplicationMultipleB.dhall b/dhall-lang/tests/binary-decode/success/unit/ApplicationMultipleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ApplicationMultipleB.dhall @@ -0,0 +1,1 @@ +f x y z diff --git a/dhall-lang/tests/binary-decode/success/unit/AssertA.dhallb b/dhall-lang/tests/binary-decode/success/unit/AssertA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/AssertA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/AssertB.dhall b/dhall-lang/tests/binary-decode/success/unit/AssertB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/AssertB.dhall @@ -0,0 +1,1 @@ +assert : _ diff --git a/dhall-lang/tests/binary-decode/success/unit/BoolFalseA.dhallb b/dhall-lang/tests/binary-decode/success/unit/BoolFalseA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BoolFalseA.dhallb @@ -0,0 +1,1 @@ +ô diff --git a/dhall-lang/tests/binary-decode/success/unit/BoolFalseB.dhall b/dhall-lang/tests/binary-decode/success/unit/BoolFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BoolFalseB.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/binary-decode/success/unit/BoolIfA.dhallb b/dhall-lang/tests/binary-decode/success/unit/BoolIfA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/BoolIfA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/BoolIfB.dhall b/dhall-lang/tests/binary-decode/success/unit/BoolIfB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BoolIfB.dhall @@ -0,0 +1,1 @@ +if True then x else y diff --git a/dhall-lang/tests/binary-decode/success/unit/BoolTrueA.dhallb b/dhall-lang/tests/binary-decode/success/unit/BoolTrueA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BoolTrueA.dhallb @@ -0,0 +1,1 @@ +õ diff --git a/dhall-lang/tests/binary-decode/success/unit/BoolTrueB.dhall b/dhall-lang/tests/binary-decode/success/unit/BoolTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BoolTrueB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalShowA.dhallb b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalShowA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalShowA.dhallb @@ -0,0 +1,1 @@ +lNatural/show diff --git a/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalShowB.dhall b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalShowB.dhall @@ -0,0 +1,1 @@ +Natural/show diff --git a/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalSubtractA.dhallb b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalSubtractA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalSubtractA.dhallb @@ -0,0 +1,1 @@ +pNatural/subtract diff --git a/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalSubtractB.dhall b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalSubtractB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BuiltinNaturalSubtractB.dhall @@ -0,0 +1,1 @@ +Natural/subtract diff --git a/dhall-lang/tests/binary-decode/success/unit/BytesA.dhallb b/dhall-lang/tests/binary-decode/success/unit/BytesA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/BytesA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/BytesB.dhall b/dhall-lang/tests/binary-decode/success/unit/BytesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/BytesB.dhall @@ -0,0 +1,23 @@ +[ 0x"00" +, 0x"01" +, 0x"02" +, 0x"03" +, 0x"04" +, 0x"05" +, 0x"06" +, 0x"07" +, 0x"08" +, 0x"09" +, 0x"0a" +, 0x"0b" +, 0x"0c" +, 0x"0d" +, 0x"0e" +, 0x"0f" +, 0x"0A" +, 0x"0B" +, 0x"0C" +, 0x"0D" +, 0x"0E" +, 0x"0F" +] diff --git a/dhall-lang/tests/binary-decode/success/unit/CompletionA.dhallb b/dhall-lang/tests/binary-decode/success/unit/CompletionA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/CompletionA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/CompletionB.dhall b/dhall-lang/tests/binary-decode/success/unit/CompletionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/CompletionB.dhall @@ -0,0 +1,1 @@ +T::r diff --git a/dhall-lang/tests/binary-decode/success/unit/DateA.dhallb b/dhall-lang/tests/binary-decode/success/unit/DateA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DateA.dhallb @@ -0,0 +1,1 @@ +„Ð diff --git a/dhall-lang/tests/binary-decode/success/unit/DateB.dhall b/dhall-lang/tests/binary-decode/success/unit/DateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DateB.dhall @@ -0,0 +1,1 @@ +2000-01-01 diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleDoubleA.dhallb b/dhall-lang/tests/binary-decode/success/unit/DoubleDoubleA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/DoubleDoubleA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleDoubleB.dhall b/dhall-lang/tests/binary-decode/success/unit/DoubleDoubleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DoubleDoubleB.dhall @@ -0,0 +1,6 @@ +{- +The CBOR for this is an (oversized) double-precision number. It could have been +stored as single- (or even half-) precision, but we require decoders to accept +it anyway. +-} +2.0 diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleHalfA.dhallb b/dhall-lang/tests/binary-decode/success/unit/DoubleHalfA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/DoubleHalfA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleHalfB.dhall b/dhall-lang/tests/binary-decode/success/unit/DoubleHalfB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DoubleHalfB.dhall @@ -0,0 +1,7 @@ +{- +The CBOR for this is a half-precision number. Although dhall specifies that +encoders should only use half-precision for infinities and NaN, it also +specifies that decoders should tolerate floating point numbers with any +precision. +-} +1.0 diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleInfinityA.dhallb b/dhall-lang/tests/binary-decode/success/unit/DoubleInfinityA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/DoubleInfinityA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleInfinityB.dhall b/dhall-lang/tests/binary-decode/success/unit/DoubleInfinityB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DoubleInfinityB.dhall @@ -0,0 +1,1 @@ +Infinity diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleNegativeInfinityA.dhallb b/dhall-lang/tests/binary-decode/success/unit/DoubleNegativeInfinityA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/DoubleNegativeInfinityA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleNegativeInfinityB.dhall b/dhall-lang/tests/binary-decode/success/unit/DoubleNegativeInfinityB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DoubleNegativeInfinityB.dhall @@ -0,0 +1,1 @@ +-Infinity diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleSingleA.dhallb b/dhall-lang/tests/binary-decode/success/unit/DoubleSingleA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/DoubleSingleA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/DoubleSingleB.dhall b/dhall-lang/tests/binary-decode/success/unit/DoubleSingleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/DoubleSingleB.dhall @@ -0,0 +1,4 @@ +{- +The CBOR for this is a single-precision number +-} +2.0 diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerBigNegativeA.dhallb b/dhall-lang/tests/binary-decode/success/unit/IntegerBigNegativeA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/IntegerBigNegativeA.dhallb @@ -0,0 +1,1 @@ +‚ÃIÿÿÿÿÿÿÿÿ diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerBigNegativeB.dhall b/dhall-lang/tests/binary-decode/success/unit/IntegerBigNegativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/IntegerBigNegativeB.dhall @@ -0,0 +1,2 @@ +{- -2^65 -} +-36893488147419103232 diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerBigPositiveA.dhallb b/dhall-lang/tests/binary-decode/success/unit/IntegerBigPositiveA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/IntegerBigPositiveA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerBigPositiveB.dhall b/dhall-lang/tests/binary-decode/success/unit/IntegerBigPositiveB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/IntegerBigPositiveB.dhall @@ -0,0 +1,2 @@ +{- 2^65 -} ++36893488147419103232 diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerNegativeOneA.dhallb b/dhall-lang/tests/binary-decode/success/unit/IntegerNegativeOneA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/IntegerNegativeOneA.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerNegativeOneB.dhall b/dhall-lang/tests/binary-decode/success/unit/IntegerNegativeOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/IntegerNegativeOneB.dhall @@ -0,0 +1,1 @@ +-1 diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerZeroA.dhallb b/dhall-lang/tests/binary-decode/success/unit/IntegerZeroA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/IntegerZeroA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/IntegerZeroB.dhall b/dhall-lang/tests/binary-decode/success/unit/IntegerZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/IntegerZeroB.dhall @@ -0,0 +1,1 @@ ++0 diff --git a/dhall-lang/tests/binary-decode/success/unit/LambdaNamedXA.dhallb b/dhall-lang/tests/binary-decode/success/unit/LambdaNamedXA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/LambdaNamedXA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/LambdaNamedXB.dhall b/dhall-lang/tests/binary-decode/success/unit/LambdaNamedXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/LambdaNamedXB.dhall @@ -0,0 +1,1 @@ +λ(x : _) → x diff --git a/dhall-lang/tests/binary-decode/success/unit/LambdaUnderscoreA.dhallb b/dhall-lang/tests/binary-decode/success/unit/LambdaUnderscoreA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/LambdaUnderscoreA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/LambdaUnderscoreB.dhall b/dhall-lang/tests/binary-decode/success/unit/LambdaUnderscoreB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/LambdaUnderscoreB.dhall @@ -0,0 +1,1 @@ +λ(_ : Natural) → _ diff --git a/dhall-lang/tests/binary-decode/success/unit/LetMultipleA.dhallb b/dhall-lang/tests/binary-decode/success/unit/LetMultipleA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/LetMultipleA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/LetMultipleB.dhall b/dhall-lang/tests/binary-decode/success/unit/LetMultipleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/LetMultipleB.dhall @@ -0,0 +1,1 @@ +let x : Natural = 1 let y = 2 in x diff --git a/dhall-lang/tests/binary-decode/success/unit/LetOneTypedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/LetOneTypedA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/LetOneTypedA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/LetOneTypedB.dhall b/dhall-lang/tests/binary-decode/success/unit/LetOneTypedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/LetOneTypedB.dhall @@ -0,0 +1,1 @@ +let x : Natural = 1 in x diff --git a/dhall-lang/tests/binary-decode/success/unit/LetOneUntypedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/LetOneUntypedA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/LetOneUntypedA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/LetOneUntypedB.dhall b/dhall-lang/tests/binary-decode/success/unit/LetOneUntypedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/LetOneUntypedB.dhall @@ -0,0 +1,1 @@ +let x = 1 in x diff --git a/dhall-lang/tests/binary-decode/success/unit/ListEmpty0A.dhallb b/dhall-lang/tests/binary-decode/success/unit/ListEmpty0A.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ListEmpty0A.dhallb @@ -0,0 +1,1 @@ +‚gNatural diff --git a/dhall-lang/tests/binary-decode/success/unit/ListEmpty0B.dhall b/dhall-lang/tests/binary-decode/success/unit/ListEmpty0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ListEmpty0B.dhall @@ -0,0 +1,1 @@ +[] : List Natural diff --git a/dhall-lang/tests/binary-decode/success/unit/ListEmpty1A.dhallb b/dhall-lang/tests/binary-decode/success/unit/ListEmpty1A.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/ListEmpty1A.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/ListEmpty1B.dhall b/dhall-lang/tests/binary-decode/success/unit/ListEmpty1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ListEmpty1B.dhall @@ -0,0 +1,1 @@ +[] : x diff --git a/dhall-lang/tests/binary-decode/success/unit/ListOneA.dhallb b/dhall-lang/tests/binary-decode/success/unit/ListOneA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/ListOneA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/ListOneB.dhall b/dhall-lang/tests/binary-decode/success/unit/ListOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ListOneB.dhall @@ -0,0 +1,1 @@ +[ _ ] diff --git a/dhall-lang/tests/binary-decode/success/unit/MergeAnnotatedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/MergeAnnotatedA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/MergeAnnotatedA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/MergeAnnotatedB.dhall b/dhall-lang/tests/binary-decode/success/unit/MergeAnnotatedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/MergeAnnotatedB.dhall @@ -0,0 +1,1 @@ +merge _ _@1 : _@2 diff --git a/dhall-lang/tests/binary-decode/success/unit/MergeUnannotatedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/MergeUnannotatedA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/MergeUnannotatedA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/MergeUnannotatedB.dhall b/dhall-lang/tests/binary-decode/success/unit/MergeUnannotatedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/MergeUnannotatedB.dhall @@ -0,0 +1,1 @@ +merge _ _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/NaturalBigA.dhallb b/dhall-lang/tests/binary-decode/success/unit/NaturalBigA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/NaturalBigA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/NaturalBigB.dhall b/dhall-lang/tests/binary-decode/success/unit/NaturalBigB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/NaturalBigB.dhall @@ -0,0 +1,2 @@ +{- 2^65 -} +36893488147419103232 diff --git a/dhall-lang/tests/binary-decode/success/unit/NaturalTwentyFourA.dhallb b/dhall-lang/tests/binary-decode/success/unit/NaturalTwentyFourA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/NaturalTwentyFourA.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/binary-decode/success/unit/NaturalTwentyFourB.dhall b/dhall-lang/tests/binary-decode/success/unit/NaturalTwentyFourB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/NaturalTwentyFourB.dhall @@ -0,0 +1,5 @@ +{- +24 is the first natural number that has a different CBOR encoding, hence the +separate test here. +-} +24 diff --git a/dhall-lang/tests/binary-decode/success/unit/NaturalZeroA.dhallb b/dhall-lang/tests/binary-decode/success/unit/NaturalZeroA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/NaturalZeroA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/NaturalZeroB.dhall b/dhall-lang/tests/binary-decode/success/unit/NaturalZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/NaturalZeroB.dhall @@ -0,0 +1,1 @@ +0 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorAndA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorAndA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorAndA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorAndB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorAndB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorAndB.dhall @@ -0,0 +1,1 @@ +_ && _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorCombineA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorCombineB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineB.dhall @@ -0,0 +1,1 @@ +_ ∧ _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorCombineTypesA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineTypesA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineTypesA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorCombineTypesB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorCombineTypesB.dhall @@ -0,0 +1,1 @@ +_ ⩓ _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorEqA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorEqA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorEqA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorEqB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorEqB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorEqB.dhall @@ -0,0 +1,1 @@ +_ == _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorEquivA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorEquivA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorEquivA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorEquivB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorEquivB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorEquivB.dhall @@ -0,0 +1,1 @@ +_ ≡ _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorImportAltA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorImportAltA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorImportAltA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorImportAltB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorImportAltB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorImportAltB.dhall @@ -0,0 +1,1 @@ +_ ? _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorListAppendA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorListAppendA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorListAppendA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorListAppendB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorListAppendB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorListAppendB.dhall @@ -0,0 +1,1 @@ +_ # _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorNeqA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorNeqA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorNeqA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorNeqB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorNeqB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorNeqB.dhall @@ -0,0 +1,1 @@ +_ != _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorOrA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorOrA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorOrA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorOrB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorOrB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorOrB.dhall @@ -0,0 +1,1 @@ +_ || _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorPlusA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorPlusA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorPlusA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorPlusB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorPlusB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorPlusB.dhall @@ -0,0 +1,1 @@ +_ + _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorPreferA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorPreferA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorPreferA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorPreferB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorPreferB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorPreferB.dhall @@ -0,0 +1,1 @@ +_ ⫽ _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorTextAppendA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorTextAppendA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorTextAppendA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorTextAppendB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorTextAppendB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorTextAppendB.dhall @@ -0,0 +1,1 @@ +_ ++ _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorTimesA.dhallb b/dhall-lang/tests/binary-decode/success/unit/OperatorTimesA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/OperatorTimesA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/OperatorTimesB.dhall b/dhall-lang/tests/binary-decode/success/unit/OperatorTimesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/OperatorTimesB.dhall @@ -0,0 +1,1 @@ +_ * _@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/PiNamedXA.dhallb b/dhall-lang/tests/binary-decode/success/unit/PiNamedXA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/PiNamedXA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/PiNamedXB.dhall b/dhall-lang/tests/binary-decode/success/unit/PiNamedXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/PiNamedXB.dhall @@ -0,0 +1,1 @@ +∀(x : Natural) → _ diff --git a/dhall-lang/tests/binary-decode/success/unit/PiUnderscoreA.dhallb b/dhall-lang/tests/binary-decode/success/unit/PiUnderscoreA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/PiUnderscoreA.dhallb @@ -0,0 +1,1 @@ +ƒgNaturaldText diff --git a/dhall-lang/tests/binary-decode/success/unit/PiUnderscoreB.dhall b/dhall-lang/tests/binary-decode/success/unit/PiUnderscoreB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/PiUnderscoreB.dhall @@ -0,0 +1,1 @@ +Natural → Text diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordFieldAccessA.dhallb b/dhall-lang/tests/binary-decode/success/unit/RecordFieldAccessA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/RecordFieldAccessA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordFieldAccessB.dhall b/dhall-lang/tests/binary-decode/success/unit/RecordFieldAccessB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/RecordFieldAccessB.dhall @@ -0,0 +1,1 @@ +_.x diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordLiteralA.dhallb b/dhall-lang/tests/binary-decode/success/unit/RecordLiteralA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/RecordLiteralA.dhallb @@ -0,0 +1,1 @@ +‚¢axgNaturalaydBool diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordLiteralB.dhall b/dhall-lang/tests/binary-decode/success/unit/RecordLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/RecordLiteralB.dhall @@ -0,0 +1,1 @@ +{ x = Natural, y = Bool } diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordProjectFieldsA.dhallb b/dhall-lang/tests/binary-decode/success/unit/RecordProjectFieldsA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/RecordProjectFieldsA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordProjectFieldsB.dhall b/dhall-lang/tests/binary-decode/success/unit/RecordProjectFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/RecordProjectFieldsB.dhall @@ -0,0 +1,1 @@ +r.{ x, y, z } diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordTypeA.dhallb b/dhall-lang/tests/binary-decode/success/unit/RecordTypeA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/RecordTypeA.dhallb @@ -0,0 +1,1 @@ +‚¢axgNaturalaydBool diff --git a/dhall-lang/tests/binary-decode/success/unit/RecordTypeB.dhall b/dhall-lang/tests/binary-decode/success/unit/RecordTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/RecordTypeB.dhall @@ -0,0 +1,1 @@ +{ x : Natural, y : Bool } diff --git a/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX2A.dhallb b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX2A.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX2A.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX2B.dhall b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX2B.dhall @@ -0,0 +1,1 @@ +x diff --git a/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX3A.dhallb b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX3A.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX3A.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX3B.dhall b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORX3B.dhall @@ -0,0 +1,1 @@ +x diff --git a/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORXA.dhallb b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORXA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORXA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORXB.dhall b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORXB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/SelfDescribeCBORXB.dhall @@ -0,0 +1,1 @@ +x diff --git a/dhall-lang/tests/binary-decode/success/unit/SomeA.dhallb b/dhall-lang/tests/binary-decode/success/unit/SomeA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/SomeA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/SomeB.dhall b/dhall-lang/tests/binary-decode/success/unit/SomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/SomeB.dhall @@ -0,0 +1,1 @@ +Some _ diff --git a/dhall-lang/tests/binary-decode/success/unit/TextInterpolatedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/TextInterpolatedA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/TextInterpolatedA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/TextInterpolatedB.dhall b/dhall-lang/tests/binary-decode/success/unit/TextInterpolatedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/TextInterpolatedB.dhall @@ -0,0 +1,1 @@ +"foo${_}bar" diff --git a/dhall-lang/tests/binary-decode/success/unit/TextSimpleA.dhallb b/dhall-lang/tests/binary-decode/success/unit/TextSimpleA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/TextSimpleA.dhallb @@ -0,0 +1,1 @@ +‚cfoo diff --git a/dhall-lang/tests/binary-decode/success/unit/TextSimpleB.dhall b/dhall-lang/tests/binary-decode/success/unit/TextSimpleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/TextSimpleB.dhall @@ -0,0 +1,1 @@ +"foo" diff --git a/dhall-lang/tests/binary-decode/success/unit/TimeA.dhallb b/dhall-lang/tests/binary-decode/success/unit/TimeA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/TimeA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/TimeB.dhall b/dhall-lang/tests/binary-decode/success/unit/TimeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/TimeB.dhall @@ -0,0 +1,1 @@ +12:00:00 diff --git a/dhall-lang/tests/binary-decode/success/unit/TimeZoneA.dhallb b/dhall-lang/tests/binary-decode/success/unit/TimeZoneA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/TimeZoneA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/TimeZoneB.dhall b/dhall-lang/tests/binary-decode/success/unit/TimeZoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/TimeZoneB.dhall @@ -0,0 +1,1 @@ ++08:00 diff --git a/dhall-lang/tests/binary-decode/success/unit/ToMapA.dhallb b/dhall-lang/tests/binary-decode/success/unit/ToMapA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/ToMapA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/ToMapAnnotatedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/ToMapAnnotatedA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/ToMapAnnotatedA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/ToMapAnnotatedB.dhall b/dhall-lang/tests/binary-decode/success/unit/ToMapAnnotatedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ToMapAnnotatedB.dhall @@ -0,0 +1,1 @@ +toMap e : T diff --git a/dhall-lang/tests/binary-decode/success/unit/ToMapB.dhall b/dhall-lang/tests/binary-decode/success/unit/ToMapB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/ToMapB.dhall @@ -0,0 +1,1 @@ +toMap e diff --git a/dhall-lang/tests/binary-decode/success/unit/UnionTypeA.dhallb b/dhall-lang/tests/binary-decode/success/unit/UnionTypeA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/UnionTypeA.dhallb @@ -0,0 +1,1 @@ +‚ ¢axgNaturalayö diff --git a/dhall-lang/tests/binary-decode/success/unit/UnionTypeB.dhall b/dhall-lang/tests/binary-decode/success/unit/UnionTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/UnionTypeB.dhall @@ -0,0 +1,1 @@ +< x : Natural | y > diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableNamedA.dhallb b/dhall-lang/tests/binary-decode/success/unit/VariableNamedA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/VariableNamedA.dhallb @@ -0,0 +1,1 @@ +‚ax diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableNamedB.dhall b/dhall-lang/tests/binary-decode/success/unit/VariableNamedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/VariableNamedB.dhall @@ -0,0 +1,1 @@ +x@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableNamedOversizedIntA.dhallb b/dhall-lang/tests/binary-decode/success/unit/VariableNamedOversizedIntA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/VariableNamedOversizedIntA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableNamedOversizedIntB.dhall b/dhall-lang/tests/binary-decode/success/unit/VariableNamedOversizedIntB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/VariableNamedOversizedIntB.dhall @@ -0,0 +1,16 @@ +{- + +This file tests that a number encoded as a type larger than required is still +read successfully. In this case, the .dhallb file has the bytes: + + 8261 781b 0000 0000 0000 0001 + +which means the array ["x", uint64(1)]. This could have been stored in fewer +bytes as + + 8261 7801 + +but decoders are required to allow the oversized representation. + +-} +x@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreA.dhallb b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreA.dhallb @@ -0,0 +1,1 @@ + diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreB.dhall b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreB.dhall @@ -0,0 +1,1 @@ +_@4 diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreOversizedIntA.dhallb b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreOversizedIntA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreOversizedIntA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreOversizedIntB.dhall b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreOversizedIntB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/VariableUnderscoreOversizedIntB.dhall @@ -0,0 +1,13 @@ +{- + +This file tests that a number encoded as a type larger than required is still +read successfully. In this case, the .dhallb file has the bytes: + + 1b00 0000 0000 0000 01 + +which means a uint64 with value 1. The number 1 could have been stored in a +single byte as 01, but decoders are required to allow the oversized +representation. + +-} +_@1 diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/EnvironmentVariableA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/EnvironmentVariableA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/EnvironmentVariableA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/EnvironmentVariableB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/EnvironmentVariableB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/EnvironmentVariableB.dhall @@ -0,0 +1,1 @@ +env:FOO diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithQueryA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithQueryA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithQueryA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithQueryB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithQueryB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithQueryB.dhall @@ -0,0 +1,1 @@ +http://foo:bar@baz:123/path1/path2?query diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithoutQueryA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithoutQueryA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithoutQueryA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithoutQueryB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithoutQueryB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpImportWithoutQueryB.dhall @@ -0,0 +1,1 @@ +http://foo:bar@baz:123/path1/path2 diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithEmptyQueryA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithEmptyQueryA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithEmptyQueryA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithEmptyQueryB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithEmptyQueryB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithEmptyQueryB.dhall @@ -0,0 +1,2 @@ +{- an empty query string is not the same as an absent query string -} +https://foo:bar@baz:123/path1/path2? diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithQueryA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithQueryA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithQueryA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithQueryB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithQueryB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithQueryB.dhall @@ -0,0 +1,1 @@ +https://foo:bar@baz:123/path1/path2?query diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyPathCharsA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyPathCharsA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyPathCharsA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyPathCharsB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyPathCharsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyPathCharsB.dhall @@ -0,0 +1,1 @@ +https://authority/path:with!funny-characters diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyQueryCharsA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyQueryCharsA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyQueryCharsA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyQueryCharsB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyQueryCharsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithTrickyQueryCharsB.dhall @@ -0,0 +1,1 @@ +https://authority/path?a%23b%5Bc diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithoutQueryA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithoutQueryA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithoutQueryA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithoutQueryB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithoutQueryB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/HttpsImportWithoutQueryB.dhall @@ -0,0 +1,1 @@ +https://foo:bar@baz:123/path1/path2 diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalHereImportA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHereImportA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHereImportA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalHereImportB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHereImportB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHereImportB.dhall @@ -0,0 +1,1 @@ +./path0/path1/path2/file diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalHomeImportA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHomeImportA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHomeImportA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalHomeImportB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHomeImportB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/LocalHomeImportB.dhall @@ -0,0 +1,1 @@ +~/path0/path1/path2/file diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalParentImportA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/LocalParentImportA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/LocalParentImportA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalParentImportB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/LocalParentImportB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/LocalParentImportB.dhall @@ -0,0 +1,1 @@ +../path0/path1/path2/file diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalRootImportA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/LocalRootImportA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/LocalRootImportA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/LocalRootImportB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/LocalRootImportB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/LocalRootImportB.dhall @@ -0,0 +1,1 @@ +/path0/path1/path2/file diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/MissingA.dhallb b/dhall-lang/tests/binary-decode/success/unit/imports/MissingA.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/binary-decode/success/unit/imports/MissingA.dhallb differ diff --git a/dhall-lang/tests/binary-decode/success/unit/imports/MissingB.dhall b/dhall-lang/tests/binary-decode/success/unit/imports/MissingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/imports/MissingB.dhall @@ -0,0 +1,1 @@ +missing diff --git a/dhall-lang/tests/binary-decode/success/unit/recordProjectionByExpressionA.dhallb b/dhall-lang/tests/binary-decode/success/unit/recordProjectionByExpressionA.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/recordProjectionByExpressionA.dhallb @@ -0,0 +1,2 @@ +ƒ +‚¢aa‚ab‚‚¡aagNatural diff --git a/dhall-lang/tests/binary-decode/success/unit/recordProjectionByExpressionB.dhall b/dhall-lang/tests/binary-decode/success/unit/recordProjectionByExpressionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/binary-decode/success/unit/recordProjectionByExpressionB.dhall @@ -0,0 +1,1 @@ +{ a = 1, b = 2 }.({ a : Natural }) diff --git a/dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc b/dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc differ diff --git a/dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21 b/dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21 new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21 @@ -0,0 +1,1 @@ +‚xevil string from bad cache diff --git a/dhall-lang/tests/import/data/cors/AllowedAll.dhall b/dhall-lang/tests/import/data/cors/AllowedAll.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/AllowedAll.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/AllowedAll.dhall diff --git a/dhall-lang/tests/import/data/cors/Empty.dhall b/dhall-lang/tests/import/data/cors/Empty.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/Empty.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/Empty.dhall diff --git a/dhall-lang/tests/import/data/cors/NoCORS.dhall b/dhall-lang/tests/import/data/cors/NoCORS.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/NoCORS.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/NoCORS.dhall diff --git a/dhall-lang/tests/import/data/cors/Null.dhall b/dhall-lang/tests/import/data/cors/Null.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/Null.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/Null.dhall diff --git a/dhall-lang/tests/import/data/cors/OnlyGithub.dhall b/dhall-lang/tests/import/data/cors/OnlyGithub.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/OnlyGithub.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/OnlyGithub.dhall diff --git a/dhall-lang/tests/import/data/cors/OnlyOther.dhall b/dhall-lang/tests/import/data/cors/OnlyOther.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/OnlyOther.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/OnlyOther.dhall diff --git a/dhall-lang/tests/import/data/cors/OnlySelf.dhall b/dhall-lang/tests/import/data/cors/OnlySelf.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/OnlySelf.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/OnlySelf.dhall diff --git a/dhall-lang/tests/import/data/cors/Prelude.dhall b/dhall-lang/tests/import/data/cors/Prelude.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/Prelude.dhall @@ -0,0 +1,1 @@ +https://prelude.dhall-lang.org/List/length diff --git a/dhall-lang/tests/import/data/cors/SelfImportAbsolute.dhall b/dhall-lang/tests/import/data/cors/SelfImportAbsolute.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/SelfImportAbsolute.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/SelfImportAbsolute.dhall diff --git a/dhall-lang/tests/import/data/cors/SelfImportRelative.dhall b/dhall-lang/tests/import/data/cors/SelfImportRelative.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cors/SelfImportRelative.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/SelfImportRelative.dhall diff --git a/dhall-lang/tests/import/data/cycle.dhall b/dhall-lang/tests/import/data/cycle.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/cycle.dhall @@ -0,0 +1,1 @@ +../failure/unit/Cycle.dhall diff --git a/dhall-lang/tests/import/data/doesNotParse.dhall b/dhall-lang/tests/import/data/doesNotParse.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/doesNotParse.dhall @@ -0,0 +1,1 @@ +[ diff --git a/dhall-lang/tests/import/data/doesNotTypecheck.dhall b/dhall-lang/tests/import/data/doesNotTypecheck.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/doesNotTypecheck.dhall @@ -0,0 +1,1 @@ +0 0 diff --git a/dhall-lang/tests/import/data/example.bin b/dhall-lang/tests/import/data/example.bin new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/example.bin @@ -0,0 +1,1 @@ +#Eg‰«Íï diff --git a/dhall-lang/tests/import/data/example.txt b/dhall-lang/tests/import/data/example.txt new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/example.txt @@ -0,0 +1,1 @@ +Hello, world! diff --git a/dhall-lang/tests/import/data/file with spaces.txt b/dhall-lang/tests/import/data/file with spaces.txt new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/file with spaces.txt @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/import/data/importBoundary.dhall b/dhall-lang/tests/import/data/importBoundary.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/importBoundary.dhall @@ -0,0 +1,3 @@ +-- This file contains a free variable. This should be a type error, even if the variable +-- is in scope in the importing expression +x diff --git a/dhall-lang/tests/import/data/nested.dhall b/dhall-lang/tests/import/data/nested.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/nested.dhall @@ -0,0 +1,1 @@ +{ x = ./simple.dhall sha256:15f52ecf91c94c1baac02d5a4964b2ed8fa401641a2c8a95e8306ec7c1e3b8d2 } diff --git a/dhall-lang/tests/import/data/poisonedCache.dhall b/dhall-lang/tests/import/data/poisonedCache.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/poisonedCache.dhall @@ -0,0 +1,4 @@ +{- This file has a poisoned cache entry. We want to + ensure we ignore cache entries which don't match + the hash -} +"Correct benign content" diff --git a/dhall-lang/tests/import/data/referentiallyOpaque.dhall b/dhall-lang/tests/import/data/referentiallyOpaque.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/referentiallyOpaque.dhall @@ -0,0 +1,18 @@ +{- This is a "referentially opaque" import (i.e. an import that is not + globally addressable), which cannot be imported by a "referentially + transparent" import (i.e. an import that is globally addressable). + + This test file is used in a failing test to verify that referentially + transparent imports cannot import referentially opaque imports. In the test + suite this file is actually imported via its GitHub URL (not its local file + path), so it plays the role of the referentially transparent import. Then, + this file attempts to import a referentially opaque import (an environment + variable in this case) to verify that the import fails. + + For this test file we need to select a referentially opaque import that + would succeed if imported on its own, so that a non-compliant implementation + doesn't fail this test for the wrong reason (i.e. due to the import not + being present). We thus use the `DHALL_TEST_VAR` environment variable, that + is expected to be set when running import tests. +-} +env:DHALL_TEST_VAR as Text diff --git a/dhall-lang/tests/import/data/simple.dhall b/dhall-lang/tests/import/data/simple.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/simple.dhall @@ -0,0 +1,1 @@ +3 diff --git a/dhall-lang/tests/import/data/simpleLocation.dhall b/dhall-lang/tests/import/data/simpleLocation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/simpleLocation.dhall @@ -0,0 +1,1 @@ +./simple.dhall as Location diff --git a/dhall-lang/tests/import/data/userAgent.dhall b/dhall-lang/tests/import/data/userAgent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/data/userAgent.dhall @@ -0,0 +1,1 @@ +"Dhall (from import)" diff --git a/dhall-lang/tests/import/failure/alternativeEnv.dhall b/dhall-lang/tests/import/failure/alternativeEnv.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/alternativeEnv.dhall @@ -0,0 +1,1 @@ +env:UNSET1 as Text ? env:UNSET2 ? missing ? env:UNSET3 diff --git a/dhall-lang/tests/import/failure/alternativeEnvMissing.dhall b/dhall-lang/tests/import/failure/alternativeEnvMissing.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/alternativeEnvMissing.dhall @@ -0,0 +1,1 @@ +env:UNSET ? missing diff --git a/dhall-lang/tests/import/failure/customHeadersUsingBoundVariable.dhall b/dhall-lang/tests/import/failure/customHeadersUsingBoundVariable.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/customHeadersUsingBoundVariable.dhall @@ -0,0 +1,15 @@ +{- This is a type error because the custom headers are type-checked with an + empty context. This is necessary because: + + * import resolution precedes β-normalization + * we also don't want custom headers to leak program state anyway + + This should fail due to the `x` within the custom header being an unbound + variable +-} + +let x = "Bar" + +in https://httpbin.org/headers + using [ { mapKey = "Foo", mapValue = x } ] + as Text diff --git a/dhall-lang/tests/import/failure/originHeadersFromRemote.dhall b/dhall-lang/tests/import/failure/originHeadersFromRemote.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/originHeadersFromRemote.dhall @@ -0,0 +1,1 @@ +https://httpbin.org/user-agent as Text diff --git a/dhall-lang/tests/import/failure/originHeadersFromRemoteENV.dhall b/dhall-lang/tests/import/failure/originHeadersFromRemoteENV.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/originHeadersFromRemoteENV.dhall @@ -0,0 +1,11 @@ +-- Use of a remote import causes Cyclic Import on env:DHALL_HEADERS +toMap + { DHALL_HEADERS = + '' + toMap { + `httpbin.org:443` = toMap { + `User-Agent` = http://example.com as Text + } + } + '' + } diff --git a/dhall-lang/tests/import/failure/unit/404.dhall b/dhall-lang/tests/import/failure/unit/404.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/404.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/nonexistent-file.dhall diff --git a/dhall-lang/tests/import/failure/unit/Cycle.dhall b/dhall-lang/tests/import/failure/unit/Cycle.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/Cycle.dhall @@ -0,0 +1,1 @@ +../../data/cycle.dhall diff --git a/dhall-lang/tests/import/failure/unit/DontRecoverCycle.dhall b/dhall-lang/tests/import/failure/unit/DontRecoverCycle.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/DontRecoverCycle.dhall @@ -0,0 +1,1 @@ +../../data/cycle.dhall ? 0 diff --git a/dhall-lang/tests/import/failure/unit/DontRecoverHashMismatch.dhall b/dhall-lang/tests/import/failure/unit/DontRecoverHashMismatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/DontRecoverHashMismatch.dhall @@ -0,0 +1,3 @@ +-- This fails because the `?` operator does not recover from integrity check +-- failures +../../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ? 0 diff --git a/dhall-lang/tests/import/failure/unit/DontRecoverParseError.dhall b/dhall-lang/tests/import/failure/unit/DontRecoverParseError.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/DontRecoverParseError.dhall @@ -0,0 +1,1 @@ +../../data/doesNotParse.dhall ? 0 diff --git a/dhall-lang/tests/import/failure/unit/DontRecoverTypeError.dhall b/dhall-lang/tests/import/failure/unit/DontRecoverTypeError.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/DontRecoverTypeError.dhall @@ -0,0 +1,1 @@ +../../data/doesNotTypecheck.dhall ? 0 diff --git a/dhall-lang/tests/import/failure/unit/EnvFromRemote.dhall b/dhall-lang/tests/import/failure/unit/EnvFromRemote.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/EnvFromRemote.dhall @@ -0,0 +1,13 @@ +{- The following remote import attempts to import an environment variable, which + must be disallowed by the referential sanity check + + One reason for doing this is to protect against remote imports exfiltrating + environment variables (such as via custom headers). Only referentially + opaque imports (i.e. local imports) have permission to refer to other + referentially opaque imports in order to protect against this attack. + + The referential sanity check also ensures that remote imports are + referentially transparent. Or in other words, any import that is globally + addressable must have a meaning that is not context-sensitive. +-} +https://raw.githubusercontent.com/dhall-lang/dhall-lang/master/tests/import/data/referentiallyOpaque.dhall diff --git a/dhall-lang/tests/import/failure/unit/EnvUnset.dhall b/dhall-lang/tests/import/failure/unit/EnvUnset.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/EnvUnset.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_UNSET diff --git a/dhall-lang/tests/import/failure/unit/EnvUnsetAsText.dhall b/dhall-lang/tests/import/failure/unit/EnvUnsetAsText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/EnvUnsetAsText.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_UNSET as Text diff --git a/dhall-lang/tests/import/failure/unit/FileMissing.dhall b/dhall-lang/tests/import/failure/unit/FileMissing.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/FileMissing.dhall @@ -0,0 +1,1 @@ +./not-a-file.dhall diff --git a/dhall-lang/tests/import/failure/unit/HashMismatch.dhall b/dhall-lang/tests/import/failure/unit/HashMismatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/HashMismatch.dhall @@ -0,0 +1,1 @@ +../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa diff --git a/dhall-lang/tests/import/failure/unit/HashMismatch2.dhall b/dhall-lang/tests/import/failure/unit/HashMismatch2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/HashMismatch2.dhall @@ -0,0 +1,2 @@ +-- This ensures that even if the file gets imported without hash first, the hash check is not skipped later +../../data/simple.dhall + ../../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ../../data/simple.dhall diff --git a/dhall-lang/tests/import/failure/unit/Missing.dhall b/dhall-lang/tests/import/failure/unit/Missing.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/Missing.dhall @@ -0,0 +1,1 @@ +missing diff --git a/dhall-lang/tests/import/failure/unit/VarAcrossImportBoundary.dhall b/dhall-lang/tests/import/failure/unit/VarAcrossImportBoundary.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/VarAcrossImportBoundary.dhall @@ -0,0 +1,1 @@ +\(x: Bool) -> ../../data/importBoundary.dhall diff --git a/dhall-lang/tests/import/failure/unit/cors/Empty.dhall b/dhall-lang/tests/import/failure/unit/cors/Empty.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/cors/Empty.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/Empty.dhall diff --git a/dhall-lang/tests/import/failure/unit/cors/NoCORS.dhall b/dhall-lang/tests/import/failure/unit/cors/NoCORS.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/cors/NoCORS.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/NoCORS.dhall diff --git a/dhall-lang/tests/import/failure/unit/cors/Null.dhall b/dhall-lang/tests/import/failure/unit/cors/Null.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/cors/Null.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/Null.dhall diff --git a/dhall-lang/tests/import/failure/unit/cors/OnlyOther.dhall b/dhall-lang/tests/import/failure/unit/cors/OnlyOther.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/cors/OnlyOther.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/OnlyOther.dhall diff --git a/dhall-lang/tests/import/failure/unit/cors/OnlySelf.dhall b/dhall-lang/tests/import/failure/unit/cors/OnlySelf.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/cors/OnlySelf.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/OnlySelf.dhall diff --git a/dhall-lang/tests/import/failure/unit/cors/TwoHops.dhall b/dhall-lang/tests/import/failure/unit/cors/TwoHops.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/failure/unit/cors/TwoHops.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/TwoHopsFail.dhall diff --git a/dhall-lang/tests/import/home/hello.dhall b/dhall-lang/tests/import/home/hello.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/home/hello.dhall @@ -0,0 +1,1 @@ +"hello" diff --git a/dhall-lang/tests/import/success/customHeadersA.dhall b/dhall-lang/tests/import/success/customHeadersA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/customHeadersA.dhall @@ -0,0 +1,3 @@ +https://httpbin.org/user-agent + using [ { mapKey = "User-Agent", mapValue = "Dhall" } ] + as Text diff --git a/dhall-lang/tests/import/success/customHeadersB.dhall b/dhall-lang/tests/import/success/customHeadersB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/customHeadersB.dhall @@ -0,0 +1,5 @@ +'' +{ + "user-agent": "Dhall" +} +'' diff --git a/dhall-lang/tests/import/success/hashFromCacheA.dhall b/dhall-lang/tests/import/success/hashFromCacheA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/hashFromCacheA.dhall @@ -0,0 +1,11 @@ +{- +An import with an integrity check MUST be fetched from the cache if possible. + +If you have set XDG_CACHE_HOME as described in tests/README.md, this hash will +be available in the cache, so even though this is a `missing` import, it can be +resolved by its hash. + +(If you're interested, the value is a fully-αβ-normalized copy of +Prelude/Optional/null) +-} +missing sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc diff --git a/dhall-lang/tests/import/success/hashFromCacheB.dhall b/dhall-lang/tests/import/success/hashFromCacheB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/hashFromCacheB.dhall @@ -0,0 +1,3 @@ +λ(_ : Type) → +λ(_ : Optional _) → + merge { None = True, Some = λ(_ : _@1) → False } _ diff --git a/dhall-lang/tests/import/success/headerForwardingA.dhall b/dhall-lang/tests/import/success/headerForwardingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/headerForwardingA.dhall @@ -0,0 +1,12 @@ +{- This test verifies that header-forwarding works correctly for relative + imports within the same domain + + `test.dhall-lang.org/foo` returns `./bar` and `test.dhall-lang.org/foo` + returns `True`, and both URLs reject all requests without a `Test` header. + + This test requires that the initial import to + `https://test.dhall-lang.org/foo` forwards the `Test` header + to the transitive relative import of `https://test.dhall-lang.org/bar` in + order to succeed. +-} +https://test.dhall-lang.org/foo using (toMap { Test = "Example" }) diff --git a/dhall-lang/tests/import/success/headerForwardingB.dhall b/dhall-lang/tests/import/success/headerForwardingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/headerForwardingB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/import/success/nestedHashA.dhall b/dhall-lang/tests/import/success/nestedHashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/nestedHashA.dhall @@ -0,0 +1,1 @@ +../data/nested.dhall sha256:add9792d79d9e03918e3236f32c6f8e89dbc05efac3451eb835676275f2c20a5 diff --git a/dhall-lang/tests/import/success/nestedHashB.dhall b/dhall-lang/tests/import/success/nestedHashB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/nestedHashB.dhall @@ -0,0 +1,1 @@ +{ x = 3 } diff --git a/dhall-lang/tests/import/success/noHeaderForwardingA.dhall b/dhall-lang/tests/import/success/noHeaderForwardingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/noHeaderForwardingA.dhall @@ -0,0 +1,6 @@ +{- The purpose of this test is to verify that the custom headers supplied to + this import are not forwarded to the transitive import of + https://httpbin.org/user-agent +-} +https://raw.githubusercontent.com/dhall-lang/dhall-lang/master/tests/import/success/customHeadersA.dhall + using [ { mapKey = "User-Agent", mapValue = "Secret" } ] diff --git a/dhall-lang/tests/import/success/noHeaderForwardingB.dhall b/dhall-lang/tests/import/success/noHeaderForwardingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/noHeaderForwardingB.dhall @@ -0,0 +1,5 @@ +'' +{ + "user-agent": "Dhall" +} +'' diff --git a/dhall-lang/tests/import/success/originHeadersA.dhall b/dhall-lang/tests/import/success/originHeadersA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersA.dhall @@ -0,0 +1,1 @@ +https://httpbin.org/user-agent as Text diff --git a/dhall-lang/tests/import/success/originHeadersB.dhall b/dhall-lang/tests/import/success/originHeadersB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersB.dhall @@ -0,0 +1,5 @@ +'' +{ + "user-agent": "Dhall" +} +'' diff --git a/dhall-lang/tests/import/success/originHeadersENV.dhall b/dhall-lang/tests/import/success/originHeadersENV.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersENV.dhall @@ -0,0 +1,10 @@ +toMap + { DHALL_HEADERS = + '' + toMap { + `httpbin.org:443` = toMap { + `User-Agent` = "Dhall" + } + } + '' + } diff --git a/dhall-lang/tests/import/success/originHeadersImportA.dhall b/dhall-lang/tests/import/success/originHeadersImportA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersImportA.dhall @@ -0,0 +1,1 @@ +https://httpbin.org/user-agent as Text diff --git a/dhall-lang/tests/import/success/originHeadersImportB.dhall b/dhall-lang/tests/import/success/originHeadersImportB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersImportB.dhall @@ -0,0 +1,5 @@ +'' +{ + "user-agent": "Dhall (from import)" +} +'' diff --git a/dhall-lang/tests/import/success/originHeadersImportENV.dhall b/dhall-lang/tests/import/success/originHeadersImportENV.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersImportENV.dhall @@ -0,0 +1,10 @@ +toMap + { DHALL_HEADERS = + '' + toMap { + `httpbin.org:443` = toMap { + `User-Agent` = ./dhall-lang/tests/import/data/userAgent.dhall + } + } + '' + } diff --git a/dhall-lang/tests/import/success/originHeadersImportFromEnvA.dhall b/dhall-lang/tests/import/success/originHeadersImportFromEnvA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersImportFromEnvA.dhall @@ -0,0 +1,1 @@ +https://httpbin.org/user-agent as Text diff --git a/dhall-lang/tests/import/success/originHeadersImportFromEnvB.dhall b/dhall-lang/tests/import/success/originHeadersImportFromEnvB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersImportFromEnvB.dhall @@ -0,0 +1,5 @@ +'' +{ + "user-agent": "Dhall (from env)" +} +'' diff --git a/dhall-lang/tests/import/success/originHeadersImportFromEnvENV.dhall b/dhall-lang/tests/import/success/originHeadersImportFromEnvENV.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersImportFromEnvENV.dhall @@ -0,0 +1,11 @@ +toMap + { DHALL_HEADERS = + '' + toMap { + `httpbin.org:443` = toMap { + `User-Agent` = env:USER_AGENT as Text + } + } + '' + , USER_AGENT = "Dhall (from env)" + } diff --git a/dhall-lang/tests/import/success/originHeadersOverrideA.dhall b/dhall-lang/tests/import/success/originHeadersOverrideA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersOverrideA.dhall @@ -0,0 +1,3 @@ +https://httpbin.org/user-agent + using [ { mapKey = "User-Agent", mapValue = "inline-header" } ] + as Text diff --git a/dhall-lang/tests/import/success/originHeadersOverrideB.dhall b/dhall-lang/tests/import/success/originHeadersOverrideB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersOverrideB.dhall @@ -0,0 +1,5 @@ +'' +{ + "user-agent": "user-header" +} +'' diff --git a/dhall-lang/tests/import/success/originHeadersOverrideENV.dhall b/dhall-lang/tests/import/success/originHeadersOverrideENV.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/originHeadersOverrideENV.dhall @@ -0,0 +1,10 @@ +toMap + { DHALL_HEADERS = + '' + toMap { + `httpbin.org:443` = toMap { + `User-Agent` = "user-header" + } + } + '' + } diff --git a/dhall-lang/tests/import/success/unit/AlternativeChain1A.dhall b/dhall-lang/tests/import/success/unit/AlternativeChain1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeChain1A.dhall @@ -0,0 +1,1 @@ +missing ? missing ? 42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeChain1B.dhall b/dhall-lang/tests/import/success/unit/AlternativeChain1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeChain1B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeChain2A.dhall b/dhall-lang/tests/import/success/unit/AlternativeChain2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeChain2A.dhall @@ -0,0 +1,1 @@ +missing ? 42 ? 10 diff --git a/dhall-lang/tests/import/success/unit/AlternativeChain2B.dhall b/dhall-lang/tests/import/success/unit/AlternativeChain2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeChain2B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeEnvA.dhall b/dhall-lang/tests/import/success/unit/AlternativeEnvA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeEnvA.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_UNSET ? 42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeEnvB.dhall b/dhall-lang/tests/import/success/unit/AlternativeEnvB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeEnvB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeImportErrorA.dhall b/dhall-lang/tests/import/success/unit/AlternativeImportErrorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeImportErrorA.dhall @@ -0,0 +1,1 @@ +missing ? 42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeImportErrorB.dhall b/dhall-lang/tests/import/success/unit/AlternativeImportErrorB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeImportErrorB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNestedImportErrorA.dhall b/dhall-lang/tests/import/success/unit/AlternativeNestedImportErrorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNestedImportErrorA.dhall @@ -0,0 +1,1 @@ +../../failure/missing.dhall ? 42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNestedImportErrorB.dhall b/dhall-lang/tests/import/success/unit/AlternativeNestedImportErrorB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNestedImportErrorB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNoError1A.dhall b/dhall-lang/tests/import/success/unit/AlternativeNoError1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNoError1A.dhall @@ -0,0 +1,1 @@ +42 ? 10 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNoError1B.dhall b/dhall-lang/tests/import/success/unit/AlternativeNoError1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNoError1B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNoError2A.dhall b/dhall-lang/tests/import/success/unit/AlternativeNoError2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNoError2A.dhall @@ -0,0 +1,1 @@ +42 ? missing diff --git a/dhall-lang/tests/import/success/unit/AlternativeNoError2B.dhall b/dhall-lang/tests/import/success/unit/AlternativeNoError2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNoError2B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNoError3A.dhall b/dhall-lang/tests/import/success/unit/AlternativeNoError3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNoError3A.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_VAR ? 10 diff --git a/dhall-lang/tests/import/success/unit/AlternativeNoError3B.dhall b/dhall-lang/tests/import/success/unit/AlternativeNoError3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeNoError3B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeSubExprA.dhall b/dhall-lang/tests/import/success/unit/AlternativeSubExprA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeSubExprA.dhall @@ -0,0 +1,1 @@ +missing + 10 ? 42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeSubExprB.dhall b/dhall-lang/tests/import/success/unit/AlternativeSubExprB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeSubExprB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/AlternativeWithVariableA.dhall b/dhall-lang/tests/import/success/unit/AlternativeWithVariableA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeWithVariableA.dhall @@ -0,0 +1,1 @@ +let x = 0 in (missing ? x) diff --git a/dhall-lang/tests/import/success/unit/AlternativeWithVariableB.dhall b/dhall-lang/tests/import/success/unit/AlternativeWithVariableB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeWithVariableB.dhall @@ -0,0 +1,1 @@ +let x = 0 in x diff --git a/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable1A.dhall b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable1A.dhall @@ -0,0 +1,1 @@ +\(x: Natural) -> x ? y diff --git a/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable1B.dhall b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable1B.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable2A.dhall b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable2A.dhall @@ -0,0 +1,1 @@ +\(x: Natural) -> (y + missing) ? x diff --git a/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable2B.dhall b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AlternativeWithWrongVariable2B.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/import/success/unit/AsBytesA.dhall b/dhall-lang/tests/import/success/unit/AsBytesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AsBytesA.dhall @@ -0,0 +1,1 @@ +../../data/example.bin as Bytes diff --git a/dhall-lang/tests/import/success/unit/AsBytesB.dhall b/dhall-lang/tests/import/success/unit/AsBytesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AsBytesB.dhall @@ -0,0 +1,1 @@ +0x"0123456789abcdef" diff --git a/dhall-lang/tests/import/success/unit/AsTextA.dhall b/dhall-lang/tests/import/success/unit/AsTextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AsTextA.dhall @@ -0,0 +1,1 @@ +../../data/example.txt as Text diff --git a/dhall-lang/tests/import/success/unit/AsTextB.dhall b/dhall-lang/tests/import/success/unit/AsTextB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/AsTextB.dhall @@ -0,0 +1,3 @@ +'' +Hello, world! +'' diff --git a/dhall-lang/tests/import/success/unit/DontCacheIfHashA.dhall b/dhall-lang/tests/import/success/unit/DontCacheIfHashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/DontCacheIfHashA.dhall @@ -0,0 +1,5 @@ +-- The let triggers a loading of `simple.dhall` in the cache, +-- but the second import uses a hash that corresponds to a different file already in the content-addressed store. +-- This test ensures that we retrieve the value corresponding to the hash and not the path even if the path is in cache. +let x = ../../data/simple.dhall +in ../../data/simple.dhall sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc diff --git a/dhall-lang/tests/import/success/unit/DontCacheIfHashB.dhall b/dhall-lang/tests/import/success/unit/DontCacheIfHashB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/DontCacheIfHashB.dhall @@ -0,0 +1,1 @@ +let x = 3 in λ(_ : Type) → λ(_ : Optional _) → merge { `None` = True, `Some` = λ(_ : _@1) → False } _ diff --git a/dhall-lang/tests/import/success/unit/EnvSetA.dhall b/dhall-lang/tests/import/success/unit/EnvSetA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/EnvSetA.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_VAR diff --git a/dhall-lang/tests/import/success/unit/EnvSetAsTextA.dhall b/dhall-lang/tests/import/success/unit/EnvSetAsTextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/EnvSetAsTextA.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_VAR as Text diff --git a/dhall-lang/tests/import/success/unit/EnvSetAsTextB.dhall b/dhall-lang/tests/import/success/unit/EnvSetAsTextB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/EnvSetAsTextB.dhall @@ -0,0 +1,1 @@ +"6 * 7" diff --git a/dhall-lang/tests/import/success/unit/EnvSetB.dhall b/dhall-lang/tests/import/success/unit/EnvSetB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/EnvSetB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/FilenameWithSpacesA.dhall b/dhall-lang/tests/import/success/unit/FilenameWithSpacesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/FilenameWithSpacesA.dhall @@ -0,0 +1,1 @@ +../../data/"file with spaces.txt" diff --git a/dhall-lang/tests/import/success/unit/FilenameWithSpacesB.dhall b/dhall-lang/tests/import/success/unit/FilenameWithSpacesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/FilenameWithSpacesB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/import/success/unit/IgnorePoisonedCacheA.dhall b/dhall-lang/tests/import/success/unit/IgnorePoisonedCacheA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/IgnorePoisonedCacheA.dhall @@ -0,0 +1,1 @@ +../../data/poisonedCache.dhall sha256:618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21 diff --git a/dhall-lang/tests/import/success/unit/IgnorePoisonedCacheB.dhall b/dhall-lang/tests/import/success/unit/IgnorePoisonedCacheB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/IgnorePoisonedCacheB.dhall @@ -0,0 +1,1 @@ +"Correct benign content" diff --git a/dhall-lang/tests/import/success/unit/ImportRelativeToHomeA.dhall b/dhall-lang/tests/import/success/unit/ImportRelativeToHomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/ImportRelativeToHomeA.dhall @@ -0,0 +1,1 @@ +~/hello.dhall ++ " world" diff --git a/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall b/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall @@ -0,0 +1,1 @@ +"hello" ++ " world" diff --git a/dhall-lang/tests/import/success/unit/MixImportModesA.dhall b/dhall-lang/tests/import/success/unit/MixImportModesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/MixImportModesA.dhall @@ -0,0 +1,2 @@ +-- This is to ensure caching doesn't accidentally confuse import modes +{ n = ../../data/simple.dhall, txt = ../../data/simple.dhall as Text, loc = ../../data/simple.dhall as Location } diff --git a/dhall-lang/tests/import/success/unit/MixImportModesB.dhall b/dhall-lang/tests/import/success/unit/MixImportModesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/MixImportModesB.dhall @@ -0,0 +1,1 @@ +{ loc = < Environment: Text | Local: Text | Missing | Remote: Text >.Local "./dhall-lang/tests/import/data/simple.dhall", n = 3, txt = "3\n" } diff --git a/dhall-lang/tests/import/success/unit/NormalizeA.dhall b/dhall-lang/tests/import/success/unit/NormalizeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/NormalizeA.dhall @@ -0,0 +1,1 @@ +../../../../../dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneA.dhall diff --git a/dhall-lang/tests/import/success/unit/NormalizeB.dhall b/dhall-lang/tests/import/success/unit/NormalizeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/NormalizeB.dhall @@ -0,0 +1,1 @@ +2 diff --git a/dhall-lang/tests/import/success/unit/QuotedPathA.dhall b/dhall-lang/tests/import/success/unit/QuotedPathA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/QuotedPathA.dhall @@ -0,0 +1,1 @@ +../".."/"data"/"example.txt" as Text diff --git a/dhall-lang/tests/import/success/unit/QuotedPathB.dhall b/dhall-lang/tests/import/success/unit/QuotedPathB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/QuotedPathB.dhall @@ -0,0 +1,3 @@ +'' +Hello, world! +'' diff --git a/dhall-lang/tests/import/success/unit/RecoverTransitiveFailureA.dhall b/dhall-lang/tests/import/success/unit/RecoverTransitiveFailureA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/RecoverTransitiveFailureA.dhall @@ -0,0 +1,1 @@ +../../failure/unit/FileMissing.dhall ? 0 diff --git a/dhall-lang/tests/import/success/unit/RecoverTransitiveFailureB.dhall b/dhall-lang/tests/import/success/unit/RecoverTransitiveFailureB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/RecoverTransitiveFailureB.dhall @@ -0,0 +1,1 @@ +0 diff --git a/dhall-lang/tests/import/success/unit/RemoteAsTextA.dhall b/dhall-lang/tests/import/success/unit/RemoteAsTextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/RemoteAsTextA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/0b983b92aa2222dc3e292c20550ee37dea3f41df/tests/import/data/example.txt as Text diff --git a/dhall-lang/tests/import/success/unit/RemoteAsTextB.dhall b/dhall-lang/tests/import/success/unit/RemoteAsTextB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/RemoteAsTextB.dhall @@ -0,0 +1,3 @@ +'' +Hello, world! +'' diff --git a/dhall-lang/tests/import/success/unit/SimpleA.dhall b/dhall-lang/tests/import/success/unit/SimpleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/SimpleA.dhall @@ -0,0 +1,1 @@ +../../data/simple.dhall diff --git a/dhall-lang/tests/import/success/unit/SimpleB.dhall b/dhall-lang/tests/import/success/unit/SimpleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/SimpleB.dhall @@ -0,0 +1,1 @@ +3 diff --git a/dhall-lang/tests/import/success/unit/SimpleHashA.dhall b/dhall-lang/tests/import/success/unit/SimpleHashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/SimpleHashA.dhall @@ -0,0 +1,1 @@ +../../data/simple.dhall sha256:15f52ecf91c94c1baac02d5a4964b2ed8fa401641a2c8a95e8306ec7c1e3b8d2 diff --git a/dhall-lang/tests/import/success/unit/SimpleHashB.dhall b/dhall-lang/tests/import/success/unit/SimpleHashB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/SimpleHashB.dhall @@ -0,0 +1,1 @@ +3 diff --git a/dhall-lang/tests/import/success/unit/SimpleRemoteA.dhall b/dhall-lang/tests/import/success/unit/SimpleRemoteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/SimpleRemoteA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/0b983b92aa2222dc3e292c20550ee37dea3f41df/tests/import/data/simple.dhall diff --git a/dhall-lang/tests/import/success/unit/SimpleRemoteB.dhall b/dhall-lang/tests/import/success/unit/SimpleRemoteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/SimpleRemoteB.dhall @@ -0,0 +1,1 @@ +3 diff --git a/dhall-lang/tests/import/success/unit/asLocation/AbsoluteA.dhall b/dhall-lang/tests/import/success/unit/asLocation/AbsoluteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/AbsoluteA.dhall @@ -0,0 +1,1 @@ +/absolute/import as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/AbsoluteB.dhall b/dhall-lang/tests/import/success/unit/asLocation/AbsoluteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/AbsoluteB.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "/absolute/import" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize1A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize1A.dhall @@ -0,0 +1,1 @@ +./foo/./bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize1B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize1B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/asLocation/foo/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize2A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize2A.dhall @@ -0,0 +1,1 @@ +./foo/baz/../bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize2B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize2B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/asLocation/foo/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize3A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize3A.dhall @@ -0,0 +1,1 @@ +./../bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize3B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize3B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize4A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize4A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize4A.dhall @@ -0,0 +1,1 @@ +../../bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize4B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize4B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize4B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize5A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize5A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize5A.dhall @@ -0,0 +1,1 @@ +./foo/../../bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Canonicalize5B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize5B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Canonicalize5B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Chain1A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Chain1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Chain1A.dhall @@ -0,0 +1,1 @@ +./Relative1A.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/Chain1B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Chain1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Chain1B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/asLocation/some/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Chain2A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Chain2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Chain2A.dhall @@ -0,0 +1,1 @@ +./Canonicalize4A.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/Chain2B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Chain2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Chain2B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Chain3A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Chain3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Chain3A.dhall @@ -0,0 +1,1 @@ +../asLocation/Canonicalize4A.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/Chain3B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Chain3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Chain3B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/DontTryResolvingA.dhall b/dhall-lang/tests/import/success/unit/asLocation/DontTryResolvingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/DontTryResolvingA.dhall @@ -0,0 +1,1 @@ +(missing as Location) ? 42 -- `missing` fails as an import, but definitely resolves as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/DontTryResolvingB.dhall b/dhall-lang/tests/import/success/unit/asLocation/DontTryResolvingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/DontTryResolvingB.dhall @@ -0,0 +1,1 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Missing diff --git a/dhall-lang/tests/import/success/unit/asLocation/EnvA.dhall b/dhall-lang/tests/import/success/unit/asLocation/EnvA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/EnvA.dhall @@ -0,0 +1,1 @@ +env:DHALL_TEST_VAR as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/EnvB.dhall b/dhall-lang/tests/import/success/unit/asLocation/EnvB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/EnvB.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Environment + "DHALL_TEST_VAR" diff --git a/dhall-lang/tests/import/success/unit/asLocation/HashA.dhall b/dhall-lang/tests/import/success/unit/asLocation/HashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/HashA.dhall @@ -0,0 +1,6 @@ +{- + If you have set XDG_CACHE_HOME as described in tests/README.md, this hash will + be available in the cache. Since this is an `as Location` test however, you + mustn't use the cache value here. +-} +./some/import.dhall sha256:efc43103e49b56c5bf089db8e0365bbfc455b8a2f0dc6ee5727a3586f85969fd as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/HashB.dhall b/dhall-lang/tests/import/success/unit/asLocation/HashB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/HashB.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/asLocation/some/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/HomeA.dhall b/dhall-lang/tests/import/success/unit/asLocation/HomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/HomeA.dhall @@ -0,0 +1,1 @@ +~/some/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/HomeB.dhall b/dhall-lang/tests/import/success/unit/asLocation/HomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/HomeB.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "~/some/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/MissingA.dhall b/dhall-lang/tests/import/success/unit/asLocation/MissingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/MissingA.dhall @@ -0,0 +1,1 @@ +missing as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/MissingB.dhall b/dhall-lang/tests/import/success/unit/asLocation/MissingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/MissingB.dhall @@ -0,0 +1,1 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Missing diff --git a/dhall-lang/tests/import/success/unit/asLocation/Relative1A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Relative1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Relative1A.dhall @@ -0,0 +1,1 @@ +./some/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Relative1B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Relative1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Relative1B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/asLocation/some/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/Relative2A.dhall b/dhall-lang/tests/import/success/unit/asLocation/Relative2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Relative2A.dhall @@ -0,0 +1,1 @@ +../some/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/Relative2B.dhall b/dhall-lang/tests/import/success/unit/asLocation/Relative2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/Relative2B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Local + "./dhall-lang/tests/import/success/unit/some/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteA.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteB.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteB.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://example.com/foo/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize1A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize1A.dhall @@ -0,0 +1,1 @@ +https://example.com/foo/./bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize1B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize1B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://example.com/foo/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize2A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize2A.dhall @@ -0,0 +1,1 @@ +https://example.com/foo/bar/../baz/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize2B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize2B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://example.com/foo/baz/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize3A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize3A.dhall @@ -0,0 +1,1 @@ +https://example.com/foo/bar/../../baz/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize3B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize3B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://example.com/baz/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize4A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize4A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize4A.dhall @@ -0,0 +1,4 @@ +{- + The standardized behaviour does not respect https://tools.ietf.org/html/rfc3986#section-5.2 . +-} +https://example.com/../bar/import.dhall as Location diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize4B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize4B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteCanonicalize4B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://example.com/../bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChain1A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain1A.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/0b983b92aa2222dc3e292c20550ee37dea3f41df/tests/import/data/simpleLocation.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChain1B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain1B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://raw.githubusercontent.com/dhall-lang/dhall-lang/0b983b92aa2222dc3e292c20550ee37dea3f41df/tests/import/data/simple.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChain2A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain2A.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/Nadrieril/dhall-rust/f7d8c64a9799f139ad65427c2518376adb9e2e2f/dhall/tests/import/success/unit/asLocation/Canonicalize3A.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChain2B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain2B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://raw.githubusercontent.com/Nadrieril/dhall-rust/f7d8c64a9799f139ad65427c2518376adb9e2e2f/dhall/tests/import/success/unit/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChain3A.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain3A.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/Nadrieril/dhall-rust/f7d8c64a9799f139ad65427c2518376adb9e2e2f/dhall/tests/import/success/unit/asLocation/Canonicalize5A.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChain3B.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChain3B.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Remote + "https://raw.githubusercontent.com/Nadrieril/dhall-rust/f7d8c64a9799f139ad65427c2518376adb9e2e2f/dhall/tests/import/success/unit/bar/import.dhall" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChainEnvA.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainEnvA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainEnvA.dhall @@ -0,0 +1,5 @@ +{- + This test verifies that `env:VAR as Location` isn't rejected as referentially opaque, + as `env:VAR` on its own would. +-} +https://raw.githubusercontent.com/Nadrieril/dhall-rust/f7d8c64a9799f139ad65427c2518376adb9e2e2f/dhall/tests/import/success/unit/asLocation/EnvA.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChainEnvB.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainEnvB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainEnvB.dhall @@ -0,0 +1,2 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Environment + "HOME" diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChainMissingA.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainMissingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainMissingA.dhall @@ -0,0 +1,6 @@ +{- This test verifies that `missing as Location` succeeds when chained since: + * The `missing` is never actually resolved (due to the `as Location`) + * The `missing` should be treated as referentially transparent (and therefore + be a valid transitive dependency of a remote import) +-} +https://raw.githubusercontent.com/Nadrieril/dhall-rust/f7d8c64a9799f139ad65427c2518376adb9e2e2f/dhall/tests/import/success/unit/asLocation/MissingA.dhall diff --git a/dhall-lang/tests/import/success/unit/asLocation/RemoteChainMissingB.dhall b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainMissingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/asLocation/RemoteChainMissingB.dhall @@ -0,0 +1,1 @@ +< Environment : Text | Local : Text | Missing | Remote : Text >.Missing diff --git a/dhall-lang/tests/import/success/unit/cors/AllowedAllA.dhall b/dhall-lang/tests/import/success/unit/cors/AllowedAllA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/AllowedAllA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/AllowedAll.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/AllowedAllB.dhall b/dhall-lang/tests/import/success/unit/cors/AllowedAllB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/AllowedAllB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/NoCORSFromLocalA.dhall b/dhall-lang/tests/import/success/unit/cors/NoCORSFromLocalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/NoCORSFromLocalA.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/NoCORS.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/NoCORSFromLocalB.dhall b/dhall-lang/tests/import/success/unit/cors/NoCORSFromLocalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/NoCORSFromLocalB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/OnlyGithubA.dhall b/dhall-lang/tests/import/success/unit/cors/OnlyGithubA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/OnlyGithubA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/OnlyGithub.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/OnlyGithubB.dhall b/dhall-lang/tests/import/success/unit/cors/OnlyGithubB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/OnlyGithubB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/PreludeA.dhall b/dhall-lang/tests/import/success/unit/cors/PreludeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/PreludeA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/acee30866a179c9e9bb3fc02ec8be2883685eb14/tests/import/data/cors/Prelude.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/PreludeB.dhall b/dhall-lang/tests/import/success/unit/cors/PreludeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/PreludeB.dhall @@ -0,0 +1,1 @@ +List/length diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportAbsolute2A.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsolute2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsolute2A.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/SelfImportAbsolute.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportAbsolute2B.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsolute2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsolute2B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportAbsoluteA.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsoluteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsoluteA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/SelfImportAbsolute.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportAbsoluteB.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsoluteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportAbsoluteB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportRelative2A.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportRelative2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportRelative2A.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/SelfImportRelative.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportRelative2B.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportRelative2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportRelative2B.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportRelativeA.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportRelativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportRelativeA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/SelfImportRelative.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/SelfImportRelativeB.dhall b/dhall-lang/tests/import/success/unit/cors/SelfImportRelativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/SelfImportRelativeB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/import/success/unit/cors/TwoHopsA.dhall b/dhall-lang/tests/import/success/unit/cors/TwoHopsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/TwoHopsA.dhall @@ -0,0 +1,1 @@ +https://test.dhall-lang.org/cors/TwoHopsSuccess.dhall diff --git a/dhall-lang/tests/import/success/unit/cors/TwoHopsB.dhall b/dhall-lang/tests/import/success/unit/cors/TwoHopsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/import/success/unit/cors/TwoHopsB.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/normalization/success/WithRecordValueA.dhall b/dhall-lang/tests/normalization/success/WithRecordValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/WithRecordValueA.dhall @@ -0,0 +1,12 @@ +{- This test illustrates that `with a = { c = 2 }` is not the same thing as + `with a.c = 2`: + + * `with a = { c = 2 }` overrides the entire value of the field `a` with a new + record containing only `c = 2` + + * `with a.c = 2` extends or updates the record stored underneath `a` to + set the field `c` to `2`. + + Compare this to the `WithNested` test, which contains the `a.c = 2` case +-} +{ a.b = 1 } with a = { c = 2 } diff --git a/dhall-lang/tests/normalization/success/WithRecordValueB.dhall b/dhall-lang/tests/normalization/success/WithRecordValueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/WithRecordValueB.dhall @@ -0,0 +1,1 @@ +{ a = { c = 2 } } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/access/0A.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/access/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/access/0A.dhall @@ -0,0 +1,1 @@ +{ x = "foo" }.x diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/access/0B.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/access/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/access/0B.dhall @@ -0,0 +1,1 @@ +"foo" diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/access/1A.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/access/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/access/1A.dhall @@ -0,0 +1,1 @@ +< Foo : Text | Bar : Natural >.Foo diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/access/1B.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/access/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/access/1B.dhall @@ -0,0 +1,1 @@ +< Bar : Natural | Foo : Text >.Foo diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/0A.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/0A.dhall @@ -0,0 +1,1 @@ +{ foo : { bar : Text } } ⩓ { foo : { baz : Bool }, qux : Integer } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/0B.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/0B.dhall @@ -0,0 +1,1 @@ +{ foo : { bar : Text, baz : Bool }, qux : Integer } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/1A.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/1A.dhall @@ -0,0 +1,1 @@ +{ foo : { bar : Text } } //\\ { foo : { baz : Bool }, qux : Integer } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/1B.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/1B.dhall @@ -0,0 +1,1 @@ +{ foo : { bar : Text, baz : Bool }, qux : Integer } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/prefer/0A.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/prefer/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/prefer/0A.dhall @@ -0,0 +1,1 @@ +{ foo = 1, bar = "ABC" } // { baz = True } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/prefer/0B.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/prefer/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/prefer/0B.dhall @@ -0,0 +1,1 @@ +{ bar = "ABC", baz = True, foo = 1 } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/projection/0A.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/projection/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/projection/0A.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = True, z = "ABC" }.{ x, y } diff --git a/dhall-lang/tests/normalization/success/haskell-tutorial/projection/0B.dhall b/dhall-lang/tests/normalization/success/haskell-tutorial/projection/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/haskell-tutorial/projection/0B.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = True } diff --git a/dhall-lang/tests/normalization/success/regression/ComplexRecordSimplificationA.dhall b/dhall-lang/tests/normalization/success/regression/ComplexRecordSimplificationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/ComplexRecordSimplificationA.dhall @@ -0,0 +1,1 @@ +\(foo: { x: Bool, y: Bool }) -> \(bar: { x: Bool }) -> (foo.{x, y} // bar).{ x } diff --git a/dhall-lang/tests/normalization/success/regression/ComplexRecordSimplificationB.dhall b/dhall-lang/tests/normalization/success/regression/ComplexRecordSimplificationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/ComplexRecordSimplificationB.dhall @@ -0,0 +1,3 @@ +λ(foo : { x : Bool, y : Bool }) → +λ(bar : { x : Bool }) → + (foo.{ x, y } ⫽ bar).{ x } diff --git a/dhall-lang/tests/normalization/success/regression/NaturalFoldExtraArgA.dhall b/dhall-lang/tests/normalization/success/regression/NaturalFoldExtraArgA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/NaturalFoldExtraArgA.dhall @@ -0,0 +1,2 @@ +{- Checks that builtins don't accidentally discard further arguments than their arity -} +Natural/fold 0 (Bool -> Bool) (λ(_ : (Bool -> Bool)) → λ(_ : Bool) → True) (λ(_ : Bool) → False) True diff --git a/dhall-lang/tests/normalization/success/regression/NaturalFoldExtraArgB.dhall b/dhall-lang/tests/normalization/success/regression/NaturalFoldExtraArgB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/NaturalFoldExtraArgB.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/normalization/success/regression/ToMapQuotedFieldsA.dhall b/dhall-lang/tests/normalization/success/regression/ToMapQuotedFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/ToMapQuotedFieldsA.dhall @@ -0,0 +1,1 @@ +toMap { `if` = 0, `foo%bar` = 1 } diff --git a/dhall-lang/tests/normalization/success/regression/ToMapQuotedFieldsB.dhall b/dhall-lang/tests/normalization/success/regression/ToMapQuotedFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/ToMapQuotedFieldsB.dhall @@ -0,0 +1,1 @@ +[ { mapKey = "foo%bar", mapValue = 1 }, { mapKey = "if", mapValue = 0 } ] diff --git a/dhall-lang/tests/normalization/success/regression/TrickyBinderIdentityA.dhall b/dhall-lang/tests/normalization/success/regression/TrickyBinderIdentityA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/TrickyBinderIdentityA.dhall @@ -0,0 +1,1 @@ +let T = Natural let ap = λ(f : T → List T) -> λ(x : T) -> f x in ap (λ(x : T) -> ap (λ(y : T) -> [x, y]) 1) 0 diff --git a/dhall-lang/tests/normalization/success/regression/TrickyBinderIdentityB.dhall b/dhall-lang/tests/normalization/success/regression/TrickyBinderIdentityB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/TrickyBinderIdentityB.dhall @@ -0,0 +1,1 @@ +[ 0, 1 ] diff --git a/dhall-lang/tests/normalization/success/regression/UnsaturatedBuiltinsA.dhall b/dhall-lang/tests/normalization/success/regression/UnsaturatedBuiltinsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/UnsaturatedBuiltinsA.dhall @@ -0,0 +1,16 @@ +{- The Haskell implementation was incorrectly normalizing partially + saturated `Natural/fold` and `List/fold` built-ins even though the standard + requires built-ins to be fully saturated before normalization. + + For example, the Haskell implementation was normalizing `Natural/fold 0` to: + + λ(natural : Type) + → λ(succ : natural → natural) + → λ(zero : natural) + → zero + + ... when the correct result should have been `Natural/fold 0` (no change) +-} +{ example0 = Natural/fold 0 +, example1 = List/fold Bool [ True ] +} diff --git a/dhall-lang/tests/normalization/success/regression/UnsaturatedBuiltinsB.dhall b/dhall-lang/tests/normalization/success/regression/UnsaturatedBuiltinsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/regression/UnsaturatedBuiltinsB.dhall @@ -0,0 +1,3 @@ +{ example0 = Natural/fold 0 +, example1 = List/fold Bool [ True ] +} diff --git a/dhall-lang/tests/normalization/success/remoteSystemsA.dhall b/dhall-lang/tests/normalization/success/remoteSystemsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/remoteSystemsA.dhall @@ -0,0 +1,51 @@ +let Text/concatMap = ../../../Prelude/Text/concatMap.dhall + +let Text/concatSep = ../../../Prelude/Text/concatSep.dhall + +let Row = + { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List Text + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + +let renderRow = + λ ( row + : Row + ) + → let host = + merge + { None = row.host + , Some = λ(user : Text) → "${user}@${row.host}" + } + row.user + + let platforms = Text/concatSep "," row.platforms + + let key = row.key + + let cores = Integer/show (Natural/toInteger row.cores) + + let speedFactor = Integer/show (Natural/toInteger row.speedFactor) + + let supportedFeatures = Text/concatSep "," row.supportedFeatures + + let mandatoryFeatures = Text/concatSep "," row.mandatoryFeatures + + in '' + ${host} ${platforms} ${key} ${cores} ${speedFactor} ${supportedFeatures} ${mandatoryFeatures} + '' + +in Text/concatMap Row renderRow diff --git a/dhall-lang/tests/normalization/success/remoteSystemsB.dhall b/dhall-lang/tests/normalization/success/remoteSystemsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/remoteSystemsB.dhall @@ -0,0 +1,166 @@ + λ ( xs + : List + { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List Text + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + ) +→ List/fold + { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List Text + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + xs + Text + ( λ ( x + : { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List Text + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + ) + → λ(y : Text) + → '' + ${merge + { None = x.host, Some = λ(user : Text) → "${user}@${x.host}" } + x.user} ${merge + { Empty = "", NonEmpty = λ(result : Text) → result } + ( List/fold + Text + x.platforms + < Empty | NonEmpty : Text > + ( λ(element : Text) + → λ(status : < Empty | NonEmpty : Text >) + → merge + { Empty = + < Empty | NonEmpty : Text >.NonEmpty element + , NonEmpty = + λ(result : Text) + → < Empty | NonEmpty : Text >.NonEmpty + ("${element},${result}") + } + status + ) + < Empty | NonEmpty : Text >.Empty + )} ${x.key} ${Integer/show + ( Natural/toInteger x.cores + )} ${Integer/show + ( Natural/toInteger x.speedFactor + )} ${merge + { Empty = + "" + , NonEmpty = + λ(result : Text) → result + } + ( List/fold + Text + x.supportedFeatures + < Empty | NonEmpty : Text > + ( λ(element : Text) + → λ ( status + : < Empty + | NonEmpty : + Text + > + ) + → merge + { Empty = + < Empty + | NonEmpty : + Text + >.NonEmpty + element + , NonEmpty = + λ(result : Text) + → < Empty + | NonEmpty : + Text + >.NonEmpty + "${element},${result}" + } + status + ) + < Empty + | NonEmpty : + Text + >.Empty + )} ${merge + { Empty = + "" + , NonEmpty = + λ(result : Text) → result + } + ( List/fold + Text + x.mandatoryFeatures + < Empty | NonEmpty : Text > + ( λ(element : Text) + → λ ( status + : < Empty + | NonEmpty : + Text + > + ) + → merge + { Empty = + < Empty + | NonEmpty : + Text + >.NonEmpty + element + , NonEmpty = + λ(result : Text) + → < Empty + | NonEmpty : + Text + >.NonEmpty + "${element},${result}" + } + status + ) + < Empty + | NonEmpty : + Text + >.Empty + )} + ${y}'' + ) + "" diff --git a/dhall-lang/tests/normalization/success/simple/completionA.dhall b/dhall-lang/tests/normalization/success/simple/completionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/completionA.dhall @@ -0,0 +1,10 @@ +let Example = + { Type = { name : Text, id : Optional Natural } + , default = { name = "", id = None Natural } + } + +in { example0 = Example::{=} + , example1 = Example::{ name = "John Doe" } + , example2 = Example::{ id = Some 0 } + , example3 = Example::{ name = "Mary Jane", id = Some 0 } + } diff --git a/dhall-lang/tests/normalization/success/simple/completionB.dhall b/dhall-lang/tests/normalization/success/simple/completionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/completionB.dhall @@ -0,0 +1,5 @@ +{ example0 = { id = None Natural, name = "" } +, example1 = { id = None Natural, name = "John Doe" } +, example2 = { id = Some 0, name = "" } +, example3 = { id = Some 0, name = "Mary Jane" } +} diff --git a/dhall-lang/tests/normalization/success/simple/doubleShowA.dhall b/dhall-lang/tests/normalization/success/simple/doubleShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/doubleShowA.dhall @@ -0,0 +1,6 @@ +{ example0 = Double/show -0.42 +, example1 = Double/show 13.37 +, example2 = Double/show NaN +, example3 = Double/show Infinity +, example4 = Double/show -Infinity +} diff --git a/dhall-lang/tests/normalization/success/simple/doubleShowB.dhall b/dhall-lang/tests/normalization/success/simple/doubleShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/doubleShowB.dhall @@ -0,0 +1,11 @@ +{ example0 = + "-0.42" +, example1 = + "13.37" +, example2 = + "NaN" +, example3 = + "Infinity" +, example4 = + "-Infinity" +} diff --git a/dhall-lang/tests/normalization/success/simple/enumA.dhall b/dhall-lang/tests/normalization/success/simple/enumA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/enumA.dhall @@ -0,0 +1,8 @@ +let Role = < Wizard | Fighter | Rogue > + +let show : Role → Text + = + λ(x : Role) + → merge { Wizard = "Wizard", Fighter = "Fighter", Rogue = "Rogue" } x + +in show Role.Wizard diff --git a/dhall-lang/tests/normalization/success/simple/enumB.dhall b/dhall-lang/tests/normalization/success/simple/enumB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/enumB.dhall @@ -0,0 +1,1 @@ +"Wizard" diff --git a/dhall-lang/tests/normalization/success/simple/equalNoCommuteA.dhall b/dhall-lang/tests/normalization/success/simple/equalNoCommuteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/equalNoCommuteA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x == False diff --git a/dhall-lang/tests/normalization/success/simple/equalNoCommuteB.dhall b/dhall-lang/tests/normalization/success/simple/equalNoCommuteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/equalNoCommuteB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x == False diff --git a/dhall-lang/tests/normalization/success/simple/integerShowA.dhall b/dhall-lang/tests/normalization/success/simple/integerShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/integerShowA.dhall @@ -0,0 +1,4 @@ +{ example0 = Integer/show +1337 +, example1 = Integer/show -42 +, example2 = Integer/show +0 +} diff --git a/dhall-lang/tests/normalization/success/simple/integerShowB.dhall b/dhall-lang/tests/normalization/success/simple/integerShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/integerShowB.dhall @@ -0,0 +1,1 @@ +{ example0 = "+1337", example1 = "-42", example2 = "+0" } diff --git a/dhall-lang/tests/normalization/success/simple/integerToDoubleA.dhall b/dhall-lang/tests/normalization/success/simple/integerToDoubleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/integerToDoubleA.dhall @@ -0,0 +1,10 @@ +[ Integer/toDouble +179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497792 +, Integer/toDouble +179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791 +, Integer/toDouble +179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945 +, Integer/toDouble +179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944 + +, Integer/toDouble -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497792 +, Integer/toDouble -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791 +, Integer/toDouble -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945 +, Integer/toDouble -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944 +] diff --git a/dhall-lang/tests/normalization/success/simple/integerToDoubleB.dhall b/dhall-lang/tests/normalization/success/simple/integerToDoubleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/integerToDoubleB.dhall @@ -0,0 +1,9 @@ +[ Infinity +, 1.7976931348623157e308 +, 1.7976931348623157e308 +, 1.7976931348623155e308 +, -Infinity +, -1.7976931348623157e308 +, -1.7976931348623157e308 +, -1.7976931348623155e308 +] diff --git a/dhall-lang/tests/normalization/success/simple/letAvoidCaptureA.dhall b/dhall-lang/tests/normalization/success/simple/letAvoidCaptureA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/letAvoidCaptureA.dhall @@ -0,0 +1,3 @@ +\(x: Natural) +-> let var = x + in \(x: Bool) -> var diff --git a/dhall-lang/tests/normalization/success/simple/letAvoidCaptureB.dhall b/dhall-lang/tests/normalization/success/simple/letAvoidCaptureB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/letAvoidCaptureB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → λ(x : Bool) → x@1 diff --git a/dhall-lang/tests/normalization/success/simple/letenumA.dhall b/dhall-lang/tests/normalization/success/simple/letenumA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/letenumA.dhall @@ -0,0 +1,3 @@ +let enum = < x >.x +in +merge { x = 1 } enum diff --git a/dhall-lang/tests/normalization/success/simple/letenumB.dhall b/dhall-lang/tests/normalization/success/simple/letenumB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/letenumB.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/simple/letletA.dhall b/dhall-lang/tests/normalization/success/simple/letletA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/letletA.dhall @@ -0,0 +1,3 @@ +let l = λ(n : Natural) → λ(m : Natural) → λ(x : Natural) → n + m * x +let f = l 2 3 +in f 445 diff --git a/dhall-lang/tests/normalization/success/simple/letletB.dhall b/dhall-lang/tests/normalization/success/simple/letletB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/letletB.dhall @@ -0,0 +1,1 @@ +1337 diff --git a/dhall-lang/tests/normalization/success/simple/listBuildA.dhall b/dhall-lang/tests/normalization/success/simple/listBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/listBuildA.dhall @@ -0,0 +1,22 @@ +{ example0 = + List/build + Bool + ( λ(list : Type) + → λ(cons : Bool → list → list) + → λ(nil : list) + → cons True (cons False nil) + ) +, example1 = + List/build + Bool + (λ(x : Type) → λ(x : Bool → x → x) → λ(x : x@1) → x@1 True (x@1 False x)) +, example2 = + λ(id : ∀(a : Type) → a → a) + → List/build + Bool + ( λ(list : Type) + → λ(cons : Bool → list → list) + → λ(nil : list) + → id list (cons True (cons False nil)) + ) +} diff --git a/dhall-lang/tests/normalization/success/simple/listBuildB.dhall b/dhall-lang/tests/normalization/success/simple/listBuildB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/listBuildB.dhall @@ -0,0 +1,7 @@ +{ example0 = + [ True, False ] +, example1 = + [ True, False ] +, example2 = + λ(id : ∀(a : Type) → a → a) → id (List Bool) [ True, False ] +} diff --git a/dhall-lang/tests/normalization/success/simple/multiLineA.dhall b/dhall-lang/tests/normalization/success/simple/multiLineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/multiLineA.dhall @@ -0,0 +1,4 @@ +'' + foo +bar +'' diff --git a/dhall-lang/tests/normalization/success/simple/multiLineB.dhall b/dhall-lang/tests/normalization/success/simple/multiLineB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/multiLineB.dhall @@ -0,0 +1,4 @@ +'' + foo +bar +'' diff --git a/dhall-lang/tests/normalization/success/simple/naturalBuildA.dhall b/dhall-lang/tests/normalization/success/simple/naturalBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/naturalBuildA.dhall @@ -0,0 +1,18 @@ +{ example0 = + Natural/build + ( λ(natural : Type) + → λ(succ : natural → natural) + → λ(zero : natural) + → succ zero + ) +, example1 = + Natural/build (λ(x : Type) → λ(x : x → x) → λ(x : x@1) → x@1 x) +, example2 = + λ(id : ∀(a : Type) → a → a) + → Natural/build + ( λ(natural : Type) + → λ(succ : natural → natural) + → λ(zero : natural) + → id natural (succ zero) + ) +} diff --git a/dhall-lang/tests/normalization/success/simple/naturalBuildB.dhall b/dhall-lang/tests/normalization/success/simple/naturalBuildB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/naturalBuildB.dhall @@ -0,0 +1,7 @@ +{ example0 = + 1 +, example1 = + 1 +, example2 = + λ(id : ∀(a : Type) → a → a) → id Natural 1 +} diff --git a/dhall-lang/tests/normalization/success/simple/notEqualNoCommuteA.dhall b/dhall-lang/tests/normalization/success/simple/notEqualNoCommuteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/notEqualNoCommuteA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x != True diff --git a/dhall-lang/tests/normalization/success/simple/notEqualNoCommuteB.dhall b/dhall-lang/tests/normalization/success/simple/notEqualNoCommuteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/notEqualNoCommuteB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x != True diff --git a/dhall-lang/tests/normalization/success/simple/plusNoCommuteA.dhall b/dhall-lang/tests/normalization/success/simple/plusNoCommuteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/plusNoCommuteA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x + 1 diff --git a/dhall-lang/tests/normalization/success/simple/plusNoCommuteB.dhall b/dhall-lang/tests/normalization/success/simple/plusNoCommuteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/plusNoCommuteB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x + 1 diff --git a/dhall-lang/tests/normalization/success/simple/simpleAdditionA.dhall b/dhall-lang/tests/normalization/success/simple/simpleAdditionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/simpleAdditionA.dhall @@ -0,0 +1,1 @@ +(\(x: Natural) -> x + 1) 0 diff --git a/dhall-lang/tests/normalization/success/simple/simpleAdditionB.dhall b/dhall-lang/tests/normalization/success/simple/simpleAdditionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/simpleAdditionB.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/simple/sortOperatorA.dhall b/dhall-lang/tests/normalization/success/simple/sortOperatorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/sortOperatorA.dhall @@ -0,0 +1,1 @@ +{ b = 2 } // { a = 1 } diff --git a/dhall-lang/tests/normalization/success/simple/sortOperatorB.dhall b/dhall-lang/tests/normalization/success/simple/sortOperatorB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/sortOperatorB.dhall @@ -0,0 +1,1 @@ +{ a = 1, b = 2 } diff --git a/dhall-lang/tests/normalization/success/simple/timesNoCommuteA.dhall b/dhall-lang/tests/normalization/success/simple/timesNoCommuteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/timesNoCommuteA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x * 2 diff --git a/dhall-lang/tests/normalization/success/simple/timesNoCommuteB.dhall b/dhall-lang/tests/normalization/success/simple/timesNoCommuteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simple/timesNoCommuteB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x * 2 diff --git a/dhall-lang/tests/normalization/success/simplifications/andA.dhall b/dhall-lang/tests/normalization/success/simplifications/andA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/andA.dhall @@ -0,0 +1,6 @@ +{ example0 = λ(x : Bool) → x && True +, example1 = λ(x : Bool) → True && x +, example2 = λ(x : Bool) → x && False +, example3 = λ(x : Bool) → False && x +, example4 = λ(x : Bool) → x && x +} diff --git a/dhall-lang/tests/normalization/success/simplifications/andB.dhall b/dhall-lang/tests/normalization/success/simplifications/andB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/andB.dhall @@ -0,0 +1,11 @@ +{ example0 = + λ(x : Bool) → x +, example1 = + λ(x : Bool) → x +, example2 = + λ(x : Bool) → False +, example3 = + λ(x : Bool) → False +, example4 = + λ(x : Bool) → x +} diff --git a/dhall-lang/tests/normalization/success/simplifications/eqA.dhall b/dhall-lang/tests/normalization/success/simplifications/eqA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/eqA.dhall @@ -0,0 +1,4 @@ +{ example0 = λ(x : Bool) → x == True +, example1 = λ(x : Bool) → True == x +, example2 = λ(x : Bool) → x == x +} diff --git a/dhall-lang/tests/normalization/success/simplifications/eqB.dhall b/dhall-lang/tests/normalization/success/simplifications/eqB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/eqB.dhall @@ -0,0 +1,7 @@ +{ example0 = + λ(x : Bool) → x +, example1 = + λ(x : Bool) → x +, example2 = + λ(x : Bool) → True +} diff --git a/dhall-lang/tests/normalization/success/simplifications/ifThenElseA.dhall b/dhall-lang/tests/normalization/success/simplifications/ifThenElseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/ifThenElseA.dhall @@ -0,0 +1,3 @@ +{ example0 = λ(x : Bool) → if x then True else False +, example1 = λ(x : Bool) → λ(y : Text) → if x then y else y +} diff --git a/dhall-lang/tests/normalization/success/simplifications/ifThenElseB.dhall b/dhall-lang/tests/normalization/success/simplifications/ifThenElseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/ifThenElseB.dhall @@ -0,0 +1,1 @@ +{ example0 = λ(x : Bool) → x, example1 = λ(x : Bool) → λ(y : Text) → y } diff --git a/dhall-lang/tests/normalization/success/simplifications/issue661A.dhall b/dhall-lang/tests/normalization/success/simplifications/issue661A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/issue661A.dhall @@ -0,0 +1,17 @@ +let T1 = { a : Natural } +let T2 = { a : Natural, b : Text } +let T3 = { z : List { a : Natural, b : Text } } +let T4 = { z : List { b : Text, c : List Natural } } + +let Prelude/List/map = ../../../../Prelude/List/map + +let f = λ(old : T1) → old ⫽ { b = "Hello" } +let g = λ(old : T2) → { z = [ old, old.{ a } ⫽ { b = "Bye" } ] : List T2 } +let h_ = λ(old : T2) → old.{ b } ⫽ { c = [ old.a ] : List Natural } +let h = + λ(old : T3) + → { z = Prelude/List/map T2 { b : Text, c : List Natural } h_ old.z } + +let k = λ(old : T1) → h (g (f old)) + +in k diff --git a/dhall-lang/tests/normalization/success/simplifications/issue661B.dhall b/dhall-lang/tests/normalization/success/simplifications/issue661B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/issue661B.dhall @@ -0,0 +1,2 @@ + λ(old : { a : Natural }) +→ { z = [ { b = "Hello", c = [ old.a ] }, { b = "Bye", c = [ old.a ] } ] } diff --git a/dhall-lang/tests/normalization/success/simplifications/neA.dhall b/dhall-lang/tests/normalization/success/simplifications/neA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/neA.dhall @@ -0,0 +1,4 @@ +{ example0 = λ(x : Bool) → x != False +, example1 = λ(x : Bool) → False != x +, example2 = λ(x : Bool) → x != x +} diff --git a/dhall-lang/tests/normalization/success/simplifications/neB.dhall b/dhall-lang/tests/normalization/success/simplifications/neB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/neB.dhall @@ -0,0 +1,7 @@ +{ example0 = + λ(x : Bool) → x +, example1 = + λ(x : Bool) → x +, example2 = + λ(x : Bool) → False +} diff --git a/dhall-lang/tests/normalization/success/simplifications/orA.dhall b/dhall-lang/tests/normalization/success/simplifications/orA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/orA.dhall @@ -0,0 +1,6 @@ +{ example0 = λ(x : Bool) → x || True +, example1 = λ(x : Bool) → True || x +, example2 = λ(x : Bool) → x || False +, example3 = λ(x : Bool) → False || x +, example4 = λ(x : Bool) → x || x +} diff --git a/dhall-lang/tests/normalization/success/simplifications/orB.dhall b/dhall-lang/tests/normalization/success/simplifications/orB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/orB.dhall @@ -0,0 +1,11 @@ +{ example0 = + λ(x : Bool) → True +, example1 = + λ(x : Bool) → True +, example2 = + λ(x : Bool) → x +, example3 = + λ(x : Bool) → x +, example4 = + λ(x : Bool) → x +} diff --git a/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection0A.dhall b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection0A.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool }) → (x ⫽ { c = 0 }).{ a, c }.c diff --git a/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection0B.dhall b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection0B.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool }) → 0 diff --git a/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection1A.dhall b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection1A.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool }) → (x ⫽ { c = 0 }).({ a : Bool, c : Natural }).a diff --git a/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection1B.dhall b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecordProjectionWithinFieldSelection1B.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool }) → x.a diff --git a/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecursiveRecordMergeWithinFieldselectionA.dhall b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecursiveRecordMergeWithinFieldselectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecursiveRecordMergeWithinFieldselectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : {} }) → (x ⫽ { b = 0 } ∧ { a = { c = 1 } }).b diff --git a/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecursiveRecordMergeWithinFieldselectionB.dhall b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecursiveRecordMergeWithinFieldselectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/rightBiasedMergeWithinRecursiveRecordMergeWithinFieldselectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : {} }) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/AssertNormalizeArgumentA.dhall b/dhall-lang/tests/normalization/success/unit/AssertNormalizeArgumentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/AssertNormalizeArgumentA.dhall @@ -0,0 +1,1 @@ +assert : (1 + 1) === (1 + 1) diff --git a/dhall-lang/tests/normalization/success/unit/AssertNormalizeArgumentB.dhall b/dhall-lang/tests/normalization/success/unit/AssertNormalizeArgumentB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/AssertNormalizeArgumentB.dhall @@ -0,0 +1,1 @@ +assert : 2 ≡ 2 diff --git a/dhall-lang/tests/normalization/success/unit/BareInterpolationA.dhall b/dhall-lang/tests/normalization/success/unit/BareInterpolationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BareInterpolationA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "${x}" diff --git a/dhall-lang/tests/normalization/success/unit/BareInterpolationB.dhall b/dhall-lang/tests/normalization/success/unit/BareInterpolationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BareInterpolationB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x diff --git a/dhall-lang/tests/normalization/success/unit/BoolA.dhall b/dhall-lang/tests/normalization/success/unit/BoolA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BoolA.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/normalization/success/unit/BoolB.dhall b/dhall-lang/tests/normalization/success/unit/BoolB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BoolB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/normalization/success/unit/BytesA.dhall b/dhall-lang/tests/normalization/success/unit/BytesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BytesA.dhall @@ -0,0 +1,1 @@ +Bytes diff --git a/dhall-lang/tests/normalization/success/unit/BytesB.dhall b/dhall-lang/tests/normalization/success/unit/BytesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BytesB.dhall @@ -0,0 +1,1 @@ +Bytes diff --git a/dhall-lang/tests/normalization/success/unit/BytesLiteralA.dhall b/dhall-lang/tests/normalization/success/unit/BytesLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BytesLiteralA.dhall @@ -0,0 +1,23 @@ +[ 0x"00" +, 0x"01" +, 0x"02" +, 0x"03" +, 0x"04" +, 0x"05" +, 0x"06" +, 0x"07" +, 0x"08" +, 0x"09" +, 0x"0a" +, 0x"0b" +, 0x"0c" +, 0x"0d" +, 0x"0e" +, 0x"0f" +, 0x"0A" +, 0x"0B" +, 0x"0C" +, 0x"0D" +, 0x"0E" +, 0x"0F" +] diff --git a/dhall-lang/tests/normalization/success/unit/BytesLiteralB.dhall b/dhall-lang/tests/normalization/success/unit/BytesLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/BytesLiteralB.dhall @@ -0,0 +1,23 @@ +[ 0x"00" +, 0x"01" +, 0x"02" +, 0x"03" +, 0x"04" +, 0x"05" +, 0x"06" +, 0x"07" +, 0x"08" +, 0x"09" +, 0x"0a" +, 0x"0b" +, 0x"0c" +, 0x"0d" +, 0x"0e" +, 0x"0f" +, 0x"0A" +, 0x"0B" +, 0x"0C" +, 0x"0D" +, 0x"0E" +, 0x"0F" +] diff --git a/dhall-lang/tests/normalization/success/unit/CompletionA.dhall b/dhall-lang/tests/normalization/success/unit/CompletionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/CompletionA.dhall @@ -0,0 +1,1 @@ +{ default = {=}, Type = {} }::{=} diff --git a/dhall-lang/tests/normalization/success/unit/CompletionB.dhall b/dhall-lang/tests/normalization/success/unit/CompletionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/CompletionB.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/dhall-lang/tests/normalization/success/unit/DoubleA.dhall b/dhall-lang/tests/normalization/success/unit/DoubleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleA.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/normalization/success/unit/DoubleB.dhall b/dhall-lang/tests/normalization/success/unit/DoubleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleB.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/normalization/success/unit/DoubleLiteralA.dhall b/dhall-lang/tests/normalization/success/unit/DoubleLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleLiteralA.dhall @@ -0,0 +1,1 @@ +1.2 diff --git a/dhall-lang/tests/normalization/success/unit/DoubleLiteralB.dhall b/dhall-lang/tests/normalization/success/unit/DoubleLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleLiteralB.dhall @@ -0,0 +1,1 @@ +1.2 diff --git a/dhall-lang/tests/normalization/success/unit/DoubleShowA.dhall b/dhall-lang/tests/normalization/success/unit/DoubleShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleShowA.dhall @@ -0,0 +1,1 @@ +Double/show diff --git a/dhall-lang/tests/normalization/success/unit/DoubleShowB.dhall b/dhall-lang/tests/normalization/success/unit/DoubleShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleShowB.dhall @@ -0,0 +1,1 @@ +Double/show diff --git a/dhall-lang/tests/normalization/success/unit/DoubleShowValueA.dhall b/dhall-lang/tests/normalization/success/unit/DoubleShowValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleShowValueA.dhall @@ -0,0 +1,1 @@ +Double/show 1.2 diff --git a/dhall-lang/tests/normalization/success/unit/DoubleShowValueB.dhall b/dhall-lang/tests/normalization/success/unit/DoubleShowValueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/DoubleShowValueB.dhall @@ -0,0 +1,1 @@ +"1.2" diff --git a/dhall-lang/tests/normalization/success/unit/EmptyAlternativeA.dhall b/dhall-lang/tests/normalization/success/unit/EmptyAlternativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/EmptyAlternativeA.dhall @@ -0,0 +1,1 @@ +merge { x = 1, y = 2 } (< x | y >.x) diff --git a/dhall-lang/tests/normalization/success/unit/EmptyAlternativeB.dhall b/dhall-lang/tests/normalization/success/unit/EmptyAlternativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/EmptyAlternativeB.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/unit/EmptyToMapA.dhall b/dhall-lang/tests/normalization/success/unit/EmptyToMapA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/EmptyToMapA.dhall @@ -0,0 +1,1 @@ +toMap {=} : List {mapKey : Text, mapValue : Natural} diff --git a/dhall-lang/tests/normalization/success/unit/EmptyToMapB.dhall b/dhall-lang/tests/normalization/success/unit/EmptyToMapB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/EmptyToMapB.dhall @@ -0,0 +1,1 @@ +[] : List { mapKey : Text, mapValue : Natural } diff --git a/dhall-lang/tests/normalization/success/unit/EquivalenceNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/EquivalenceNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/EquivalenceNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +(1 + 1) === (1 + 2) diff --git a/dhall-lang/tests/normalization/success/unit/EquivalenceNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/EquivalenceNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/EquivalenceNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +2 ≡ 3 diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationCaptureA.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationCaptureA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationCaptureA.dhall @@ -0,0 +1,1 @@ +(λ(_ : Bool) → λ(_ : Bool) → _@1) True False diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationCaptureB.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationCaptureB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationCaptureB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationNoSubstituteA.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNoSubstituteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNoSubstituteA.dhall @@ -0,0 +1,1 @@ +λ(y : Bool) → (λ(x : Bool) → y) True diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationNoSubstituteB.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNoSubstituteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNoSubstituteB.dhall @@ -0,0 +1,1 @@ +λ(y : Bool) → y diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNormalizeArgumentsA.dhall @@ -0,0 +1,3 @@ + λ(f : Bool → Natural) +→ λ(x : Bool) +→ (if True then f else f) (if True then x else x) diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(f : Bool → Natural) → λ(x : Bool) → f x diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationSubstituteA.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationSubstituteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationSubstituteA.dhall @@ -0,0 +1,1 @@ +(λ(x : Bool) → x) True diff --git a/dhall-lang/tests/normalization/success/unit/FunctionApplicationSubstituteB.dhall b/dhall-lang/tests/normalization/success/unit/FunctionApplicationSubstituteB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionApplicationSubstituteB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/FunctionNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/FunctionNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +let id = λ(X : Type) → X in λ(x : id Bool) → if True then x else x diff --git a/dhall-lang/tests/normalization/success/unit/FunctionNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/FunctionNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/FunctionTypeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/FunctionTypeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionTypeNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +let id = λ(X : Type) → X in id Bool → id Natural diff --git a/dhall-lang/tests/normalization/success/unit/FunctionTypeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/FunctionTypeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/FunctionTypeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Bool → Natural diff --git a/dhall-lang/tests/normalization/success/unit/IfAlternativesIdenticalA.dhall b/dhall-lang/tests/normalization/success/unit/IfAlternativesIdenticalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfAlternativesIdenticalA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Natural) → if x then y else y diff --git a/dhall-lang/tests/normalization/success/unit/IfAlternativesIdenticalB.dhall b/dhall-lang/tests/normalization/success/unit/IfAlternativesIdenticalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfAlternativesIdenticalB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Natural) → y diff --git a/dhall-lang/tests/normalization/success/unit/IfFalseA.dhall b/dhall-lang/tests/normalization/success/unit/IfFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfFalseA.dhall @@ -0,0 +1,1 @@ +if False then 1 else 2 diff --git a/dhall-lang/tests/normalization/success/unit/IfFalseB.dhall b/dhall-lang/tests/normalization/success/unit/IfFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfFalseB.dhall @@ -0,0 +1,1 @@ +2 diff --git a/dhall-lang/tests/normalization/success/unit/IfNormalizePredicateAndBranchesA.dhall b/dhall-lang/tests/normalization/success/unit/IfNormalizePredicateAndBranchesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfNormalizePredicateAndBranchesA.dhall @@ -0,0 +1,4 @@ + λ(b : Bool) +→ λ(x : Natural) +→ λ(y : Natural) +→ if if True then b else b then if True then x else x else if True then y else y diff --git a/dhall-lang/tests/normalization/success/unit/IfNormalizePredicateAndBranchesB.dhall b/dhall-lang/tests/normalization/success/unit/IfNormalizePredicateAndBranchesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfNormalizePredicateAndBranchesB.dhall @@ -0,0 +1,1 @@ +λ(b : Bool) → λ(x : Natural) → λ(y : Natural) → if b then x else y diff --git a/dhall-lang/tests/normalization/success/unit/IfTrivialA.dhall b/dhall-lang/tests/normalization/success/unit/IfTrivialA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfTrivialA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → if x then True else False diff --git a/dhall-lang/tests/normalization/success/unit/IfTrivialB.dhall b/dhall-lang/tests/normalization/success/unit/IfTrivialB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfTrivialB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/IfTrueA.dhall b/dhall-lang/tests/normalization/success/unit/IfTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfTrueA.dhall @@ -0,0 +1,1 @@ +if True then 1 else 2 diff --git a/dhall-lang/tests/normalization/success/unit/IfTrueB.dhall b/dhall-lang/tests/normalization/success/unit/IfTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IfTrueB.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerA.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/normalization/success/unit/IntegerB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerB.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampA.dhall @@ -0,0 +1,1 @@ +Integer/clamp diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampB.dhall @@ -0,0 +1,1 @@ +Integer/clamp diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampNegativeA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampNegativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampNegativeA.dhall @@ -0,0 +1,1 @@ +Integer/clamp -6 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampNegativeB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampNegativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampNegativeB.dhall @@ -0,0 +1,1 @@ +0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampPositiveA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampPositiveA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampPositiveA.dhall @@ -0,0 +1,1 @@ +Integer/clamp +5 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampPositiveB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampPositiveB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampPositiveB.dhall @@ -0,0 +1,1 @@ +5 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampZeroA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampZeroA.dhall @@ -0,0 +1,1 @@ +Integer/clamp +0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerClampZeroB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerClampZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerClampZeroB.dhall @@ -0,0 +1,1 @@ +0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegateA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegateA.dhall @@ -0,0 +1,1 @@ +Integer/negate diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegateB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegateB.dhall @@ -0,0 +1,1 @@ +Integer/negate diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegateNegativeA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegateNegativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegateNegativeA.dhall @@ -0,0 +1,1 @@ +Integer/negate -7 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegateNegativeB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegateNegativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegateNegativeB.dhall @@ -0,0 +1,1 @@ ++7 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegatePositiveA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegatePositiveA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegatePositiveA.dhall @@ -0,0 +1,1 @@ +Integer/negate +3 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegatePositiveB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegatePositiveB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegatePositiveB.dhall @@ -0,0 +1,1 @@ +-3 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegateZeroA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegateZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegateZeroA.dhall @@ -0,0 +1,1 @@ +Integer/negate +0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegateZeroB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegateZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegateZeroB.dhall @@ -0,0 +1,1 @@ ++0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegativeA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegativeA.dhall @@ -0,0 +1,1 @@ +-1 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerNegativeB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerNegativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerNegativeB.dhall @@ -0,0 +1,1 @@ +-1 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerPositiveA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerPositiveA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerPositiveA.dhall @@ -0,0 +1,1 @@ ++1 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerPositiveB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerPositiveB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerPositiveB.dhall @@ -0,0 +1,1 @@ ++1 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerShow-12A.dhall b/dhall-lang/tests/normalization/success/unit/IntegerShow-12A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerShow-12A.dhall @@ -0,0 +1,1 @@ +Integer/show -12 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerShow-12B.dhall b/dhall-lang/tests/normalization/success/unit/IntegerShow-12B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerShow-12B.dhall @@ -0,0 +1,1 @@ +"-12" diff --git a/dhall-lang/tests/normalization/success/unit/IntegerShow12A.dhall b/dhall-lang/tests/normalization/success/unit/IntegerShow12A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerShow12A.dhall @@ -0,0 +1,1 @@ +Integer/show +12 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerShow12B.dhall b/dhall-lang/tests/normalization/success/unit/IntegerShow12B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerShow12B.dhall @@ -0,0 +1,1 @@ +"+12" diff --git a/dhall-lang/tests/normalization/success/unit/IntegerShowA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerShowA.dhall @@ -0,0 +1,1 @@ +Integer/show diff --git a/dhall-lang/tests/normalization/success/unit/IntegerShowB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerShowB.dhall @@ -0,0 +1,1 @@ +Integer/show diff --git a/dhall-lang/tests/normalization/success/unit/IntegerToDouble-12A.dhall b/dhall-lang/tests/normalization/success/unit/IntegerToDouble-12A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerToDouble-12A.dhall @@ -0,0 +1,1 @@ +Integer/toDouble -12 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerToDouble-12B.dhall b/dhall-lang/tests/normalization/success/unit/IntegerToDouble-12B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerToDouble-12B.dhall @@ -0,0 +1,1 @@ +-12.0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerToDouble12A.dhall b/dhall-lang/tests/normalization/success/unit/IntegerToDouble12A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerToDouble12A.dhall @@ -0,0 +1,1 @@ +Integer/toDouble +12 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerToDouble12B.dhall b/dhall-lang/tests/normalization/success/unit/IntegerToDouble12B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerToDouble12B.dhall @@ -0,0 +1,1 @@ +12.0 diff --git a/dhall-lang/tests/normalization/success/unit/IntegerToDoubleA.dhall b/dhall-lang/tests/normalization/success/unit/IntegerToDoubleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerToDoubleA.dhall @@ -0,0 +1,1 @@ +Integer/toDouble diff --git a/dhall-lang/tests/normalization/success/unit/IntegerToDoubleB.dhall b/dhall-lang/tests/normalization/success/unit/IntegerToDoubleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/IntegerToDoubleB.dhall @@ -0,0 +1,1 @@ +Integer/toDouble diff --git a/dhall-lang/tests/normalization/success/unit/KindA.dhall b/dhall-lang/tests/normalization/success/unit/KindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/KindA.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/normalization/success/unit/KindB.dhall b/dhall-lang/tests/normalization/success/unit/KindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/KindB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/normalization/success/unit/LetA.dhall b/dhall-lang/tests/normalization/success/unit/LetA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/LetA.dhall @@ -0,0 +1,1 @@ +λ(y : Bool) → let x = y in x diff --git a/dhall-lang/tests/normalization/success/unit/LetB.dhall b/dhall-lang/tests/normalization/success/unit/LetB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/LetB.dhall @@ -0,0 +1,1 @@ +λ(y : Bool) → y diff --git a/dhall-lang/tests/normalization/success/unit/LetWithTypeA.dhall b/dhall-lang/tests/normalization/success/unit/LetWithTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/LetWithTypeA.dhall @@ -0,0 +1,1 @@ +λ(y : Bool) → let x : Bool = y in x diff --git a/dhall-lang/tests/normalization/success/unit/LetWithTypeB.dhall b/dhall-lang/tests/normalization/success/unit/LetWithTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/LetWithTypeB.dhall @@ -0,0 +1,1 @@ +λ(y : Bool) → y diff --git a/dhall-lang/tests/normalization/success/unit/ListA.dhall b/dhall-lang/tests/normalization/success/unit/ListA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListA.dhall @@ -0,0 +1,1 @@ +List diff --git a/dhall-lang/tests/normalization/success/unit/ListB.dhall b/dhall-lang/tests/normalization/success/unit/ListB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListB.dhall @@ -0,0 +1,1 @@ +List diff --git a/dhall-lang/tests/normalization/success/unit/ListBuildA.dhall b/dhall-lang/tests/normalization/success/unit/ListBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListBuildA.dhall @@ -0,0 +1,1 @@ +List/build diff --git a/dhall-lang/tests/normalization/success/unit/ListBuildB.dhall b/dhall-lang/tests/normalization/success/unit/ListBuildB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListBuildB.dhall @@ -0,0 +1,1 @@ +List/build diff --git a/dhall-lang/tests/normalization/success/unit/ListBuildFoldFusionA.dhall b/dhall-lang/tests/normalization/success/unit/ListBuildFoldFusionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListBuildFoldFusionA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : List T) → List/build T (List/fold T x) diff --git a/dhall-lang/tests/normalization/success/unit/ListBuildFoldFusionB.dhall b/dhall-lang/tests/normalization/success/unit/ListBuildFoldFusionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListBuildFoldFusionB.dhall @@ -0,0 +1,8 @@ + λ(T : Type) +→ λ(x : List T) +→ List/fold + T + x + (List T) + (λ(a : T) → λ(`as` : List T) → [ a ] # `as`) + ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListBuildImplementationA.dhall b/dhall-lang/tests/normalization/success/unit/ListBuildImplementationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListBuildImplementationA.dhall @@ -0,0 +1,3 @@ + λ(T : Type) +→ λ(f : ∀(list : Type) → (T → list → list) → list → list) +→ List/build T f diff --git a/dhall-lang/tests/normalization/success/unit/ListBuildImplementationB.dhall b/dhall-lang/tests/normalization/success/unit/ListBuildImplementationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListBuildImplementationB.dhall @@ -0,0 +1,3 @@ + λ(T : Type) +→ λ(f : ∀(list : Type) → (T → list → list) → list → list) +→ f (List T) (λ(a : T) → λ(`as` : List T) → [ a ] # `as`) ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListFoldA.dhall b/dhall-lang/tests/normalization/success/unit/ListFoldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListFoldA.dhall @@ -0,0 +1,1 @@ +List/fold diff --git a/dhall-lang/tests/normalization/success/unit/ListFoldB.dhall b/dhall-lang/tests/normalization/success/unit/ListFoldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListFoldB.dhall @@ -0,0 +1,1 @@ +List/fold diff --git a/dhall-lang/tests/normalization/success/unit/ListFoldEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ListFoldEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListFoldEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool → Bool) → List/fold T ([] : List T) Bool f True diff --git a/dhall-lang/tests/normalization/success/unit/ListFoldEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ListFoldEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListFoldEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool → Bool) → True diff --git a/dhall-lang/tests/normalization/success/unit/ListFoldOneA.dhall b/dhall-lang/tests/normalization/success/unit/ListFoldOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListFoldOneA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool → Bool) → λ(x : T) → List/fold T [ x ] Bool f True diff --git a/dhall-lang/tests/normalization/success/unit/ListFoldOneB.dhall b/dhall-lang/tests/normalization/success/unit/ListFoldOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListFoldOneB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool → Bool) → λ(x : T) → f x True diff --git a/dhall-lang/tests/normalization/success/unit/ListHeadA.dhall b/dhall-lang/tests/normalization/success/unit/ListHeadA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListHeadA.dhall @@ -0,0 +1,1 @@ +List/head diff --git a/dhall-lang/tests/normalization/success/unit/ListHeadB.dhall b/dhall-lang/tests/normalization/success/unit/ListHeadB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListHeadB.dhall @@ -0,0 +1,1 @@ +List/head diff --git a/dhall-lang/tests/normalization/success/unit/ListHeadEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ListHeadEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListHeadEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → List/head T ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListHeadEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ListHeadEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListHeadEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → None T diff --git a/dhall-lang/tests/normalization/success/unit/ListHeadTwoA.dhall b/dhall-lang/tests/normalization/success/unit/ListHeadTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListHeadTwoA.dhall @@ -0,0 +1,1 @@ +List/head Natural [ 1, 2 ] diff --git a/dhall-lang/tests/normalization/success/unit/ListHeadTwoB.dhall b/dhall-lang/tests/normalization/success/unit/ListHeadTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListHeadTwoB.dhall @@ -0,0 +1,1 @@ +Some 1 diff --git a/dhall-lang/tests/normalization/success/unit/ListIndexedA.dhall b/dhall-lang/tests/normalization/success/unit/ListIndexedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListIndexedA.dhall @@ -0,0 +1,1 @@ +List/indexed diff --git a/dhall-lang/tests/normalization/success/unit/ListIndexedB.dhall b/dhall-lang/tests/normalization/success/unit/ListIndexedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListIndexedB.dhall @@ -0,0 +1,1 @@ +List/indexed diff --git a/dhall-lang/tests/normalization/success/unit/ListIndexedEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ListIndexedEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListIndexedEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → List/indexed T ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListIndexedEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ListIndexedEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListIndexedEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → [] : List { index : Natural, value : T } diff --git a/dhall-lang/tests/normalization/success/unit/ListIndexedOneA.dhall b/dhall-lang/tests/normalization/success/unit/ListIndexedOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListIndexedOneA.dhall @@ -0,0 +1,1 @@ +List/indexed Natural [ 1 ] diff --git a/dhall-lang/tests/normalization/success/unit/ListIndexedOneB.dhall b/dhall-lang/tests/normalization/success/unit/ListIndexedOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListIndexedOneB.dhall @@ -0,0 +1,1 @@ +[ { index = 0, value = 1 } ] diff --git a/dhall-lang/tests/normalization/success/unit/ListLastA.dhall b/dhall-lang/tests/normalization/success/unit/ListLastA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLastA.dhall @@ -0,0 +1,1 @@ +List/last diff --git a/dhall-lang/tests/normalization/success/unit/ListLastB.dhall b/dhall-lang/tests/normalization/success/unit/ListLastB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLastB.dhall @@ -0,0 +1,1 @@ +List/last diff --git a/dhall-lang/tests/normalization/success/unit/ListLastEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ListLastEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLastEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → List/last T ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListLastEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ListLastEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLastEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → None T diff --git a/dhall-lang/tests/normalization/success/unit/ListLastTwoA.dhall b/dhall-lang/tests/normalization/success/unit/ListLastTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLastTwoA.dhall @@ -0,0 +1,1 @@ +List/last Natural [ 1, 2 ] diff --git a/dhall-lang/tests/normalization/success/unit/ListLastTwoB.dhall b/dhall-lang/tests/normalization/success/unit/ListLastTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLastTwoB.dhall @@ -0,0 +1,1 @@ +Some 2 diff --git a/dhall-lang/tests/normalization/success/unit/ListLengthA.dhall b/dhall-lang/tests/normalization/success/unit/ListLengthA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLengthA.dhall @@ -0,0 +1,1 @@ +List/length diff --git a/dhall-lang/tests/normalization/success/unit/ListLengthB.dhall b/dhall-lang/tests/normalization/success/unit/ListLengthB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLengthB.dhall @@ -0,0 +1,1 @@ +List/length diff --git a/dhall-lang/tests/normalization/success/unit/ListLengthEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ListLengthEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLengthEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → List/length T ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListLengthEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ListLengthEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLengthEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/ListLengthOneA.dhall b/dhall-lang/tests/normalization/success/unit/ListLengthOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLengthOneA.dhall @@ -0,0 +1,1 @@ +List/length Natural [ 1 ] diff --git a/dhall-lang/tests/normalization/success/unit/ListLengthOneB.dhall b/dhall-lang/tests/normalization/success/unit/ListLengthOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListLengthOneB.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/unit/ListNormalizeElementsA.dhall b/dhall-lang/tests/normalization/success/unit/ListNormalizeElementsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListNormalizeElementsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → [ if True then x else x ] diff --git a/dhall-lang/tests/normalization/success/unit/ListNormalizeElementsB.dhall b/dhall-lang/tests/normalization/success/unit/ListNormalizeElementsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListNormalizeElementsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → [ x ] diff --git a/dhall-lang/tests/normalization/success/unit/ListNormalizeTypeAnnotationA.dhall b/dhall-lang/tests/normalization/success/unit/ListNormalizeTypeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListNormalizeTypeAnnotationA.dhall @@ -0,0 +1,1 @@ +[] : { x = List Bool }.x diff --git a/dhall-lang/tests/normalization/success/unit/ListNormalizeTypeAnnotationB.dhall b/dhall-lang/tests/normalization/success/unit/ListNormalizeTypeAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListNormalizeTypeAnnotationB.dhall @@ -0,0 +1,1 @@ +[] : List Bool diff --git a/dhall-lang/tests/normalization/success/unit/ListReverseA.dhall b/dhall-lang/tests/normalization/success/unit/ListReverseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListReverseA.dhall @@ -0,0 +1,1 @@ +List/reverse diff --git a/dhall-lang/tests/normalization/success/unit/ListReverseB.dhall b/dhall-lang/tests/normalization/success/unit/ListReverseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListReverseB.dhall @@ -0,0 +1,1 @@ +List/reverse diff --git a/dhall-lang/tests/normalization/success/unit/ListReverseEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ListReverseEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListReverseEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → List/reverse T ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/ListReverseEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ListReverseEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListReverseEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → [] : List T diff --git a/dhall-lang/tests/normalization/success/unit/ListReverseTwoA.dhall b/dhall-lang/tests/normalization/success/unit/ListReverseTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListReverseTwoA.dhall @@ -0,0 +1,1 @@ +List/reverse Natural [ 1, 2 ] diff --git a/dhall-lang/tests/normalization/success/unit/ListReverseTwoB.dhall b/dhall-lang/tests/normalization/success/unit/ListReverseTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ListReverseTwoB.dhall @@ -0,0 +1,1 @@ +[ 2, 1 ] diff --git a/dhall-lang/tests/normalization/success/unit/MergeA.dhall b/dhall-lang/tests/normalization/success/unit/MergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool) → λ(x : T) → merge { a = f } (< a : T >.a x) diff --git a/dhall-lang/tests/normalization/success/unit/MergeB.dhall b/dhall-lang/tests/normalization/success/unit/MergeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool) → λ(x : T) → f x diff --git a/dhall-lang/tests/normalization/success/unit/MergeEmptyAlternativeA.dhall b/dhall-lang/tests/normalization/success/unit/MergeEmptyAlternativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeEmptyAlternativeA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → merge { a = x } < a >.a diff --git a/dhall-lang/tests/normalization/success/unit/MergeEmptyAlternativeB.dhall b/dhall-lang/tests/normalization/success/unit/MergeEmptyAlternativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeEmptyAlternativeB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/MergeNoneA.dhall b/dhall-lang/tests/normalization/success/unit/MergeNoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeNoneA.dhall @@ -0,0 +1,1 @@ +merge { None = False, Some = \(b : Bool) -> b } (None Bool) diff --git a/dhall-lang/tests/normalization/success/unit/MergeNoneB.dhall b/dhall-lang/tests/normalization/success/unit/MergeNoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeNoneB.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/normalization/success/unit/MergeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/MergeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeNormalizeArgumentsA.dhall @@ -0,0 +1,3 @@ + λ(x : { a : Bool }) +→ λ(y : < a >) +→ merge (if True then x else x) (if True then y else y) diff --git a/dhall-lang/tests/normalization/success/unit/MergeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/MergeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : < a >) → merge x y diff --git a/dhall-lang/tests/normalization/success/unit/MergeSomeA.dhall b/dhall-lang/tests/normalization/success/unit/MergeSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeSomeA.dhall @@ -0,0 +1,1 @@ +merge { None = False, Some = \(b : Bool) -> b } (Some True) diff --git a/dhall-lang/tests/normalization/success/unit/MergeSomeB.dhall b/dhall-lang/tests/normalization/success/unit/MergeSomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeSomeB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/MergeWithTypeA.dhall b/dhall-lang/tests/normalization/success/unit/MergeWithTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeWithTypeA.dhall @@ -0,0 +1,4 @@ + λ(T : Type) +→ λ(f : T → Bool) +→ λ(x : T) +→ merge { a = f } (< a : T >.a x) : Bool diff --git a/dhall-lang/tests/normalization/success/unit/MergeWithTypeB.dhall b/dhall-lang/tests/normalization/success/unit/MergeWithTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeWithTypeB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(f : T → Bool) → λ(x : T) → f x diff --git a/dhall-lang/tests/normalization/success/unit/MergeWithTypeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/MergeWithTypeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeWithTypeNormalizeArgumentsA.dhall @@ -0,0 +1,5 @@ +let id = λ(X : Type) → X + +in λ(x : { a : Bool }) + → λ(y : < a >) + → merge (if True then x else x) (if True then y else y) : id Bool diff --git a/dhall-lang/tests/normalization/success/unit/MergeWithTypeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/MergeWithTypeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/MergeWithTypeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : < a >) → merge x y : Bool diff --git a/dhall-lang/tests/normalization/success/unit/NaturalA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalA.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/normalization/success/unit/NaturalB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/normalization/success/unit/NaturalBuildA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalBuildA.dhall @@ -0,0 +1,1 @@ +Natural/build diff --git a/dhall-lang/tests/normalization/success/unit/NaturalBuildB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalBuildB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalBuildB.dhall @@ -0,0 +1,1 @@ +Natural/build diff --git a/dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → Natural/build (Natural/fold x) diff --git a/dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → Natural/fold x Natural (λ(x : Natural) → x + 1) 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalBuildImplementationA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalBuildImplementationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalBuildImplementationA.dhall @@ -0,0 +1,2 @@ + λ(f : ∀(natural : Type) → (natural → natural) → natural → natural) +→ Natural/build f diff --git a/dhall-lang/tests/normalization/success/unit/NaturalBuildImplementationB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalBuildImplementationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalBuildImplementationB.dhall @@ -0,0 +1,2 @@ + λ(f : ∀(natural : Type) → (natural → natural) → natural → natural) +→ f Natural (λ(x : Natural) → x + 1) 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalEvenA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalEvenA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalEvenA.dhall @@ -0,0 +1,1 @@ +Natural/even diff --git a/dhall-lang/tests/normalization/success/unit/NaturalEvenB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalEvenB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalEvenB.dhall @@ -0,0 +1,1 @@ +Natural/even diff --git a/dhall-lang/tests/normalization/success/unit/NaturalEvenOneA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalEvenOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalEvenOneA.dhall @@ -0,0 +1,1 @@ +Natural/even 1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalEvenOneB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalEvenOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalEvenOneB.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/normalization/success/unit/NaturalEvenZeroA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalEvenZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalEvenZeroA.dhall @@ -0,0 +1,1 @@ +Natural/even 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalEvenZeroB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalEvenZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalEvenZeroB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/NaturalFoldA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalFoldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalFoldA.dhall @@ -0,0 +1,1 @@ +Natural/fold diff --git a/dhall-lang/tests/normalization/success/unit/NaturalFoldB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalFoldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalFoldB.dhall @@ -0,0 +1,1 @@ +Natural/fold diff --git a/dhall-lang/tests/normalization/success/unit/NaturalFoldOneA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalFoldOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalFoldOneA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → Natural/fold 1 Bool (λ(_ : Bool) → True) x diff --git a/dhall-lang/tests/normalization/success/unit/NaturalFoldOneB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalFoldOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalFoldOneB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True diff --git a/dhall-lang/tests/normalization/success/unit/NaturalFoldZeroA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalFoldZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalFoldZeroA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → Natural/fold 0 Bool (λ(_ : Bool) → True) x diff --git a/dhall-lang/tests/normalization/success/unit/NaturalFoldZeroB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalFoldZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalFoldZeroB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/NaturalIsZeroA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroA.dhall @@ -0,0 +1,1 @@ +Natural/isZero diff --git a/dhall-lang/tests/normalization/success/unit/NaturalIsZeroB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroB.dhall @@ -0,0 +1,1 @@ +Natural/isZero diff --git a/dhall-lang/tests/normalization/success/unit/NaturalIsZeroOneA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroOneA.dhall @@ -0,0 +1,1 @@ +Natural/isZero 1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalIsZeroOneB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroOneB.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/normalization/success/unit/NaturalIsZeroZeroA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroZeroA.dhall @@ -0,0 +1,1 @@ +Natural/isZero 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalIsZeroZeroB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalIsZeroZeroB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/NaturalLiteralA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalLiteralA.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalLiteralB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalLiteralB.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalOddA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalOddA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalOddA.dhall @@ -0,0 +1,1 @@ +Natural/odd diff --git a/dhall-lang/tests/normalization/success/unit/NaturalOddB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalOddB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalOddB.dhall @@ -0,0 +1,1 @@ +Natural/odd diff --git a/dhall-lang/tests/normalization/success/unit/NaturalOddOneA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalOddOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalOddOneA.dhall @@ -0,0 +1,1 @@ +Natural/odd 1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalOddOneB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalOddOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalOddOneB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/NaturalOddZeroA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalOddZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalOddZeroA.dhall @@ -0,0 +1,1 @@ +Natural/odd 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalOddZeroB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalOddZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalOddZeroB.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/normalization/success/unit/NaturalShowA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalShowA.dhall @@ -0,0 +1,1 @@ +Natural/show diff --git a/dhall-lang/tests/normalization/success/unit/NaturalShowB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalShowB.dhall @@ -0,0 +1,1 @@ +Natural/show diff --git a/dhall-lang/tests/normalization/success/unit/NaturalShowOneA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalShowOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalShowOneA.dhall @@ -0,0 +1,1 @@ +Natural/show 1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalShowOneB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalShowOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalShowOneB.dhall @@ -0,0 +1,1 @@ +"1" diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractEquivalentA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractEquivalentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractEquivalentA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → Natural/subtract x x diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractEquivalentB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractEquivalentB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractEquivalentB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractFromZeroA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractFromZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractFromZeroA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → Natural/subtract x 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractFromZeroB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractFromZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractFromZeroB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractGreaterA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractGreaterA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractGreaterA.dhall @@ -0,0 +1,1 @@ +Natural/subtract 3 10 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractGreaterB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractGreaterB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractGreaterB.dhall @@ -0,0 +1,1 @@ +7 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractLessA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractLessA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractLessA.dhall @@ -0,0 +1,1 @@ +Natural/subtract 3 2 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractLessB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractLessB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractLessB.dhall @@ -0,0 +1,1 @@ +0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractNormalizeA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractNormalizeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractNormalizeA.dhall @@ -0,0 +1,3 @@ + λ(x : Natural) +→ λ(y : Natural) +→ Natural/subtract (if True then x else y) (10 + 20) diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractNormalizeB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractNormalizeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractNormalizeB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → λ(y : Natural) → Natural/subtract x 30 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero0A.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero0A.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → Natural/subtract 0 x diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero0B.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero0B.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero1A.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero1A.dhall @@ -0,0 +1,1 @@ +Natural/subtract 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero1B.dhall b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalSubtractZero1B.dhall @@ -0,0 +1,1 @@ +Natural/subtract 0 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalToIntegerA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerA.dhall @@ -0,0 +1,1 @@ +Natural/toInteger diff --git a/dhall-lang/tests/normalization/success/unit/NaturalToIntegerB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerB.dhall @@ -0,0 +1,1 @@ +Natural/toInteger diff --git a/dhall-lang/tests/normalization/success/unit/NaturalToIntegerOneA.dhall b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerOneA.dhall @@ -0,0 +1,1 @@ +Natural/toInteger 1 diff --git a/dhall-lang/tests/normalization/success/unit/NaturalToIntegerOneB.dhall b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NaturalToIntegerOneB.dhall @@ -0,0 +1,1 @@ ++1 diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionA.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a, b }.{ a } diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionB.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a } diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeA.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeA.dhall @@ -0,0 +1,2 @@ + λ(x : { a : Bool, b : Bool, c : Bool }) +→ x.({ a : Bool, b : Bool }).({ a : Bool }) diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeB.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a } diff --git a/dhall-lang/tests/normalization/success/unit/NoneA.dhall b/dhall-lang/tests/normalization/success/unit/NoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NoneA.dhall @@ -0,0 +1,1 @@ +None diff --git a/dhall-lang/tests/normalization/success/unit/NoneB.dhall b/dhall-lang/tests/normalization/success/unit/NoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NoneB.dhall @@ -0,0 +1,1 @@ +None diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndEquivalentArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndEquivalentArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndEquivalentArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x && x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndEquivalentArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndEquivalentArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndEquivalentArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndLhsFalseA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsFalseA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → False && x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndLhsFalseB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsFalseB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → False diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndLhsTrueA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsTrueA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True && x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndLhsTrueB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndLhsTrueB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → True && x && (True && y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → x && y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndRhsFalseA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsFalseA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x && False diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndRhsFalseB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsFalseB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → False diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndRhsTrueA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsTrueA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x && True diff --git a/dhall-lang/tests/normalization/success/unit/OperatorAndRhsTrueB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorAndRhsTrueB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualEquivalentArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualEquivalentArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualEquivalentArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x == x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualEquivalentArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualEquivalentArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualEquivalentArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualLhsTrueA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualLhsTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualLhsTrueA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x == True diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualLhsTrueB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualLhsTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualLhsTrueB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → True == x == (True == y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → x == y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualRhsTrueA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualRhsTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualRhsTrueA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True == x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorEqualRhsTrueB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorEqualRhsTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorEqualRhsTrueB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateLhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateLhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateLhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : List T) → x # ([] : List T) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateLhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateLhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateLhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : List T) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateListListA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateListListA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateListListA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : T) → λ(y : T) → [ x ] # [ y ] diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateListListB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateListListB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateListListB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : T) → λ(y : T) → [ x, y ] diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateNormalizeArgumentsA.dhall @@ -0,0 +1,4 @@ + λ(T : Type) +→ λ(x : List T) +→ λ(y : List T) +→ ([] : List T) # x # (([] : List T) # y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : List T) → λ(y : List T) → x # y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateRhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateRhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : List T) → ([] : List T) # x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateRhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorListConcatenateRhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → λ(x : List T) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualEquivalentArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualEquivalentArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualEquivalentArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x != x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualEquivalentArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualEquivalentArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualEquivalentArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → False diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualLhsFalseA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualLhsFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualLhsFalseA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → False != x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualLhsFalseB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualLhsFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualLhsFalseB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → False != x != (False != y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → x != y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualRhsFalseA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualRhsFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualRhsFalseA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x != False diff --git a/dhall-lang/tests/normalization/success/unit/OperatorNotEqualRhsFalseB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualRhsFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorNotEqualRhsFalseB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrEquivalentArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrEquivalentArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrEquivalentArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x || x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrEquivalentArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrEquivalentArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrEquivalentArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrLhsFalseA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsFalseA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → False || x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrLhsFalseB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsFalseB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrLhsTrueA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsTrueA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True || x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrLhsTrueB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrLhsTrueB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → False || x || (False || y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → x || y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrRhsFalseA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsFalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsFalseA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x || False diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrRhsFalseB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsFalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsFalseB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrRhsTrueA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsTrueA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x || True diff --git a/dhall-lang/tests/normalization/success/unit/OperatorOrRhsTrueB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorOrRhsTrueB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → True diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusLhsZeroA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusLhsZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusLhsZeroA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 0 + x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusLhsZeroB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusLhsZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusLhsZeroB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → λ(y : Natural) → 0 + x + (0 + y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → λ(y : Natural) → x + y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneA.dhall @@ -0,0 +1,1 @@ +1 + 1 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusOneAndOneB.dhall @@ -0,0 +1,1 @@ +2 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusRhsZeroA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusRhsZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusRhsZeroA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x + 0 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorPlusRhsZeroB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorPlusRhsZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorPlusRhsZeroB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "" ++ x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsNonEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsNonEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsNonEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "hai" ++ x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsNonEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsNonEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateLhsNonEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "hai${x}" diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x ++ "" diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsNonEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsNonEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsNonEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x ++ "hai" diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsNonEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsNonEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateRhsNonEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "${x}hai" diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateTextTextA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateTextTextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateTextTextA.dhall @@ -0,0 +1,1 @@ +"x" ++ "y" diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateTextTextB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateTextTextB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTextConcatenateTextTextB.dhall @@ -0,0 +1,1 @@ +"xy" diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsOneA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsOneA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 1 * x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsOneB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsOneB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsZeroA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsZeroA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 0 * x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsZeroB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesLhsZeroB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → λ(y : Natural) → 1 * x * (1 * y) diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → λ(y : Natural) → x * y diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsOneA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsOneA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x * 1 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsOneB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsOneB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsZeroA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsZeroA.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → x * 0 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsZeroB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesRhsZeroB.dhall @@ -0,0 +1,1 @@ +λ(x : Natural) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesTwoAndTwoA.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesTwoAndTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesTwoAndTwoA.dhall @@ -0,0 +1,1 @@ +2 * 2 diff --git a/dhall-lang/tests/normalization/success/unit/OperatorTimesTwoAndTwoB.dhall b/dhall-lang/tests/normalization/success/unit/OperatorTimesTwoAndTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OperatorTimesTwoAndTwoB.dhall @@ -0,0 +1,1 @@ +4 diff --git a/dhall-lang/tests/normalization/success/unit/OptionalA.dhall b/dhall-lang/tests/normalization/success/unit/OptionalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OptionalA.dhall @@ -0,0 +1,1 @@ +Optional diff --git a/dhall-lang/tests/normalization/success/unit/OptionalB.dhall b/dhall-lang/tests/normalization/success/unit/OptionalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/OptionalB.dhall @@ -0,0 +1,1 @@ +Optional diff --git a/dhall-lang/tests/normalization/success/unit/RecordA.dhall b/dhall-lang/tests/normalization/success/unit/RecordA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → { a = if True then x else x, b = x } diff --git a/dhall-lang/tests/normalization/success/unit/RecordB.dhall b/dhall-lang/tests/normalization/success/unit/RecordB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → { a = x, b = x } diff --git a/dhall-lang/tests/normalization/success/unit/RecordEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecordEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordEmptyA.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/dhall-lang/tests/normalization/success/unit/RecordEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecordEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordEmptyB.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsA.dhall @@ -0,0 +1,1 @@ +let x = { y = 1 } in { x, x.z = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsB.dhall @@ -0,0 +1,1 @@ +{ x = { y = 1, z = 2 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitDottedFieldsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitDottedFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitDottedFieldsA.dhall @@ -0,0 +1,1 @@ +{ x.y.z = True } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitDottedFieldsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitDottedFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitDottedFieldsB.dhall @@ -0,0 +1,1 @@ +{ x = { y = { z = True } } } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitDuplicateFieldsNoCollisionsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitDuplicateFieldsNoCollisionsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitDuplicateFieldsNoCollisionsA.dhall @@ -0,0 +1,9 @@ +{- This expression desugars to: + + { x = { y = 0 } ∧ { z = 0 } } + + ... which then β-normalizes to: + + { x = { y = 0, z = 0 } } +-} +{ x = { y = 0 }, x = { z = 0 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitDuplicateFieldsNoCollisionsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitDuplicateFieldsNoCollisionsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitDuplicateFieldsNoCollisionsB.dhall @@ -0,0 +1,1 @@ +{ x = { y = 0, z = 0 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitNixLikeA.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitNixLikeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitNixLikeA.dhall @@ -0,0 +1,4 @@ +{- The purpose of this test is to verify that the Nix-like idiom of setting + multiple overlapping dotted fields works correctly +-} +{ x.y = 1, x.z = True } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitNixLikeB.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitNixLikeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitNixLikeB.dhall @@ -0,0 +1,1 @@ +{ x = { y = 1, z = True } } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitPun1A.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitPun1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitPun1A.dhall @@ -0,0 +1,1 @@ +let x = 0 in { x } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitPun1B.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitPun1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitPun1B.dhall @@ -0,0 +1,1 @@ +{ x = 0 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitPun2A.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitPun2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitPun2A.dhall @@ -0,0 +1,1 @@ +let x = 0 let y = 1 in { x, y, z = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitPun2B.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitPun2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitPun2B.dhall @@ -0,0 +1,1 @@ +{ x = 0, y = 1, z = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitTriplicateFieldsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitTriplicateFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitTriplicateFieldsA.dhall @@ -0,0 +1,7 @@ +{- This test ensures that an implementation handles more than one duplicate + field correctly and combines them with the correct order and associativity +-} + λ(a : { x : Natural }) +→ λ(b : { y : Natural }) +→ λ(c : { z : Natural }) +→ { k = a, k = b, k = c } diff --git a/dhall-lang/tests/normalization/success/unit/RecordLitTriplicateFieldsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordLitTriplicateFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordLitTriplicateFieldsB.dhall @@ -0,0 +1,4 @@ + λ(a : { x : Natural }) +→ λ(b : { y : Natural }) +→ λ(c : { z : Natural }) +→ { k = a ∧ b ∧ c } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionA.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = 2, z = 3 }.{ x, z } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionB.dhall @@ -0,0 +1,1 @@ +{ x = 1, z = 3 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeEmptyA.dhall @@ -0,0 +1,1 @@ +{ a = 10, b = Some 10 }.({}) diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeEmptyB.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNonEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNonEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNonEmptyA.dhall @@ -0,0 +1,1 @@ +{ a = 10, b = Some 10, c = [ "text" ]}.({ a : Natural, b : Optional Natural }) diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNonEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNonEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNonEmptyB.dhall @@ -0,0 +1,1 @@ +{ a = 10, b = Some 10 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNormalizeProjectionA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNormalizeProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNormalizeProjectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.({ a : Bool, b : Bool }) diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNormalizeProjectionB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNormalizeProjectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeNormalizeProjectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a, b } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeWithinFieldSelectionA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeWithinFieldSelectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeWithinFieldSelectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.({ a : Bool, b : Bool }).a diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeWithinFieldSelectionB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeWithinFieldSelectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionByTypeWithinFieldSelectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.a diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x.{} diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → {=} diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → (if True then x else x).{ a, b } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a, b } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeFieldsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeFieldsA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ c, a } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeFieldsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionNormalizeFieldsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a, c } diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionWithinFieldSelectionA.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionWithinFieldSelectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionWithinFieldSelectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a, b }.a diff --git a/dhall-lang/tests/normalization/success/unit/RecordProjectionWithinFieldSelectionB.dhall b/dhall-lang/tests/normalization/success/unit/RecordProjectionWithinFieldSelectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordProjectionWithinFieldSelectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.a diff --git a/dhall-lang/tests/normalization/success/unit/RecordSelectionA.dhall b/dhall-lang/tests/normalization/success/unit/RecordSelectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordSelectionA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → { a = x }.a diff --git a/dhall-lang/tests/normalization/success/unit/RecordSelectionB.dhall b/dhall-lang/tests/normalization/success/unit/RecordSelectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordSelectionB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/RecordSelectionNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordSelectionNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordSelectionNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : { a : Bool }) → (if True then x else y).a diff --git a/dhall-lang/tests/normalization/success/unit/RecordSelectionNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordSelectionNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordSelectionNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : { a : Bool }) → x.a diff --git a/dhall-lang/tests/normalization/success/unit/RecordSortFieldsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordSortFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordSortFieldsA.dhall @@ -0,0 +1,1 @@ +{ b = 1, a = 0 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordSortFieldsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordSortFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordSortFieldsB.dhall @@ -0,0 +1,1 @@ +{ a = 0, b = 1 } diff --git a/dhall-lang/tests/normalization/success/unit/RecordTypeA.dhall b/dhall-lang/tests/normalization/success/unit/RecordTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordTypeA.dhall @@ -0,0 +1,1 @@ +let id = λ(X : Type) → X in λ(T : Type) → { a : id Bool, b : T } diff --git a/dhall-lang/tests/normalization/success/unit/RecordTypeB.dhall b/dhall-lang/tests/normalization/success/unit/RecordTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordTypeB.dhall @@ -0,0 +1,1 @@ +λ(T : Type) → { a : Bool, b : T } diff --git a/dhall-lang/tests/normalization/success/unit/RecordTypeEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecordTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordTypeEmptyA.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/normalization/success/unit/RecordTypeEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecordTypeEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordTypeEmptyB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/normalization/success/unit/RecordTypeSortFieldsA.dhall b/dhall-lang/tests/normalization/success/unit/RecordTypeSortFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordTypeSortFieldsA.dhall @@ -0,0 +1,1 @@ +{ b : Bool, a : Natural } diff --git a/dhall-lang/tests/normalization/success/unit/RecordTypeSortFieldsB.dhall b/dhall-lang/tests/normalization/success/unit/RecordTypeSortFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecordTypeSortFieldsB.dhall @@ -0,0 +1,1 @@ +{ a : Natural, b : Bool } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeCollisionA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeCollisionA.dhall @@ -0,0 +1,1 @@ +{ x = { z = 1 } } ∧ { x = { y = 2 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeCollisionB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeCollisionB.dhall @@ -0,0 +1,1 @@ +{ x = { y = 2, z = 1 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeLhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeLhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeLhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → {=} ∧ x diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeLhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeLhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeLhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNoCollisionA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNoCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNoCollisionA.dhall @@ -0,0 +1,1 @@ +{ x = { a = 1 } } ∧ { y = { b = 2 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNoCollisionB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNoCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNoCollisionB.dhall @@ -0,0 +1,1 @@ +{ x = { a = 1 }, y = { b = 2 } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : { b : Bool }) → x ∧ {=} ∧ ({=} ∧ y) diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : { b : Bool }) → x ∧ y diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeRhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeRhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x ∧ {=} diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeRhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeRhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection0A.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection0A.dhall @@ -0,0 +1,1 @@ +λ(x : { c : Bool }) → (x ∧ { a = 0, b = 1 }).a diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection0B.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection0B.dhall @@ -0,0 +1,1 @@ +λ(x : { c : Bool }) → (x ∧ { a = 0 }).a diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection1A.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection1A.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → (x ∧ { a = 1 }).b diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection1B.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection1B.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → x.b diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection2A.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection2A.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → ({ a = 1 } ∧ x).b diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection2B.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection2B.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → x.b diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection3A.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection3A.dhall @@ -0,0 +1,1 @@ +λ(x : { c : Bool }) → ({ a = 0, b = 1 } ∧ x).a diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection3B.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordMergeWithinFieldSelection3B.dhall @@ -0,0 +1,1 @@ +λ(x : { c : Bool }) → ({ a = 0 } ∧ x).a diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeCollisionA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeCollisionA.dhall @@ -0,0 +1,1 @@ +{ x : { z : Bool } } ⩓ { x : { y : Natural } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeCollisionB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeCollisionB.dhall @@ -0,0 +1,1 @@ +{ x : { y : Natural, z : Bool } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeDeepA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeDeepA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeDeepA.dhall @@ -0,0 +1,1 @@ +{ a : { b : { x : Bool } } } ⩓ { a : { b : { y : Bool } } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeDeepB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeDeepB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeDeepB.dhall @@ -0,0 +1,1 @@ +{ a : { b : { x : Bool, y : Bool } } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeLhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeLhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeLhsEmptyA.dhall @@ -0,0 +1,1 @@ +{} ⩓ { a : Bool } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeLhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeLhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeLhsEmptyB.dhall @@ -0,0 +1,1 @@ +{ a : Bool } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNoCollisionA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNoCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNoCollisionA.dhall @@ -0,0 +1,1 @@ +{ x : { a : Bool } } ⩓ { y : { b : Natural } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNoCollisionB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNoCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNoCollisionB.dhall @@ -0,0 +1,1 @@ +{ x : { a : Bool }, y : { b : Natural } } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +{ a : Bool } ⩓ {} ⩓ ({} ⩓ { b : Bool }) diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +{ a : Bool, b : Bool } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeRhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeRhsEmptyA.dhall @@ -0,0 +1,1 @@ +{ a : Bool } ⩓ {} diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeRhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeRhsEmptyB.dhall @@ -0,0 +1,1 @@ +{ a : Bool } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeSortsA.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeSortsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeSortsA.dhall @@ -0,0 +1,1 @@ +{ a : Kind } ⩓ { b : Kind } diff --git a/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeSortsB.dhall b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeSortsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RecursiveRecordTypeMergeSortsB.dhall @@ -0,0 +1,1 @@ +{ a : Kind, b : Kind } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeEquivalentArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeEquivalentArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeEquivalentArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x ⫽ x diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeEquivalentArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeEquivalentArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeEquivalentArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection0A.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection0A.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → (x ⫽ { a = 0 }).a diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection0B.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection0B.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → 0 diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection1A.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection1A.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → (x ⫽ { a = 0 }).b diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection1B.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection1B.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → x.b diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection2A.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection2A.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → λ(y : Bool) → ({ a = y } ⫽ x).b diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection2B.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection2B.dhall @@ -0,0 +1,1 @@ +λ(x : { b : Bool }) → λ(y : Bool) → x.b diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection3A.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection3A.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → ({ a = 0, b = 1 } ⫽ x).a diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection3B.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedMergeWithinFieldSelection3B.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → ({ a = 0 } ⫽ x).a diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeCollisionA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeCollisionA.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = 2 } ⫽ { x = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeCollisionB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeCollisionB.dhall @@ -0,0 +1,1 @@ +{ x = 2, y = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeLhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeLhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeLhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → {=} ⫽ x diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeLhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeLhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeLhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNoCollisionA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNoCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNoCollisionA.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = 2 } ⫽ { a = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNoCollisionB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNoCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNoCollisionB.dhall @@ -0,0 +1,1 @@ +{ a = 2, x = 1, y = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : { a : Bool }) → x ⫽ {=} ⫽ (y ⫽ {=}) diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → λ(y : { a : Bool }) → x ⫽ y diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeRhsEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeRhsEmptyA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x ⫽ {=} diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeRhsEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeRhsEmptyB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool }) → x diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { c : Natural }) → (x ⫽ { a = 1, b = 2 }).{ a, c } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { c : Natural }) → x.{ c } ⫽ { a = 1 } diff --git a/dhall-lang/tests/normalization/success/unit/ShowConstructorEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ShowConstructorEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ShowConstructorEmptyA.dhall @@ -0,0 +1,1 @@ +showConstructor .A diff --git a/dhall-lang/tests/normalization/success/unit/ShowConstructorEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ShowConstructorEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ShowConstructorEmptyB.dhall @@ -0,0 +1,1 @@ +"A" diff --git a/dhall-lang/tests/normalization/success/unit/ShowConstructorNonEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/ShowConstructorNonEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ShowConstructorNonEmptyA.dhall @@ -0,0 +1,1 @@ +showConstructor (< A : Bool>.A False) diff --git a/dhall-lang/tests/normalization/success/unit/ShowConstructorNonEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/ShowConstructorNonEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ShowConstructorNonEmptyB.dhall @@ -0,0 +1,1 @@ +"A" diff --git a/dhall-lang/tests/normalization/success/unit/SomeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/SomeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/SomeNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → Some (if True then x else y) diff --git a/dhall-lang/tests/normalization/success/unit/SomeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/SomeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/SomeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → λ(y : Bool) → Some x diff --git a/dhall-lang/tests/normalization/success/unit/SortA.dhall b/dhall-lang/tests/normalization/success/unit/SortA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/SortA.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/normalization/success/unit/SortB.dhall b/dhall-lang/tests/normalization/success/unit/SortB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/SortB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/normalization/success/unit/TextA.dhall b/dhall-lang/tests/normalization/success/unit/TextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextA.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/normalization/success/unit/TextB.dhall b/dhall-lang/tests/normalization/success/unit/TextB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/normalization/success/unit/TextInterpolateA.dhall b/dhall-lang/tests/normalization/success/unit/TextInterpolateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextInterpolateA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "s${"b${x}"}" diff --git a/dhall-lang/tests/normalization/success/unit/TextInterpolateB.dhall b/dhall-lang/tests/normalization/success/unit/TextInterpolateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextInterpolateB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "sb${x}" diff --git a/dhall-lang/tests/normalization/success/unit/TextLitNested1A.dhall b/dhall-lang/tests/normalization/success/unit/TextLitNested1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLitNested1A.dhall @@ -0,0 +1,1 @@ +λ(x: Text) → "${""}${x}" diff --git a/dhall-lang/tests/normalization/success/unit/TextLitNested1B.dhall b/dhall-lang/tests/normalization/success/unit/TextLitNested1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLitNested1B.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x diff --git a/dhall-lang/tests/normalization/success/unit/TextLitNested2A.dhall b/dhall-lang/tests/normalization/success/unit/TextLitNested2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLitNested2A.dhall @@ -0,0 +1,1 @@ +λ(x: Text) → "${"${x}"}" diff --git a/dhall-lang/tests/normalization/success/unit/TextLitNested2B.dhall b/dhall-lang/tests/normalization/success/unit/TextLitNested2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLitNested2B.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x diff --git a/dhall-lang/tests/normalization/success/unit/TextLitNested3A.dhall b/dhall-lang/tests/normalization/success/unit/TextLitNested3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLitNested3A.dhall @@ -0,0 +1,1 @@ +λ(x: Text) → "${"${""}"}${x}" diff --git a/dhall-lang/tests/normalization/success/unit/TextLitNested3B.dhall b/dhall-lang/tests/normalization/success/unit/TextLitNested3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLitNested3B.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → x diff --git a/dhall-lang/tests/normalization/success/unit/TextLiteralA.dhall b/dhall-lang/tests/normalization/success/unit/TextLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLiteralA.dhall @@ -0,0 +1,1 @@ +"s" diff --git a/dhall-lang/tests/normalization/success/unit/TextLiteralB.dhall b/dhall-lang/tests/normalization/success/unit/TextLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextLiteralB.dhall @@ -0,0 +1,1 @@ +"s" diff --git a/dhall-lang/tests/normalization/success/unit/TextNormalizeInterpolationsA.dhall b/dhall-lang/tests/normalization/success/unit/TextNormalizeInterpolationsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextNormalizeInterpolationsA.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → λ(y : Text) → "s${if True then x else y}" diff --git a/dhall-lang/tests/normalization/success/unit/TextNormalizeInterpolationsB.dhall b/dhall-lang/tests/normalization/success/unit/TextNormalizeInterpolationsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextNormalizeInterpolationsB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → λ(y : Text) → "s${x}" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall @@ -0,0 +1,3 @@ +{- This test verifies that an implementation works with an abstract "replacement". +-} +λ(x : Text) → Text/replace "a" "-${x}-" "_a__a_" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "_-${x}-__-${x}-_" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackA.dhall @@ -0,0 +1,4 @@ +{- This test verifies that an implementation does not beta normalize with an + abstract "haystack". +-} +λ(x : Text) → λ(y : Text) → Text/replace "a" "-${x}-" "_a_${y}_a_" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → λ(y : Text) → Text/replace "a" "-${x}-" "_a_${y}_a_" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty1A.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty1A.dhall @@ -0,0 +1,1 @@ +Text/replace "" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty1B.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty1B.dhall @@ -0,0 +1,1 @@ +Text/replace "" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty2A.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty2A.dhall @@ -0,0 +1,2 @@ +λ(replacement : Text) → + Text/replace "" replacement diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty2B.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty2B.dhall @@ -0,0 +1,2 @@ +λ(replacement : Text) → + Text/replace "" replacement diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty3A.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty3A.dhall @@ -0,0 +1,3 @@ +λ(replacement : Text) → +λ(haystack : Text) → + Text/replace "" replacement haystack diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty3B.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceEmpty3B.dhall @@ -0,0 +1,1 @@ +λ(replacement : Text) → λ(haystack : Text) → haystack diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceMultipleA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceMultipleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceMultipleA.dhall @@ -0,0 +1,1 @@ +Text/replace "foo" "bar" "foobazfoo" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceMultipleB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceMultipleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceMultipleB.dhall @@ -0,0 +1,1 @@ +"barbazbar" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceNFCUnicodeA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceNFCUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceNFCUnicodeA.dhall @@ -0,0 +1,1 @@ +Text/replace "👨" "👩" "👨‍👩‍👧‍👦" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceNFCUnicodeB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceNFCUnicodeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceNFCUnicodeB.dhall @@ -0,0 +1,1 @@ +"👩‍👩‍👧‍👦" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceNormalizationA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceNormalizationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceNormalizationA.dhall @@ -0,0 +1,3 @@ +-- This test verifies that implementations do not perform Unicode normalization +-- before substitution. +Text/replace "a\u{0301}" "b" "\u{00e1}c" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceNormalizationB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceNormalizationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceNormalizationB.dhall @@ -0,0 +1,1 @@ +"ác" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceOverlappingA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceOverlappingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceOverlappingA.dhall @@ -0,0 +1,1 @@ +Text/replace "aa" "b" "aaaaa" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceOverlappingB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceOverlappingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceOverlappingB.dhall @@ -0,0 +1,1 @@ +"bba" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceSimpleA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceSimpleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceSimpleA.dhall @@ -0,0 +1,1 @@ +Text/replace "foo" "bar" "foo" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceSimpleB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceSimpleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceSimpleB.dhall @@ -0,0 +1,1 @@ +"bar" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceUnicodeA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceUnicodeA.dhall @@ -0,0 +1,1 @@ +Text/replace "💣" "💥" "💣💣💣" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceUnicodeB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceUnicodeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceUnicodeB.dhall @@ -0,0 +1,1 @@ +"💥💥💥" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceVarA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceVarA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceVarA.dhall @@ -0,0 +1,3 @@ +{- This test verifies that an implementation works with a variable as "replacement". +-} +λ(x : Text) → Text/replace "a" x "aaa" diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceVarB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceVarB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextReplaceVarB.dhall @@ -0,0 +1,1 @@ +λ(x : Text) → "${x}${x}${x}" diff --git a/dhall-lang/tests/normalization/success/unit/TextShowA.dhall b/dhall-lang/tests/normalization/success/unit/TextShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowA.dhall @@ -0,0 +1,1 @@ +Text/show diff --git a/dhall-lang/tests/normalization/success/unit/TextShowAllEscapesA.dhall b/dhall-lang/tests/normalization/success/unit/TextShowAllEscapesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowAllEscapesA.dhall @@ -0,0 +1,1 @@ +Text/show "\"\$\\\b\f\n\r\tツa\u0007b\u0010c" diff --git a/dhall-lang/tests/normalization/success/unit/TextShowAllEscapesB.dhall b/dhall-lang/tests/normalization/success/unit/TextShowAllEscapesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowAllEscapesB.dhall @@ -0,0 +1,1 @@ +"\"\\\"\\u0024\\\\\\b\\f\\n\\r\\tツa\\u0007b\\u0010c\"" diff --git a/dhall-lang/tests/normalization/success/unit/TextShowB.dhall b/dhall-lang/tests/normalization/success/unit/TextShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowB.dhall @@ -0,0 +1,1 @@ +Text/show diff --git a/dhall-lang/tests/normalization/success/unit/TextShowEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/TextShowEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowEmptyA.dhall @@ -0,0 +1,1 @@ +Text/show "" diff --git a/dhall-lang/tests/normalization/success/unit/TextShowEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/TextShowEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowEmptyB.dhall @@ -0,0 +1,1 @@ +"\"\"" diff --git a/dhall-lang/tests/normalization/success/unit/TextShowInterpolatedA.dhall b/dhall-lang/tests/normalization/success/unit/TextShowInterpolatedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowInterpolatedA.dhall @@ -0,0 +1,1 @@ +λ(containing : Text) → Text/show "text ${containing} interpolation" diff --git a/dhall-lang/tests/normalization/success/unit/TextShowInterpolatedB.dhall b/dhall-lang/tests/normalization/success/unit/TextShowInterpolatedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TextShowInterpolatedB.dhall @@ -0,0 +1,1 @@ +λ(containing: Text) → Text/show "text ${containing} interpolation" diff --git a/dhall-lang/tests/normalization/success/unit/TimeAsRecordA.dhall b/dhall-lang/tests/normalization/success/unit/TimeAsRecordA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TimeAsRecordA.dhall @@ -0,0 +1,2 @@ +-- Timestamps are records, and this is a no-op +2000-01-01T12:00:00+08:00.{ time, date, timeZone } diff --git a/dhall-lang/tests/normalization/success/unit/TimeAsRecordB.dhall b/dhall-lang/tests/normalization/success/unit/TimeAsRecordB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TimeAsRecordB.dhall @@ -0,0 +1,1 @@ +2000-01-01T12:00:00+08:00 diff --git a/dhall-lang/tests/normalization/success/unit/ToMapA.dhall b/dhall-lang/tests/normalization/success/unit/ToMapA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ToMapA.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4, baz= 9 } diff --git a/dhall-lang/tests/normalization/success/unit/ToMapB.dhall b/dhall-lang/tests/normalization/success/unit/ToMapB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ToMapB.dhall @@ -0,0 +1,4 @@ +[ { mapKey = "bar", mapValue = 4 } +, { mapKey = "baz", mapValue = 9 } +, { mapKey = "foo", mapValue = 1 } +] diff --git a/dhall-lang/tests/normalization/success/unit/ToMapWithTypeA.dhall b/dhall-lang/tests/normalization/success/unit/ToMapWithTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ToMapWithTypeA.dhall @@ -0,0 +1,16 @@ +{- This test verifies that the normalized result does not contain a type + annotation if the input record is non-empty. + + The reason for this test is that implementations might need to store + optional type annotations for both `toMap` invocations and empty list + literals. If an implementation does so, a common mistake is to take + the optional type annotation and always pass it through as the optional + type annotation for the list literal that `toMap` generates. + + However, the standard specifies that `toMap` should only generate a + type annotation if the input record is empty. If the input record is + non-empty then the resulting normalized list is non-empty and therefore + should not have a type annotation (since a non-empty list with a type + annotation is not in normal form). +-} +toMap { foo= 1, bar= 4, baz= 9 } : List { mapKey : Text, mapValue : Natural } diff --git a/dhall-lang/tests/normalization/success/unit/ToMapWithTypeB.dhall b/dhall-lang/tests/normalization/success/unit/ToMapWithTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/ToMapWithTypeB.dhall @@ -0,0 +1,4 @@ +[ { mapKey = "bar", mapValue = 4 } +, { mapKey = "baz", mapValue = 9 } +, { mapKey = "foo", mapValue = 1 } +] diff --git a/dhall-lang/tests/normalization/success/unit/TrueA.dhall b/dhall-lang/tests/normalization/success/unit/TrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TrueA.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/TrueB.dhall b/dhall-lang/tests/normalization/success/unit/TrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TrueB.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/normalization/success/unit/TypeA.dhall b/dhall-lang/tests/normalization/success/unit/TypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TypeA.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/normalization/success/unit/TypeAnnotationA.dhall b/dhall-lang/tests/normalization/success/unit/TypeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TypeAnnotationA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x : Bool diff --git a/dhall-lang/tests/normalization/success/unit/TypeAnnotationB.dhall b/dhall-lang/tests/normalization/success/unit/TypeAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TypeAnnotationB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/TypeB.dhall b/dhall-lang/tests/normalization/success/unit/TypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/TypeB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/normalization/success/unit/UnionProjectConstructorA.dhall b/dhall-lang/tests/normalization/success/unit/UnionProjectConstructorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionProjectConstructorA.dhall @@ -0,0 +1,1 @@ +< x : Bool >.x diff --git a/dhall-lang/tests/normalization/success/unit/UnionProjectConstructorB.dhall b/dhall-lang/tests/normalization/success/unit/UnionProjectConstructorB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionProjectConstructorB.dhall @@ -0,0 +1,1 @@ +< x : Bool >.x diff --git a/dhall-lang/tests/normalization/success/unit/UnionTypeA.dhall b/dhall-lang/tests/normalization/success/unit/UnionTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionTypeA.dhall @@ -0,0 +1,1 @@ +< x : Bool | z > diff --git a/dhall-lang/tests/normalization/success/unit/UnionTypeB.dhall b/dhall-lang/tests/normalization/success/unit/UnionTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionTypeB.dhall @@ -0,0 +1,1 @@ +< x : Bool | z > diff --git a/dhall-lang/tests/normalization/success/unit/UnionTypeEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/UnionTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionTypeEmptyA.dhall @@ -0,0 +1,1 @@ +<> diff --git a/dhall-lang/tests/normalization/success/unit/UnionTypeEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/UnionTypeEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionTypeEmptyB.dhall @@ -0,0 +1,1 @@ +<> diff --git a/dhall-lang/tests/normalization/success/unit/UnionTypeNormalizeArgumentsA.dhall b/dhall-lang/tests/normalization/success/unit/UnionTypeNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionTypeNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +let id = λ(X : Type) → X in < x : id Bool | z > diff --git a/dhall-lang/tests/normalization/success/unit/UnionTypeNormalizeArgumentsB.dhall b/dhall-lang/tests/normalization/success/unit/UnionTypeNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/UnionTypeNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +< x : Bool | z > diff --git a/dhall-lang/tests/normalization/success/unit/VariableA.dhall b/dhall-lang/tests/normalization/success/unit/VariableA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/VariableA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/VariableB.dhall b/dhall-lang/tests/normalization/success/unit/VariableB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/VariableB.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/normalization/success/unit/WithA.dhall b/dhall-lang/tests/normalization/success/unit/WithA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithA.dhall @@ -0,0 +1,1 @@ +{ a = 1 } with b = 2 diff --git a/dhall-lang/tests/normalization/success/unit/WithB.dhall b/dhall-lang/tests/normalization/success/unit/WithB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithB.dhall @@ -0,0 +1,1 @@ +{ a = 1, b = 2 } diff --git a/dhall-lang/tests/normalization/success/unit/WithChainedA.dhall b/dhall-lang/tests/normalization/success/unit/WithChainedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithChainedA.dhall @@ -0,0 +1,4 @@ +{- This test verifies that an implementation correctly handles chained + `with` expressions +-} +{ a = 1 } with b = 2 with c = 3 diff --git a/dhall-lang/tests/normalization/success/unit/WithChainedB.dhall b/dhall-lang/tests/normalization/success/unit/WithChainedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithChainedB.dhall @@ -0,0 +1,1 @@ +{ a = 1, b = 2, c = 3 } diff --git a/dhall-lang/tests/normalization/success/unit/WithCreateIntermediateRecordsA.dhall b/dhall-lang/tests/normalization/success/unit/WithCreateIntermediateRecordsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithCreateIntermediateRecordsA.dhall @@ -0,0 +1,3 @@ +{- This test illustrates that if an intermediate record does + not exist, the `with` operator can create one -} +{ a = 5 } with b.c = 10 diff --git a/dhall-lang/tests/normalization/success/unit/WithCreateIntermediateRecordsB.dhall b/dhall-lang/tests/normalization/success/unit/WithCreateIntermediateRecordsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithCreateIntermediateRecordsB.dhall @@ -0,0 +1,1 @@ +{ a = 5, b.c = 10 } diff --git a/dhall-lang/tests/normalization/success/unit/WithDesugarA.dhall b/dhall-lang/tests/normalization/success/unit/WithDesugarA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithDesugarA.dhall @@ -0,0 +1,3 @@ +{- This test verifies that an implementation no longer implements the old desugaring (pre-v19.0.0) +-} +\(x: { a : { b : { c : {} } }}) -> x with a.b.c = 42 diff --git a/dhall-lang/tests/normalization/success/unit/WithDesugarB.dhall b/dhall-lang/tests/normalization/success/unit/WithDesugarB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithDesugarB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : { b : { c : {} } } }) → x with a.b.c = 42 diff --git a/dhall-lang/tests/normalization/success/unit/WithNestedA.dhall b/dhall-lang/tests/normalization/success/unit/WithNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithNestedA.dhall @@ -0,0 +1,12 @@ +{- This test verifies that an implementation handles `with` expressions that + update nested labels correctly + + A common mistake an implementation might make is to produce the following + result: + + { a.c = 2 } + + ... due to the nested update clobbering the inner record. A compliant + implementation extends inner records. +-} +{ a.b = 1 } with a.c = 2 diff --git a/dhall-lang/tests/normalization/success/unit/WithNestedB.dhall b/dhall-lang/tests/normalization/success/unit/WithNestedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithNestedB.dhall @@ -0,0 +1,1 @@ +{ a = { b = 1, c = 2 } } diff --git a/dhall-lang/tests/normalization/success/unit/WithOnOptionalNoneA.dhall b/dhall-lang/tests/normalization/success/unit/WithOnOptionalNoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOnOptionalNoneA.dhall @@ -0,0 +1,1 @@ +(None Natural) with ? = 1 diff --git a/dhall-lang/tests/normalization/success/unit/WithOnOptionalNoneB.dhall b/dhall-lang/tests/normalization/success/unit/WithOnOptionalNoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOnOptionalNoneB.dhall @@ -0,0 +1,1 @@ +None Natural diff --git a/dhall-lang/tests/normalization/success/unit/WithOnOptionalSomeA.dhall b/dhall-lang/tests/normalization/success/unit/WithOnOptionalSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOnOptionalSomeA.dhall @@ -0,0 +1,1 @@ +(Some 0) with ? = 1 diff --git a/dhall-lang/tests/normalization/success/unit/WithOnOptionalSomeB.dhall b/dhall-lang/tests/normalization/success/unit/WithOnOptionalSomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOnOptionalSomeB.dhall @@ -0,0 +1,1 @@ +Some 1 diff --git a/dhall-lang/tests/normalization/success/unit/WithOptionalDeeplyNestedA.dhall b/dhall-lang/tests/normalization/success/unit/WithOptionalDeeplyNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOptionalDeeplyNestedA.dhall @@ -0,0 +1,1 @@ +(Some { x = Some { y = Some { z = Some 0 } } }) with ?.x.?.y.?.z.? = 1 diff --git a/dhall-lang/tests/normalization/success/unit/WithOptionalDeeplyNestedB.dhall b/dhall-lang/tests/normalization/success/unit/WithOptionalDeeplyNestedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOptionalDeeplyNestedB.dhall @@ -0,0 +1,1 @@ +Some { x = Some { y = Some { z = Some 1 } } } diff --git a/dhall-lang/tests/normalization/success/unit/WithOptionalNestedA.dhall b/dhall-lang/tests/normalization/success/unit/WithOptionalNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOptionalNestedA.dhall @@ -0,0 +1,1 @@ +{ x = Some 0 } with x.? = 1 diff --git a/dhall-lang/tests/normalization/success/unit/WithOptionalNestedB.dhall b/dhall-lang/tests/normalization/success/unit/WithOptionalNestedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithOptionalNestedB.dhall @@ -0,0 +1,1 @@ +{ x = Some 1 } diff --git a/dhall-lang/tests/normalization/success/unit/WithPartiallyAbstractA.dhall b/dhall-lang/tests/normalization/success/unit/WithPartiallyAbstractA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithPartiallyAbstractA.dhall @@ -0,0 +1,4 @@ +{- This test verifies that an implementation will evaluate a +partially abstract `with` expression correctly +-} +λ(x : { b : { c : {} } }) → { a = x } with a.b.c = 42 diff --git a/dhall-lang/tests/normalization/success/unit/WithPartiallyAbstractB.dhall b/dhall-lang/tests/normalization/success/unit/WithPartiallyAbstractB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithPartiallyAbstractB.dhall @@ -0,0 +1,1 @@ +λ(x : { b : { c : {} } }) → { a = x with b.c = 42 } diff --git a/dhall-lang/tests/normalization/success/unit/WithPriorityA.dhall b/dhall-lang/tests/normalization/success/unit/WithPriorityA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithPriorityA.dhall @@ -0,0 +1,6 @@ +{- This test ensures that updates are ordered and latter updates take priority + when the same field is updated more than one time + + In this example, the `a` field is updated twice, and the latter update wins +-} +{ a = 1 } with a = 2 with a = 3 diff --git a/dhall-lang/tests/normalization/success/unit/WithPriorityB.dhall b/dhall-lang/tests/normalization/success/unit/WithPriorityB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/WithPriorityB.dhall @@ -0,0 +1,1 @@ +{ a = 3 } diff --git a/dhall-lang/tests/parser/failure/ImportHeadersExteriorHash.dhall b/dhall-lang/tests/parser/failure/ImportHeadersExteriorHash.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/ImportHeadersExteriorHash.dhall @@ -0,0 +1,1 @@ +(https://example.com/foo using ./headers) sha256:0000000000000000000000000000000000000000000000000000000000000000 diff --git a/dhall-lang/tests/parser/failure/ProjectionByTypeNeedsParens.dhall b/dhall-lang/tests/parser/failure/ProjectionByTypeNeedsParens.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/ProjectionByTypeNeedsParens.dhall @@ -0,0 +1,1 @@ +r.{ x: T } diff --git a/dhall-lang/tests/parser/failure/annotation.dhall b/dhall-lang/tests/parser/failure/annotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/annotation.dhall @@ -0,0 +1,1 @@ +let a:Natural = 1 in a diff --git a/dhall-lang/tests/parser/failure/assertBinding.dhall b/dhall-lang/tests/parser/failure/assertBinding.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/assertBinding.dhall @@ -0,0 +1,1 @@ +let assert = 2 in 1 diff --git a/dhall-lang/tests/parser/failure/boundBuiltins.dhall b/dhall-lang/tests/parser/failure/boundBuiltins.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/boundBuiltins.dhall @@ -0,0 +1,6 @@ +{- + Builtin names are disallowed in bound variables. + The grammar doesn't explicitly disallow this, but the implementation should + refuse it. See the comments above the `nonreserved-label` rule. +-} +let Bool : Natural = 1 in Bool diff --git a/dhall-lang/tests/parser/failure/builtinWithIndex.dhall b/dhall-lang/tests/parser/failure/builtinWithIndex.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/builtinWithIndex.dhall @@ -0,0 +1,1 @@ +Bool@2 diff --git a/dhall-lang/tests/parser/failure/bytesInvalid.dhall b/dhall-lang/tests/parser/failure/bytesInvalid.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/bytesInvalid.dhall @@ -0,0 +1,1 @@ +0x"invalid" diff --git a/dhall-lang/tests/parser/failure/bytesOddLength.dhall b/dhall-lang/tests/parser/failure/bytesOddLength.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/bytesOddLength.dhall @@ -0,0 +1,1 @@ +0x"0" diff --git a/dhall-lang/tests/parser/failure/doubleBoundsNeg.dhall b/dhall-lang/tests/parser/failure/doubleBoundsNeg.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/doubleBoundsNeg.dhall @@ -0,0 +1,1 @@ +-179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497792.0 diff --git a/dhall-lang/tests/parser/failure/doubleBoundsPos.dhall b/dhall-lang/tests/parser/failure/doubleBoundsPos.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/doubleBoundsPos.dhall @@ -0,0 +1,1 @@ +179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497792.0 diff --git a/dhall-lang/tests/parser/failure/fSomeX.dhall b/dhall-lang/tests/parser/failure/fSomeX.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/fSomeX.dhall @@ -0,0 +1,1 @@ +f Some x diff --git a/dhall-lang/tests/parser/failure/importAccess.dhall b/dhall-lang/tests/parser/failure/importAccess.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/importAccess.dhall @@ -0,0 +1,1 @@ +./testImport .hello diff --git a/dhall-lang/tests/parser/failure/incompleteIf.dhall b/dhall-lang/tests/parser/failure/incompleteIf.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/incompleteIf.dhall @@ -0,0 +1,10 @@ +-- This test verifies that an implementation rejects the following expression at +-- parse time (i.e. due to an incomplete `if` expression) rather than at +-- type-checking time (i.e. due to an unbound variable named `if` or `else`) +-- +-- This ensures that implementations are not treating keywords as potential +-- identifier names. In other words, if they fail to parse an incomplete +-- `if` expression they don't try to alternatively parse the expression as +-- function application instead. + +if a then b else diff --git a/dhall-lang/tests/parser/failure/mandatoryNewline.dhall b/dhall-lang/tests/parser/failure/mandatoryNewline.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/mandatoryNewline.dhall @@ -0,0 +1,2 @@ +-- Multi-line literals require a mandatory newline after the opening quotes +''ABC'' diff --git a/dhall-lang/tests/parser/failure/nonBase16Hash.dhall b/dhall-lang/tests/parser/failure/nonBase16Hash.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/nonBase16Hash.dhall @@ -0,0 +1,1 @@ +./foo sha256:d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe1g diff --git a/dhall-lang/tests/parser/failure/nonCharacter.dhall b/dhall-lang/tests/parser/failure/nonCharacter.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/nonCharacter.dhall @@ -0,0 +1,1 @@ +"\u{10FFFF}" diff --git a/dhall-lang/tests/parser/failure/nonCharacterUnbraced.dhall b/dhall-lang/tests/parser/failure/nonCharacterUnbraced.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/nonCharacterUnbraced.dhall @@ -0,0 +1,6 @@ +{- +The parser should reject unicode escape sequences for non-characters +(0xNFFFE-0xNFFFF for each `N` in `{ 0 .. F }), regardless of whether they are +braced or not. +-} +"\uFFFE" diff --git a/dhall-lang/tests/parser/failure/nonUtf8.dhall b/dhall-lang/tests/parser/failure/nonUtf8.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/nonUtf8.dhall @@ -0,0 +1,4 @@ +{- This test verifies that an implementation correctly rejects non-UTF8 + characters, such as this one: "í €" +-} +1 diff --git a/dhall-lang/tests/parser/failure/spacing/AnnotationNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/AnnotationNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/AnnotationNoSpace.dhall @@ -0,0 +1,1 @@ +x :T diff --git a/dhall-lang/tests/parser/failure/spacing/ApplicationNoSpace1.dhall b/dhall-lang/tests/parser/failure/spacing/ApplicationNoSpace1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ApplicationNoSpace1.dhall @@ -0,0 +1,1 @@ +f(x) diff --git a/dhall-lang/tests/parser/failure/spacing/ApplicationNoSpace2.dhall b/dhall-lang/tests/parser/failure/spacing/ApplicationNoSpace2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ApplicationNoSpace2.dhall @@ -0,0 +1,2 @@ +-- There needs to be a space between a function and its argument +./example.dhall[1] diff --git a/dhall-lang/tests/parser/failure/spacing/AssertNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/AssertNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/AssertNoSpace.dhall @@ -0,0 +1,1 @@ +assert :T diff --git a/dhall-lang/tests/parser/failure/spacing/ForallNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/ForallNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ForallNoSpace.dhall @@ -0,0 +1,1 @@ +forall(x :T) -> x diff --git a/dhall-lang/tests/parser/failure/spacing/HeadersNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/HeadersNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/HeadersNoSpace.dhall @@ -0,0 +1,1 @@ +https://example.com/foo using(x) diff --git a/dhall-lang/tests/parser/failure/spacing/IfNoSpace1.dhall b/dhall-lang/tests/parser/failure/spacing/IfNoSpace1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/IfNoSpace1.dhall @@ -0,0 +1,1 @@ +if(b) then x else y diff --git a/dhall-lang/tests/parser/failure/spacing/IfNoSpace2.dhall b/dhall-lang/tests/parser/failure/spacing/IfNoSpace2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/IfNoSpace2.dhall @@ -0,0 +1,1 @@ +if b then(x) else y diff --git a/dhall-lang/tests/parser/failure/spacing/IfNoSpace3.dhall b/dhall-lang/tests/parser/failure/spacing/IfNoSpace3.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/IfNoSpace3.dhall @@ -0,0 +1,1 @@ +if b then x else(y) diff --git a/dhall-lang/tests/parser/failure/spacing/ImportAltNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/ImportAltNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ImportAltNoSpace.dhall @@ -0,0 +1,1 @@ +x ?y diff --git a/dhall-lang/tests/parser/failure/spacing/ImportHashedNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/ImportHashedNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ImportHashedNoSpace.dhall @@ -0,0 +1,1 @@ +missingsha256:0000000000000000000000000000000000000000000000000000000000000000 diff --git a/dhall-lang/tests/parser/failure/spacing/LambdaNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/LambdaNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/LambdaNoSpace.dhall @@ -0,0 +1,1 @@ +\(x :T) -> x diff --git a/dhall-lang/tests/parser/failure/spacing/LetAnnotNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/LetAnnotNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/LetAnnotNoSpace.dhall @@ -0,0 +1,1 @@ +let x :T = y in e diff --git a/dhall-lang/tests/parser/failure/spacing/LetNoSpace1.dhall b/dhall-lang/tests/parser/failure/spacing/LetNoSpace1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/LetNoSpace1.dhall @@ -0,0 +1,1 @@ +letx = y in e diff --git a/dhall-lang/tests/parser/failure/spacing/LetNoSpace2.dhall b/dhall-lang/tests/parser/failure/spacing/LetNoSpace2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/LetNoSpace2.dhall @@ -0,0 +1,1 @@ +let x = y in(e) diff --git a/dhall-lang/tests/parser/failure/spacing/LetNoSpace3.dhall b/dhall-lang/tests/parser/failure/spacing/LetNoSpace3.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/LetNoSpace3.dhall @@ -0,0 +1,1 @@ +let x = NaNin x diff --git a/dhall-lang/tests/parser/failure/spacing/LetNoSpace4.dhall b/dhall-lang/tests/parser/failure/spacing/LetNoSpace4.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/LetNoSpace4.dhall @@ -0,0 +1,1 @@ +let x = 3let y = x in y diff --git a/dhall-lang/tests/parser/failure/spacing/ListLitEmptyNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/ListLitEmptyNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ListLitEmptyNoSpace.dhall @@ -0,0 +1,1 @@ +[] :T diff --git a/dhall-lang/tests/parser/failure/spacing/MergeAnnotationNoSpace3.dhall b/dhall-lang/tests/parser/failure/spacing/MergeAnnotationNoSpace3.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/MergeAnnotationNoSpace3.dhall @@ -0,0 +1,1 @@ +merge x y :T diff --git a/dhall-lang/tests/parser/failure/spacing/MergeNoSpace1.dhall b/dhall-lang/tests/parser/failure/spacing/MergeNoSpace1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/MergeNoSpace1.dhall @@ -0,0 +1,1 @@ +merge(x) y diff --git a/dhall-lang/tests/parser/failure/spacing/MergeNoSpace2.dhall b/dhall-lang/tests/parser/failure/spacing/MergeNoSpace2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/MergeNoSpace2.dhall @@ -0,0 +1,1 @@ +merge x(y) diff --git a/dhall-lang/tests/parser/failure/spacing/NaturalPlusNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/NaturalPlusNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/NaturalPlusNoSpace.dhall @@ -0,0 +1,1 @@ +x +y diff --git a/dhall-lang/tests/parser/failure/spacing/RecordTypeNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/RecordTypeNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/RecordTypeNoSpace.dhall @@ -0,0 +1,1 @@ +{ x :T } diff --git a/dhall-lang/tests/parser/failure/spacing/SomeNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/SomeNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/SomeNoSpace.dhall @@ -0,0 +1,1 @@ +Some(x) diff --git a/dhall-lang/tests/parser/failure/spacing/ToMapAnnotNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/ToMapAnnotNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ToMapAnnotNoSpace.dhall @@ -0,0 +1,1 @@ +toMap x :T diff --git a/dhall-lang/tests/parser/failure/spacing/ToMapNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/ToMapNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/ToMapNoSpace.dhall @@ -0,0 +1,1 @@ +toMap(x) diff --git a/dhall-lang/tests/parser/failure/spacing/UnionTypeNoSpace.dhall b/dhall-lang/tests/parser/failure/spacing/UnionTypeNoSpace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/spacing/UnionTypeNoSpace.dhall @@ -0,0 +1,1 @@ +< x :T > diff --git a/dhall-lang/tests/parser/failure/surrogatePairUnbraced.dhall b/dhall-lang/tests/parser/failure/surrogatePairUnbraced.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/surrogatePairUnbraced.dhall @@ -0,0 +1,5 @@ +{- +The parser should reject unicode escape sequences for surrogate pairs +(0xD800-DFFF), regardless of whether they are braced or not. +-} +"\uD800" diff --git a/dhall-lang/tests/parser/failure/time/DateTimeZone.dhall b/dhall-lang/tests/parser/failure/time/DateTimeZone.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/DateTimeZone.dhall @@ -0,0 +1,2 @@ +-- A date and time zone is not valid (because the time is missing) +2011-04-01+02:00 diff --git a/dhall-lang/tests/parser/failure/time/InvalidDayOfMonth.dhall b/dhall-lang/tests/parser/failure/time/InvalidDayOfMonth.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/InvalidDayOfMonth.dhall @@ -0,0 +1,2 @@ +-- April only has 30 days +2000-04-31 diff --git a/dhall-lang/tests/parser/failure/time/InvalidHour.dhall b/dhall-lang/tests/parser/failure/time/InvalidHour.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/InvalidHour.dhall @@ -0,0 +1,2 @@ +-- Hours must range between 0-23 +24:00:00 diff --git a/dhall-lang/tests/parser/failure/time/InvalidLeapSecond.dhall b/dhall-lang/tests/parser/failure/time/InvalidLeapSecond.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/InvalidLeapSecond.dhall @@ -0,0 +1,3 @@ +-- Leap seconds are not permitted by the Dhall standard, even though RFC 3339 +-- supports them +2016-12-31T23:59:60 diff --git a/dhall-lang/tests/parser/failure/time/InvalidMinute.dhall b/dhall-lang/tests/parser/failure/time/InvalidMinute.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/InvalidMinute.dhall @@ -0,0 +1,2 @@ +-- Minutes must range between 0-59 +00:60:00 diff --git a/dhall-lang/tests/parser/failure/time/InvalidMonth.dhall b/dhall-lang/tests/parser/failure/time/InvalidMonth.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/InvalidMonth.dhall @@ -0,0 +1,2 @@ +-- Months must be between 1-12 +2000-13-01 diff --git a/dhall-lang/tests/parser/failure/time/InvalidSecond.dhall b/dhall-lang/tests/parser/failure/time/InvalidSecond.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/InvalidSecond.dhall @@ -0,0 +1,2 @@ +-- Seconds must range between 0-59 (and leap seconds are not supported) +00:00:60 diff --git a/dhall-lang/tests/parser/failure/time/NegativeYear.dhall b/dhall-lang/tests/parser/failure/time/NegativeYear.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/NegativeYear.dhall @@ -0,0 +1,2 @@ +-- Negative years are not permitted +-0001-01-01 diff --git a/dhall-lang/tests/parser/failure/time/YearTooLarge.dhall b/dhall-lang/tests/parser/failure/time/YearTooLarge.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/time/YearTooLarge.dhall @@ -0,0 +1,2 @@ +-- Only 4-digit years are permitted +10000-01-01 diff --git a/dhall-lang/tests/parser/failure/unit/AssertNoAnnotation.dhall b/dhall-lang/tests/parser/failure/unit/AssertNoAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/AssertNoAnnotation.dhall @@ -0,0 +1,1 @@ +assert diff --git a/dhall-lang/tests/parser/failure/unit/BoolLitTrueWithIndex.dhall b/dhall-lang/tests/parser/failure/unit/BoolLitTrueWithIndex.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/BoolLitTrueWithIndex.dhall @@ -0,0 +1,1 @@ +True@0 diff --git a/dhall-lang/tests/parser/failure/unit/BuiltinBoolWithIndex.dhall b/dhall-lang/tests/parser/failure/unit/BuiltinBoolWithIndex.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/BuiltinBoolWithIndex.dhall @@ -0,0 +1,1 @@ +Bool@1 diff --git a/dhall-lang/tests/parser/failure/unit/BuiltinTypeWithIndex.dhall b/dhall-lang/tests/parser/failure/unit/BuiltinTypeWithIndex.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/BuiltinTypeWithIndex.dhall @@ -0,0 +1,1 @@ +Type@0 diff --git a/dhall-lang/tests/parser/failure/unit/ImportEnvWrongEscape.dhall b/dhall-lang/tests/parser/failure/unit/ImportEnvWrongEscape.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/ImportEnvWrongEscape.dhall @@ -0,0 +1,1 @@ +env:"\$" diff --git a/dhall-lang/tests/parser/failure/unit/ListLitEmptyAnnotation.dhall b/dhall-lang/tests/parser/failure/unit/ListLitEmptyAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/ListLitEmptyAnnotation.dhall @@ -0,0 +1,1 @@ +([]) : List T diff --git a/dhall-lang/tests/parser/failure/unit/ListLitEmptyMissingAnnotation.dhall b/dhall-lang/tests/parser/failure/unit/ListLitEmptyMissingAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/ListLitEmptyMissingAnnotation.dhall @@ -0,0 +1,1 @@ +[] diff --git a/dhall-lang/tests/parser/failure/unit/ListLitTwoCommas.dhall b/dhall-lang/tests/parser/failure/unit/ListLitTwoCommas.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/ListLitTwoCommas.dhall @@ -0,0 +1,1 @@ +[ ,, ] diff --git a/dhall-lang/tests/parser/failure/unit/MergeAlone.dhall b/dhall-lang/tests/parser/failure/unit/MergeAlone.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/MergeAlone.dhall @@ -0,0 +1,1 @@ +merge diff --git a/dhall-lang/tests/parser/failure/unit/MergeOneArgument.dhall b/dhall-lang/tests/parser/failure/unit/MergeOneArgument.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/MergeOneArgument.dhall @@ -0,0 +1,1 @@ +merge x diff --git a/dhall-lang/tests/parser/failure/unit/NaturalLitLeadingZero.dhall b/dhall-lang/tests/parser/failure/unit/NaturalLitLeadingZero.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/NaturalLitLeadingZero.dhall @@ -0,0 +1,1 @@ +042 diff --git a/dhall-lang/tests/parser/failure/unit/OldUnionLitSyntax.dhall b/dhall-lang/tests/parser/failure/unit/OldUnionLitSyntax.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/OldUnionLitSyntax.dhall @@ -0,0 +1,1 @@ +< x = 3 | y : Bool > diff --git a/dhall-lang/tests/parser/failure/unit/ProjectionTwoCommas.dhall b/dhall-lang/tests/parser/failure/unit/ProjectionTwoCommas.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/ProjectionTwoCommas.dhall @@ -0,0 +1,1 @@ +foo.{ ,, } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword00.dhall @@ -0,0 +1,1 @@ +{ if: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword01.dhall @@ -0,0 +1,1 @@ +{ then: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword02.dhall @@ -0,0 +1,1 @@ +{ else: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword03.dhall @@ -0,0 +1,1 @@ +{ let: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword04.dhall @@ -0,0 +1,1 @@ +{ in: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword05.dhall @@ -0,0 +1,1 @@ +{ using: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword06.dhall @@ -0,0 +1,1 @@ +{ missing: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword07.dhall @@ -0,0 +1,1 @@ +{ assert: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword08.dhall @@ -0,0 +1,1 @@ +{ as: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword09.dhall @@ -0,0 +1,1 @@ +{ Infinity: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword10.dhall @@ -0,0 +1,1 @@ +{ NaN: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword11.dhall @@ -0,0 +1,1 @@ +{ merge: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword12.dhall @@ -0,0 +1,1 @@ +{ toMap: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword13.dhall @@ -0,0 +1,1 @@ +{ with: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordFieldMustNotBeKeyword14.dhall @@ -0,0 +1,1 @@ +{ forall: Text } diff --git a/dhall-lang/tests/parser/failure/unit/RecordLitPunDotted.dhall b/dhall-lang/tests/parser/failure/unit/RecordLitPunDotted.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordLitPunDotted.dhall @@ -0,0 +1,1 @@ +{ x.y.z } diff --git a/dhall-lang/tests/parser/failure/unit/RecordTwoCommas.dhall b/dhall-lang/tests/parser/failure/unit/RecordTwoCommas.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/RecordTwoCommas.dhall @@ -0,0 +1,1 @@ +{ ,, } diff --git a/dhall-lang/tests/parser/failure/unit/SomeAlone.dhall b/dhall-lang/tests/parser/failure/unit/SomeAlone.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/SomeAlone.dhall @@ -0,0 +1,1 @@ +Some diff --git a/dhall-lang/tests/parser/failure/unit/UnionTypeTwoDelims.dhall b/dhall-lang/tests/parser/failure/unit/UnionTypeTwoDelims.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/UnionTypeTwoDelims.dhall @@ -0,0 +1,1 @@ +< || > diff --git a/dhall-lang/tests/parser/failure/unit/UrlWithQuotedPath.dhall b/dhall-lang/tests/parser/failure/unit/UrlWithQuotedPath.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/UrlWithQuotedPath.dhall @@ -0,0 +1,1 @@ +https://example.com/"a%20b"/c diff --git a/dhall-lang/tests/parser/failure/unit/UsingToMap.dhall b/dhall-lang/tests/parser/failure/unit/UsingToMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/UsingToMap.dhall @@ -0,0 +1,8 @@ +{- At one point the Haskell implementation permitted this idiom, which was not + standards-compliant + + The problem with the following expression is that the argument to `using` + is parsed as a `completionExpression`, which means that any use of `toMap` + within a `using` clause must be parenthesized +-} +https://example.com using toMap { Foo = "Bar" } diff --git a/dhall-lang/tests/parser/failure/unit/WithPrecedence1.dhall b/dhall-lang/tests/parser/failure/unit/WithPrecedence1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/WithPrecedence1.dhall @@ -0,0 +1,1 @@ +{ x = 0 } // { y = 1 } with x = 1 diff --git a/dhall-lang/tests/parser/failure/unit/WithPrecedence2.dhall b/dhall-lang/tests/parser/failure/unit/WithPrecedence2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/WithPrecedence2.dhall @@ -0,0 +1,1 @@ +foo { x = 0 } with x = 1 diff --git a/dhall-lang/tests/parser/failure/unit/WithPrecedence3.dhall b/dhall-lang/tests/parser/failure/unit/WithPrecedence3.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/WithPrecedence3.dhall @@ -0,0 +1,1 @@ +{ x = 0 } with x = 1 : T diff --git a/dhall-lang/tests/parser/failure/unit/WithWhitespace.dhall b/dhall-lang/tests/parser/failure/unit/WithWhitespace.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/WithWhitespace.dhall @@ -0,0 +1,2 @@ +-- For https://github.com/dhall-lang/dhall-haskell/issues/2212 +{=}with foo = 0with bar = 1 diff --git a/dhall-lang/tests/parser/failure/unit/showConstructorAlone.dhall b/dhall-lang/tests/parser/failure/unit/showConstructorAlone.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/failure/unit/showConstructorAlone.dhall @@ -0,0 +1,1 @@ +showConstructor diff --git a/dhall-lang/tests/parser/success/annotationsA.dhall b/dhall-lang/tests/parser/success/annotationsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/annotationsA.dhall @@ -0,0 +1,1 @@ +([] : List Natural) # [ 1, 2, 3 ] # ([ 1, 2, 3 ] : List Natural) : List Natural diff --git a/dhall-lang/tests/parser/success/annotationsB.dhallb b/dhall-lang/tests/parser/success/annotationsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/annotationsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/binaryA.dhall b/dhall-lang/tests/parser/success/binaryA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/binaryA.dhall @@ -0,0 +1,8 @@ + λ(x : Bool) +→ λ(x : Bool) +→ { example0 = 0b0 + , example1 = 0b10 + , example2 = -0b11001 + , example3 = +0b100 + , example4 = x@0b01 + } diff --git a/dhall-lang/tests/parser/success/binaryB.dhallb b/dhall-lang/tests/parser/success/binaryB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/binaryB.dhallb differ diff --git a/dhall-lang/tests/parser/success/blockCommentA.dhall b/dhall-lang/tests/parser/success/blockCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/blockCommentA.dhall @@ -0,0 +1,3 @@ +{- foo -} + +1 diff --git a/dhall-lang/tests/parser/success/blockCommentB.dhallb b/dhall-lang/tests/parser/success/blockCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/blockCommentB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/builtinNameAsFieldA.dhall b/dhall-lang/tests/parser/success/builtinNameAsFieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/builtinNameAsFieldA.dhall @@ -0,0 +1,3 @@ +let Prelude = https://prelude.dhall-lang.org/package.dhall + +in Prelude.List.map diff --git a/dhall-lang/tests/parser/success/builtinNameAsFieldB.dhallb b/dhall-lang/tests/parser/success/builtinNameAsFieldB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/builtinNameAsFieldB.dhallb differ diff --git a/dhall-lang/tests/parser/success/builtinsA.dhall b/dhall-lang/tests/parser/success/builtinsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/builtinsA.dhall @@ -0,0 +1,40 @@ +[ Date/show +, Double/show +, Integer/clamp +, Integer/negate +, Integer/show +, Integer/toDouble +, List/build +, List/fold +, List/head +, List/indexed +, List/last +, List/length +, List/reverse +, Natural/build +, Natural/even +, Natural/fold +, Natural/isZero +, Natural/odd +, Natural/show +, Natural/subtract +, Natural/toInteger +, Text/replace +, Text/show +, Time/show +, TimeZone/show +, Bool +, Bytes +, Date +, Double +, False +, Integer +, List +, Natural +, None +, Optional +, Text +, Time +, TimeZone +, True +] diff --git a/dhall-lang/tests/parser/success/builtinsB.dhallb b/dhall-lang/tests/parser/success/builtinsB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/builtinsB.dhallb @@ -0,0 +1,1 @@ +˜)öiDate/showkDouble/showmInteger/clampnInteger/negatelInteger/showpInteger/toDoublejList/buildiList/foldiList/headlList/indexediList/lastkList/lengthlList/reversemNatural/buildlNatural/evenlNatural/foldnNatural/isZerokNatural/oddlNatural/showpNatural/subtractqNatural/toIntegerlText/replaceiText/showiTime/showmTimeZone/showdBooleBytesdDatefDoubleôgIntegerdListgNaturaldNonehOptionaldTextdTimehTimeZoneõ diff --git a/dhall-lang/tests/parser/success/bytesA.dhall b/dhall-lang/tests/parser/success/bytesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/bytesA.dhall @@ -0,0 +1,25 @@ +[ 0x"" +, 0x"00" +, 0x"01" +, 0x"02" +, 0x"03" +, 0x"04" +, 0x"05" +, 0x"06" +, 0x"07" +, 0x"08" +, 0x"09" +, 0x"0a" +, 0x"0b" +, 0x"0c" +, 0x"0d" +, 0x"0e" +, 0x"0f" +, 0x"0A" +, 0x"0B" +, 0x"0C" +, 0x"0D" +, 0x"0E" +, 0x"0F" +, 0x"000102030405060708090a0b0c0d0e0f0A0B0C0D0E0F" +] diff --git a/dhall-lang/tests/parser/success/bytesB.dhallb b/dhall-lang/tests/parser/success/bytesB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/bytesB.dhallb differ diff --git a/dhall-lang/tests/parser/success/collectionImportTypeA.dhall b/dhall-lang/tests/parser/success/collectionImportTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/collectionImportTypeA.dhall @@ -0,0 +1,3 @@ +{ example0 = None ./type.dhall +, example1 = [] : List ./type.dhall +} diff --git a/dhall-lang/tests/parser/success/collectionImportTypeB.dhallb b/dhall-lang/tests/parser/success/collectionImportTypeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/collectionImportTypeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/fieldsA.dhall b/dhall-lang/tests/parser/success/fieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/fieldsA.dhall @@ -0,0 +1,1 @@ +({ foo = { bar = { baz = 1 } } }).foo. bar .baz diff --git a/dhall-lang/tests/parser/success/fieldsB.dhallb b/dhall-lang/tests/parser/success/fieldsB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/fieldsB.dhallb @@ -0,0 +1,1 @@ +ƒ ƒ ƒ ‚¡cfoo‚¡cbar‚¡cbaz‚cfoocbarcbaz diff --git a/dhall-lang/tests/parser/success/forallA.dhall b/dhall-lang/tests/parser/success/forallA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/forallA.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → forall (b : Type) -> a diff --git a/dhall-lang/tests/parser/success/forallB.dhallb b/dhall-lang/tests/parser/success/forallB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/forallB.dhallb differ diff --git a/dhall-lang/tests/parser/success/functionTypeA.dhall b/dhall-lang/tests/parser/success/functionTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/functionTypeA.dhall @@ -0,0 +1,1 @@ +Bool → Bool -> Bool diff --git a/dhall-lang/tests/parser/success/functionTypeB.dhallb b/dhall-lang/tests/parser/success/functionTypeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/functionTypeB.dhallb @@ -0,0 +1,1 @@ +ƒdBoolƒdBooldBool diff --git a/dhall-lang/tests/parser/success/hexadecimalA.dhall b/dhall-lang/tests/parser/success/hexadecimalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/hexadecimalA.dhall @@ -0,0 +1,6 @@ + λ(x : Bool) +→ λ(x : Bool) +→ { example0 = 0xFF + , example1 = -0x1A10 + , example2 = x@0x01 + } diff --git a/dhall-lang/tests/parser/success/hexadecimalB.dhallb b/dhall-lang/tests/parser/success/hexadecimalB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/hexadecimalB.dhallb @@ -0,0 +1,1 @@ +„axdBool„axdBool‚£hexample0‚ÿhexample1‚9hexample2‚ax diff --git a/dhall-lang/tests/parser/success/identifierA.dhall b/dhall-lang/tests/parser/success/identifierA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/identifierA.dhall @@ -0,0 +1,1 @@ +λ(a : Type) → λ(a : Type) → a@1 diff --git a/dhall-lang/tests/parser/success/identifierB.dhallb b/dhall-lang/tests/parser/success/identifierB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/identifierB.dhallb @@ -0,0 +1,1 @@ +„aadType„aadType‚aa diff --git a/dhall-lang/tests/parser/success/labelA.dhall b/dhall-lang/tests/parser/success/labelA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/labelA.dhall @@ -0,0 +1,2 @@ +let _ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-/ = 1 +in _ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-/ diff --git a/dhall-lang/tests/parser/success/labelB.dhallb b/dhall-lang/tests/parser/success/labelB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/labelB.dhallb differ diff --git a/dhall-lang/tests/parser/success/lambdaA.dhall b/dhall-lang/tests/parser/success/lambdaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/lambdaA.dhall @@ -0,0 +1,1 @@ +λ(a : Type) → \(b : Type) -> a diff --git a/dhall-lang/tests/parser/success/lambdaB.dhallb b/dhall-lang/tests/parser/success/lambdaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/lambdaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/largeExpressionA.dhall b/dhall-lang/tests/parser/success/largeExpressionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/largeExpressionA.dhall @@ -0,0 +1,272 @@ + λ ( xs + : List + { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List + < AArch64_Linux + | ARMv5tel_Linux + | ARMv7l_Linux + | I686_Cygwin + | I686_Linux + | MIPS64el_Linux + | PowerPC_Linux + | X86_64_Cygwin + | X86_64_Darwin + | X86_64_FreeBSD + | X86_64_Linux + | X86_64_Solaris + > + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + ) +→ List/fold + { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List + < AArch64_Linux + | ARMv5tel_Linux + | ARMv7l_Linux + | I686_Cygwin + | I686_Linux + | MIPS64el_Linux + | PowerPC_Linux + | X86_64_Cygwin + | X86_64_Darwin + | X86_64_FreeBSD + | X86_64_Linux + | X86_64_Solaris + > + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + xs + Text + ( λ ( x + : { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List + < AArch64_Linux + | ARMv5tel_Linux + | ARMv7l_Linux + | I686_Cygwin + | I686_Linux + | MIPS64el_Linux + | PowerPC_Linux + | X86_64_Cygwin + | X86_64_Darwin + | X86_64_FreeBSD + | X86_64_Linux + | X86_64_Solaris + > + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + ) + → λ(y : Text) + → merge + { None = x.host + , Some = λ(user : Text) → user ++ "@" ++ x.host ++ "" + } + x.user + ++ " " + ++ ( merge + { Empty = "", NonEmpty = λ(result : Text) → result } + ( List/fold + < AArch64_Linux + | ARMv5tel_Linux + | ARMv7l_Linux + | I686_Cygwin + | I686_Linux + | MIPS64el_Linux + | PowerPC_Linux + | X86_64_Cygwin + | X86_64_Darwin + | X86_64_FreeBSD + | X86_64_Linux + | X86_64_Solaris + > + x.platforms + < Empty | NonEmpty : Text > + ( λ ( element + : < AArch64_Linux + | ARMv5tel_Linux + | ARMv7l_Linux + | I686_Cygwin + | I686_Linux + | MIPS64el_Linux + | PowerPC_Linux + | X86_64_Cygwin + | X86_64_Darwin + | X86_64_FreeBSD + | X86_64_Linux + | X86_64_Solaris + > + ) + → λ(status : < Empty | NonEmpty : Text >) + → merge + { Empty = + < Empty | NonEmpty : Text >.NonEmpty + ( merge + { AArch64_Linux = + "aarch64-linux" + , ARMv5tel_Linux = + "armv5tel-linux" + , ARMv7l_Linux = + "armv7l-linux" + , I686_Cygwin = + "i686-cygwin" + , I686_Linux = + "i686-linux" + , MIPS64el_Linux = + "mips64el-linux" + , PowerPC_Linux = + "powerpc-linux" + , X86_64_Cygwin = + "x86_64-cygwin" + , X86_64_Darwin = + "x86_64-darwin" + , X86_64_FreeBSD = + "x86_64-freebsd" + , X86_64_Linux = + "x86_64-linux" + , X86_64_Solaris = + "x86_64-solaris" + } + element + ) + , NonEmpty = + λ(result : Text) + → < Empty | NonEmpty : Text >.NonEmpty + ( ( merge + { AArch64_Linux = + "aarch64-linux" + , ARMv5tel_Linux = + "armv5tel-linux" + , ARMv7l_Linux = + "armv7l-linux" + , I686_Cygwin = + "i686-cygwin" + , I686_Linux = + "i686-linux" + , MIPS64el_Linux = + "mips64el-linux" + , PowerPC_Linux = + "powerpc-linux" + , X86_64_Cygwin = + "x86_64-cygwin" + , X86_64_Darwin = + "x86_64-darwin" + , X86_64_FreeBSD = + "x86_64-freebsd" + , X86_64_Linux = + "x86_64-linux" + , X86_64_Solaris = + "x86_64-solaris" + } + element + ) + ++ "," + ++ result + ) + } + status + : < Empty | NonEmpty : Text > + ) + < Empty | NonEmpty : Text >.Empty + ) + : Text + ) + ++ " " + ++ x.key + ++ " " + ++ Integer/show (Natural/toInteger x.cores) + ++ " " + ++ Integer/show (Natural/toInteger x.speedFactor) + ++ " " + ++ ( merge + { Empty = "", NonEmpty = λ(result : Text) → result } + ( List/fold + Text + x.supportedFeatures + < Empty | NonEmpty : Text > + ( λ(element : Text) + → λ(status : < Empty | NonEmpty : Text >) + → merge + { Empty = + < Empty | NonEmpty : Text >.NonEmpty element + , NonEmpty = + λ(result : Text) + → < Empty | NonEmpty : Text >.NonEmpty + (element ++ "," ++ result) + } + status + : < Empty | NonEmpty : Text > + ) + < Empty | NonEmpty : Text >.Empty + ) + : Text + ) + ++ " " + ++ ( merge + { Empty = "", NonEmpty = λ(result : Text) → result } + ( List/fold + Text + x.mandatoryFeatures + < Empty | NonEmpty : Text > + ( λ(element : Text) + → λ(status : < Empty | NonEmpty : Text >) + → merge + { Empty = + < Empty | NonEmpty : Text >.NonEmpty element + , NonEmpty = + λ(result : Text) + → < Empty | NonEmpty : Text >.NonEmpty + (element ++ "," ++ result) + } + status + : < Empty | NonEmpty : Text > + ) + < Empty | NonEmpty : Text >.Empty + ) + : Text + ) + ++ '' + + '' + ++ y + ) + "" diff --git a/dhall-lang/tests/parser/success/largeExpressionB.dhallb b/dhall-lang/tests/parser/success/largeExpressionB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/largeExpressionB.dhallb differ diff --git a/dhall-lang/tests/parser/success/leadingSeparatorsA.dhall b/dhall-lang/tests/parser/success/leadingSeparatorsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/leadingSeparatorsA.dhall @@ -0,0 +1,10 @@ +{ emptyRecordLiteral = { , = } +, emptyRecordType = { , } +, emptyList = [,] : List Natural +, emptyUnionType = < | > + +, recordLiteral = { , x = 1, y = True } +, recordType = { , x : Natural, y : Bool } +, list = [ , 1, 2 ] +, unionType = < | x : Natural | y : Bool > +} diff --git a/dhall-lang/tests/parser/success/leadingSeparatorsB.dhallb b/dhall-lang/tests/parser/success/leadingSeparatorsB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/leadingSeparatorsB.dhallb @@ -0,0 +1,1 @@ +‚¨iemptyList‚gNaturalremptyRecordLiteral‚ oemptyRecordType‚ nemptyUnionType‚  dlist„ö‚‚mrecordLiteral‚¢ax‚ayõjrecordType‚¢axgNaturalaydBooliunionType‚ ¢axgNaturalaydBool diff --git a/dhall-lang/tests/parser/success/leadingTabsA.dhall b/dhall-lang/tests/parser/success/leadingTabsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/leadingTabsA.dhall @@ -0,0 +1,21 @@ +{- This test verifies that leading tabs are correctly stripped + + Since one line is blank and the other line only has tabs, they are all + stripped since they all count as leading whitespace for dedenting purposes. + + The end result is that the dedented string is equivalent to: + +``` +'' + +'' +``` + + ... which desugars to a single "\n". + + Carefully note that the two spaces before the starting quotes are not + counted for dedenting purposes. +-} + '' + + '' diff --git a/dhall-lang/tests/parser/success/leadingTabsB.dhallb b/dhall-lang/tests/parser/success/leadingTabsB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/leadingTabsB.dhallb @@ -0,0 +1,1 @@ +‚a diff --git a/dhall-lang/tests/parser/success/lineCommentA.dhall b/dhall-lang/tests/parser/success/lineCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/lineCommentA.dhall @@ -0,0 +1,3 @@ +-- foo + +1 diff --git a/dhall-lang/tests/parser/success/lineCommentB.dhallb b/dhall-lang/tests/parser/success/lineCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/lineCommentB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/lineCommentCRLFA.dhall b/dhall-lang/tests/parser/success/lineCommentCRLFA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/lineCommentCRLFA.dhall @@ -0,0 +1,3 @@ +-- foo + +1 diff --git a/dhall-lang/tests/parser/success/lineCommentCRLFB.dhallb b/dhall-lang/tests/parser/success/lineCommentCRLFB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/lineCommentCRLFB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/listA.dhall b/dhall-lang/tests/parser/success/listA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/listA.dhall @@ -0,0 +1,4 @@ +[ [+1, +2, +3] +, [+1, +2, +3] : List Integer +, [] : List Integer +] diff --git a/dhall-lang/tests/parser/success/listB.dhallb b/dhall-lang/tests/parser/success/listB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/listB.dhallb differ diff --git a/dhall-lang/tests/parser/success/listWithCommentA.dhall b/dhall-lang/tests/parser/success/listWithCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/listWithCommentA.dhall @@ -0,0 +1,3 @@ +[ + 1, -- item one +{- foo -} 2, 3 ] diff --git a/dhall-lang/tests/parser/success/listWithCommentB.dhallb b/dhall-lang/tests/parser/success/listWithCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/listWithCommentB.dhallb @@ -0,0 +1,1 @@ +…ö‚‚‚ diff --git a/dhall-lang/tests/parser/success/mergeA.dhall b/dhall-lang/tests/parser/success/mergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/mergeA.dhall @@ -0,0 +1,7 @@ + λ(x : <>) +→ { bar = merge {=} x : Integer + , foo = + merge + { Left = λ(b : Bool) → b, Right = Natural/even } + (< Left : Bool | Right : Natural >.Left True) + } diff --git a/dhall-lang/tests/parser/success/mergeB.dhallb b/dhall-lang/tests/parser/success/mergeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/mergeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/missingFooA.dhall b/dhall-lang/tests/parser/success/missingFooA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/missingFooA.dhall @@ -0,0 +1,1 @@ +missingFoo diff --git a/dhall-lang/tests/parser/success/missingFooB.dhallb b/dhall-lang/tests/parser/success/missingFooB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/missingFooB.dhallb differ diff --git a/dhall-lang/tests/parser/success/missingInParenthesesA.dhall b/dhall-lang/tests/parser/success/missingInParenthesesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/missingInParenthesesA.dhall @@ -0,0 +1,1 @@ +(missing) diff --git a/dhall-lang/tests/parser/success/missingInParenthesesB.dhallb b/dhall-lang/tests/parser/success/missingInParenthesesB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/missingInParenthesesB.dhallb differ diff --git a/dhall-lang/tests/parser/success/missingSlashA.dhall b/dhall-lang/tests/parser/success/missingSlashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/missingSlashA.dhall @@ -0,0 +1,1 @@ +missing/ diff --git a/dhall-lang/tests/parser/success/missingSlashB.dhallb b/dhall-lang/tests/parser/success/missingSlashB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/missingSlashB.dhallb differ diff --git a/dhall-lang/tests/parser/success/mixedBlockLineCommentA.dhall b/dhall-lang/tests/parser/success/mixedBlockLineCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/mixedBlockLineCommentA.dhall @@ -0,0 +1,6 @@ +{- foo -} +-- bar +{- --baz -} +-- {- qux -} + +1 diff --git a/dhall-lang/tests/parser/success/mixedBlockLineCommentB.dhallb b/dhall-lang/tests/parser/success/mixedBlockLineCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/mixedBlockLineCommentB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/naturalA.dhall b/dhall-lang/tests/parser/success/naturalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/naturalA.dhall @@ -0,0 +1,1 @@ +[ 0, 1, 10 ] diff --git a/dhall-lang/tests/parser/success/naturalB.dhallb b/dhall-lang/tests/parser/success/naturalB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/naturalB.dhallb differ diff --git a/dhall-lang/tests/parser/success/nestedBlockCommentA.dhall b/dhall-lang/tests/parser/success/nestedBlockCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/nestedBlockCommentA.dhall @@ -0,0 +1,3 @@ +{- foo {- bar -} baz -} + +1 diff --git a/dhall-lang/tests/parser/success/nestedBlockCommentB.dhallb b/dhall-lang/tests/parser/success/nestedBlockCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/nestedBlockCommentB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/operatorsA.dhall b/dhall-lang/tests/parser/success/operatorsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/operatorsA.dhall @@ -0,0 +1,3 @@ + { foo = False && Natural/even (1 + 2 * 3) || True == False != True } +∧ { bar = [ "ABC" ++ "DEF" ] # [ "GHI" ] } ⫽ { baz = True } +: { foo : Bool, baz: Bool } ⩓ { bar : List Text } diff --git a/dhall-lang/tests/parser/success/operatorsB.dhallb b/dhall-lang/tests/parser/success/operatorsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/operatorsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/preferMissingNoSpacesA.dhall b/dhall-lang/tests/parser/success/preferMissingNoSpacesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/preferMissingNoSpacesA.dhall @@ -0,0 +1,1 @@ +missing//foo diff --git a/dhall-lang/tests/parser/success/preferMissingNoSpacesB.dhallb b/dhall-lang/tests/parser/success/preferMissingNoSpacesB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/preferMissingNoSpacesB.dhallb differ diff --git a/dhall-lang/tests/parser/success/quotedBoundVariableA.dhall b/dhall-lang/tests/parser/success/quotedBoundVariableA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/quotedBoundVariableA.dhall @@ -0,0 +1,1 @@ +(\(`Natural/even`: Natural -> Bool) -> `Natural/even`) Natural/odd 0 diff --git a/dhall-lang/tests/parser/success/quotedBoundVariableB.dhallb b/dhall-lang/tests/parser/success/quotedBoundVariableB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/quotedBoundVariableB.dhallb differ diff --git a/dhall-lang/tests/parser/success/quotedLabelA.dhall b/dhall-lang/tests/parser/success/quotedLabelA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/quotedLabelA.dhall @@ -0,0 +1,5 @@ +{ example1 = let `let` = 1 in `let` +, example2 = let `:.` = 1 in `:.` +, example3 = let `$ref` = 1 in `$ref` +, example4 = let `` = 1 in `` +} diff --git a/dhall-lang/tests/parser/success/quotedLabelB.dhallb b/dhall-lang/tests/parser/success/quotedLabelB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/quotedLabelB.dhallb differ diff --git a/dhall-lang/tests/parser/success/quotedRecordLabelA.dhall b/dhall-lang/tests/parser/success/quotedRecordLabelA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/quotedRecordLabelA.dhall @@ -0,0 +1,1 @@ +{foo = 1, `` = 2, ` ` = 3} diff --git a/dhall-lang/tests/parser/success/quotedRecordLabelB.dhallb b/dhall-lang/tests/parser/success/quotedRecordLabelB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/quotedRecordLabelB.dhallb @@ -0,0 +1,1 @@ +‚£`‚a ‚cfoo‚ diff --git a/dhall-lang/tests/parser/success/quotedUnionLabelA.dhall b/dhall-lang/tests/parser/success/quotedUnionLabelA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/quotedUnionLabelA.dhall @@ -0,0 +1,1 @@ + diff --git a/dhall-lang/tests/parser/success/quotedUnionLabelB.dhallb b/dhall-lang/tests/parser/success/quotedUnionLabelB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/quotedUnionLabelB.dhallb @@ -0,0 +1,1 @@ +‚ £`gNaturala gNaturalcfoogNatural diff --git a/dhall-lang/tests/parser/success/recordA.dhall b/dhall-lang/tests/parser/success/recordA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/recordA.dhall @@ -0,0 +1,4 @@ +{ foo = +1 +, bar = 2 +, baz = True +} : { foo : Integer, bar : Natural, baz : Bool } diff --git a/dhall-lang/tests/parser/success/recordB.dhallb b/dhall-lang/tests/parser/success/recordB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/recordB.dhallb @@ -0,0 +1,1 @@ +ƒ‚£cbar‚cbazõcfoo‚‚£cbargNaturalcbazdBoolcfoogInteger diff --git a/dhall-lang/tests/parser/success/recordProjectionByExpressionA.dhall b/dhall-lang/tests/parser/success/recordProjectionByExpressionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/recordProjectionByExpressionA.dhall @@ -0,0 +1,15 @@ +let example1 = λ(A : Type) → λ(B : Type) → λ(C : { x : A, y : B }) → C.({ x : A }) : { x : A } + +let example2 = + λ(A : Type) + → λ(B : Type) + → λ(C : { p : A, q : B }) + → C.(let r = { p : A } in r) : { p : A } + +let A = Natural + +let B = Text + +in + +(example1 A B { x = 10, y = "Text" }) ∧ (example2 A B { p = 10, q = "Text" }) : { x : A, p : A } diff --git a/dhall-lang/tests/parser/success/recordProjectionByExpressionB.dhallb b/dhall-lang/tests/parser/success/recordProjectionByExpressionB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/recordProjectionByExpressionB.dhallb differ diff --git a/dhall-lang/tests/parser/success/reservedPrefixA.dhall b/dhall-lang/tests/parser/success/reservedPrefixA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/reservedPrefixA.dhall @@ -0,0 +1,1 @@ +let TypeSynonym = Integer in +1 : TypeSynonym diff --git a/dhall-lang/tests/parser/success/reservedPrefixB.dhallb b/dhall-lang/tests/parser/success/reservedPrefixB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/reservedPrefixB.dhallb differ diff --git a/dhall-lang/tests/parser/success/text/dollarSignA.dhall b/dhall-lang/tests/parser/success/text/dollarSignA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/dollarSignA.dhall @@ -0,0 +1,1 @@ +"$" diff --git a/dhall-lang/tests/parser/success/text/dollarSignB.dhallb b/dhall-lang/tests/parser/success/text/dollarSignB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/dollarSignB.dhallb @@ -0,0 +1,1 @@ +‚a$ diff --git a/dhall-lang/tests/parser/success/text/doubleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/doubleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/doubleQuotedStringA.dhall @@ -0,0 +1,1 @@ +"ABC" diff --git a/dhall-lang/tests/parser/success/text/doubleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/doubleQuotedStringB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/doubleQuotedStringB.dhallb @@ -0,0 +1,1 @@ +‚cABC diff --git a/dhall-lang/tests/parser/success/text/escapeA.dhall b/dhall-lang/tests/parser/success/text/escapeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/escapeA.dhall @@ -0,0 +1,9 @@ +-- Verify that an implementation is processing escape sequences correctly + +'' +''${ +''' +$ +" +\ +'' diff --git a/dhall-lang/tests/parser/success/text/escapeB.dhallb b/dhall-lang/tests/parser/success/text/escapeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/escapeB.dhallb @@ -0,0 +1,5 @@ +‚l${ +'' +$ +" +\ diff --git a/dhall-lang/tests/parser/success/text/escapedDoubleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/escapedDoubleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/escapedDoubleQuotedStringA.dhall @@ -0,0 +1,1 @@ +"\\\"\$\\\/\b\f\n\r\t\u{1D11E} \u2200(a : Type) \u2192 a" diff --git a/dhall-lang/tests/parser/success/text/escapedDoubleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/escapedDoubleQuotedStringB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/escapedDoubleQuotedStringB.dhallb @@ -0,0 +1,2 @@ +‚x"\"$\/ + 𝄞 ∀(a : Type) → a diff --git a/dhall-lang/tests/parser/success/text/escapedSingleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/escapedSingleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/escapedSingleQuotedStringA.dhall @@ -0,0 +1,4 @@ +'' +''${ +''' +'' diff --git a/dhall-lang/tests/parser/success/text/escapedSingleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/escapedSingleQuotedStringB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/escapedSingleQuotedStringB.dhallb @@ -0,0 +1,2 @@ +‚f${ +'' diff --git a/dhall-lang/tests/parser/success/text/interestingA.dhall b/dhall-lang/tests/parser/success/text/interestingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/interestingA.dhall @@ -0,0 +1,7 @@ +-- Non-trivial example that combines several multi-line literal features + +λ(x : Text) → '' + ${x} baz + bar + foo + '' diff --git a/dhall-lang/tests/parser/success/text/interestingB.dhallb b/dhall-lang/tests/parser/success/text/interestingB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/text/interestingB.dhallb differ diff --git a/dhall-lang/tests/parser/success/text/interiorIndentA.dhall b/dhall-lang/tests/parser/success/text/interiorIndentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/interiorIndentA.dhall @@ -0,0 +1,16 @@ +{- The indent is computed as the minimum number of leading spaces over all lines + in a multi-line literal, including the line right before the closing quotes. + In this case, there are three lines: + + * The first line containing " foo" with two leading spaces + * The second line containing " bar" with two leading spaces + * The third line containing "" with zero leading spaces + + Since the last line has zero leading spaces, the minimum number of leading + spaces over all three lines is zero, so we don't strip any spaces. +-} + +'' + foo + bar +'' diff --git a/dhall-lang/tests/parser/success/text/interiorIndentB.dhallb b/dhall-lang/tests/parser/success/text/interiorIndentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/interiorIndentB.dhallb @@ -0,0 +1,2 @@ +‚l foo + bar diff --git a/dhall-lang/tests/parser/success/text/interpolatedDoubleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/interpolatedDoubleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/interpolatedDoubleQuotedStringA.dhall @@ -0,0 +1,1 @@ +"ABC${Natural/show 123}" diff --git a/dhall-lang/tests/parser/success/text/interpolatedDoubleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/interpolatedDoubleQuotedStringB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/text/interpolatedDoubleQuotedStringB.dhallb differ diff --git a/dhall-lang/tests/parser/success/text/interpolatedSingleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/interpolatedSingleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/interpolatedSingleQuotedStringA.dhall @@ -0,0 +1,4 @@ +'' +ABC +${Natural/show 123} +'' diff --git a/dhall-lang/tests/parser/success/text/interpolatedSingleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/interpolatedSingleQuotedStringB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/text/interpolatedSingleQuotedStringB.dhallb differ diff --git a/dhall-lang/tests/parser/success/text/interpolationA.dhall b/dhall-lang/tests/parser/success/text/interpolationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/interpolationA.dhall @@ -0,0 +1,9 @@ +{- This example verifies that an implementation is correctly breaking leading + spaces at interpolated expressions. The first line has the fewest number of + leading spaces (2) due to the interruption by the interpolated expression. +-} + +'' +${Natural/show 1} foo + bar +'' diff --git a/dhall-lang/tests/parser/success/text/interpolationB.dhallb b/dhall-lang/tests/parser/success/text/interpolationB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/text/interpolationB.dhallb differ diff --git a/dhall-lang/tests/parser/success/text/multilineBlankLineA.dhall b/dhall-lang/tests/parser/success/text/multilineBlankLineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineBlankLineA.dhall @@ -0,0 +1,5 @@ + '' + hello + + there + '' diff --git a/dhall-lang/tests/parser/success/text/multilineBlankLineB.dhallb b/dhall-lang/tests/parser/success/text/multilineBlankLineB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineBlankLineB.dhallb @@ -0,0 +1,3 @@ +‚mhello + +there diff --git a/dhall-lang/tests/parser/success/text/multilineBlankLineCrlfA.dhall b/dhall-lang/tests/parser/success/text/multilineBlankLineCrlfA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineBlankLineCrlfA.dhall @@ -0,0 +1,5 @@ + '' + hello + + there + '' diff --git a/dhall-lang/tests/parser/success/text/multilineBlankLineCrlfB.dhallb b/dhall-lang/tests/parser/success/text/multilineBlankLineCrlfB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineBlankLineCrlfB.dhallb @@ -0,0 +1,3 @@ +‚mhello + +there diff --git a/dhall-lang/tests/parser/success/text/multilineCorruptedLeadingWhitespaceA.dhall b/dhall-lang/tests/parser/success/text/multilineCorruptedLeadingWhitespaceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineCorruptedLeadingWhitespaceA.dhall @@ -0,0 +1,5 @@ + '' + hai + there + ok + '' diff --git a/dhall-lang/tests/parser/success/text/multilineCorruptedLeadingWhitespaceB.dhallb b/dhall-lang/tests/parser/success/text/multilineCorruptedLeadingWhitespaceB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineCorruptedLeadingWhitespaceB.dhallb @@ -0,0 +1,4 @@ +‚q hai + there + ok + diff --git a/dhall-lang/tests/parser/success/text/multilineIndentedAndAlignedA.dhall b/dhall-lang/tests/parser/success/text/multilineIndentedAndAlignedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineIndentedAndAlignedA.dhall @@ -0,0 +1,4 @@ + '' + hai + there + '' diff --git a/dhall-lang/tests/parser/success/text/multilineIndentedAndAlignedB.dhallb b/dhall-lang/tests/parser/success/text/multilineIndentedAndAlignedB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineIndentedAndAlignedB.dhallb @@ -0,0 +1,2 @@ +‚jhai +there diff --git a/dhall-lang/tests/parser/success/text/multilineMismatchedLeadingWhitespaceA.dhall b/dhall-lang/tests/parser/success/text/multilineMismatchedLeadingWhitespaceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineMismatchedLeadingWhitespaceA.dhall @@ -0,0 +1,4 @@ +'' + a + b +'' diff --git a/dhall-lang/tests/parser/success/text/multilineMismatchedLeadingWhitespaceB.dhallb b/dhall-lang/tests/parser/success/text/multilineMismatchedLeadingWhitespaceB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineMismatchedLeadingWhitespaceB.dhallb @@ -0,0 +1,2 @@ +‚f a + b diff --git a/dhall-lang/tests/parser/success/text/multilinePreserveCommentA.dhall b/dhall-lang/tests/parser/success/text/multilinePreserveCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilinePreserveCommentA.dhall @@ -0,0 +1,8 @@ +{- A comment within the interior of a multi-line literal counts as part of the + literal +-} + +'' +-- Hello +{- world -} +'' diff --git a/dhall-lang/tests/parser/success/text/multilinePreserveCommentB.dhallb b/dhall-lang/tests/parser/success/text/multilinePreserveCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilinePreserveCommentB.dhallb @@ -0,0 +1,2 @@ +‚u-- Hello +{- world -} diff --git a/dhall-lang/tests/parser/success/text/multilineTabsA.dhall b/dhall-lang/tests/parser/success/text/multilineTabsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineTabsA.dhall @@ -0,0 +1,5 @@ + '' + hai + there + lol + '' diff --git a/dhall-lang/tests/parser/success/text/multilineTabsB.dhallb b/dhall-lang/tests/parser/success/text/multilineTabsB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/multilineTabsB.dhallb @@ -0,0 +1,3 @@ +‚rhai + there + lol diff --git a/dhall-lang/tests/parser/success/text/nonAssignedUnicodeA.dhall b/dhall-lang/tests/parser/success/text/nonAssignedUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/nonAssignedUnicodeA.dhall @@ -0,0 +1,1 @@ +"\u{1FFF0}" diff --git a/dhall-lang/tests/parser/success/text/nonAssignedUnicodeB.dhallb b/dhall-lang/tests/parser/success/text/nonAssignedUnicodeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/nonAssignedUnicodeB.dhallb @@ -0,0 +1,1 @@ +‚d🿰 diff --git a/dhall-lang/tests/parser/success/text/preserveCommentA.dhall b/dhall-lang/tests/parser/success/text/preserveCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/preserveCommentA.dhall @@ -0,0 +1,1 @@ +"-- $--$--{--}$" diff --git a/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb b/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb @@ -0,0 +1,1 @@ +‚n-- $--$--{--}$ diff --git a/dhall-lang/tests/parser/success/text/singleLineA.dhall b/dhall-lang/tests/parser/success/text/singleLineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/singleLineA.dhall @@ -0,0 +1,6 @@ +{- This is how you encode a multi-line literal that contains no newlines + + The leading newline is stripped +-} +'' +foo'' diff --git a/dhall-lang/tests/parser/success/text/singleLineB.dhallb b/dhall-lang/tests/parser/success/text/singleLineB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/singleLineB.dhallb @@ -0,0 +1,1 @@ +‚cfoo diff --git a/dhall-lang/tests/parser/success/text/singleQuoteConcatA.dhall b/dhall-lang/tests/parser/success/text/singleQuoteConcatA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/singleQuoteConcatA.dhall @@ -0,0 +1,5 @@ +'' +a'' +++ +'' +b'' diff --git a/dhall-lang/tests/parser/success/text/singleQuoteConcatB.dhallb b/dhall-lang/tests/parser/success/text/singleQuoteConcatB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/singleQuoteConcatB.dhallb @@ -0,0 +1,1 @@ +„‚aa‚ab diff --git a/dhall-lang/tests/parser/success/text/singleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/singleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/singleQuotedStringA.dhall @@ -0,0 +1,4 @@ +'' +ABC +DEF +'' diff --git a/dhall-lang/tests/parser/success/text/singleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/singleQuotedStringB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/singleQuotedStringB.dhallb @@ -0,0 +1,2 @@ +‚hABC +DEF diff --git a/dhall-lang/tests/parser/success/text/templateA.dhall b/dhall-lang/tests/parser/success/text/templateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/templateA.dhall @@ -0,0 +1,13 @@ + \(record : { name : Text + , value : Double + , taxed_value : Double + , in_ca : Bool + } + ) -> '' +Hello ${record.name} +You have just won ${Double/show record.value} dollars! +${ if record.in_ca + then "Well, ${Double/show record.taxed_value} dollars, after taxes" + else "" + } +'' diff --git a/dhall-lang/tests/parser/success/text/templateB.dhallb b/dhall-lang/tests/parser/success/text/templateB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/text/templateB.dhallb differ diff --git a/dhall-lang/tests/parser/success/text/twoLinesA.dhall b/dhall-lang/tests/parser/success/text/twoLinesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/twoLinesA.dhall @@ -0,0 +1,7 @@ +{- Verify that an implementation is correctly preserving newlines in the + corresponding double-quoted literal +-} + +'' +foo +bar'' diff --git a/dhall-lang/tests/parser/success/text/twoLinesB.dhallb b/dhall-lang/tests/parser/success/text/twoLinesB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/twoLinesB.dhallb @@ -0,0 +1,2 @@ +‚gfoo +bar diff --git a/dhall-lang/tests/parser/success/text/unicodeBracedA.dhall b/dhall-lang/tests/parser/success/text/unicodeBracedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeBracedA.dhall @@ -0,0 +1,1 @@ +"\u{1}\u{10}\u{100}\u{1000}\u{10000}\u{100000}" diff --git a/dhall-lang/tests/parser/success/text/unicodeBracedB.dhallb b/dhall-lang/tests/parser/success/text/unicodeBracedB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeBracedB.dhallb @@ -0,0 +1,1 @@ +‚oĀက𐀀ô€€€ diff --git a/dhall-lang/tests/parser/success/text/unicodeDoubleQuotedStringA.dhall b/dhall-lang/tests/parser/success/text/unicodeDoubleQuotedStringA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeDoubleQuotedStringA.dhall @@ -0,0 +1,1 @@ +"∀(a : Type) → a" diff --git a/dhall-lang/tests/parser/success/text/unicodeDoubleQuotedStringB.dhallb b/dhall-lang/tests/parser/success/text/unicodeDoubleQuotedStringB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeDoubleQuotedStringB.dhallb @@ -0,0 +1,1 @@ +‚s∀(a : Type) → a diff --git a/dhall-lang/tests/parser/success/text/unicodeEscapedA.dhall b/dhall-lang/tests/parser/success/text/unicodeEscapedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeEscapedA.dhall @@ -0,0 +1,1 @@ +"A\u2115B\u{1FA00}C\u{43}D\u{00000001F574}E\u0022F" diff --git a/dhall-lang/tests/parser/success/text/unicodeEscapedB.dhallb b/dhall-lang/tests/parser/success/text/unicodeEscapedB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodeEscapedB.dhallb @@ -0,0 +1,1 @@ +‚sAℕB🨀CCD🕴E"F diff --git a/dhall-lang/tests/parser/success/text/unicodePlane16A.dhall b/dhall-lang/tests/parser/success/text/unicodePlane16A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodePlane16A.dhall @@ -0,0 +1,1 @@ +"\u{10fffd}\u{1fffd}" diff --git a/dhall-lang/tests/parser/success/text/unicodePlane16B.dhallb b/dhall-lang/tests/parser/success/text/unicodePlane16B.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/text/unicodePlane16B.dhallb @@ -0,0 +1,1 @@ +‚hô¿½ðŸ¿½ diff --git a/dhall-lang/tests/parser/success/time/DateTimeA.dhall b/dhall-lang/tests/parser/success/time/DateTimeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/time/DateTimeA.dhall @@ -0,0 +1,1 @@ +1960-12-25T04:23:34 diff --git a/dhall-lang/tests/parser/success/time/DateTimeB.dhallb b/dhall-lang/tests/parser/success/time/DateTimeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/time/DateTimeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/time/DateTimeTimeZoneA.dhall b/dhall-lang/tests/parser/success/time/DateTimeTimeZoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/time/DateTimeTimeZoneA.dhall @@ -0,0 +1,1 @@ +2020-01-01T12:00:00-08:00 diff --git a/dhall-lang/tests/parser/success/time/DateTimeTimeZoneB.dhallb b/dhall-lang/tests/parser/success/time/DateTimeTimeZoneB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/time/DateTimeTimeZoneB.dhallb differ diff --git a/dhall-lang/tests/parser/success/time/LowercaseTA.dhall b/dhall-lang/tests/parser/success/time/LowercaseTA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/time/LowercaseTA.dhall @@ -0,0 +1,2 @@ +-- Check that lowercase `t` is supported +2000-01-01t12:00:00 diff --git a/dhall-lang/tests/parser/success/time/LowercaseTB.dhallb b/dhall-lang/tests/parser/success/time/LowercaseTB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/time/LowercaseTB.dhallb differ diff --git a/dhall-lang/tests/parser/success/time/TimeTimeZoneA.dhall b/dhall-lang/tests/parser/success/time/TimeTimeZoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/time/TimeTimeZoneA.dhall @@ -0,0 +1,1 @@ +00:00:00+00:00 diff --git a/dhall-lang/tests/parser/success/time/TimeTimeZoneB.dhallb b/dhall-lang/tests/parser/success/time/TimeTimeZoneB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/time/TimeTimeZoneB.dhallb differ diff --git a/dhall-lang/tests/parser/success/time/TimeTimeZoneZA.dhall b/dhall-lang/tests/parser/success/time/TimeTimeZoneZA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/time/TimeTimeZoneZA.dhall @@ -0,0 +1,5 @@ +-- Same as `./TimeTimeZoneA.dhall`, but with `Z` as the `TimeZone` +-- +-- This ensures that implementation still parse `Z` in conjunction with a time, +-- even if `Z` by itself is not permitted +00:00:00Z diff --git a/dhall-lang/tests/parser/success/time/TimeTimeZoneZB.dhallb b/dhall-lang/tests/parser/success/time/TimeTimeZoneZB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/time/TimeTimeZoneZB.dhallb differ diff --git a/dhall-lang/tests/parser/success/toMapA.dhall b/dhall-lang/tests/parser/success/toMapA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/toMapA.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4, baz= 9 } diff --git a/dhall-lang/tests/parser/success/toMapB.dhallb b/dhall-lang/tests/parser/success/toMapB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/toMapB.dhallb @@ -0,0 +1,1 @@ +‚‚£cbar‚cbaz‚ cfoo‚ diff --git a/dhall-lang/tests/parser/success/unicodeCommentA.dhall b/dhall-lang/tests/parser/success/unicodeCommentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unicodeCommentA.dhall @@ -0,0 +1,3 @@ +{- ∀(a : Type) → a -} + +1 diff --git a/dhall-lang/tests/parser/success/unicodeCommentB.dhallb b/dhall-lang/tests/parser/success/unicodeCommentB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unicodeCommentB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/unit/AnnotationA.dhall b/dhall-lang/tests/parser/success/unit/AnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/AnnotationA.dhall @@ -0,0 +1,1 @@ +x : T diff --git a/dhall-lang/tests/parser/success/unit/AnnotationB.dhallb b/dhall-lang/tests/parser/success/unit/AnnotationB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/AnnotationB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/AssertA.dhall b/dhall-lang/tests/parser/success/unit/AssertA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/AssertA.dhall @@ -0,0 +1,1 @@ +assert : T diff --git a/dhall-lang/tests/parser/success/unit/AssertB.dhallb b/dhall-lang/tests/parser/success/unit/AssertB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/AssertB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/AssertEquivalenceA.dhall b/dhall-lang/tests/parser/success/unit/AssertEquivalenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/AssertEquivalenceA.dhall @@ -0,0 +1,1 @@ +assert : x === y diff --git a/dhall-lang/tests/parser/success/unit/AssertEquivalenceB.dhallb b/dhall-lang/tests/parser/success/unit/AssertEquivalenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/AssertEquivalenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/AssertEquivalenceUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/AssertEquivalenceUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/AssertEquivalenceUnicodeA.dhall @@ -0,0 +1,1 @@ +assert : x ≡ y diff --git a/dhall-lang/tests/parser/success/unit/AssertEquivalenceUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/AssertEquivalenceUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/AssertEquivalenceUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/AssertPrecedenceA.dhall b/dhall-lang/tests/parser/success/unit/AssertPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/AssertPrecedenceA.dhall @@ -0,0 +1,1 @@ +assert : T U diff --git a/dhall-lang/tests/parser/success/unit/AssertPrecedenceB.dhallb b/dhall-lang/tests/parser/success/unit/AssertPrecedenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/AssertPrecedenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/BoolA.dhall b/dhall-lang/tests/parser/success/unit/BoolA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/BoolA.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/parser/success/unit/BoolB.dhallb b/dhall-lang/tests/parser/success/unit/BoolB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/BoolB.dhallb @@ -0,0 +1,1 @@ +dBool diff --git a/dhall-lang/tests/parser/success/unit/BoolLitTrueA.dhall b/dhall-lang/tests/parser/success/unit/BoolLitTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/BoolLitTrueA.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/parser/success/unit/BoolLitTrueB.dhallb b/dhall-lang/tests/parser/success/unit/BoolLitTrueB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/BoolLitTrueB.dhallb @@ -0,0 +1,1 @@ +õ diff --git a/dhall-lang/tests/parser/success/unit/BuiltinListBuildA.dhall b/dhall-lang/tests/parser/success/unit/BuiltinListBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/BuiltinListBuildA.dhall @@ -0,0 +1,1 @@ +List/Build diff --git a/dhall-lang/tests/parser/success/unit/BuiltinListBuildB.dhallb b/dhall-lang/tests/parser/success/unit/BuiltinListBuildB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/BuiltinListBuildB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/CompletionA.dhall b/dhall-lang/tests/parser/success/unit/CompletionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/CompletionA.dhall @@ -0,0 +1,1 @@ +T :: r diff --git a/dhall-lang/tests/parser/success/unit/CompletionB.dhallb b/dhall-lang/tests/parser/success/unit/CompletionB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/CompletionB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DateA.dhall b/dhall-lang/tests/parser/success/unit/DateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DateA.dhall @@ -0,0 +1,1 @@ +Date diff --git a/dhall-lang/tests/parser/success/unit/DateB.dhallb b/dhall-lang/tests/parser/success/unit/DateB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DateB.dhallb @@ -0,0 +1,1 @@ +dDate diff --git a/dhall-lang/tests/parser/success/unit/DateLiteralA.dhall b/dhall-lang/tests/parser/success/unit/DateLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DateLiteralA.dhall @@ -0,0 +1,1 @@ +2020-01-01 diff --git a/dhall-lang/tests/parser/success/unit/DateLiteralB.dhallb b/dhall-lang/tests/parser/success/unit/DateLiteralB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DateLiteralB.dhallb @@ -0,0 +1,1 @@ +„ä diff --git a/dhall-lang/tests/parser/success/unit/DeBruijnIndexA.dhall b/dhall-lang/tests/parser/success/unit/DeBruijnIndexA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DeBruijnIndexA.dhall @@ -0,0 +1,1 @@ +x == x@0 diff --git a/dhall-lang/tests/parser/success/unit/DeBruijnIndexB.dhallb b/dhall-lang/tests/parser/success/unit/DeBruijnIndexB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DeBruijnIndexB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLit16bitA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLit16bitA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLit16bitA.dhall @@ -0,0 +1,1 @@ +5.5 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLit16bitB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLit16bitB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLit16bitB.dhallb @@ -0,0 +1,1 @@ +ùE€ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLit32bitA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLit32bitA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLit32bitA.dhall @@ -0,0 +1,1 @@ +5555.5 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLit32bitB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLit32bitB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLit32bitB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLit64bitA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLit64bitA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLit64bitA.dhall @@ -0,0 +1,1 @@ +55555555555.5 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLit64bitB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLit64bitB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLit64bitB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitExponentA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitExponentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitExponentA.dhall @@ -0,0 +1,1 @@ +1.23e4 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitExponentB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitExponentB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitExponentB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitExponentNegativeA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNegativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNegativeA.dhall @@ -0,0 +1,1 @@ +1.23e-4 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitExponentNegativeB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNegativeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNegativeB.dhallb @@ -0,0 +1,1 @@ +û? 1ônÒF diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitExponentNoDotA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNoDotA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNoDotA.dhall @@ -0,0 +1,1 @@ +1e4 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitExponentNoDotB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNoDotB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitExponentNoDotB.dhallb @@ -0,0 +1,1 @@ +ùpâ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitInfinityA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitInfinityA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitInfinityA.dhall @@ -0,0 +1,1 @@ +Infinity diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitInfinityB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitInfinityB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitInfinityB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNaNA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitNaNA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitNaNA.dhall @@ -0,0 +1,1 @@ +NaN diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNaNB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitNaNB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitNaNB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNegInfinityA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitNegInfinityA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitNegInfinityA.dhall @@ -0,0 +1,1 @@ +-Infinity diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNegInfinityB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitNegInfinityB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitNegInfinityB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNegZeroA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitNegZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitNegZeroA.dhall @@ -0,0 +1,1 @@ +-0.0 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNegZeroB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitNegZeroB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitNegZeroB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNegativeA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitNegativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitNegativeA.dhall @@ -0,0 +1,1 @@ +-1.23 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitNegativeB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitNegativeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitNegativeB.dhallb @@ -0,0 +1,1 @@ +û¿ó®záG® diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitPositiveA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitPositiveA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitPositiveA.dhall @@ -0,0 +1,1 @@ +1.23 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitPositiveB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitPositiveB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitPositiveB.dhallb @@ -0,0 +1,1 @@ +û?ó®záG® diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntA.dhall @@ -0,0 +1,5 @@ +{- + Some languages do not make principled distinctions between number types, so + this checks that this Double is not silently considered as a Natural +-} +1.0 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitSecretlyIntB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitZeroA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/DoubleLitZeroA.dhall @@ -0,0 +1,1 @@ +0.0 diff --git a/dhall-lang/tests/parser/success/unit/DoubleLitZeroB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitZeroB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/DoubleLitZeroB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/EmptyRecordLiteralA.dhall b/dhall-lang/tests/parser/success/unit/EmptyRecordLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/EmptyRecordLiteralA.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/dhall-lang/tests/parser/success/unit/EmptyRecordLiteralB.dhallb b/dhall-lang/tests/parser/success/unit/EmptyRecordLiteralB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/EmptyRecordLiteralB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/FieldA.dhall b/dhall-lang/tests/parser/success/unit/FieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FieldA.dhall @@ -0,0 +1,1 @@ +r.x diff --git a/dhall-lang/tests/parser/success/unit/FieldB.dhallb b/dhall-lang/tests/parser/success/unit/FieldB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FieldB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FieldBuiltinNameA.dhall b/dhall-lang/tests/parser/success/unit/FieldBuiltinNameA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FieldBuiltinNameA.dhall @@ -0,0 +1,1 @@ +r.List diff --git a/dhall-lang/tests/parser/success/unit/FieldBuiltinNameB.dhallb b/dhall-lang/tests/parser/success/unit/FieldBuiltinNameB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FieldBuiltinNameB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FieldQuotedA.dhall b/dhall-lang/tests/parser/success/unit/FieldQuotedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FieldQuotedA.dhall @@ -0,0 +1,1 @@ +r.`x` diff --git a/dhall-lang/tests/parser/success/unit/FieldQuotedB.dhallb b/dhall-lang/tests/parser/success/unit/FieldQuotedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FieldQuotedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ForallA.dhall b/dhall-lang/tests/parser/success/unit/ForallA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ForallA.dhall @@ -0,0 +1,1 @@ +forall(x: T) -> x diff --git a/dhall-lang/tests/parser/success/unit/ForallB.dhallb b/dhall-lang/tests/parser/success/unit/ForallB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ForallB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ForallNestedA.dhall b/dhall-lang/tests/parser/success/unit/ForallNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ForallNestedA.dhall @@ -0,0 +1,1 @@ +forall(x: T) -> forall(y: U) -> x diff --git a/dhall-lang/tests/parser/success/unit/ForallNestedB.dhallb b/dhall-lang/tests/parser/success/unit/ForallNestedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ForallNestedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ForallUnderscoreA.dhall b/dhall-lang/tests/parser/success/unit/ForallUnderscoreA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ForallUnderscoreA.dhall @@ -0,0 +1,1 @@ +forall(_: T) -> x diff --git a/dhall-lang/tests/parser/success/unit/ForallUnderscoreB.dhallb b/dhall-lang/tests/parser/success/unit/ForallUnderscoreB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ForallUnderscoreB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ForallUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/ForallUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ForallUnicodeA.dhall @@ -0,0 +1,1 @@ +∀(x : T) -> y diff --git a/dhall-lang/tests/parser/success/unit/ForallUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/ForallUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ForallUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionApplicationMultipleArgsA.dhall b/dhall-lang/tests/parser/success/unit/FunctionApplicationMultipleArgsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionApplicationMultipleArgsA.dhall @@ -0,0 +1,1 @@ +f x y z diff --git a/dhall-lang/tests/parser/success/unit/FunctionApplicationMultipleArgsB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionApplicationMultipleArgsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionApplicationMultipleArgsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionApplicationOneArgA.dhall b/dhall-lang/tests/parser/success/unit/FunctionApplicationOneArgA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionApplicationOneArgA.dhall @@ -0,0 +1,1 @@ +f x diff --git a/dhall-lang/tests/parser/success/unit/FunctionApplicationOneArgB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionApplicationOneArgB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionApplicationOneArgB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypeArrowA.dhall b/dhall-lang/tests/parser/success/unit/FunctionTypeArrowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionTypeArrowA.dhall @@ -0,0 +1,1 @@ +T -> U diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypeArrowB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionTypeArrowB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionTypeArrowB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiA.dhall b/dhall-lang/tests/parser/success/unit/FunctionTypePiA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionTypePiA.dhall @@ -0,0 +1,1 @@ +forall(x: T) -> U diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionTypePiB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionTypePiB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiNestedA.dhall b/dhall-lang/tests/parser/success/unit/FunctionTypePiNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionTypePiNestedA.dhall @@ -0,0 +1,1 @@ +forall(x: T) -> ∀(y: U) -> V diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiNestedB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionTypePiNestedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionTypePiNestedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiUnderscoreA.dhall b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnderscoreA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnderscoreA.dhall @@ -0,0 +1,1 @@ +forall(_: T) -> U diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiUnderscoreB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnderscoreB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnderscoreB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnicodeA.dhall @@ -0,0 +1,1 @@ +∀(x: T) -> U diff --git a/dhall-lang/tests/parser/success/unit/FunctionTypePiUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/FunctionTypePiUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/IntegerLitNegativeA.dhall b/dhall-lang/tests/parser/success/unit/IntegerLitNegativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/IntegerLitNegativeA.dhall @@ -0,0 +1,1 @@ +-10 diff --git a/dhall-lang/tests/parser/success/unit/IntegerLitNegativeB.dhallb b/dhall-lang/tests/parser/success/unit/IntegerLitNegativeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/IntegerLitNegativeB.dhallb @@ -0,0 +1,1 @@ +‚) diff --git a/dhall-lang/tests/parser/success/unit/IntegerLitPositiveA.dhall b/dhall-lang/tests/parser/success/unit/IntegerLitPositiveA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/IntegerLitPositiveA.dhall @@ -0,0 +1,1 @@ ++10 diff --git a/dhall-lang/tests/parser/success/unit/IntegerLitPositiveB.dhallb b/dhall-lang/tests/parser/success/unit/IntegerLitPositiveB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/IntegerLitPositiveB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/unit/KindA.dhall b/dhall-lang/tests/parser/success/unit/KindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/KindA.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/parser/success/unit/KindB.dhallb b/dhall-lang/tests/parser/success/unit/KindB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/KindB.dhallb @@ -0,0 +1,1 @@ +dKind diff --git a/dhall-lang/tests/parser/success/unit/LambdaA.dhall b/dhall-lang/tests/parser/success/unit/LambdaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LambdaA.dhall @@ -0,0 +1,1 @@ +\(x: T) -> x diff --git a/dhall-lang/tests/parser/success/unit/LambdaB.dhallb b/dhall-lang/tests/parser/success/unit/LambdaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LambdaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LambdaNestedA.dhall b/dhall-lang/tests/parser/success/unit/LambdaNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LambdaNestedA.dhall @@ -0,0 +1,1 @@ +\(x: T) -> \(y: U) -> x diff --git a/dhall-lang/tests/parser/success/unit/LambdaNestedB.dhallb b/dhall-lang/tests/parser/success/unit/LambdaNestedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LambdaNestedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LambdaUnderscoreA.dhall b/dhall-lang/tests/parser/success/unit/LambdaUnderscoreA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LambdaUnderscoreA.dhall @@ -0,0 +1,1 @@ +\(_: T) -> x diff --git a/dhall-lang/tests/parser/success/unit/LambdaUnderscoreB.dhallb b/dhall-lang/tests/parser/success/unit/LambdaUnderscoreB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LambdaUnderscoreB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LambdaUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/LambdaUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LambdaUnicodeA.dhall @@ -0,0 +1,1 @@ +λ(x : T) -> y diff --git a/dhall-lang/tests/parser/success/unit/LambdaUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/LambdaUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LambdaUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LetA.dhall b/dhall-lang/tests/parser/success/unit/LetA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LetA.dhall @@ -0,0 +1,1 @@ +let x: T = v in e diff --git a/dhall-lang/tests/parser/success/unit/LetAnnotA.dhall b/dhall-lang/tests/parser/success/unit/LetAnnotA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LetAnnotA.dhall @@ -0,0 +1,1 @@ +let x: T = y in e diff --git a/dhall-lang/tests/parser/success/unit/LetAnnotB.dhallb b/dhall-lang/tests/parser/success/unit/LetAnnotB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LetAnnotB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LetB.dhallb b/dhall-lang/tests/parser/success/unit/LetB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LetB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LetMultiA.dhall b/dhall-lang/tests/parser/success/unit/LetMultiA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LetMultiA.dhall @@ -0,0 +1,1 @@ +let x: T = v let y: U = w in e diff --git a/dhall-lang/tests/parser/success/unit/LetMultiB.dhallb b/dhall-lang/tests/parser/success/unit/LetMultiB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LetMultiB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LetNestedA.dhall b/dhall-lang/tests/parser/success/unit/LetNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LetNestedA.dhall @@ -0,0 +1,1 @@ +let x: T = v in let y: U = w in e diff --git a/dhall-lang/tests/parser/success/unit/LetNestedB.dhallb b/dhall-lang/tests/parser/success/unit/LetNestedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LetNestedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/LetNoAnnotA.dhall b/dhall-lang/tests/parser/success/unit/LetNoAnnotA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/LetNoAnnotA.dhall @@ -0,0 +1,1 @@ +let x = y in e diff --git a/dhall-lang/tests/parser/success/unit/LetNoAnnotB.dhallb b/dhall-lang/tests/parser/success/unit/LetNoAnnotB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/LetNoAnnotB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmpty1A.dhall b/dhall-lang/tests/parser/success/unit/ListLitEmpty1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitEmpty1A.dhall @@ -0,0 +1,1 @@ +[] : List T diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmpty1B.dhallb b/dhall-lang/tests/parser/success/unit/ListLitEmpty1B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitEmpty1B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmpty2A.dhall b/dhall-lang/tests/parser/success/unit/ListLitEmpty2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitEmpty2A.dhall @@ -0,0 +1,1 @@ +[] : T diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmpty2B.dhallb b/dhall-lang/tests/parser/success/unit/ListLitEmpty2B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitEmpty2B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmptyCommaA.dhall b/dhall-lang/tests/parser/success/unit/ListLitEmptyCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitEmptyCommaA.dhall @@ -0,0 +1,1 @@ +[ , ] : List Bool diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmptyCommaB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitEmptyCommaB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitEmptyCommaB.dhallb @@ -0,0 +1,1 @@ +‚dBool diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmptyPrecedenceA.dhall b/dhall-lang/tests/parser/success/unit/ListLitEmptyPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitEmptyPrecedenceA.dhall @@ -0,0 +1,1 @@ +[] : List T U diff --git a/dhall-lang/tests/parser/success/unit/ListLitEmptyPrecedenceB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitEmptyPrecedenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitEmptyPrecedenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitLeadingCommaA.dhall b/dhall-lang/tests/parser/success/unit/ListLitLeadingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitLeadingCommaA.dhall @@ -0,0 +1,1 @@ +[ , x, y ] diff --git a/dhall-lang/tests/parser/success/unit/ListLitLeadingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitLeadingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitLeadingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitNonEmptyA.dhall b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyA.dhall @@ -0,0 +1,1 @@ +[x, y] diff --git a/dhall-lang/tests/parser/success/unit/ListLitNonEmptyAnnotatedA.dhall b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyAnnotatedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyAnnotatedA.dhall @@ -0,0 +1,1 @@ +[x, y] : List T diff --git a/dhall-lang/tests/parser/success/unit/ListLitNonEmptyAnnotatedB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyAnnotatedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyAnnotatedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitNonEmptyB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitNonEmptyB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitTrailingAndLeadingCommasA.dhall b/dhall-lang/tests/parser/success/unit/ListLitTrailingAndLeadingCommasA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitTrailingAndLeadingCommasA.dhall @@ -0,0 +1,1 @@ +[ , x, y, ] diff --git a/dhall-lang/tests/parser/success/unit/ListLitTrailingAndLeadingCommasB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitTrailingAndLeadingCommasB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitTrailingAndLeadingCommasB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListLitTrailingCommaA.dhall b/dhall-lang/tests/parser/success/unit/ListLitTrailingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListLitTrailingCommaA.dhall @@ -0,0 +1,1 @@ +[ x, y, ] diff --git a/dhall-lang/tests/parser/success/unit/ListLitTrailingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/ListLitTrailingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ListLitTrailingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ListWithNewlineA.dhall b/dhall-lang/tests/parser/success/unit/ListWithNewlineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListWithNewlineA.dhall @@ -0,0 +1,11 @@ +[ [ + 1, + 2, + 3, + ] +, [ + , 1 + , 2 + , 3 + ] +] diff --git a/dhall-lang/tests/parser/success/unit/ListWithNewlineB.dhallb b/dhall-lang/tests/parser/success/unit/ListWithNewlineB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ListWithNewlineB.dhallb @@ -0,0 +1,1 @@ +„ö…ö‚‚‚…ö‚‚‚ diff --git a/dhall-lang/tests/parser/success/unit/MergeA.dhall b/dhall-lang/tests/parser/success/unit/MergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/MergeA.dhall @@ -0,0 +1,1 @@ +merge x y diff --git a/dhall-lang/tests/parser/success/unit/MergeAnnotationA.dhall b/dhall-lang/tests/parser/success/unit/MergeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/MergeAnnotationA.dhall @@ -0,0 +1,1 @@ +merge x y : t diff --git a/dhall-lang/tests/parser/success/unit/MergeAnnotationB.dhallb b/dhall-lang/tests/parser/success/unit/MergeAnnotationB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/MergeAnnotationB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/MergeAnnotationPrecedenceA.dhall b/dhall-lang/tests/parser/success/unit/MergeAnnotationPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/MergeAnnotationPrecedenceA.dhall @@ -0,0 +1,1 @@ +merge x y : t a diff --git a/dhall-lang/tests/parser/success/unit/MergeAnnotationPrecedenceB.dhallb b/dhall-lang/tests/parser/success/unit/MergeAnnotationPrecedenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/MergeAnnotationPrecedenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/MergeB.dhallb b/dhall-lang/tests/parser/success/unit/MergeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/MergeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/MergeParenAnnotationA.dhall b/dhall-lang/tests/parser/success/unit/MergeParenAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/MergeParenAnnotationA.dhall @@ -0,0 +1,1 @@ +(merge x y) : t diff --git a/dhall-lang/tests/parser/success/unit/MergeParenAnnotationB.dhallb b/dhall-lang/tests/parser/success/unit/MergeParenAnnotationB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/MergeParenAnnotationB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/MergeXYZA.dhall b/dhall-lang/tests/parser/success/unit/MergeXYZA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/MergeXYZA.dhall @@ -0,0 +1,1 @@ +merge x y z diff --git a/dhall-lang/tests/parser/success/unit/MergeXYZB.dhallb b/dhall-lang/tests/parser/success/unit/MergeXYZB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/MergeXYZB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/NaturalLitA.dhall b/dhall-lang/tests/parser/success/unit/NaturalLitA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/NaturalLitA.dhall @@ -0,0 +1,1 @@ +42 diff --git a/dhall-lang/tests/parser/success/unit/NaturalLitB.dhallb b/dhall-lang/tests/parser/success/unit/NaturalLitB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/NaturalLitB.dhallb @@ -0,0 +1,1 @@ +‚* diff --git a/dhall-lang/tests/parser/success/unit/ProjectionA.dhall b/dhall-lang/tests/parser/success/unit/ProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ProjectionA.dhall @@ -0,0 +1,1 @@ +r.{x, y, z} diff --git a/dhall-lang/tests/parser/success/unit/ProjectionB.dhallb b/dhall-lang/tests/parser/success/unit/ProjectionB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ProjectionB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ProjectionLeadingCommaA.dhall b/dhall-lang/tests/parser/success/unit/ProjectionLeadingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ProjectionLeadingCommaA.dhall @@ -0,0 +1,1 @@ +foo.{ , x, y } diff --git a/dhall-lang/tests/parser/success/unit/ProjectionLeadingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/ProjectionLeadingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ProjectionLeadingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ProjectionTrailingAndLeadingCommasA.dhall b/dhall-lang/tests/parser/success/unit/ProjectionTrailingAndLeadingCommasA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ProjectionTrailingAndLeadingCommasA.dhall @@ -0,0 +1,1 @@ +foo.{ , x, y, } diff --git a/dhall-lang/tests/parser/success/unit/ProjectionTrailingAndLeadingCommasB.dhallb b/dhall-lang/tests/parser/success/unit/ProjectionTrailingAndLeadingCommasB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ProjectionTrailingAndLeadingCommasB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ProjectionTrailingCommaA.dhall b/dhall-lang/tests/parser/success/unit/ProjectionTrailingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ProjectionTrailingCommaA.dhall @@ -0,0 +1,1 @@ +foo.{ x, y, } diff --git a/dhall-lang/tests/parser/success/unit/ProjectionTrailingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/ProjectionTrailingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ProjectionTrailingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/QuotedBoolA.dhall b/dhall-lang/tests/parser/success/unit/QuotedBoolA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/QuotedBoolA.dhall @@ -0,0 +1,1 @@ +`Bool` diff --git a/dhall-lang/tests/parser/success/unit/QuotedBoolB.dhallb b/dhall-lang/tests/parser/success/unit/QuotedBoolB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/QuotedBoolB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/QuotedTrueA.dhall b/dhall-lang/tests/parser/success/unit/QuotedTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/QuotedTrueA.dhall @@ -0,0 +1,1 @@ +`True` diff --git a/dhall-lang/tests/parser/success/unit/QuotedTrueB.dhallb b/dhall-lang/tests/parser/success/unit/QuotedTrueB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/QuotedTrueB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/QuotedTypeA.dhall b/dhall-lang/tests/parser/success/unit/QuotedTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/QuotedTypeA.dhall @@ -0,0 +1,1 @@ +`Type` diff --git a/dhall-lang/tests/parser/success/unit/QuotedTypeB.dhallb b/dhall-lang/tests/parser/success/unit/QuotedTypeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/QuotedTypeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/QuotedVariableA.dhall b/dhall-lang/tests/parser/success/unit/QuotedVariableA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/QuotedVariableA.dhall @@ -0,0 +1,1 @@ +`x+y` diff --git a/dhall-lang/tests/parser/success/unit/QuotedVariableB.dhallb b/dhall-lang/tests/parser/success/unit/QuotedVariableB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/QuotedVariableB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitA.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = 2 } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitB.dhallb @@ -0,0 +1,1 @@ +‚¢ax‚ay‚ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitDottedA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitDottedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitDottedA.dhall @@ -0,0 +1,7 @@ +{- The purpose of this test is to illustrate that dotted fields are syntactic + sugar that does not survive the parsing stage. The underlying expression is + actually represented and encoded as: + + { x = { y = { z = 1 } } } +-} +{ x.y.z = 1 } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitDottedB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitDottedB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitDottedB.dhallb @@ -0,0 +1,1 @@ +‚¡ax‚¡ay‚¡az‚ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitDottedEscapeA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitDottedEscapeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitDottedEscapeA.dhall @@ -0,0 +1,1 @@ +{ `x.y`.z = 1 } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitDottedEscapeB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitDottedEscapeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitDottedEscapeB.dhallb @@ -0,0 +1,1 @@ +‚¡cx.y‚¡az‚ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitDuplicatesA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitDuplicatesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitDuplicatesA.dhall @@ -0,0 +1,7 @@ +{- The purpose of this test is to illustrate that duplicate fields are + syntactic sugar that does not survive the parsing stage. The underlying + expression is actually represented and encoded as: + + { x = { y = 1 } ∧ { z = 1 } } +-} +{ x = { y = 1 }, x = { z = 1 } } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitDuplicatesB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitDuplicatesB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitDuplicatesB.dhallb @@ -0,0 +1,1 @@ +‚¡ax„‚¡ay‚‚¡az‚ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasA.dhall @@ -0,0 +1,1 @@ +{ , =, } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyBothCommasB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyLeadingCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitEmptyLeadingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyLeadingCommaA.dhall @@ -0,0 +1,1 @@ +{ , = } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyLeadingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitEmptyLeadingCommaB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyLeadingCommaB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyTrailingCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitEmptyTrailingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyTrailingCommaA.dhall @@ -0,0 +1,1 @@ +{ =, } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitEmptyTrailingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitEmptyTrailingCommaB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitEmptyTrailingCommaB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordLitLeadingCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitLeadingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitLeadingCommaA.dhall @@ -0,0 +1,1 @@ +{ , x = 0, y = 1 } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitLeadingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitLeadingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitLeadingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitNixLikeA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitNixLikeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitNixLikeA.dhall @@ -0,0 +1,5 @@ +{- The purpose of this test is to verify that the combination of the dotted + field notation and the duplicate record fields desugar to the desired syntax + tree +-} +{ x.y = 1, x.z = True } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitNixLikeB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitNixLikeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitNixLikeB.dhallb @@ -0,0 +1,1 @@ +‚¡ax„‚¡ay‚‚¡azõ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitPunA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitPunA.dhall @@ -0,0 +1,1 @@ +{ x, y, z } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitPunB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitPunB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateA.dhall @@ -0,0 +1,1 @@ +{ x, y, x } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunMixedA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitPunMixedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitPunMixedA.dhall @@ -0,0 +1,1 @@ +{ x, y = 1, z, w.a.b = 2 } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunMixedB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitPunMixedB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitPunMixedB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunSomeA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitPunSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitPunSomeA.dhall @@ -0,0 +1,1 @@ +{ Some } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitPunSomeB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitPunSomeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitPunSomeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitSomeA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitSomeA.dhall @@ -0,0 +1,1 @@ +{ Some = 0 } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitSomeB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitSomeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitSomeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitTrailingAndLeadingCommasA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitTrailingAndLeadingCommasA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitTrailingAndLeadingCommasA.dhall @@ -0,0 +1,1 @@ +{ , x = 0, y = 1, } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitTrailingAndLeadingCommasB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitTrailingAndLeadingCommasB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitTrailingAndLeadingCommasB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordLitTrailingCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordLitTrailingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordLitTrailingCommaA.dhall @@ -0,0 +1,1 @@ +{ x = 0, y = 1, } diff --git a/dhall-lang/tests/parser/success/unit/RecordLitTrailingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordLitTrailingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordLitTrailingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeA.dhall b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeA.dhall @@ -0,0 +1,1 @@ +{ a = 1, b = 2 }.({ a : Natural }) diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeB.dhallb b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeB.dhallb @@ -0,0 +1,2 @@ +ƒ +‚¢aa‚ab‚‚¡aagNatural diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeEmptyA.dhall b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeEmptyA.dhall @@ -0,0 +1,1 @@ +{ a = 1, b = 2 }.({}) diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeEmptyB.dhallb b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeEmptyB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordProjectionByTypeEmptyB.dhallb @@ -0,0 +1,2 @@ +ƒ +‚¢aa‚ab‚‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeA.dhall @@ -0,0 +1,1 @@ +{ x: T, y: U } diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordTypeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeEmptyA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyA.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeEmptyB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeEmptyCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyCommaA.dhall @@ -0,0 +1,1 @@ +{ , } diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeEmptyCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyCommaB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeEmptyCommaB.dhallb @@ -0,0 +1,1 @@ +‚  diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeLeadingCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeLeadingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeLeadingCommaA.dhall @@ -0,0 +1,1 @@ +{ , x : T, y : U } diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeLeadingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeLeadingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordTypeLeadingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeTrailingAndLeadingCommasA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingAndLeadingCommasA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingAndLeadingCommasA.dhall @@ -0,0 +1,1 @@ +{ , x : T, y : U, } diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeTrailingAndLeadingCommasB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingAndLeadingCommasB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingAndLeadingCommasB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeTrailingCommaA.dhall b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingCommaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingCommaA.dhall @@ -0,0 +1,1 @@ +{ x : T, y : U, } diff --git a/dhall-lang/tests/parser/success/unit/RecordTypeTrailingCommaB.dhallb b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingCommaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/RecordTypeTrailingCommaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/SelectionSomeA.dhall b/dhall-lang/tests/parser/success/unit/SelectionSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/SelectionSomeA.dhall @@ -0,0 +1,1 @@ +record.{ Some } diff --git a/dhall-lang/tests/parser/success/unit/SelectionSomeB.dhallb b/dhall-lang/tests/parser/success/unit/SelectionSomeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/SelectionSomeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ShebangA.dhall b/dhall-lang/tests/parser/success/unit/ShebangA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShebangA.dhall @@ -0,0 +1,2 @@ +#!/usr/bin/env -S dhall text --file +"A" diff --git a/dhall-lang/tests/parser/success/unit/ShebangB.dhallb b/dhall-lang/tests/parser/success/unit/ShebangB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShebangB.dhallb @@ -0,0 +1,1 @@ +‚aA diff --git a/dhall-lang/tests/parser/success/unit/ShebangNixA.dhall b/dhall-lang/tests/parser/success/unit/ShebangNixA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShebangNixA.dhall @@ -0,0 +1,3 @@ +#! /usr/bin/env nix-shell +#! nix-shell -i "dhall --file" -p dhall +42 diff --git a/dhall-lang/tests/parser/success/unit/ShebangNixB.dhallb b/dhall-lang/tests/parser/success/unit/ShebangNixB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShebangNixB.dhallb @@ -0,0 +1,1 @@ +‚* diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorA.dhall b/dhall-lang/tests/parser/success/unit/ShowConstructorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShowConstructorA.dhall @@ -0,0 +1,1 @@ +showConstructor .A diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorB.dhallb b/dhall-lang/tests/parser/success/unit/ShowConstructorB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShowConstructorB.dhallb @@ -0,0 +1,1 @@ +‚"ƒ ‚ ¡aAöaA diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueA.dhall b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueA.dhall @@ -0,0 +1,1 @@ +showConstructor (.A False) diff --git a/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueB.dhallb b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ShowConstructorWithValueB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/SomeXA.dhall b/dhall-lang/tests/parser/success/unit/SomeXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/SomeXA.dhall @@ -0,0 +1,1 @@ +Some x diff --git a/dhall-lang/tests/parser/success/unit/SomeXB.dhallb b/dhall-lang/tests/parser/success/unit/SomeXB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/SomeXB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/SomeXYZA.dhall b/dhall-lang/tests/parser/success/unit/SomeXYZA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/SomeXYZA.dhall @@ -0,0 +1,6 @@ +{- +This is always a type error, but if this +was a parse error it would be quite confusing +because Some looks like a builtin. +-} +Some x y z diff --git a/dhall-lang/tests/parser/success/unit/SomeXYZB.dhallb b/dhall-lang/tests/parser/success/unit/SomeXYZB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/SomeXYZB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/SortA.dhall b/dhall-lang/tests/parser/success/unit/SortA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/SortA.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/parser/success/unit/SortB.dhallb b/dhall-lang/tests/parser/success/unit/SortB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/SortB.dhallb @@ -0,0 +1,1 @@ +dSort diff --git a/dhall-lang/tests/parser/success/unit/TimeA.dhall b/dhall-lang/tests/parser/success/unit/TimeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TimeA.dhall @@ -0,0 +1,1 @@ +Time diff --git a/dhall-lang/tests/parser/success/unit/TimeB.dhallb b/dhall-lang/tests/parser/success/unit/TimeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TimeB.dhallb @@ -0,0 +1,1 @@ +dTime diff --git a/dhall-lang/tests/parser/success/unit/TimeLiteralA.dhall b/dhall-lang/tests/parser/success/unit/TimeLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TimeLiteralA.dhall @@ -0,0 +1,1 @@ +12:00:00 diff --git a/dhall-lang/tests/parser/success/unit/TimeLiteralB.dhallb b/dhall-lang/tests/parser/success/unit/TimeLiteralB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/TimeLiteralB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/TimeZoneA.dhall b/dhall-lang/tests/parser/success/unit/TimeZoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TimeZoneA.dhall @@ -0,0 +1,1 @@ +TimeZone diff --git a/dhall-lang/tests/parser/success/unit/TimeZoneB.dhallb b/dhall-lang/tests/parser/success/unit/TimeZoneB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TimeZoneB.dhallb @@ -0,0 +1,1 @@ +hTimeZone diff --git a/dhall-lang/tests/parser/success/unit/TimeZoneLiteralA.dhall b/dhall-lang/tests/parser/success/unit/TimeZoneLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TimeZoneLiteralA.dhall @@ -0,0 +1,1 @@ ++08:00 diff --git a/dhall-lang/tests/parser/success/unit/TimeZoneLiteralB.dhallb b/dhall-lang/tests/parser/success/unit/TimeZoneLiteralB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/TimeZoneLiteralB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ToMapA.dhall b/dhall-lang/tests/parser/success/unit/ToMapA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ToMapA.dhall @@ -0,0 +1,1 @@ +toMap x diff --git a/dhall-lang/tests/parser/success/unit/ToMapAnnotA.dhall b/dhall-lang/tests/parser/success/unit/ToMapAnnotA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ToMapAnnotA.dhall @@ -0,0 +1,1 @@ +toMap x : T diff --git a/dhall-lang/tests/parser/success/unit/ToMapAnnotB.dhallb b/dhall-lang/tests/parser/success/unit/ToMapAnnotB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ToMapAnnotB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ToMapB.dhallb b/dhall-lang/tests/parser/success/unit/ToMapB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/ToMapB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineA.dhall b/dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineA.dhall @@ -0,0 +1,2 @@ +-- This test verifies that a trailing line comment does not require a newline +1-- diff --git a/dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineB.dhallb b/dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/unit/TypeA.dhall b/dhall-lang/tests/parser/success/unit/TypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TypeA.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/parser/success/unit/TypeB.dhallb b/dhall-lang/tests/parser/success/unit/TypeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/TypeB.dhallb @@ -0,0 +1,1 @@ +dType diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeEmptyA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyA.dhall @@ -0,0 +1,1 @@ +< > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeEmptyB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyB.dhallb @@ -0,0 +1,1 @@ +‚   diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeEmptyDelimA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyDelimA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyDelimA.dhall @@ -0,0 +1,1 @@ +< | > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeEmptyDelimB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyDelimB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeEmptyDelimB.dhallb @@ -0,0 +1,1 @@ +‚   diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeLeadingDelimA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeLeadingDelimA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeLeadingDelimA.dhall @@ -0,0 +1,1 @@ +< | x: T | y: U > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeLeadingDelimB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeLeadingDelimB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/UnionTypeLeadingDelimB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeSomeA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeSomeA.dhall @@ -0,0 +1,1 @@ +< Some: Natural > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeSomeB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeSomeB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeSomeB.dhallb @@ -0,0 +1,1 @@ +‚ ¡dSomegNatural diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeTrailingAndLeadingDelimsA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingAndLeadingDelimsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingAndLeadingDelimsA.dhall @@ -0,0 +1,1 @@ +< | x: T | y: U | > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeTrailingAndLeadingDelimsB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingAndLeadingDelimsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingAndLeadingDelimsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeTrailingDelimA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingDelimA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingDelimA.dhall @@ -0,0 +1,1 @@ +< x: T | y: U | > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeTrailingDelimB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingDelimB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/UnionTypeTrailingDelimB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeXA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXA.dhall @@ -0,0 +1,1 @@ +< x > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeXB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXB.dhallb @@ -0,0 +1,1 @@ +‚ ¡axö diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXTYA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeXTYA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXTYA.dhall @@ -0,0 +1,1 @@ +< x: T | y > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXTYB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeXTYB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/UnionTypeXTYB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXTYUA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeXTYUA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXTYUA.dhall @@ -0,0 +1,1 @@ +< x: T | y: U > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXTYUB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeXTYUB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/UnionTypeXTYUB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXYA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeXYA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXYA.dhall @@ -0,0 +1,1 @@ +< x | y > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXYB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeXYB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXYB.dhallb @@ -0,0 +1,1 @@ +‚ ¢axöayö diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXYTA.dhall b/dhall-lang/tests/parser/success/unit/UnionTypeXYTA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/UnionTypeXYTA.dhall @@ -0,0 +1,1 @@ +< x | y: T > diff --git a/dhall-lang/tests/parser/success/unit/UnionTypeXYTB.dhallb b/dhall-lang/tests/parser/success/unit/UnionTypeXYTB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/UnionTypeXYTB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/VariableA.dhall b/dhall-lang/tests/parser/success/unit/VariableA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/VariableA.dhall @@ -0,0 +1,1 @@ +x diff --git a/dhall-lang/tests/parser/success/unit/VariableB.dhallb b/dhall-lang/tests/parser/success/unit/VariableB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/VariableB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceA.dhall b/dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceA.dhall @@ -0,0 +1,1 @@ +` x ` diff --git a/dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceB.dhallb b/dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/VariableUnderscoreA.dhall b/dhall-lang/tests/parser/success/unit/VariableUnderscoreA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/VariableUnderscoreA.dhall @@ -0,0 +1,1 @@ +_ diff --git a/dhall-lang/tests/parser/success/unit/VariableUnderscoreB.dhallb b/dhall-lang/tests/parser/success/unit/VariableUnderscoreB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/VariableUnderscoreB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/WithA.dhall b/dhall-lang/tests/parser/success/unit/WithA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithA.dhall @@ -0,0 +1,1 @@ +{ a = 1 } with a = 2 diff --git a/dhall-lang/tests/parser/success/unit/WithB.dhallb b/dhall-lang/tests/parser/success/unit/WithB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithB.dhallb @@ -0,0 +1,1 @@ +„‚¡aa‚aa‚ diff --git a/dhall-lang/tests/parser/success/unit/WithMultipleA.dhall b/dhall-lang/tests/parser/success/unit/WithMultipleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithMultipleA.dhall @@ -0,0 +1,4 @@ +{- This test verifies that an implementation correctly encodes chained + `with` expressions in a left-associative way. +-} +{ a.b = 1, c.d = 2 } with a.b = 3 with c.e = 4 diff --git a/dhall-lang/tests/parser/success/unit/WithMultipleB.dhallb b/dhall-lang/tests/parser/success/unit/WithMultipleB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithMultipleB.dhallb @@ -0,0 +1,1 @@ +„„‚¢aa‚¡ab‚ac‚¡ad‚‚aaab‚‚acae‚ diff --git a/dhall-lang/tests/parser/success/unit/WithPrecedence1A.dhall b/dhall-lang/tests/parser/success/unit/WithPrecedence1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithPrecedence1A.dhall @@ -0,0 +1,13 @@ +{- The purpose of this test is to illustrate that function application has + higher precedence than `with` so that chained with expressions parse + correctly + + The following expression should parse as: + + ({ a = Some 1 } with a = Some 2) with a = Some 3 + + ... and not parse as: + + { a = Some 1 } with a = (Some 2 with a = Some 3) +-} +{ a = Some 1 } with a = Some 2 with a = Some 3 diff --git a/dhall-lang/tests/parser/success/unit/WithPrecedence1B.dhallb b/dhall-lang/tests/parser/success/unit/WithPrecedence1B.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithPrecedence1B.dhallb @@ -0,0 +1,1 @@ +„„‚¡aaƒö‚aaƒö‚aaƒö‚ diff --git a/dhall-lang/tests/parser/success/unit/WithPrecedence2A.dhall b/dhall-lang/tests/parser/success/unit/WithPrecedence2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithPrecedence2A.dhall @@ -0,0 +1,1 @@ +{ x = 0 } with x = 1 + 1 diff --git a/dhall-lang/tests/parser/success/unit/WithPrecedence2B.dhallb b/dhall-lang/tests/parser/success/unit/WithPrecedence2B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/WithPrecedence2B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/WithPrecedence3A.dhall b/dhall-lang/tests/parser/success/unit/WithPrecedence3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithPrecedence3A.dhall @@ -0,0 +1,1 @@ +foo::{ x = 0 } with x = 1 diff --git a/dhall-lang/tests/parser/success/unit/WithPrecedence3B.dhallb b/dhall-lang/tests/parser/success/unit/WithPrecedence3B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/WithPrecedence3B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/WithSomeA.dhall b/dhall-lang/tests/parser/success/unit/WithSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/WithSomeA.dhall @@ -0,0 +1,1 @@ +{ Some = 0 } with Some = 1 diff --git a/dhall-lang/tests/parser/success/unit/WithSomeB.dhallb b/dhall-lang/tests/parser/success/unit/WithSomeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/WithSomeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/ifThenElseA.dhall b/dhall-lang/tests/parser/success/unit/ifThenElseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ifThenElseA.dhall @@ -0,0 +1,1 @@ +if True then 1 else 2 diff --git a/dhall-lang/tests/parser/success/unit/ifThenElseB.dhallb b/dhall-lang/tests/parser/success/unit/ifThenElseB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/ifThenElseB.dhallb @@ -0,0 +1,1 @@ +„õ‚‚ diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationAbsoluteA.dhall b/dhall-lang/tests/parser/success/unit/import/AsLocationAbsoluteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationAbsoluteA.dhall @@ -0,0 +1,1 @@ +/absolute/import as Location diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationAbsoluteB.dhallb b/dhall-lang/tests/parser/success/unit/import/AsLocationAbsoluteB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationAbsoluteB.dhallb @@ -0,0 +1,1 @@ +†öhabsolutefimport diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationEnvA.dhall b/dhall-lang/tests/parser/success/unit/import/AsLocationEnvA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationEnvA.dhall @@ -0,0 +1,1 @@ +env:HOME as Location diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationEnvB.dhallb b/dhall-lang/tests/parser/success/unit/import/AsLocationEnvB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationEnvB.dhallb @@ -0,0 +1,1 @@ +…ödHOME diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationHashA.dhall b/dhall-lang/tests/parser/success/unit/import/AsLocationHashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationHashA.dhall @@ -0,0 +1,1 @@ +./some/import sha256:0000000000000000000000000000000000000000000000000000000000000000 as Location diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationHashB.dhallb b/dhall-lang/tests/parser/success/unit/import/AsLocationHashB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/AsLocationHashB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationLocalA.dhall b/dhall-lang/tests/parser/success/unit/import/AsLocationLocalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationLocalA.dhall @@ -0,0 +1,1 @@ +./local/import as Location diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationLocalB.dhallb b/dhall-lang/tests/parser/success/unit/import/AsLocationLocalB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationLocalB.dhallb @@ -0,0 +1,1 @@ +†öelocalfimport diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationMissingA.dhall b/dhall-lang/tests/parser/success/unit/import/AsLocationMissingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationMissingA.dhall @@ -0,0 +1,1 @@ +missing as Location diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationMissingB.dhallb b/dhall-lang/tests/parser/success/unit/import/AsLocationMissingB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationMissingB.dhallb @@ -0,0 +1,1 @@ +„ö diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationRemoteA.dhall b/dhall-lang/tests/parser/success/unit/import/AsLocationRemoteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationRemoteA.dhall @@ -0,0 +1,1 @@ +https://prelude.dhall-lang.org/package.dhall as Location diff --git a/dhall-lang/tests/parser/success/unit/import/AsLocationRemoteB.dhallb b/dhall-lang/tests/parser/success/unit/import/AsLocationRemoteB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/AsLocationRemoteB.dhallb @@ -0,0 +1,1 @@ +ˆöövprelude.dhall-lang.orgmpackage.dhallö diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersA.dhall b/dhall-lang/tests/parser/success/unit/import/HeadersA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/HeadersA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo using x diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersB.dhallb b/dhall-lang/tests/parser/success/unit/import/HeadersB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/HeadersB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashA.dhall b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo using (./headers sha256:0000000000000000000000000000000000000000000000000000000000000000) sha256:1111111111111111111111111111111111111111111111111111111111111111 diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashB.dhallb b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashPrecedenceA.dhall b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashPrecedenceA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo using ./headers sha256:0000000000000000000000000000000000000000000000000000000000000000 sha256:1111111111111111111111111111111111111111111111111111111111111111 diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashPrecedenceB.dhallb b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashPrecedenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/HeadersDoubleHashPrecedenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersHashPrecedenceA.dhall b/dhall-lang/tests/parser/success/unit/import/HeadersHashPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/HeadersHashPrecedenceA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo using ./headers sha256:0000000000000000000000000000000000000000000000000000000000000000 diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersHashPrecedenceB.dhallb b/dhall-lang/tests/parser/success/unit/import/HeadersHashPrecedenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/HeadersHashPrecedenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersInteriorHashA.dhall b/dhall-lang/tests/parser/success/unit/import/HeadersInteriorHashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/HeadersInteriorHashA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo using (./headers sha256:0000000000000000000000000000000000000000000000000000000000000000) diff --git a/dhall-lang/tests/parser/success/unit/import/HeadersInteriorHashB.dhallb b/dhall-lang/tests/parser/success/unit/import/HeadersInteriorHashB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/HeadersInteriorHashB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/ImportAsNoSpaceA.dhall b/dhall-lang/tests/parser/success/unit/import/ImportAsNoSpaceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/ImportAsNoSpaceA.dhall @@ -0,0 +1,1 @@ +./import asText diff --git a/dhall-lang/tests/parser/success/unit/import/ImportAsNoSpaceB.dhallb b/dhall-lang/tests/parser/success/unit/import/ImportAsNoSpaceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/ImportAsNoSpaceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/MissingA.dhall b/dhall-lang/tests/parser/success/unit/import/MissingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/MissingA.dhall @@ -0,0 +1,1 @@ +missing diff --git a/dhall-lang/tests/parser/success/unit/import/MissingB.dhallb b/dhall-lang/tests/parser/success/unit/import/MissingB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/MissingB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/asTextA.dhall b/dhall-lang/tests/parser/success/unit/import/asTextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/asTextA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo as Text diff --git a/dhall-lang/tests/parser/success/unit/import/asTextB.dhallb b/dhall-lang/tests/parser/success/unit/import/asTextB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/asTextB.dhallb @@ -0,0 +1,1 @@ +ˆöökexample.comcfooö diff --git a/dhall-lang/tests/parser/success/unit/import/environmentVariableBashA.dhall b/dhall-lang/tests/parser/success/unit/import/environmentVariableBashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/environmentVariableBashA.dhall @@ -0,0 +1,1 @@ +env:FOO diff --git a/dhall-lang/tests/parser/success/unit/import/environmentVariableBashB.dhallb b/dhall-lang/tests/parser/success/unit/import/environmentVariableBashB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/environmentVariableBashB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/environmentVariablePosixA.dhall b/dhall-lang/tests/parser/success/unit/import/environmentVariablePosixA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/environmentVariablePosixA.dhall @@ -0,0 +1,2 @@ +-- Yes, this is legal +env:"\"\\\a\b\f\n\r\t\v!<[~" diff --git a/dhall-lang/tests/parser/success/unit/import/environmentVariablePosixB.dhallb b/dhall-lang/tests/parser/success/unit/import/environmentVariablePosixB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/environmentVariablePosixB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/hashA.dhall b/dhall-lang/tests/parser/success/unit/import/hashA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/hashA.dhall @@ -0,0 +1,1 @@ +./a.dhall sha256:16173e984d35ee3ffd8b6b79167df89480e67d1cd03ea5d0fc93689e4d928e61 diff --git a/dhall-lang/tests/parser/success/unit/import/hashB.dhallb b/dhall-lang/tests/parser/success/unit/import/hashB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/hashB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/importAltA.dhall b/dhall-lang/tests/parser/success/unit/import/importAltA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/importAltA.dhall @@ -0,0 +1,1 @@ +env:UNSET1 as Text ? env:UNSET2 ? missing ? env:UNSET3 ? 2 diff --git a/dhall-lang/tests/parser/success/unit/import/importAltB.dhallb b/dhall-lang/tests/parser/success/unit/import/importAltB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/importAltB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/inlineUsingA.dhall b/dhall-lang/tests/parser/success/unit/import/inlineUsingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/inlineUsingA.dhall @@ -0,0 +1,14 @@ +{- The language standard used to require that custom headers were provided via + an external import, but was later amended to support inline headers as part + of: + + https://github.com/dhall-lang/dhall-lang/pull/560 + + This test verifies that an implementation supports such inline custom headers +-} + +https://example.com/foo using + [ { mapKey = "Authorization" + , mapValue = "token 5199831f4dd3b79e7c5b7e0ebe75d67aa66e79d4" + } + ] diff --git a/dhall-lang/tests/parser/success/unit/import/inlineUsingB.dhallb b/dhall-lang/tests/parser/success/unit/import/inlineUsingB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/inlineUsingB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathAbsoluteA.dhall b/dhall-lang/tests/parser/success/unit/import/pathAbsoluteA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathAbsoluteA.dhall @@ -0,0 +1,1 @@ +/absolute/path diff --git a/dhall-lang/tests/parser/success/unit/import/pathAbsoluteB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathAbsoluteB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathAbsoluteB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathHereA.dhall b/dhall-lang/tests/parser/success/unit/import/pathHereA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathHereA.dhall @@ -0,0 +1,1 @@ +./relative/path diff --git a/dhall-lang/tests/parser/success/unit/import/pathHereB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathHereB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathHereB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathHomeA.dhall b/dhall-lang/tests/parser/success/unit/import/pathHomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathHomeA.dhall @@ -0,0 +1,1 @@ +~/home/anchored/path diff --git a/dhall-lang/tests/parser/success/unit/import/pathHomeB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathHomeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathHomeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathParentA.dhall b/dhall-lang/tests/parser/success/unit/import/pathParentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathParentA.dhall @@ -0,0 +1,1 @@ +../parent/path diff --git a/dhall-lang/tests/parser/success/unit/import/pathParentB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathParentB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathParentB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationLambdaA.dhall b/dhall-lang/tests/parser/success/unit/import/pathTerminationLambdaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathTerminationLambdaA.dhall @@ -0,0 +1,2 @@ +-- Verify that certain punctuation marks terminate paths correctly +λ(x : ./example) -> x diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationLambdaB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathTerminationLambdaB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathTerminationLambdaB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationListA.dhall b/dhall-lang/tests/parser/success/unit/import/pathTerminationListA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathTerminationListA.dhall @@ -0,0 +1,2 @@ +-- Verify that certain punctuation marks terminate paths correctly +[./example,./example, ./example] diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationListB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathTerminationListB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathTerminationListB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationRecordA.dhall b/dhall-lang/tests/parser/success/unit/import/pathTerminationRecordA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathTerminationRecordA.dhall @@ -0,0 +1,2 @@ +-- Verify that certain punctuation marks terminate paths correctly +{foo = ./example, bar = ./example} diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationRecordB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathTerminationRecordB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathTerminationRecordB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationUnionA.dhall b/dhall-lang/tests/parser/success/unit/import/pathTerminationUnionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/pathTerminationUnionA.dhall @@ -0,0 +1,2 @@ +-- Verify that certain punctuation marks terminate paths correctly + diff --git a/dhall-lang/tests/parser/success/unit/import/pathTerminationUnionB.dhallb b/dhall-lang/tests/parser/success/unit/import/pathTerminationUnionB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/pathTerminationUnionB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/quotedPathsA.dhall b/dhall-lang/tests/parser/success/unit/import/quotedPathsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/quotedPathsA.dhall @@ -0,0 +1,1 @@ +/"foo"/bar/"baz qux" diff --git a/dhall-lang/tests/parser/success/unit/import/quotedPathsB.dhallb b/dhall-lang/tests/parser/success/unit/import/quotedPathsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/quotedPathsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/unicodePathsA.dhall b/dhall-lang/tests/parser/success/unit/import/unicodePathsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/unicodePathsA.dhall @@ -0,0 +1,1 @@ +./families/"禺.dhall" diff --git a/dhall-lang/tests/parser/success/unit/import/unicodePathsB.dhallb b/dhall-lang/tests/parser/success/unit/import/unicodePathsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/unicodePathsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/basicHttpA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpA.dhall @@ -0,0 +1,1 @@ +http://example.com/someFile.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/basicHttpB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/basicHttpsA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpsA.dhall @@ -0,0 +1,1 @@ +https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True diff --git a/dhall-lang/tests/parser/success/unit/import/urls/basicHttpsB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/basicHttpsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyPath0A.dhall b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath0A.dhall @@ -0,0 +1,3 @@ +-- the normal form for an empty path is a path of `/` +-- see RFC7230 section 2.7.3 +https://example.com diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyPath0B.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath0B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath0B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyPath1A.dhall b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath1A.dhall @@ -0,0 +1,1 @@ +https://example.com/ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyPath1B.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath1B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/emptyPath1B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyPathSegmentA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/emptyPathSegmentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/emptyPathSegmentA.dhall @@ -0,0 +1,2 @@ +-- empty path segments are not equivalent to missing path segments +https://example.com/foo//bar diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyPathSegmentB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/emptyPathSegmentB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/emptyPathSegmentB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyQueryA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/emptyQueryA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/emptyQueryA.dhall @@ -0,0 +1,3 @@ +-- an empty query string is not the same as a missing one +-- see RFC 3986 section 6.2.3 +https://example.com/foo? diff --git a/dhall-lang/tests/parser/success/unit/import/urls/emptyQueryB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/emptyQueryB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/emptyQueryB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/escapedPathA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/escapedPathA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/escapedPathA.dhall @@ -0,0 +1,1 @@ +https://example.com/a%20b/c%2fd/e+f/g%2dh diff --git a/dhall-lang/tests/parser/success/unit/import/urls/escapedPathB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/escapedPathB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/escapedPathB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/escapedQueryA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/escapedQueryA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/escapedQueryA.dhall @@ -0,0 +1,1 @@ +https://example.com/foo?a%20b=c%2fd&e+f/? diff --git a/dhall-lang/tests/parser/success/unit/import/urls/escapedQueryB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/escapedQueryB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/escapedQueryB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/fragmentParsesAsListAppendA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/fragmentParsesAsListAppendA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/fragmentParsesAsListAppendA.dhall @@ -0,0 +1,11 @@ +{- Fragment identifiers are not allowed in URLs because they serve no purpose + for Dhall and they could lead to ambiguity if a parser interprets them as + the list append operator (`#`) + + The following expression therefore only has one valid parse, which is to + interpret the `#` as a list append. In other words, the following expression + is parsed as: + + (https://example.com/foo) # bar +-} +https://example.com/foo#bar diff --git a/dhall-lang/tests/parser/success/unit/import/urls/fragmentParsesAsListAppendB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/fragmentParsesAsListAppendB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/fragmentParsesAsListAppendB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv4A.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv4A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv4A.dhall @@ -0,0 +1,1 @@ +https://127.0.0.1/index.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv4B.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv4B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv4B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv4upperoctetsA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv4upperoctetsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv4upperoctetsA.dhall @@ -0,0 +1,1 @@ +https://200.249.250.255/index.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv4upperoctetsB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv4upperoctetsB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv4upperoctetsB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6longA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv6longA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv6longA.dhall @@ -0,0 +1,1 @@ +https://[2001:db8:85a3:0:0:8a2e:370:7334]/tutorial.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6longB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv6longB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv6longB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6mediumA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv6mediumA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv6mediumA.dhall @@ -0,0 +1,1 @@ +https://[2001:db8:85a3::8a2e:370:7334]/tutorial.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6mediumB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv6mediumB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv6mediumB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6shortA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv6shortA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv6shortA.dhall @@ -0,0 +1,1 @@ +https://[::]/index.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6shortB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv6shortB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv6shortB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6verylongA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv6verylongA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv6verylongA.dhall @@ -0,0 +1,1 @@ +http://[AAAA:BBBB:CCCC:DDDD:EEEE:FFFF:0000::]/tutorial.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6verylongB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv6verylongB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv6verylongB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6withipv4A.dhall b/dhall-lang/tests/parser/success/unit/import/urls/ipv6withipv4A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/ipv6withipv4A.dhall @@ -0,0 +1,1 @@ +https://[2001:db8:85a3::8a2e:3.112.115.52]/tutorial.dhall diff --git a/dhall-lang/tests/parser/success/unit/import/urls/ipv6withipv4B.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/ipv6withipv4B.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/ipv6withipv4B.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/portA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/portA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/portA.dhall @@ -0,0 +1,1 @@ +https://example.com:1234/foo diff --git a/dhall-lang/tests/parser/success/unit/import/urls/portB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/portB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/portB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/potPourriA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/potPourriA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/potPourriA.dhall @@ -0,0 +1,1 @@ +https://-._~%2C!$&'*+;=:@0abc1--12a------a-a--a-0/foo?/-._~%2C!$&'*+;=:@/? diff --git a/dhall-lang/tests/parser/success/unit/import/urls/potPourriB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/potPourriB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/potPourriB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/import/urls/userinfoA.dhall b/dhall-lang/tests/parser/success/unit/import/urls/userinfoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/import/urls/userinfoA.dhall @@ -0,0 +1,1 @@ +https://john:doe@example.com/foo diff --git a/dhall-lang/tests/parser/success/unit/import/urls/userinfoB.dhallb b/dhall-lang/tests/parser/success/unit/import/urls/userinfoB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/import/urls/userinfoB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolAndA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolAndA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolAndA.dhall @@ -0,0 +1,1 @@ +x && y diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolAndAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolAndAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolAndAssocA.dhall @@ -0,0 +1,1 @@ +w && x && y && z diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolAndAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolAndAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolAndAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolAndB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolAndB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolAndB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolEQA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolEQA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolEQA.dhall @@ -0,0 +1,1 @@ +x == y diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolEQAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolEQAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolEQAssocA.dhall @@ -0,0 +1,1 @@ +w == x == y == z diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolEQAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolEQAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolEQAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolEQB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolEQB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolEQB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolNEA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolNEA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolNEA.dhall @@ -0,0 +1,1 @@ +x != y diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolNEAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolNEAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolNEAssocA.dhall @@ -0,0 +1,1 @@ +w != x != y != z diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolNEAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolNEAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolNEAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolNEB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolNEB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolNEB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolOrA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolOrA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolOrA.dhall @@ -0,0 +1,1 @@ +x || y diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolOrAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/BoolOrAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/BoolOrAssocA.dhall @@ -0,0 +1,1 @@ +w || x || y || z diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolOrAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolOrAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolOrAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/BoolOrB.dhallb b/dhall-lang/tests/parser/success/unit/operators/BoolOrB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/BoolOrB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/EquivalenceA.dhall b/dhall-lang/tests/parser/success/unit/operators/EquivalenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/EquivalenceA.dhall @@ -0,0 +1,1 @@ +x === y diff --git a/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocA.dhall @@ -0,0 +1,1 @@ +w === x === y === z diff --git a/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/EquivalenceAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/EquivalenceB.dhallb b/dhall-lang/tests/parser/success/unit/operators/EquivalenceB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/EquivalenceB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/ImportAltA.dhall b/dhall-lang/tests/parser/success/unit/operators/ImportAltA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/ImportAltA.dhall @@ -0,0 +1,1 @@ +x ? y diff --git a/dhall-lang/tests/parser/success/unit/operators/ImportAltAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/ImportAltAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/ImportAltAssocA.dhall @@ -0,0 +1,1 @@ +w ? x ? y ? z diff --git a/dhall-lang/tests/parser/success/unit/operators/ImportAltAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/ImportAltAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/ImportAltAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/ImportAltB.dhallb b/dhall-lang/tests/parser/success/unit/operators/ImportAltB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/ImportAltB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/ListAppendA.dhall b/dhall-lang/tests/parser/success/unit/operators/ListAppendA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/ListAppendA.dhall @@ -0,0 +1,1 @@ +x # y diff --git a/dhall-lang/tests/parser/success/unit/operators/ListAppendAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/ListAppendAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/ListAppendAssocA.dhall @@ -0,0 +1,1 @@ +w # x # y # z diff --git a/dhall-lang/tests/parser/success/unit/operators/ListAppendAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/ListAppendAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/ListAppendAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/ListAppendB.dhallb b/dhall-lang/tests/parser/success/unit/operators/ListAppendB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/ListAppendB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalPlusA.dhall b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusA.dhall @@ -0,0 +1,1 @@ +x + y diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalPlusAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusAssocA.dhall @@ -0,0 +1,1 @@ +w + x + y + z diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalPlusAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalPlusB.dhallb b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/NaturalPlusB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalTimesA.dhall b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesA.dhall @@ -0,0 +1,1 @@ +x * y diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalTimesAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesAssocA.dhall @@ -0,0 +1,1 @@ +w * x * y * z diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalTimesAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/NaturalTimesB.dhallb b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/NaturalTimesB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceBoolA.dhall b/dhall-lang/tests/parser/success/unit/operators/PrecedenceBoolA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/PrecedenceBoolA.dhall @@ -0,0 +1,1 @@ +a && b || c d == e || f != g && h || i diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceBoolB.dhallb b/dhall-lang/tests/parser/success/unit/operators/PrecedenceBoolB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/PrecedenceBoolB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceEquivalenceA.dhall b/dhall-lang/tests/parser/success/unit/operators/PrecedenceEquivalenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/PrecedenceEquivalenceA.dhall @@ -0,0 +1,1 @@ +2 + 3 * 4 === 4 * 3 + 2 diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceEquivalenceB.dhallb b/dhall-lang/tests/parser/success/unit/operators/PrecedenceEquivalenceB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/PrecedenceEquivalenceB.dhallb @@ -0,0 +1,1 @@ +„ „‚„‚‚„„‚‚‚ diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceNatA.dhall b/dhall-lang/tests/parser/success/unit/operators/PrecedenceNatA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/PrecedenceNatA.dhall @@ -0,0 +1,1 @@ +a + b * d + e f * (g + h) diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceNatB.dhallb b/dhall-lang/tests/parser/success/unit/operators/PrecedenceNatB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/PrecedenceNatB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceRecordA.dhall b/dhall-lang/tests/parser/success/unit/operators/PrecedenceRecordA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/PrecedenceRecordA.dhall @@ -0,0 +1,1 @@ +a // b c /\ d ⫽ e.{x} ∧ f diff --git a/dhall-lang/tests/parser/success/unit/operators/PrecedenceRecordB.dhallb b/dhall-lang/tests/parser/success/unit/operators/PrecedenceRecordB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/PrecedenceRecordB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall @@ -0,0 +1,1 @@ +x /\ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall @@ -0,0 +1,1 @@ +w /\ x /\ y /\ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeA.dhall @@ -0,0 +1,1 @@ +x ∧ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeAssocA.dhall @@ -0,0 +1,1 @@ +w ∧ x /\ y ∧ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall @@ -0,0 +1,1 @@ +x //\\ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall @@ -0,0 +1,1 @@ +w //\\ x //\\ y //\\ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeA.dhall @@ -0,0 +1,1 @@ +x ⩓ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeAssocA.dhall @@ -0,0 +1,1 @@ +w ⩓ x //\\ y ⩓ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeA.dhall @@ -0,0 +1,1 @@ +x // y diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeAssocA.dhall @@ -0,0 +1,1 @@ +w // x // y // z diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeA.dhall @@ -0,0 +1,1 @@ +x ⫽ y diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeAssocA.dhall @@ -0,0 +1,1 @@ +w ⫽ x // y ⫽ z diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeB.dhallb b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/RightBiasedRecordMergeUnicodeB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/TextAppendA.dhall b/dhall-lang/tests/parser/success/unit/operators/TextAppendA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/TextAppendA.dhall @@ -0,0 +1,1 @@ +x ++ y diff --git a/dhall-lang/tests/parser/success/unit/operators/TextAppendAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/TextAppendAssocA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/unit/operators/TextAppendAssocA.dhall @@ -0,0 +1,1 @@ +w ++ x ++ y ++ z diff --git a/dhall-lang/tests/parser/success/unit/operators/TextAppendAssocB.dhallb b/dhall-lang/tests/parser/success/unit/operators/TextAppendAssocB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/TextAppendAssocB.dhallb differ diff --git a/dhall-lang/tests/parser/success/unit/operators/TextAppendB.dhallb b/dhall-lang/tests/parser/success/unit/operators/TextAppendB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/unit/operators/TextAppendB.dhallb differ diff --git a/dhall-lang/tests/parser/success/usingToMapA.dhall b/dhall-lang/tests/parser/success/usingToMapA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/usingToMapA.dhall @@ -0,0 +1,1 @@ +https://example.com using (toMap { Foo = "Bar" }) diff --git a/dhall-lang/tests/parser/success/usingToMapB.dhallb b/dhall-lang/tests/parser/success/usingToMapB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/usingToMapB.dhallb differ diff --git a/dhall-lang/tests/parser/success/whitespaceA.dhall b/dhall-lang/tests/parser/success/whitespaceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/whitespaceA.dhall @@ -0,0 +1,3 @@ + +1 + diff --git a/dhall-lang/tests/parser/success/whitespaceB.dhallb b/dhall-lang/tests/parser/success/whitespaceB.dhallb new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/whitespaceB.dhallb @@ -0,0 +1,1 @@ +‚ diff --git a/dhall-lang/tests/parser/success/whitespaceBuffetA.dhall b/dhall-lang/tests/parser/success/whitespaceBuffetA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/whitespaceBuffetA.dhall @@ -0,0 +1,9 @@ + -- This + + Natural/even {- + +{- file +-} + has + + -} 2 -- mixed {- line endings -} diff --git a/dhall-lang/tests/parser/success/whitespaceBuffetB.dhallb b/dhall-lang/tests/parser/success/whitespaceBuffetB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/whitespaceBuffetB.dhallb differ diff --git a/dhall-lang/tests/parser/success/withQuestionMarkA.dhall b/dhall-lang/tests/parser/success/withQuestionMarkA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/withQuestionMarkA.dhall @@ -0,0 +1,1 @@ +(Some 0) with ? = 1 diff --git a/dhall-lang/tests/parser/success/withQuestionMarkB.dhallb b/dhall-lang/tests/parser/success/withQuestionMarkB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/withQuestionMarkB.dhallb differ diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/0A.dhall b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/0A.dhall @@ -0,0 +1,1 @@ +{ x = "foo" }.x diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/0B.hash b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/0B.hash @@ -0,0 +1,1 @@ +sha256:fd881e3d48cbc85b4044697bdce8167a77f3fb4665ff0b647a1210a17528818a diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/1A.dhall b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/1A.dhall @@ -0,0 +1,1 @@ +< Foo : Text | Bar : Natural >.Foo diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/1B.hash b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/1B.hash @@ -0,0 +1,1 @@ +sha256:35ba8bddad36acfb29cc6f1700364544c145e96cf522f592f18f90c2f96e6e9c diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/0A.dhall b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/0A.dhall @@ -0,0 +1,1 @@ +{ foo : { bar : Text } } ⩓ { foo : { baz : Bool }, qux : Integer } diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/0B.hash b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/0B.hash @@ -0,0 +1,1 @@ +sha256:4495bbf3fea6c579c65ee51463b225747803b94668013528b9ca0384304cb350 diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/1A.dhall b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/1A.dhall @@ -0,0 +1,1 @@ +{ foo : { bar : Text } } //\\ { foo : { baz : Bool }, qux : Integer } diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/1B.hash b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/1B.hash @@ -0,0 +1,1 @@ +sha256:4495bbf3fea6c579c65ee51463b225747803b94668013528b9ca0384304cb350 diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/0A.dhall b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/0A.dhall @@ -0,0 +1,1 @@ +{ foo = 1, bar = "ABC" } // { baz = True } diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/0B.hash b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/0B.hash @@ -0,0 +1,1 @@ +sha256:18fbad84131d28b6d412e6bc09d5ee8eaf432b639c6cc6f1bef1b4ef366642d7 diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/0A.dhall b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/0A.dhall @@ -0,0 +1,1 @@ +{ x = 1, y = True, z = "ABC" }.{ x, y } diff --git a/dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/0B.hash b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/0B.hash @@ -0,0 +1,1 @@ +sha256:b7ae500723633be94b53b905384236fcd18cbce59314bb51044bb7d3f3939e6e diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/and.dhall [ True, False, True ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/and.dhall ([] : List Bool) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0A.dhall @@ -0,0 +1,2 @@ +../../../../../../Prelude/Bool/build.dhall +(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1A.dhall @@ -0,0 +1,2 @@ +../../../../../../Prelude/Bool/build.dhall +(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall [ False, True, False ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall [ False, True ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall [ False ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall ([] : List Bool) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/fold.dhall True Natural 0 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0B.hash @@ -0,0 +1,1 @@ +sha256:d0a48d41dcc572839faa9499b6c316b8d0d7115efac2ac770f062cd5fd6d0181 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/fold.dhall False Natural 0 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1B.hash @@ -0,0 +1,1 @@ +sha256:d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/not.dhall True diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/not.dhall False diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall [ True, False, True ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall [ True, False ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall [ True ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall ([] : List Bool) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/or.dhall [ True, False, True ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/or.dhall ([] : List Bool) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/show.dhall True diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0B.hash @@ -0,0 +1,1 @@ +sha256:cdbb7fd982ba05e709fe67b23818fffb65ff9c0b8abde1abb5ac1a8245891a3f diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/show.dhall False diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1B.hash @@ -0,0 +1,1 @@ +sha256:2357bb42b56beb99180d967177c0490061bd3536a147dfe144d2630f983004e5 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Double/show.dhall -3.1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0B.hash @@ -0,0 +1,1 @@ +sha256:d0b3cdb4f3cd5375495629450de676f445c0da6980a5ada251df199079d0ef89 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Double/show.dhall 0.4 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1B.hash @@ -0,0 +1,1 @@ +sha256:dd5e8756d06f12ef6e003dc769b6e1222e5aa0c8491579dc65b2dd6f4f0ec53d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/show.dhall -3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0B.hash @@ -0,0 +1,1 @@ +sha256:053de6c2b7f281dd82dd9b643cc848e64633b88c9c57082ec0ac41257c5592d7 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/show.dhall +0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1B.hash @@ -0,0 +1,1 @@ +sha256:4ab1c5aa262f39cdbe1f4924accb69bb44e2a616b5a0ca39655eebd0cc863d33 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/toDouble.dhall -3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0B.hash @@ -0,0 +1,1 @@ +sha256:3c97d2d6c7d01c1c324e6e0a7fcf3b756ff56cf1bf398c4945f04898ae9325a7 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/toDouble.dhall +2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1B.hash @@ -0,0 +1,1 @@ +sha256:fe5c1f8c6cc72fc9aeb61e3b0c5217bf62d2427bcfa678aeefeaa9d04cb9627c diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/all/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/all/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/all/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/all.dhall Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/all/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/all/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/all/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/all/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/all/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/all/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/all.dhall Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/all/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/all/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/all/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/any/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/any/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/any/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/any.dhall Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/any/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/any/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/any/0B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/any/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/any/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/any/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/any.dhall Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/any/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/any/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/any/1B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/build/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/build/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/build.dhall +Text +( λ(list : Type) +→ λ(cons : Text → list → list) +→ λ(nil : list) +→ cons "ABC" (cons "DEF" nil) +) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/build/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/build/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/build/0B.hash @@ -0,0 +1,1 @@ +sha256:8a08646db7447b14cf03a497635242b6fb76365017fc1699b2a8807272a2ec58 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/build/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/build/1A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/build.dhall +Text +( λ(list : Type) +→ λ(cons : Text → list → list) +→ λ(nil : list) +→ nil +) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/build/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/build/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/build/1B.hash @@ -0,0 +1,1 @@ +sha256:6da0c98142d1168ac9d6080b7853d2b59b97d42079e1b2f121daf449b3b2e449 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0A.dhall @@ -0,0 +1,5 @@ +../../../../../../Prelude/List/concat.dhall Natural +[ [ 0, 1, 2 ] +, [ 3, 4 ] +, [ 5, 6, 7, 8 ] +] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0B.hash @@ -0,0 +1,1 @@ +sha256:ae3a399d05bafcee80c088ca6c740f0c61c2a4c6fce6d7e4f4fa26560eac083f diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1A.dhall @@ -0,0 +1,5 @@ +../../../../../../Prelude/List/concat.dhall Natural +[ [] : List Natural +, [] : List Natural +, [] : List Natural +] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/concatMap.dhall Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0B.hash @@ -0,0 +1,1 @@ +sha256:ea1f5046bcba6efb41bde23738d9a3f3aa2cda3dc722999d9e4f477eb9d1b12d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/concatMap.dhall Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/filter.dhall Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0B.hash @@ -0,0 +1,1 @@ +sha256:988afbf26d86e95a4e6b78b0c344c9f987dcd5f7d7a7c541601bb1e9a01c9102 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/filter.dhall Natural Natural/odd [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1B.hash @@ -0,0 +1,1 @@ +sha256:68248e1b69b249e6aeebcd36e7034f159b75d2931105fb4d41fc55d644b7ee8d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/List/fold.dhall +Natural +[ 2, 3, 5 ] +Natural +(λ(x : Natural) → λ(y : Natural) → x + y) +0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0B.hash @@ -0,0 +1,1 @@ +sha256:d4428061b6fd69b6b45574603ac71060f9756a5c9a1642df322812e3a7ea858b diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1A.dhall @@ -0,0 +1,7 @@ + λ(nil : Natural) +→ ../../../../../../Prelude/List/fold.dhall + Natural + [ 2, 3, 5 ] + Natural + (λ(x : Natural) → λ(y : Natural) → x + y) + nil diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1B.hash @@ -0,0 +1,1 @@ +sha256:3bd732ae873cb107c3dfef4ae953f6480af310b27fda6b678b43569841e1012b diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2A.dhall @@ -0,0 +1,4 @@ + λ(list : Type) +→ λ(cons : Natural → list → list) +→ λ(nil : list) +→ ../../../../../../Prelude/List/fold.dhall Natural [ 2, 3, 5 ] list cons nil diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2B.hash @@ -0,0 +1,1 @@ +sha256:186c485f65cbbf97aba127a1205a16ee1125ec279e727ff05d8f8ada624257c7 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/generate.dhall 5 Bool Natural/even diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0B.hash @@ -0,0 +1,1 @@ +sha256:0860d18cdc28bc4e7b081bf8c9891ab07e303e4f72b3439bb3a92d7dedd7e8fa diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/generate.dhall 0 Bool Natural/even diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1B.hash @@ -0,0 +1,1 @@ +sha256:fb7841e1b3b3e3511196b38df96e73ac7785edef663ea450f97b3c1322742d69 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/head/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/head/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/head/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/head.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/head/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/head/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/head/0B.hash @@ -0,0 +1,1 @@ +sha256:7ac81b06d39113c93f17cc3d2aa55867453f68f35f58a4d577f5bacbb969225f diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/head/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/head/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/head/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/head.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/head/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/head/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/head/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/indexed.dhall Bool [ True, False, True ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0B.hash @@ -0,0 +1,1 @@ +sha256:7225a557384940f3f2f7f40e5e3e36384be7892c08a24e5467d0f75cd0dda9e1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/indexed.dhall Bool ([] : List Bool) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1B.hash @@ -0,0 +1,1 @@ +sha256:ff10538dd6bf3bf736bf38f54575e1ddd251aa1d6aad7c6ff6f4159bfc87cc4a diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/iterate.dhall 10 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0B.hash @@ -0,0 +1,1 @@ +sha256:577ea4905798b4fbd4803b3a7c82902594f0c3e5d84af46cec4514da9801760a diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/iterate.dhall 0 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/last/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/last/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/last/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/last.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/last/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/last/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/last/0B.hash @@ -0,0 +1,1 @@ +sha256:1400a0fa058e1c8fc58926856000d82d99fad204bf48e36f54dccaafc0acd3a0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/last/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/last/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/last/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/last.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/last/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/last/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/last/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/length/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/length/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/length/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/length.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/length/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/length/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/length/0B.hash @@ -0,0 +1,1 @@ +sha256:15f52ecf91c94c1baac02d5a4964b2ed8fa401641a2c8a95e8306ec7c1e3b8d2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/length/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/length/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/length/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/length.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/length/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/length/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/length/1B.hash @@ -0,0 +1,1 @@ +sha256:d0a48d41dcc572839faa9499b6c316b8d0d7115efac2ac770f062cd5fd6d0181 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/map/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/map/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/map/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/map.dhall Natural Bool Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/map/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/map/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/map/0B.hash @@ -0,0 +1,1 @@ +sha256:aaf20d96e69473f836397764ec61b64a65dc5084ee33692ecd8b85ca63962827 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/map/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/map/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/map/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/map.dhall Natural Bool Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/map/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/map/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/map/1B.hash @@ -0,0 +1,1 @@ +sha256:fb7841e1b3b3e3511196b38df96e73ac7785edef663ea450f97b3c1322742d69 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/null/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/null/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/null/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/null.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/null/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/null/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/null/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/null/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/null/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/null/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/null.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/null/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/null/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/null/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/replicate.dhall 9 Natural 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0B.hash @@ -0,0 +1,1 @@ +sha256:4241079fe7c8a46be37831a35dedb60645c3a86a2ab24778e03c27c820813cdc diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/replicate.dhall 0 Natural 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/reverse.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0B.hash @@ -0,0 +1,1 @@ +sha256:ed586af4895ad8118e77976c6ee2fef5a39f69eb9378df32349c81fee2d61d4d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/reverse.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0A.dhall @@ -0,0 +1,15 @@ +../../../../../../Prelude/List/shifted.dhall +Bool +[ [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = False } + ] +, [ { index = 0, value = False } + , { index = 1, value = False } + ] +, [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = True } + ] +] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0B.hash @@ -0,0 +1,1 @@ +sha256:e5c27411e9b0692ac96e6914420f17748eda33d3854067675c6a3b3780fb15a6 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/shifted.dhall Bool ([] : List (List { index : Natural, value : Bool })) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1B.hash @@ -0,0 +1,1 @@ +sha256:ff10538dd6bf3bf736bf38f54575e1ddd251aa1d6aad7c6ff6f4159bfc87cc4a diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/unzip.dhall +Text +Bool +[ { _1 = "ABC", _2 = True } +, { _1 = "DEF", _2 = False } +, { _1 = "GHI", _2 = True } +] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0B.hash @@ -0,0 +1,1 @@ +sha256:fffb0db166d08b99a1beb1650a3c9ee6e7bf6ce1054150bea4dae9b8ce5e4fbf diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/unzip.dhall Text Bool ([] : List { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1B.hash @@ -0,0 +1,1 @@ +sha256:c598ac5f10c7d20fe201f94ed5d9d18a847e89c65db9478492c930e5c42af710 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/Natural/build.dhall +( λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ succ (succ (succ zero)) +) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0B.hash @@ -0,0 +1,1 @@ +sha256:15f52ecf91c94c1baac02d5a4964b2ed8fa401641a2c8a95e8306ec7c1e3b8d2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/Natural/build.dhall +( λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ zero +) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1B.hash @@ -0,0 +1,1 @@ +sha256:d0a48d41dcc572839faa9499b6c316b8d0d7115efac2ac770f062cd5fd6d0181 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/enumerate.dhall 10 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0B.hash @@ -0,0 +1,1 @@ +sha256:a7af1902b53cc68a9613b659ebf58d06c840072625d14f9fde7eefa0e0f2add0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/enumerate.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/even.dhall 3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/even.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/fold.dhall 3 Natural (λ(x : Natural) → 5 * x) 1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0B.hash @@ -0,0 +1,1 @@ +sha256:39b0b6e0e0b616af4f20c7b06fefcd26dcdbd5be772d885fe73487574ec8b56b diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1A.dhall @@ -0,0 +1,1 @@ +λ(zero : Natural) → ../../../../../../Prelude/Natural/fold.dhall 3 Natural (λ(x : Natural) → 5 * x) zero diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1B.hash @@ -0,0 +1,1 @@ +sha256:c6ddb630f2abfcd78aa874079323ba2a9f80f548c5687346a0fcedff78d14f52 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2A.dhall @@ -0,0 +1,4 @@ + λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ ../../../../../../Prelude/Natural/fold.dhall 3 natural succ zero diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2B.hash @@ -0,0 +1,1 @@ +sha256:08681d6fb9b1bb78be37f5a976186daa8fc39d0d1d3f7dbb716dc33937a6746d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/isZero.dhall 2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/isZero.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/odd.dhall 3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/odd.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/product.dhall [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0B.hash @@ -0,0 +1,1 @@ +sha256:49036d5d861d35d4aff797975a3447ebae71a9057951a03fc810ab8e8e00a498 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/product.dhall ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1B.hash @@ -0,0 +1,1 @@ +sha256:d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/show.dhall 3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0B.hash @@ -0,0 +1,1 @@ +sha256:c8911e8084484ca0d468334986a19f0a11cc18b31f41f272e7d4ad2cd479ad39 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/show.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1B.hash @@ -0,0 +1,1 @@ +sha256:e3062e0493964ebaef8880667ad8a6289c277618c0b31141610abf5d69e7c9ea diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/sum.dhall [ 2, 3, 5 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0B.hash @@ -0,0 +1,1 @@ +sha256:d4428061b6fd69b6b45574603ac71060f9756a5c9a1642df322812e3a7ea858b diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/sum.dhall ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1B.hash @@ -0,0 +1,1 @@ +sha256:d0a48d41dcc572839faa9499b6c316b8d0d7115efac2ac770f062cd5fd6d0181 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toDouble.dhall 3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0B.hash @@ -0,0 +1,1 @@ +sha256:45b03fd4a48720ca71d4d12967cdde317c918d7c0295845cf9628784a124108d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toDouble.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1B.hash @@ -0,0 +1,1 @@ +sha256:3c213998cb56b97b31168d9dce02d084fb5f5103caef41fb6dc375f593749a7d diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toInteger.dhall 3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0B.hash @@ -0,0 +1,1 @@ +sha256:aa773179ef61a5d65c774bcc510806531ce8fa97c550961526153e42959e6f76 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toInteger.dhall 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1B.hash @@ -0,0 +1,1 @@ +sha256:5abe149a174ca99b6da92c97b0a7c8900a5f9acddb720bf7173eef877c6a187b diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/all.dhall Natural Natural/even (Some 3) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/all.dhall Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/any.dhall Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/any.dhall Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/Optional/build.dhall +Natural +( λ(optional : Type) +→ λ(some : Natural → optional) +→ λ(none : optional) +→ some 1 +) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0B.hash @@ -0,0 +1,1 @@ +sha256:033652a641ac54a27f52b874877889c6a9c7f8c435dae9f8e956e4d402d6f2c7 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/Optional/build.dhall +Natural +( λ(optional : Type) +→ λ(some : Natural → optional) +→ λ(none : optional) +→ none +) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat.dhall Natural (Some (Some 1)) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0B.hash @@ -0,0 +1,1 @@ +sha256:033652a641ac54a27f52b874877889c6a9c7f8c435dae9f8e956e4d402d6f2c7 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat.dhall Natural (Some (None Natural)) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat.dhall Natural (None (Optional Natural)) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/filter.dhall Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0B.hash @@ -0,0 +1,1 @@ +sha256:1400a0fa058e1c8fc58926856000d82d99fad204bf48e36f54dccaafc0acd3a0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/filter.dhall Natural Natural/odd (Some 2) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/fold.dhall Natural (Some 2) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0B.hash @@ -0,0 +1,1 @@ +sha256:4caf97e8c445d4d4b5c5b992973e098ed4ae88a355915f5a59db640a589bc9cb diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/fold.dhall Natural (None Natural) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1B.hash @@ -0,0 +1,1 @@ +sha256:d0a48d41dcc572839faa9499b6c316b8d0d7115efac2ac770f062cd5fd6d0181 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0B.hash @@ -0,0 +1,1 @@ +sha256:033652a641ac54a27f52b874877889c6a9c7f8c435dae9f8e956e4d402d6f2c7 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head.dhall Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0B.hash @@ -0,0 +1,1 @@ +sha256:1400a0fa058e1c8fc58926856000d82d99fad204bf48e36f54dccaafc0acd3a0 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last.dhall Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2B.hash @@ -0,0 +1,1 @@ +sha256:bfdc295856e05e3610d202d9c12f56f7c423de81cd6069f590786ca176b94df3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/length.dhall Natural (Some 2) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0B.hash @@ -0,0 +1,1 @@ +sha256:d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/length.dhall Natural (None Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1B.hash @@ -0,0 +1,1 @@ +sha256:d0a48d41dcc572839faa9499b6c316b8d0d7115efac2ac770f062cd5fd6d0181 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (Some 3) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0B.hash @@ -0,0 +1,1 @@ +sha256:3af5b2f9dcc58e7950e2f0281f796de2ac5e87554ae758e38c36cd55cf53743e diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (None Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1B.hash @@ -0,0 +1,1 @@ +sha256:2c9884f8336ed425b13068919b216c42be286636c657faa15b911382436b3f00 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/null.dhall Natural (Some 2) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0B.hash @@ -0,0 +1,1 @@ +sha256:2017ff3461395672aa0aa4f64894fd2f95a4b120e2690e8951656d79adc2eed2 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/null.dhall Natural (None Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1B.hash @@ -0,0 +1,1 @@ +sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/toList.dhall Natural (Some 1) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0B.hash @@ -0,0 +1,1 @@ +sha256:75be41333b1ef7a6f5c5cfbcd6097681f3968736dc393b9bf53b2e609564217f diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/toList.dhall Natural (None Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1B.hash @@ -0,0 +1,1 @@ +sha256:d79a2e0e14809ab2dbd2d180e60da8e129a5fb197bdd0caed57e3828402e48a9 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/unzip.dhall Text Bool (Some { _1 = "ABC", _2 = True }) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0B.hash @@ -0,0 +1,1 @@ +sha256:5604f6ef6cf7385166101c61738c34a84983f1b7b4695858fa2068fc669eb2c1 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/unzip.dhall Text Bool (None { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1B.hash @@ -0,0 +1,1 @@ +sha256:6de82c54048538c97063c9ae31919b4ca21018ae7119bc123508c136ee653280 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concat.dhall [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0B.hash @@ -0,0 +1,1 @@ +sha256:1f73cf8a6efa724376c3342f9e0104c499e16420732b8c25efc6ab1c18979772 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concat.dhall ([] : List Text) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1B.hash @@ -0,0 +1,1 @@ +sha256:f08ed5225480d827ff3ce74b756afa6330f66d974d6f0d6160d767b5c45642aa diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMap.dhall Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0B.hash @@ -0,0 +1,1 @@ +sha256:fa7f18d0522f120dbf229ff0a55f96792ce76613ba17611c53f3f5efd81df510 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMap.dhall Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1B.hash @@ -0,0 +1,1 @@ +sha256:f08ed5225480d827ff3ce74b756afa6330f66d974d6f0d6160d767b5c45642aa diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show [ 0, 1, 2 ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0B.hash @@ -0,0 +1,1 @@ +sha256:952e63727a69b5f2db65645167c3a8f60dbc350608562a1c90423c819a1b5baf diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show ([] : List Natural) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1B.hash @@ -0,0 +1,1 @@ +sha256:f08ed5225480d827ff3ce74b756afa6330f66d974d6f0d6160d767b5c45642aa diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatSep.dhall ", " [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0B.hash @@ -0,0 +1,1 @@ +sha256:151ad6d86cced932c9ed6fa5d69b88fb47e160a13762f4d92dcb1e847ccd30d6 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatSep.dhall ", " ([] : List Text) diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1B.hash @@ -0,0 +1,1 @@ +sha256:f08ed5225480d827ff3ce74b756afa6330f66d974d6f0d6160d767b5c45642aa diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/show.dhall "ABC" diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0B.hash @@ -0,0 +1,1 @@ +sha256:8dffa347e98424c7b1e91e3e3758fc203a4e52fd990dc4b050da18cdb39655d3 diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/show.dhall "\u0000 \$ \\ \n \u263a" diff --git a/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1B.hash b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1B.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1B.hash @@ -0,0 +1,1 @@ +sha256:92655b5ee59ddfb1decfd19cf8b37e8f2dd5dbd317f55bcbb780bf6ed2010b0a diff --git a/dhall-lang/tests/semantic-hash/success/remoteSystemsA.dhall b/dhall-lang/tests/semantic-hash/success/remoteSystemsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/remoteSystemsA.dhall @@ -0,0 +1,51 @@ +let Text/concatMap = ../../../Prelude/Text/concatMap + +let Text/concatSep = ../../../Prelude/Text/concatSep + +let Row = + { cores : + Natural + , host : + Text + , key : + Text + , mandatoryFeatures : + List Text + , platforms : + List Text + , speedFactor : + Natural + , supportedFeatures : + List Text + , user : + Optional Text + } + +let renderRow = + λ ( row + : Row + ) + → let host = + merge + { None = row.host + , Some = λ(user : Text) → "${user}@${row.host}" + } + row.user + + let platforms = Text/concatSep "," row.platforms + + let key = row.key + + let cores = Integer/show (Natural/toInteger row.cores) + + let speedFactor = Integer/show (Natural/toInteger row.speedFactor) + + let supportedFeatures = Text/concatSep "," row.supportedFeatures + + let mandatoryFeatures = Text/concatSep "," row.mandatoryFeatures + + in '' + ${host} ${platforms} ${key} ${cores} ${speedFactor} ${supportedFeatures} ${mandatoryFeatures} + '' + +in Text/concatMap Row renderRow diff --git a/dhall-lang/tests/semantic-hash/success/remoteSystemsB.hash b/dhall-lang/tests/semantic-hash/success/remoteSystemsB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/remoteSystemsB.hash @@ -0,0 +1,1 @@ +sha256:573b0d8fbc28c09c155cf239963b6ba71941aace25e23806043017f7fe75098b diff --git a/dhall-lang/tests/semantic-hash/success/simple/doubleShowA.dhall b/dhall-lang/tests/semantic-hash/success/simple/doubleShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/doubleShowA.dhall @@ -0,0 +1,6 @@ +{ example0 = Double/show -0.42 +, example1 = Double/show 13.37 +, example2 = Double/show NaN +, example3 = Double/show Infinity +, example4 = Double/show -Infinity +} diff --git a/dhall-lang/tests/semantic-hash/success/simple/doubleShowB.hash b/dhall-lang/tests/semantic-hash/success/simple/doubleShowB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/doubleShowB.hash @@ -0,0 +1,1 @@ +sha256:519ea07f25f759795d4326f06a97401fe0a5efe7823139976d1158c939ee6176 diff --git a/dhall-lang/tests/semantic-hash/success/simple/enumA.dhall b/dhall-lang/tests/semantic-hash/success/simple/enumA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/enumA.dhall @@ -0,0 +1,8 @@ +let Role = < Wizard | Fighter | Rogue > + +let show : Role → Text + = + λ(x : Role) + → merge { Wizard = "Wizard", Fighter = "Fighter", Rogue = "Rogue" } x + +in show Role.Wizard diff --git a/dhall-lang/tests/semantic-hash/success/simple/enumB.hash b/dhall-lang/tests/semantic-hash/success/simple/enumB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/enumB.hash @@ -0,0 +1,1 @@ +sha256:0e6e479638f87eca04805548d70b5de9d22c5359e7d84ccbcfe148577bc25a4e diff --git a/dhall-lang/tests/semantic-hash/success/simple/integerShowA.dhall b/dhall-lang/tests/semantic-hash/success/simple/integerShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/integerShowA.dhall @@ -0,0 +1,4 @@ +{ example0 = Integer/show +1337 +, example1 = Integer/show -42 +, example2 = Integer/show +0 +} diff --git a/dhall-lang/tests/semantic-hash/success/simple/integerShowB.hash b/dhall-lang/tests/semantic-hash/success/simple/integerShowB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/integerShowB.hash @@ -0,0 +1,1 @@ +sha256:7ff01ad1c68550be713834548385874f38fd7b989e3c4b8cad7125bc266e2bb3 diff --git a/dhall-lang/tests/semantic-hash/success/simple/integerToDoubleA.dhall b/dhall-lang/tests/semantic-hash/success/simple/integerToDoubleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/integerToDoubleA.dhall @@ -0,0 +1,10 @@ +[ Integer/toDouble +179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497792 +, Integer/toDouble +179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791 +, Integer/toDouble +179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945 +, Integer/toDouble +179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944 + +, Integer/toDouble -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497792 +, Integer/toDouble -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791 +, Integer/toDouble -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945 +, Integer/toDouble -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944 +] diff --git a/dhall-lang/tests/semantic-hash/success/simple/integerToDoubleB.hash b/dhall-lang/tests/semantic-hash/success/simple/integerToDoubleB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/integerToDoubleB.hash @@ -0,0 +1,1 @@ +sha256:439d81a4aee03a27da069772c4ea51d64c025faac1a2e749734cc5e4cf0f2484 diff --git a/dhall-lang/tests/semantic-hash/success/simple/letletA.dhall b/dhall-lang/tests/semantic-hash/success/simple/letletA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/letletA.dhall @@ -0,0 +1,3 @@ +let l = λ(n : Natural) → λ(m : Natural) → λ(x : Natural) → n + m * x +let f = l 2 3 +in f 445 diff --git a/dhall-lang/tests/semantic-hash/success/simple/letletB.hash b/dhall-lang/tests/semantic-hash/success/simple/letletB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/letletB.hash @@ -0,0 +1,1 @@ +sha256:97285916da4ee4a1e108af044b449edcdfb818c2f55aefd64f0af76b347da16d diff --git a/dhall-lang/tests/semantic-hash/success/simple/listBuildA.dhall b/dhall-lang/tests/semantic-hash/success/simple/listBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/listBuildA.dhall @@ -0,0 +1,22 @@ +{ example0 = + List/build + Bool + ( λ(list : Type) + → λ(cons : Bool → list → list) + → λ(nil : list) + → cons True (cons False nil) + ) +, example1 = + List/build + Bool + (λ(x : Type) → λ(x : Bool → x → x) → λ(x : x@1) → x@1 True (x@1 False x)) +, example2 = + λ(id : ∀(a : Type) → a → a) + → List/build + Bool + ( λ(list : Type) + → λ(cons : Bool → list → list) + → λ(nil : list) + → id list (cons True (cons False nil)) + ) +} diff --git a/dhall-lang/tests/semantic-hash/success/simple/listBuildB.hash b/dhall-lang/tests/semantic-hash/success/simple/listBuildB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/listBuildB.hash @@ -0,0 +1,1 @@ +sha256:f8f03d5be6563b275253b4d995499e783112ff98ed231855e9152ba45970f8c7 diff --git a/dhall-lang/tests/semantic-hash/success/simple/multiLineA.dhall b/dhall-lang/tests/semantic-hash/success/simple/multiLineA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/multiLineA.dhall @@ -0,0 +1,4 @@ +'' + foo +bar +'' diff --git a/dhall-lang/tests/semantic-hash/success/simple/multiLineB.hash b/dhall-lang/tests/semantic-hash/success/simple/multiLineB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/multiLineB.hash @@ -0,0 +1,1 @@ +sha256:2ab4fb081094ad6729186b7cd8a0ec67f7845bbea59ec5a484bff2de42390137 diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalBuildA.dhall b/dhall-lang/tests/semantic-hash/success/simple/naturalBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalBuildA.dhall @@ -0,0 +1,18 @@ +{ example0 = + Natural/build + ( λ(natural : Type) + → λ(succ : natural → natural) + → λ(zero : natural) + → succ zero + ) +, example1 = + Natural/build (λ(x : Type) → λ(x : x → x) → λ(x : x@1) → x@1 x) +, example2 = + λ(id : ∀(a : Type) → a → a) + → Natural/build + ( λ(natural : Type) + → λ(succ : natural → natural) + → λ(zero : natural) + → id natural (succ zero) + ) +} diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalBuildB.hash b/dhall-lang/tests/semantic-hash/success/simple/naturalBuildB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalBuildB.hash @@ -0,0 +1,1 @@ +sha256:3e14f3cbed2ddcc78cb9bf66bf2372c2059fd6c4b406ca309a05b89b7f62b011 diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalPlusA.dhall b/dhall-lang/tests/semantic-hash/success/simple/naturalPlusA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalPlusA.dhall @@ -0,0 +1,1 @@ +1 + 2 diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalPlusB.hash b/dhall-lang/tests/semantic-hash/success/simple/naturalPlusB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalPlusB.hash @@ -0,0 +1,1 @@ +sha256:15f52ecf91c94c1baac02d5a4964b2ed8fa401641a2c8a95e8306ec7c1e3b8d2 diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalShowA.dhall b/dhall-lang/tests/semantic-hash/success/simple/naturalShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalShowA.dhall @@ -0,0 +1,1 @@ +Natural/show 42 diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalShowB.hash b/dhall-lang/tests/semantic-hash/success/simple/naturalShowB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalShowB.hash @@ -0,0 +1,1 @@ +sha256:3d1abfe685ff9abcf5e1a6bcce9b1a8374fc8ac176c22ef3e0188bd29e7d8c6d diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalToIntegerA.dhall b/dhall-lang/tests/semantic-hash/success/simple/naturalToIntegerA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalToIntegerA.dhall @@ -0,0 +1,1 @@ +Natural/toInteger 1 diff --git a/dhall-lang/tests/semantic-hash/success/simple/naturalToIntegerB.hash b/dhall-lang/tests/semantic-hash/success/simple/naturalToIntegerB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/naturalToIntegerB.hash @@ -0,0 +1,1 @@ +sha256:d2cbb0e226f332ea76d63b3ae4332780c4051d1388d3e190debd5441f4595a04 diff --git a/dhall-lang/tests/semantic-hash/success/simple/sortOperatorA.dhall b/dhall-lang/tests/semantic-hash/success/simple/sortOperatorA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/sortOperatorA.dhall @@ -0,0 +1,1 @@ +{ b = 2 } // { a = 1 } diff --git a/dhall-lang/tests/semantic-hash/success/simple/sortOperatorB.hash b/dhall-lang/tests/semantic-hash/success/simple/sortOperatorB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simple/sortOperatorB.hash @@ -0,0 +1,1 @@ +sha256:97090822fa42ff0245484a518e2457f85271f4c36fc9462b82498d85b2cc98fc diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/andA.dhall b/dhall-lang/tests/semantic-hash/success/simplifications/andA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/andA.dhall @@ -0,0 +1,6 @@ +{ example0 = λ(x : Bool) → x && True +, example1 = λ(x : Bool) → True && x +, example2 = λ(x : Bool) → x && False +, example3 = λ(x : Bool) → False && x +, example4 = λ(x : Bool) → x && x +} diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/andB.hash b/dhall-lang/tests/semantic-hash/success/simplifications/andB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/andB.hash @@ -0,0 +1,1 @@ +sha256:ceac399e820b2a86c65077e07e77bb62f10253fda02a51e438457adf4368b580 diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/eqA.dhall b/dhall-lang/tests/semantic-hash/success/simplifications/eqA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/eqA.dhall @@ -0,0 +1,4 @@ +{ example0 = λ(x : Bool) → x == True +, example1 = λ(x : Bool) → True == x +, example2 = λ(x : Bool) → x == x +} diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/eqB.hash b/dhall-lang/tests/semantic-hash/success/simplifications/eqB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/eqB.hash @@ -0,0 +1,1 @@ +sha256:5524bd7e3ecdeaa98a25f51f40a1cb33896c2e3e0e21e14c939d17dac946fa4d diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/ifThenElseA.dhall b/dhall-lang/tests/semantic-hash/success/simplifications/ifThenElseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/ifThenElseA.dhall @@ -0,0 +1,3 @@ +{ example0 = λ(x : Bool) → if x then True else False +, example1 = λ(x : Bool) → λ(y : Text) → if x then y else y +} diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/ifThenElseB.hash b/dhall-lang/tests/semantic-hash/success/simplifications/ifThenElseB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/ifThenElseB.hash @@ -0,0 +1,1 @@ +sha256:40b3cdc4cc8f2ff9b733e5e8d8613ec8c3d17fc11f22cfd96d8109765c15add5 diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/neA.dhall b/dhall-lang/tests/semantic-hash/success/simplifications/neA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/neA.dhall @@ -0,0 +1,4 @@ +{ example0 = λ(x : Bool) → x != False +, example1 = λ(x : Bool) → False != x +, example2 = λ(x : Bool) → x != x +} diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/neB.hash b/dhall-lang/tests/semantic-hash/success/simplifications/neB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/neB.hash @@ -0,0 +1,1 @@ +sha256:69d11e754a064f8abe927e5df446896372a6367135e08c52b5c2274e3bd03bc7 diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/orA.dhall b/dhall-lang/tests/semantic-hash/success/simplifications/orA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/orA.dhall @@ -0,0 +1,6 @@ +{ example0 = λ(x : Bool) → x || True +, example1 = λ(x : Bool) → True || x +, example2 = λ(x : Bool) → x || False +, example3 = λ(x : Bool) → False || x +, example4 = λ(x : Bool) → x || x +} diff --git a/dhall-lang/tests/semantic-hash/success/simplifications/orB.hash b/dhall-lang/tests/semantic-hash/success/simplifications/orB.hash new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/semantic-hash/success/simplifications/orB.hash @@ -0,0 +1,1 @@ +sha256:41437a8eb5753b2d340fc27cc192265459da57cd65d487447a261f2eede2f5ef diff --git a/dhall-lang/tests/type-inference/failure/DateApplyTime.dhall b/dhall-lang/tests/type-inference/failure/DateApplyTime.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/DateApplyTime.dhall @@ -0,0 +1,3 @@ +-- This parses, but will fail to type-check, because in the absence of the `T` +-- it is interpreted as a `Date` applied to a `Time` +2020-01-01 12:00:00 diff --git a/dhall-lang/tests/type-inference/failure/SortInLet.dhall b/dhall-lang/tests/type-inference/failure/SortInLet.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/SortInLet.dhall @@ -0,0 +1,1 @@ +let x = Sort in 0 diff --git a/dhall-lang/tests/type-inference/failure/hurkensParadox.dhall b/dhall-lang/tests/type-inference/failure/hurkensParadox.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/hurkensParadox.dhall @@ -0,0 +1,49 @@ + let bottom : Type = ∀(any : Type) → any + +in let not : Type → Type = λ(p : Type) → p → bottom + +in let pow = λ(X : Kind) → X → Type + +in let U = ∀(X : Kind) → (pow (pow X) → X) → pow (pow X) + +in let tau + : pow (pow U) → U + = λ(t : pow (pow U)) + → λ(X : Kind) + → λ(f : pow (pow X) → X) + → λ(p : pow X) + → t (λ(x : U) → p (f (x X f))) + +in let sigma : U → pow (pow U) = λ(s : U) → s U (λ(t : pow (pow U)) → tau t) + +in let Delta + : pow U + = λ(y : U) → not (∀(p : pow U) → sigma y p → p (tau (sigma y))) + +in let Omega : U = tau (λ(p : pow U) → ∀(x : U) → sigma x p → p x) + +in let Theta : Type = ∀(p : pow U) → (∀(x : U) → sigma x p → p x) → p Omega + +in let D : Type = ∀(p : pow U) → sigma Omega p → p (tau (sigma Omega)) + +in let lem1 + : ∀(p : pow U) → (∀(x : U) → sigma x p → p x) → p Omega + = λ(p : pow U) + → λ(t1 : ∀(x : U) → sigma x p → p x) + → t1 Omega (λ(x : U) → t1 (tau (sigma x))) + +in let lem3 : D = λ(p : pow U) → lem1 (λ(y : U) → p (tau (sigma y))) + +in let lem2 + : not D + = lem1 + Delta + ( λ(x : U) + → λ(H2 : sigma x Delta) + → λ(H3 : ∀(p : pow U) → sigma x p → p (tau (sigma x))) + → H3 Delta H2 (λ(pp : pow U) → H3 (λ(y : U) → pp (tau (sigma y)))) + ) + +in let evidence : bottom = lem2 lem3 + +in evidence diff --git a/dhall-lang/tests/type-inference/failure/recordOfKind.dhall b/dhall-lang/tests/type-inference/failure/recordOfKind.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/recordOfKind.dhall @@ -0,0 +1,1 @@ +{ a = Kind } diff --git a/dhall-lang/tests/type-inference/failure/unit/AnnotationRecordWrongFieldName.dhall b/dhall-lang/tests/type-inference/failure/unit/AnnotationRecordWrongFieldName.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AnnotationRecordWrongFieldName.dhall @@ -0,0 +1,1 @@ +{ x = 1 } : { y : Natural } diff --git a/dhall-lang/tests/type-inference/failure/unit/AnnotationRecordWrongFieldType.dhall b/dhall-lang/tests/type-inference/failure/unit/AnnotationRecordWrongFieldType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AnnotationRecordWrongFieldType.dhall @@ -0,0 +1,1 @@ +{ x = 1 } : { x : Text } diff --git a/dhall-lang/tests/type-inference/failure/unit/AssertAlphaTrap.dhall b/dhall-lang/tests/type-inference/failure/unit/AssertAlphaTrap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AssertAlphaTrap.dhall @@ -0,0 +1,1 @@ +assert : (\(_: Bool) -> _) === (\(x: Bool) -> _) diff --git a/dhall-lang/tests/type-inference/failure/unit/AssertAlphaTrap2.dhall b/dhall-lang/tests/type-inference/failure/unit/AssertAlphaTrap2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AssertAlphaTrap2.dhall @@ -0,0 +1,1 @@ +\(_: Bool) -> assert : (\(_: Bool) -> _) === (\(x: Bool) -> _) diff --git a/dhall-lang/tests/type-inference/failure/unit/AssertDoubleZeros.dhall b/dhall-lang/tests/type-inference/failure/unit/AssertDoubleZeros.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AssertDoubleZeros.dhall @@ -0,0 +1,1 @@ +assert : -0.0 ≡ +0.0 diff --git a/dhall-lang/tests/type-inference/failure/unit/AssertNotEquivalence.dhall b/dhall-lang/tests/type-inference/failure/unit/AssertNotEquivalence.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AssertNotEquivalence.dhall @@ -0,0 +1,1 @@ +assert : Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/AssertTriviallyFalse.dhall b/dhall-lang/tests/type-inference/failure/unit/AssertTriviallyFalse.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/AssertTriviallyFalse.dhall @@ -0,0 +1,1 @@ +assert : 1 === 2 diff --git a/dhall-lang/tests/type-inference/failure/unit/CompletionMissingRequiredField.dhall b/dhall-lang/tests/type-inference/failure/unit/CompletionMissingRequiredField.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/CompletionMissingRequiredField.dhall @@ -0,0 +1,6 @@ +let Example = + { Type = { name : Text, id : Optional Natural } + , default = { id = None Natural } + } + +in Example::{=} diff --git a/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongDefaultType.dhall b/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongDefaultType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongDefaultType.dhall @@ -0,0 +1,6 @@ +let Example = + { Type = { name : Text, id : Optional Natural } + , default = { name = True, id = None Natural } + } + +in Example::{=} diff --git a/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongFieldName.dhall b/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongFieldName.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongFieldName.dhall @@ -0,0 +1,6 @@ +let Example = + { Type = { name : Text, id : Optional Natural } + , default = { name = "", id = None Natural } + } + +in Example::{ nam = "John Doe" } diff --git a/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongOverridenType.dhall b/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongOverridenType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/CompletionWithWrongOverridenType.dhall @@ -0,0 +1,6 @@ +let Example = + { Type = { name : Text, id : Optional Natural } + , default = { name = "", id = None Natural } + } + +in Example::{ name = True } diff --git a/dhall-lang/tests/type-inference/failure/unit/EmptyToMap.dhall b/dhall-lang/tests/type-inference/failure/unit/EmptyToMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/EmptyToMap.dhall @@ -0,0 +1,1 @@ +toMap {=} diff --git a/dhall-lang/tests/type-inference/failure/unit/EquivalenceNotSameType.dhall b/dhall-lang/tests/type-inference/failure/unit/EquivalenceNotSameType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/EquivalenceNotSameType.dhall @@ -0,0 +1,1 @@ +1 === False diff --git a/dhall-lang/tests/type-inference/failure/unit/EquivalenceNotTerms.dhall b/dhall-lang/tests/type-inference/failure/unit/EquivalenceNotTerms.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/EquivalenceNotTerms.dhall @@ -0,0 +1,1 @@ +Bool === Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionApplicationArgumentNotMatch.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionApplicationArgumentNotMatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionApplicationArgumentNotMatch.dhall @@ -0,0 +1,1 @@ +(λ(_ : Natural) → _) True diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionApplicationIsNotFunction.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionApplicationIsNotFunction.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionApplicationIsNotFunction.dhall @@ -0,0 +1,1 @@ +True True diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionArgumentTypeNotAType.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionArgumentTypeNotAType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionArgumentTypeNotAType.dhall @@ -0,0 +1,1 @@ +λ(_ : 1) → _ diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionTypeArgumentTypeNotAType.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeArgumentTypeNotAType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeArgumentTypeNotAType.dhall @@ -0,0 +1,1 @@ +2 → _ diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionTypeKindSort.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeKindSort.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeKindSort.dhall @@ -0,0 +1,1 @@ +Kind → Sort diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionTypeOutputTypeNotAType.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeOutputTypeNotAType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeOutputTypeNotAType.dhall @@ -0,0 +1,1 @@ +Bool -> 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/FunctionTypeTypeSort.dhall b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeTypeSort.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/FunctionTypeTypeSort.dhall @@ -0,0 +1,1 @@ +Type → Sort diff --git a/dhall-lang/tests/type-inference/failure/unit/HeterogenousToMap.dhall b/dhall-lang/tests/type-inference/failure/unit/HeterogenousToMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/HeterogenousToMap.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= "Bar" } diff --git a/dhall-lang/tests/type-inference/failure/unit/IfBranchesNotMatch.dhall b/dhall-lang/tests/type-inference/failure/unit/IfBranchesNotMatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/IfBranchesNotMatch.dhall @@ -0,0 +1,1 @@ +if True then 1 else "" diff --git a/dhall-lang/tests/type-inference/failure/unit/IfBranchesNotTermTypeOrKind.dhall b/dhall-lang/tests/type-inference/failure/unit/IfBranchesNotTermTypeOrKind.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/IfBranchesNotTermTypeOrKind.dhall @@ -0,0 +1,1 @@ +if True then Kind else Kind diff --git a/dhall-lang/tests/type-inference/failure/unit/IfNotBool.dhall b/dhall-lang/tests/type-inference/failure/unit/IfNotBool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/IfNotBool.dhall @@ -0,0 +1,1 @@ +if 1 then 1 else 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/LetInSort.dhall b/dhall-lang/tests/type-inference/failure/unit/LetInSort.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/LetInSort.dhall @@ -0,0 +1,1 @@ +\(x: let x = 0 in Sort) -> 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/LetWithNonterminatingAnnotation.dhall b/dhall-lang/tests/type-inference/failure/unit/LetWithNonterminatingAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/LetWithNonterminatingAnnotation.dhall @@ -0,0 +1,14 @@ +-- When you check if an inferred type is equivalent to an annotation, +-- you must alpha-beta-normalize both sides first. But it is not safe +-- to beta-normalise an expression which hasn't first been +-- typechecked. +-- +-- This test contains an annotation which doesn't typecheck, and +-- which, when beta-normalized, doesn't terminate. It exists to +-- verify that implementations typecheck the annotation before +-- checking equivalence. +let a + : (λ(x : Natural) → x x) (λ(x : Natural) → x x) + = 3 + +in 5 diff --git a/dhall-lang/tests/type-inference/failure/unit/LetWithWrongAnnotation.dhall b/dhall-lang/tests/type-inference/failure/unit/LetWithWrongAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/LetWithWrongAnnotation.dhall @@ -0,0 +1,1 @@ +let x : Natural = True in True diff --git a/dhall-lang/tests/type-inference/failure/unit/ListLiteralEmptyNotType.dhall b/dhall-lang/tests/type-inference/failure/unit/ListLiteralEmptyNotType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ListLiteralEmptyNotType.dhall @@ -0,0 +1,1 @@ +[] : List Type diff --git a/dhall-lang/tests/type-inference/failure/unit/ListLiteralNotType.dhall b/dhall-lang/tests/type-inference/failure/unit/ListLiteralNotType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ListLiteralNotType.dhall @@ -0,0 +1,1 @@ +[ Bool ] diff --git a/dhall-lang/tests/type-inference/failure/unit/ListLiteralTypesNotMatch.dhall b/dhall-lang/tests/type-inference/failure/unit/ListLiteralTypesNotMatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ListLiteralTypesNotMatch.dhall @@ -0,0 +1,1 @@ +[ True, 1 ] diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeAlternativeHasNoHandler.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeAlternativeHasNoHandler.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeAlternativeHasNoHandler.dhall @@ -0,0 +1,1 @@ +merge {=} (< x : Bool >.x True) diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeAnnotationMismatch.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeAnnotationMismatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeAnnotationMismatch.dhall @@ -0,0 +1,1 @@ +merge { x = 0 } < x >.x : Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeAnnotationNotType.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeAnnotationNotType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeAnnotationNotType.dhall @@ -0,0 +1,1 @@ +merge {=} <> : Type diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeBool.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeBool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeBool.dhall @@ -0,0 +1,1 @@ +\(x: { True: Natural, False: Natural }) -> merge x True diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeEmptyNeedsDirectAnnotation1.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeEmptyNeedsDirectAnnotation1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeEmptyNeedsDirectAnnotation1.dhall @@ -0,0 +1,1 @@ +\(x: <>) -> (merge {=} x) : Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeEmptyNeedsDirectAnnotation2.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeEmptyNeedsDirectAnnotation2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeEmptyNeedsDirectAnnotation2.dhall @@ -0,0 +1,1 @@ +\(x: <>) -> let y: Bool = merge {=} x in 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeEmptyWithoutAnnotation.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeEmptyWithoutAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeEmptyWithoutAnnotation.dhall @@ -0,0 +1,1 @@ +merge {=} <> diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeHandlerFreeVar.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerFreeVar.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerFreeVar.dhall @@ -0,0 +1,1 @@ +merge { x = None } (.x Bool) diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotFunction.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotFunction.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotFunction.dhall @@ -0,0 +1,1 @@ +merge { x = True } (< x : Bool >.x True) diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotInUnion.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotInUnion.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotInUnion.dhall @@ -0,0 +1,1 @@ +merge { x = λ(_ : Bool) → _ } <> : Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotMatchAlternativeType.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotMatchAlternativeType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeHandlerNotMatchAlternativeType.dhall @@ -0,0 +1,1 @@ +merge { x = λ(_ : Bool) → _ } (< x : Natural >.x 1) diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeHandlersWithDifferentType.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeHandlersWithDifferentType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeHandlersWithDifferentType.dhall @@ -0,0 +1,1 @@ +merge { x = λ(_ : Bool) → _, y = λ(_ : Natural) → _ } (< x : Bool | y : Natural >.x True) diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeLhsNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeLhsNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeLhsNotRecord.dhall @@ -0,0 +1,1 @@ +merge True < x >.x diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeMissingHandler1.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeMissingHandler1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeMissingHandler1.dhall @@ -0,0 +1,1 @@ +merge {=} .x diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeMissingHandler2.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeMissingHandler2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeMissingHandler2.dhall @@ -0,0 +1,1 @@ +merge { x = 0 } .x diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeRhsNotUnion.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeRhsNotUnion.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeRhsNotUnion.dhall @@ -0,0 +1,1 @@ +merge {=} True diff --git a/dhall-lang/tests/type-inference/failure/unit/MergeUnusedHandler.dhall b/dhall-lang/tests/type-inference/failure/unit/MergeUnusedHandler.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MergeUnusedHandler.dhall @@ -0,0 +1,1 @@ +merge { x = 1, y = 2 } < x >.x diff --git a/dhall-lang/tests/type-inference/failure/unit/MistypedToMap1.dhall b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap1.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4 } : Natural diff --git a/dhall-lang/tests/type-inference/failure/unit/MistypedToMap2.dhall b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap2.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4 } : List Natural diff --git a/dhall-lang/tests/type-inference/failure/unit/MistypedToMap3.dhall b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap3.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap3.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4 } : List { mapKey : Natural, mapValue : Natural } diff --git a/dhall-lang/tests/type-inference/failure/unit/MistypedToMap4.dhall b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap4.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/MistypedToMap4.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4 } : List { mapKey : Text, mapValue : Text } diff --git a/dhall-lang/tests/type-inference/failure/unit/NaturalSubtractNotNatural.dhall b/dhall-lang/tests/type-inference/failure/unit/NaturalSubtractNotNatural.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/NaturalSubtractNotNatural.dhall @@ -0,0 +1,1 @@ +Natural/subtract True True diff --git a/dhall-lang/tests/type-inference/failure/unit/NestedAnnotInnerWrong.dhall b/dhall-lang/tests/type-inference/failure/unit/NestedAnnotInnerWrong.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/NestedAnnotInnerWrong.dhall @@ -0,0 +1,1 @@ +(0 : Bool) : Natural diff --git a/dhall-lang/tests/type-inference/failure/unit/NestedAnnotOuterWrong.dhall b/dhall-lang/tests/type-inference/failure/unit/NestedAnnotOuterWrong.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/NestedAnnotOuterWrong.dhall @@ -0,0 +1,1 @@ +(0 : Natural) : Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/NonRecordToMap.dhall b/dhall-lang/tests/type-inference/failure/unit/NonRecordToMap.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/NonRecordToMap.dhall @@ -0,0 +1,1 @@ +toMap "text" diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorAndNotBool.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorAndNotBool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorAndNotBool.dhall @@ -0,0 +1,1 @@ +1 && 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorEqualNotBool.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorEqualNotBool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorEqualNotBool.dhall @@ -0,0 +1,1 @@ +1 == 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateLhsNotList.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateLhsNotList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateLhsNotList.dhall @@ -0,0 +1,1 @@ +1 # [ True ] diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateListsNotMatch.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateListsNotMatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateListsNotMatch.dhall @@ -0,0 +1,1 @@ +[ True ] # [ 1 ] diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateNotListsButMatch.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateNotListsButMatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateNotListsButMatch.dhall @@ -0,0 +1,1 @@ +1 # 2 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateRhsNotList.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateRhsNotList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorListConcatenateRhsNotList.dhall @@ -0,0 +1,1 @@ +[ True ] # 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorNotEqualNotBool.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorNotEqualNotBool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorNotEqualNotBool.dhall @@ -0,0 +1,1 @@ +1 != 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorOrNotBool.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorOrNotBool.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorOrNotBool.dhall @@ -0,0 +1,1 @@ +1 || 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorPlusNotNatural.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorPlusNotNatural.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorPlusNotNatural.dhall @@ -0,0 +1,1 @@ +True + True diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorTextConcatenateLhsNotText.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorTextConcatenateLhsNotText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorTextConcatenateLhsNotText.dhall @@ -0,0 +1,1 @@ +1 ++ "" diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorTextConcatenateRhsNotText.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorTextConcatenateRhsNotText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorTextConcatenateRhsNotText.dhall @@ -0,0 +1,1 @@ +"" ++ 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/OperatorTimesNotNatural.dhall b/dhall-lang/tests/type-inference/failure/unit/OperatorTimesNotNatural.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OperatorTimesNotNatural.dhall @@ -0,0 +1,1 @@ +True * True diff --git a/dhall-lang/tests/type-inference/failure/unit/OptionalDeprecatedSyntaxAbsent.dhall b/dhall-lang/tests/type-inference/failure/unit/OptionalDeprecatedSyntaxAbsent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OptionalDeprecatedSyntaxAbsent.dhall @@ -0,0 +1,1 @@ +[] : Optional Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/OptionalDeprecatedSyntaxPresent.dhall b/dhall-lang/tests/type-inference/failure/unit/OptionalDeprecatedSyntaxPresent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/OptionalDeprecatedSyntaxPresent.dhall @@ -0,0 +1,1 @@ +[ 1 ] : Optional Natural diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsAbstract.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsAbstract.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsAbstract.dhall @@ -0,0 +1,13 @@ +{- This test illustrates that duplicate fields need not be literals in order + to be properly normalized. One or both of the duplicate fields can be + abstract because field duplication delegates its behavior to the `∧` + operator + + This particular example fails because it desugars to: + + λ(r : { y : Natural }) → { x = { y = 1 } ∧ r } + + ... and the `∧` operator can infer that the two records collide on the + field `y` +-} +λ(r : { y : Natural }) → { x = { y = 1 }, x = r } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsCollidingRecords.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsCollidingRecords.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsCollidingRecords.dhall @@ -0,0 +1,8 @@ +{- This fails because the expression desugars to: + + { x = { y = 0 } ∧ { y = 0 } } + + ... which is ill-typed due to `∧` forbidding collisions and the two `y` + fields collide. +-} +{ x = { y = 0 }, x = { y = 0 } } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsNotRecords.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsNotRecords.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordLitDuplicateFieldsNotRecords.dhall @@ -0,0 +1,7 @@ +{- This fails because the expression desugars to: + + { x = 0 ∧ 0 } + + ... which is ill-typed due to ∧ only working on records +-} +{ x = 0, x = 0 } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordProjectionByTypeFieldTypeMismatch.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionByTypeFieldTypeMismatch.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionByTypeFieldTypeMismatch.dhall @@ -0,0 +1,1 @@ +{ y = {=} }.( {y : Natural} ) diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordProjectionByTypeNotPresent.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionByTypeNotPresent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionByTypeNotPresent.dhall @@ -0,0 +1,1 @@ +{ y = {=} }.( {x : Natural} ) diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordProjectionDuplicateFields.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionDuplicateFields.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionDuplicateFields.dhall @@ -0,0 +1,1 @@ +{ x = 1 }.{ x, x } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordProjectionEmpty.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionEmpty.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionEmpty.dhall @@ -0,0 +1,1 @@ +{=}.{ x } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordProjectionNotPresent.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionNotPresent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionNotPresent.dhall @@ -0,0 +1,1 @@ +{ y = {=} }.{ x } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordProjectionNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordProjectionNotRecord.dhall @@ -0,0 +1,1 @@ +True.{ x } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordSelectionEmpty.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionEmpty.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionEmpty.dhall @@ -0,0 +1,1 @@ +{=}.x diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordSelectionNotPresent.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionNotPresent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionNotPresent.dhall @@ -0,0 +1,1 @@ +{ y = {=} }.x diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordSelectionNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionNotRecord.dhall @@ -0,0 +1,1 @@ +True.x diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordSelectionTypeNotUnionType.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionTypeNotUnionType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordSelectionTypeNotUnionType.dhall @@ -0,0 +1,1 @@ +Bool.x diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordTypeDuplicateFields.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordTypeDuplicateFields.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordTypeDuplicateFields.dhall @@ -0,0 +1,1 @@ +{ x: Natural, x: Natural } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecordTypeValueMember.dhall b/dhall-lang/tests/type-inference/failure/unit/RecordTypeValueMember.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecordTypeValueMember.dhall @@ -0,0 +1,1 @@ +{ x : True } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeLhsNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeLhsNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeLhsNotRecord.dhall @@ -0,0 +1,1 @@ +True ∧ {=} diff --git a/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeOverlapping.dhall b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeOverlapping.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeOverlapping.dhall @@ -0,0 +1,1 @@ +{ x = True } ∧ { x = False } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeRhsNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeRhsNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordMergeRhsNotRecord.dhall @@ -0,0 +1,1 @@ +{=} ∧ True diff --git a/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeLhsNotRecordType.dhall b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeLhsNotRecordType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeLhsNotRecordType.dhall @@ -0,0 +1,1 @@ +Bool ⩓ {} diff --git a/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeOverlapping.dhall b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeOverlapping.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeOverlapping.dhall @@ -0,0 +1,1 @@ +{ x : Bool } ⩓ { x : Natural } diff --git a/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeRhsNotRecordType.dhall b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeRhsNotRecordType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RecursiveRecordTypeMergeRhsNotRecordType.dhall @@ -0,0 +1,1 @@ +{} ⩓ Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/RemovedBuiltinOptionalBuild.dhall b/dhall-lang/tests/type-inference/failure/unit/RemovedBuiltinOptionalBuild.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RemovedBuiltinOptionalBuild.dhall @@ -0,0 +1,1 @@ +Optional/build diff --git a/dhall-lang/tests/type-inference/failure/unit/RemovedBuiltinOptionalFold.dhall b/dhall-lang/tests/type-inference/failure/unit/RemovedBuiltinOptionalFold.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RemovedBuiltinOptionalFold.dhall @@ -0,0 +1,1 @@ +Optional/fold diff --git a/dhall-lang/tests/type-inference/failure/unit/RightBiasedRecordMergeLhsNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/RightBiasedRecordMergeLhsNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RightBiasedRecordMergeLhsNotRecord.dhall @@ -0,0 +1,1 @@ +True ⫽ {=} diff --git a/dhall-lang/tests/type-inference/failure/unit/RightBiasedRecordMergeRhsNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/RightBiasedRecordMergeRhsNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/RightBiasedRecordMergeRhsNotRecord.dhall @@ -0,0 +1,1 @@ +{=} ⫽ True diff --git a/dhall-lang/tests/type-inference/failure/unit/ShowConstructorNotFullyApplied.dhall b/dhall-lang/tests/type-inference/failure/unit/ShowConstructorNotFullyApplied.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ShowConstructorNotFullyApplied.dhall @@ -0,0 +1,1 @@ +showConstructor < A : Bool >.A diff --git a/dhall-lang/tests/type-inference/failure/unit/ShowConstructorNotFullyAppliedOptional.dhall b/dhall-lang/tests/type-inference/failure/unit/ShowConstructorNotFullyAppliedOptional.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ShowConstructorNotFullyAppliedOptional.dhall @@ -0,0 +1,1 @@ +showConstructor None diff --git a/dhall-lang/tests/type-inference/failure/unit/ShowConstructorWrongArgument.dhall b/dhall-lang/tests/type-inference/failure/unit/ShowConstructorWrongArgument.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ShowConstructorWrongArgument.dhall @@ -0,0 +1,1 @@ +showConstructor 0 diff --git a/dhall-lang/tests/type-inference/failure/unit/SomeNotType.dhall b/dhall-lang/tests/type-inference/failure/unit/SomeNotType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/SomeNotType.dhall @@ -0,0 +1,1 @@ +Some Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/Sort.dhall b/dhall-lang/tests/type-inference/failure/unit/Sort.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/Sort.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/failure/unit/TextLiteralInterpolateNotText.dhall b/dhall-lang/tests/type-inference/failure/unit/TextLiteralInterpolateNotText.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/TextLiteralInterpolateNotText.dhall @@ -0,0 +1,1 @@ +"${1}" diff --git a/dhall-lang/tests/type-inference/failure/unit/ToMapEmptyInvalidAnnotation.dhall b/dhall-lang/tests/type-inference/failure/unit/ToMapEmptyInvalidAnnotation.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ToMapEmptyInvalidAnnotation.dhall @@ -0,0 +1,2 @@ +-- The mapKey must be Text +toMap {=} : List { mapKey : Bool, mapValue : Text } diff --git a/dhall-lang/tests/type-inference/failure/unit/ToMapWrongKind.dhall b/dhall-lang/tests/type-inference/failure/unit/ToMapWrongKind.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/ToMapWrongKind.dhall @@ -0,0 +1,1 @@ +toMap { x = Bool } diff --git a/dhall-lang/tests/type-inference/failure/unit/TypeAnnotationWrong.dhall b/dhall-lang/tests/type-inference/failure/unit/TypeAnnotationWrong.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/TypeAnnotationWrong.dhall @@ -0,0 +1,1 @@ +1 : Bool diff --git a/dhall-lang/tests/type-inference/failure/unit/UnionConstructorFieldNotPresent.dhall b/dhall-lang/tests/type-inference/failure/unit/UnionConstructorFieldNotPresent.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/UnionConstructorFieldNotPresent.dhall @@ -0,0 +1,1 @@ +< x : Bool >.y diff --git a/dhall-lang/tests/type-inference/failure/unit/UnionDeprecatedConstructorsKeyword.dhall b/dhall-lang/tests/type-inference/failure/unit/UnionDeprecatedConstructorsKeyword.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/UnionDeprecatedConstructorsKeyword.dhall @@ -0,0 +1,1 @@ +constructors < Left : Natural | Right : Bool > diff --git a/dhall-lang/tests/type-inference/failure/unit/UnionTypeDuplicateVariants1.dhall b/dhall-lang/tests/type-inference/failure/unit/UnionTypeDuplicateVariants1.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/UnionTypeDuplicateVariants1.dhall @@ -0,0 +1,1 @@ + diff --git a/dhall-lang/tests/type-inference/failure/unit/UnionTypeDuplicateVariants2.dhall b/dhall-lang/tests/type-inference/failure/unit/UnionTypeDuplicateVariants2.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/UnionTypeDuplicateVariants2.dhall @@ -0,0 +1,1 @@ + diff --git a/dhall-lang/tests/type-inference/failure/unit/UnionTypeNotType.dhall b/dhall-lang/tests/type-inference/failure/unit/UnionTypeNotType.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/UnionTypeNotType.dhall @@ -0,0 +1,1 @@ +< x : True > diff --git a/dhall-lang/tests/type-inference/failure/unit/VariableFree.dhall b/dhall-lang/tests/type-inference/failure/unit/VariableFree.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/VariableFree.dhall @@ -0,0 +1,1 @@ +x diff --git a/dhall-lang/tests/type-inference/failure/unit/WithInfersKind.dhall b/dhall-lang/tests/type-inference/failure/unit/WithInfersKind.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/WithInfersKind.dhall @@ -0,0 +1,1 @@ +Some ({=} with x = Bool) diff --git a/dhall-lang/tests/type-inference/failure/unit/WithInvalidOverrideA.dhall b/dhall-lang/tests/type-inference/failure/unit/WithInvalidOverrideA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/WithInvalidOverrideA.dhall @@ -0,0 +1,6 @@ +{- The `with` keyword cannot "descend" past a field that is not a record + + In the following example, the `a` field is not a record, therefore there is + no possibility of adding or overriding `a` with an inner `b` field +-} +{ a = 1 } with a.b = 2 diff --git a/dhall-lang/tests/type-inference/failure/unit/WithNotOptional.dhall b/dhall-lang/tests/type-inference/failure/unit/WithNotOptional.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/WithNotOptional.dhall @@ -0,0 +1,1 @@ +{ x = 0 } with ? = 1 diff --git a/dhall-lang/tests/type-inference/failure/unit/WithNotRecord.dhall b/dhall-lang/tests/type-inference/failure/unit/WithNotRecord.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/WithNotRecord.dhall @@ -0,0 +1,1 @@ +5 with a = 10 diff --git a/dhall-lang/tests/type-inference/failure/unit/WithOptionalRecordTypeChanged.dhall b/dhall-lang/tests/type-inference/failure/unit/WithOptionalRecordTypeChanged.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/WithOptionalRecordTypeChanged.dhall @@ -0,0 +1,1 @@ +(None { x : Natural }) with ?.x = True diff --git a/dhall-lang/tests/type-inference/failure/unit/WithOptionalTypeChanged.dhall b/dhall-lang/tests/type-inference/failure/unit/WithOptionalTypeChanged.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/WithOptionalTypeChanged.dhall @@ -0,0 +1,1 @@ +(None Natural) with ? = "hello" diff --git a/dhall-lang/tests/type-inference/failure/unit/Z.dhall b/dhall-lang/tests/type-inference/failure/unit/Z.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/unit/Z.dhall @@ -0,0 +1,4 @@ +-- The purpose of this test is to check that an implementation is not parsing a +-- standalone `Z` as a `TimeOffset`. Instead, this should be treated as an +-- unbound variable named `Z` +Z diff --git a/dhall-lang/tests/type-inference/success/CacheImportsA.dhall b/dhall-lang/tests/type-inference/success/CacheImportsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/CacheImportsA.dhall @@ -0,0 +1,11 @@ +{- + This URL returns (probably) a different result for each request. This test + ensures that import results for a given URL are correctly cached within an + execution of dhall. +-} +let _ = + assert + : https://test.dhall-lang.org/random-string as Text + ≡ https://test.dhall-lang.org/random-string as Text + +in 0 diff --git a/dhall-lang/tests/type-inference/success/CacheImportsB.dhall b/dhall-lang/tests/type-inference/success/CacheImportsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/CacheImportsB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeA.dhall b/dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeA.dhall @@ -0,0 +1,10 @@ +{- + This URL returns (probably) a different result for each request. This test + ensures that import locations are canonicalized before being cached. +-} +let _ = + assert + : https://test.dhall-lang.org/random-string as Text + ≡ https://test.dhall-lang.org/foo/../random-string as Text + +in 0 diff --git a/dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeB.dhall b/dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/accessEncodedTypeA.dhall b/dhall-lang/tests/type-inference/success/accessEncodedTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessEncodedTypeA.dhall @@ -0,0 +1,4 @@ + λ ( record + : ∀(k : Kind) → ∀(makeRecord : ∀(x : Type) → ∀(y : Type → Type) → k) → k + ) +→ record Type (λ(x : Type) → λ(y : Type → Type) → x) diff --git a/dhall-lang/tests/type-inference/success/accessEncodedTypeB.dhall b/dhall-lang/tests/type-inference/success/accessEncodedTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessEncodedTypeB.dhall @@ -0,0 +1,4 @@ + ∀ ( record + : ∀(k : Kind) → ∀(makeRecord : ∀(x : Type) → ∀(y : Type → Type) → k) → k + ) +→ Type diff --git a/dhall-lang/tests/type-inference/success/accessTypeA.dhall b/dhall-lang/tests/type-inference/success/accessTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessTypeA.dhall @@ -0,0 +1,1 @@ +λ(record : { x : Type, y : Type → Type }) → record.x diff --git a/dhall-lang/tests/type-inference/success/accessTypeB.dhall b/dhall-lang/tests/type-inference/success/accessTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessTypeB.dhall @@ -0,0 +1,1 @@ +∀(record : { x : Type, y : Type → Type }) → Type diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsA.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsA.dhall @@ -0,0 +1,1 @@ +{ foo = 1 } ⫽ { bar = Text } diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsB.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsB.dhall @@ -0,0 +1,1 @@ +{ bar : Type, foo : Natural } diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldA.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldA.dhall @@ -0,0 +1,1 @@ +{ a = 0 } ⫽ { a = Bool } diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldB.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldB.dhall @@ -0,0 +1,1 @@ +{ a : Type } diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/and.dhall [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/and.dhall ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall @@ -0,0 +1,2 @@ +../../../../../../Prelude/Bool/build.dhall +(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall @@ -0,0 +1,2 @@ +../../../../../../Prelude/Bool/build.dhall +(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall [ False, True, False ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall [ False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall [ False ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even.dhall ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/3B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/fold.dhall True Natural 0 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/fold.dhall False Natural 0 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/not.dhall True diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/not.dhall False diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall [ True, False ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall [ True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd.dhall ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/or.dhall [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/or.dhall ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/show.dhall True diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/show.dhall False diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Double/show.dhall -3.1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Double/show.dhall 0.4 diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/show.dhall -3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/show.dhall +0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/toDouble.dhall -3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/toDouble.dhall +2 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/all.dhall Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/all.dhall Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/any.dhall Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/any.dhall Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/build.dhall +Text +( λ(list : Type) +→ λ(cons : Text → list → list) +→ λ(nil : list) +→ cons "ABC" (cons "DEF" nil) +) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/0B.dhall @@ -0,0 +1,1 @@ +List Text diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/build.dhall +Text +( λ(list : Type) +→ λ(cons : Text → list → list) +→ λ(nil : list) +→ nil +) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/1B.dhall @@ -0,0 +1,1 @@ +List Text diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall @@ -0,0 +1,5 @@ +../../../../../../Prelude/List/concat.dhall Natural +[ [ 0, 1, 2 ] +, [ 3, 4 ] +, [ 5, 6, 7, 8 ] +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall @@ -0,0 +1,5 @@ +../../../../../../Prelude/List/concat.dhall Natural +[ [] : List Natural +, [] : List Natural +, [] : List Natural +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/concatMap.dhall Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/concatMap.dhall Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/filter.dhall Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/filter.dhall Natural Natural/odd [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/List/fold.dhall +Natural +[ 2, 3, 5 ] +Natural +(λ(x : Natural) → λ(y : Natural) → x + y) +0 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall @@ -0,0 +1,7 @@ + λ(nil : Natural) +→ ../../../../../../Prelude/List/fold.dhall + Natural + [ 2, 3, 5 ] + Natural + (λ(x : Natural) → λ(y : Natural) → x + y) + nil diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/1B.dhall @@ -0,0 +1,1 @@ +∀(nil : Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall @@ -0,0 +1,4 @@ + λ(list : Type) +→ λ(cons : Natural → list → list) +→ λ(nil : list) +→ ../../../../../../Prelude/List/fold.dhall Natural [ 2, 3, 5 ] list cons nil diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/2B.dhall @@ -0,0 +1,1 @@ +∀(list : Type) → ∀(cons : Natural → list → list) → ∀(nil : list) → list diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/generate.dhall 5 Bool Natural/even diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/0B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/generate.dhall 0 Bool Natural/even diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/1B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/head.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/head.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/indexed.dhall Bool [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/indexed.dhall Bool ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/iterate.dhall 10 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/iterate.dhall 0 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/last.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/last.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/length.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/length.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/map.dhall Natural Bool Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/0B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/map.dhall Natural Bool Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/1B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/null.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/null.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/replicate.dhall 9 Natural 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/replicate.dhall 0 Natural 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/reverse.dhall Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/reverse.dhall Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall @@ -0,0 +1,15 @@ +../../../../../../Prelude/List/shifted.dhall +Bool +[ [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = False } + ] +, [ { index = 0, value = False } + , { index = 1, value = False } + ] +, [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = True } + ] +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/shifted.dhall Bool ([] : List (List { index : Natural, value : Bool })) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/unzip.dhall +Text +Bool +[ { _1 = "ABC", _2 = True } +, { _1 = "DEF", _2 = False } +, { _1 = "GHI", _2 = True } +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0B.dhall @@ -0,0 +1,1 @@ +{ _1 : List Text, _2 : List Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/unzip.dhall Text Bool ([] : List { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1B.dhall @@ -0,0 +1,1 @@ +{ _1 : List Text, _2 : List Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/00A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/00A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/00A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/and diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/00B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/00B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/00B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/01A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/01A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/01A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/or diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/01B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/01B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/01B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/02A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/02A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/02A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/even diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/02B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/02B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/02B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/03A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/03A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/03A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/odd diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/03B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/03B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/03B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/04A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/04A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/04A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/List/concat diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/04B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/04B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/04B.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(xss : List (List a)) → List a diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/05A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/05A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/05A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/List/shifted diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/05B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/05B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/05B.dhall @@ -0,0 +1,3 @@ + ∀(a : Type) +→ ∀(kvss : List (List { index : Natural, value : a })) +→ List { index : Natural, value : a } diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/06A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/06A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/06A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Natural/sum diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/06B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/06B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/06B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/07A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/07A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/07A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Natural/product diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/07B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/07B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/07B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/08A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/08A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/08A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Optional/head diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/08B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/08B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/08B.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(xs : List (Optional a)) → Optional a diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/09A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/09A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/09A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Optional/last diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/09B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/09B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/09B.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(xs : List (Optional a)) → Optional a diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/10A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/10A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/10A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Text/concat diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/10B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/10B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/10B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Text) → Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/Natural/build.dhall +( λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ succ (succ (succ zero)) +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/Natural/build.dhall +( λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ zero +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/enumerate.dhall 10 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/enumerate.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/even.dhall 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/even.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/fold.dhall 3 Natural (λ(x : Natural) → 5 * x) 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall @@ -0,0 +1,1 @@ +λ(zero : Natural) → ../../../../../../Prelude/Natural/fold.dhall 3 Natural (λ(x : Natural) → 5 * x) zero diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1B.dhall @@ -0,0 +1,1 @@ +∀(zero : Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall @@ -0,0 +1,4 @@ + λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ ../../../../../../Prelude/Natural/fold.dhall 3 natural succ zero diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2B.dhall @@ -0,0 +1,1 @@ +∀(natural : Type) → ∀(succ : natural → natural) → ∀(zero : natural) → natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/isZero.dhall 2 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/isZero.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/odd.dhall 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/odd.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/product.dhall [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/product.dhall ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/show.dhall 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/show.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/sum.dhall [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/sum.dhall ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toDouble.dhall 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toDouble.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toInteger.dhall 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0B.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toInteger.dhall 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1B.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/all.dhall Natural Natural/even (Some 3) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/all.dhall Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/any.dhall Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/any.dhall Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/Optional/build.dhall +Natural +( λ(optional : Type) +→ λ(some : Natural → optional) +→ λ(none : optional) +→ some 1 +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/Optional/build.dhall +Natural +( λ(optional : Type) +→ λ(some : Natural → optional) +→ λ(none : optional) +→ none +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat.dhall Natural (Some (Some 1)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat.dhall Natural (Some (None Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat.dhall Natural (None (Optional Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/filter.dhall Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/filter.dhall Natural Natural/odd (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/fold.dhall Natural (Some 2) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/fold.dhall Natural (None Natural) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head.dhall Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last.dhall Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/length.dhall Natural (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/length.dhall Natural (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (Some 3) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0B.dhall @@ -0,0 +1,1 @@ +Optional Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1B.dhall @@ -0,0 +1,1 @@ +Optional Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/null.dhall Natural (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/null.dhall Natural (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/toList.dhall Natural (Some 1) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/toList.dhall Natural (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/unzip.dhall Text Bool (Some { _1 = "ABC", _2 = True }) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0B.dhall @@ -0,0 +1,1 @@ +{ _1 : Optional Text, _2 : Optional Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/unzip.dhall Text Bool (None { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1B.dhall @@ -0,0 +1,1 @@ +{ _1 : Optional Text, _2 : Optional Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concat.dhall [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concat.dhall ([] : List Text) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMap.dhall Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMap.dhall Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatSep.dhall ", " [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatSep.dhall ", " ([] : List Text) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/preludeA.dhall b/dhall-lang/tests/type-inference/success/preludeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preludeA.dhall @@ -0,0 +1,1 @@ +../../../Prelude/package.dhall diff --git a/dhall-lang/tests/type-inference/success/preludeB.dhall b/dhall-lang/tests/type-inference/success/preludeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preludeB.dhall @@ -0,0 +1,740 @@ +{ Bool : + { and : ∀(xs : List Bool) → Bool + , build : + ∀(f : ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) → Bool + , equal : ∀(x : Bool) → ∀(y : Bool) → Bool + , even : ∀(xs : List Bool) → Bool + , fold : + ∀(b : Bool) → ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool + , not : ∀(b : Bool) → Bool + , odd : ∀(xs : List Bool) → Bool + , or : ∀(xs : List Bool) → Bool + , show : ∀(b : Bool) → Text + } +, Date : { show : Date → Text } +, Double : { show : Double → Text } +, Function : + { compose : + ∀(a : Type) → + ∀(b : Type) → + ∀(c : Type) → + ∀(f : a → b) → + ∀(g : b → c) → + ∀(x : a) → + c + , composeList : ∀(a : Type) → ∀(functions : List (a → a)) → a → a + , identity : ∀(a : Type) → ∀(x : a) → a + } +, Integer : + { abs : ∀(n : Integer) → Natural + , add : ∀(m : Integer) → ∀(n : Integer) → Integer + , clamp : Integer → Natural + , equal : ∀(a : Integer) → ∀(b : Integer) → Bool + , greaterThan : ∀(x : Integer) → ∀(y : Integer) → Bool + , greaterThanEqual : ∀(x : Integer) → ∀(y : Integer) → Bool + , lessThan : ∀(x : Integer) → ∀(y : Integer) → Bool + , lessThanEqual : ∀(x : Integer) → ∀(y : Integer) → Bool + , multiply : ∀(m : Integer) → ∀(n : Integer) → Integer + , negate : Integer → Integer + , negative : ∀(n : Integer) → Bool + , nonNegative : ∀(n : Integer) → Bool + , nonPositive : ∀(n : Integer) → Bool + , positive : ∀(n : Integer) → Bool + , show : Integer → Text + , subtract : ∀(m : Integer) → ∀(n : Integer) → Integer + , toDouble : Integer → Double + , toNatural : ∀(n : Integer) → Optional Natural + } +, JSON : + { Nesting : Type + , Tagged : ∀(a : Type) → Type + , Type : Type + , array : + ∀ ( x + : List + ( ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + ) + ) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , bool : + ∀(x : Bool) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , double : + ∀(x : Double) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , integer : + ∀(x : Integer) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , keyText : + ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } + , keyValue : + ∀(v : Type) → + ∀(key : Text) → + ∀(value : v) → + { mapKey : Text, mapValue : v } + , natural : + ∀(x : Natural) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , null : + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , number : + ∀(x : Double) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , object : + ∀ ( x + : List + { mapKey : Text + , mapValue : + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + } + ) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , omitNullFields : + ∀ ( old + : ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + ) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , render : + ∀ ( json + : ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + ) → + Text + , renderCompact : + ∀ ( j + : ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + ) → + Text + , renderInteger : ∀(integer : Integer) → Text + , renderYAML : + ∀ ( json + : ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + ) → + Text + , string : + ∀(x : Text) → + ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + , tagInline : + ∀(tagFieldName : Text) → + ∀(a : Type) → + ∀(contents : a) → + { contents : a, field : Text, nesting : < Inline | Nested : Text > } + , tagNested : + ∀(contentsFieldName : Text) → + ∀(tagFieldName : Text) → + ∀(a : Type) → + ∀(contents : a) → + { contents : a, field : Text, nesting : < Inline | Nested : Text > } + } +, List : + { all : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → Bool + , any : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → Bool + , build : + ∀(a : Type) → + (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) → + List a + , concat : ∀(a : Type) → ∀(xss : List (List a)) → List a + , concatMap : + ∀(a : Type) → ∀(b : Type) → ∀(f : a → List b) → ∀(xs : List a) → List b + , default : ∀(a : Type) → ∀(o : Optional (List a)) → List a + , drop : ∀(n : Natural) → ∀(a : Type) → ∀(xs : List a) → List a + , empty : ∀(a : Type) → List a + , filter : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → List a + , filterMap : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → Optional b) → + ∀(xs : List a) → + List b + , fold : + ∀(a : Type) → + List a → + ∀(list : Type) → + ∀(cons : a → list → list) → + ∀(nil : list) → + list + , foldLeft : + ∀(a : Type) → + ∀(xs : List a) → + ∀(list : Type) → + ∀(cons : list → a → list) → + ∀(nil : list) → + list + , generate : ∀(n : Natural) → ∀(a : Type) → ∀(f : Natural → a) → List a + , head : ∀(a : Type) → List a → Optional a + , index : ∀(n : Natural) → ∀(a : Type) → ∀(xs : List a) → Optional a + , indexed : ∀(a : Type) → List a → List { index : Natural, value : a } + , iterate : ∀(n : Natural) → ∀(a : Type) → ∀(f : a → a) → ∀(x : a) → List a + , last : ∀(a : Type) → List a → Optional a + , length : ∀(a : Type) → List a → Natural + , map : ∀(a : Type) → ∀(b : Type) → ∀(f : a → b) → ∀(xs : List a) → List b + , mapMaybe : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → Optional b) → + ∀(xs : List a) → + List b + , mapWithIndex : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : Natural → a → b) → + ∀(xs : List a) → + List b + , null : ∀(a : Type) → ∀(xs : List a) → Bool + , partition : + ∀(a : Type) → + ∀(f : a → Bool) → + ∀(xs : List a) → + { false : List a, true : List a } + , replicate : ∀(n : Natural) → ∀(a : Type) → ∀(x : a) → List a + , reverse : ∀(a : Type) → List a → List a + , shifted : + ∀(a : Type) → + ∀(kvss : List (List { index : Natural, value : a })) → + List { index : Natural, value : a } + , take : ∀(n : Natural) → ∀(a : Type) → ∀(xs : List a) → List a + , unpackOptionals : ∀(a : Type) → ∀(xs : List (Optional a)) → List a + , unzip : + ∀(a : Type) → + ∀(b : Type) → + ∀(xs : List { _1 : a, _2 : b }) → + { _1 : List a, _2 : List b } + , zip : + ∀(a : Type) → + ∀(xs : List a) → + ∀(b : Type) → + ∀(ys : List b) → + List { _1 : a, _2 : b } + } +, Location : { Type : Type } +, Map : + { Entry : ∀(k : Type) → ∀(v : Type) → Type + , Type : ∀(k : Type) → ∀(v : Type) → Type + , empty : ∀(k : Type) → ∀(v : Type) → List { mapKey : k, mapValue : v } + , keyText : + ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } + , keyValue : + ∀(v : Type) → + ∀(key : Text) → + ∀(value : v) → + { mapKey : Text, mapValue : v } + , keys : + ∀(k : Type) → + ∀(v : Type) → + ∀(xs : List { mapKey : k, mapValue : v }) → + List k + , map : + ∀(k : Type) → + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → b) → + ∀(m : List { mapKey : k, mapValue : a }) → + List { mapKey : k, mapValue : b } + , mapMaybe : + ∀(k : Type) → + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → Optional b) → + ∀(m : List { mapKey : k, mapValue : a }) → + List { mapKey : k, mapValue : b } + , unpackOptionals : + ∀(k : Type) → + ∀(v : Type) → + ∀(xs : List { mapKey : k, mapValue : Optional v }) → + List { mapKey : k, mapValue : v } + , values : + ∀(k : Type) → + ∀(v : Type) → + ∀(xs : List { mapKey : k, mapValue : v }) → + List v + } +, Monoid : ∀(m : Type) → Type +, Natural : + { build : + ( ∀(natural : Type) → + ∀(succ : natural → natural) → + ∀(zero : natural) → + natural + ) → + Natural + , enumerate : ∀(n : Natural) → List Natural + , equal : ∀(a : Natural) → ∀(b : Natural) → Bool + , even : Natural → Bool + , fold : + Natural → + ∀(natural : Type) → + ∀(succ : natural → natural) → + ∀(zero : natural) → + natural + , greaterThan : ∀(x : Natural) → ∀(y : Natural) → Bool + , greaterThanEqual : ∀(x : Natural) → ∀(y : Natural) → Bool + , isZero : Natural → Bool + , lessThan : ∀(x : Natural) → ∀(y : Natural) → Bool + , lessThanEqual : ∀(x : Natural) → ∀(y : Natural) → Bool + , listMax : ∀(xs : List Natural) → Optional Natural + , listMin : ∀(xs : List Natural) → Optional Natural + , max : ∀(a : Natural) → ∀(b : Natural) → Natural + , min : ∀(a : Natural) → ∀(b : Natural) → Natural + , odd : Natural → Bool + , product : ∀(xs : List Natural) → Natural + , show : Natural → Text + , sort : ∀(xs : List Natural) → List Natural + , subtract : Natural → Natural → Natural + , sum : ∀(xs : List Natural) → Natural + , toDouble : ∀(n : Natural) → Double + , toInteger : Natural → Integer + } +, NonEmpty : + { Type : ∀(a : Type) → Type + , all : + ∀(a : Type) → + ∀(f : a → Bool) → + ∀(xs : { head : a, tail : List a }) → + Bool + , any : + ∀(a : Type) → + ∀(f : a → Bool) → + ∀(xs : { head : a, tail : List a }) → + Bool + , concat : + ∀(a : Type) → + ∀ ( xss + : { head : { head : a, tail : List a } + , tail : List { head : a, tail : List a } + } + ) → + { head : a, tail : List a } + , concatMap : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → { head : b, tail : List b }) → + ∀(xs : { head : a, tail : List a }) → + { head : b, tail : List b } + , head : ∀(a : Type) → ∀(xs : { head : a, tail : List a }) → a + , index : + ∀(n : Natural) → + ∀(a : Type) → + ∀(xs : { head : a, tail : List a }) → + Optional a + , indexed : + ∀(a : Type) → + ∀(xs : { head : a, tail : List a }) → + { head : { index : Natural, value : a } + , tail : List { index : Natural, value : a } + } + , last : ∀(a : Type) → ∀(xs : { head : a, tail : List a }) → a + , length : ∀(a : Type) → ∀(xs : { head : a, tail : List a }) → Natural + , make : + ∀(a : Type) → + ∀(head : a) → + ∀(tail : List a) → + { head : a, tail : List a } + , map : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → b) → + ∀(xs : { head : a, tail : List a }) → + { head : b, tail : List b } + , reverse : + ∀(a : Type) → + ∀(xs : { head : a, tail : List a }) → + { head : a, tail : List a } + , shifted : + ∀(a : Type) → + ∀ ( kvss + : { head : + { head : { index : Natural, value : a } + , tail : List { index : Natural, value : a } + } + , tail : + List + { head : { index : Natural, value : a } + , tail : List { index : Natural, value : a } + } + } + ) → + { head : { index : Natural, value : a } + , tail : List { index : Natural, value : a } + } + , singleton : ∀(a : Type) → ∀(x : a) → { head : a, tail : List a } + , toList : ∀(a : Type) → ∀(xs : { head : a, tail : List a }) → List a + , unzip : + ∀(a : Type) → + ∀(b : Type) → + ∀(xs : { head : { _1 : a, _2 : b }, tail : List { _1 : a, _2 : b } }) → + { _1 : { head : a, tail : List a }, _2 : { head : b, tail : List b } } + , zip : + ∀(a : Type) → + ∀(xs : { head : a, tail : List a }) → + ∀(b : Type) → + ∀(ys : { head : b, tail : List b }) → + { head : { _1 : a, _2 : b }, tail : List { _1 : a, _2 : b } } + } +, Operator : + { `!=` : ∀(m : Bool) → ∀(n : Bool) → Bool + , `#` : ∀(type : Type) → ∀(m : List type) → ∀(n : List type) → List type + , `&&` : ∀(m : Bool) → ∀(n : Bool) → Bool + , `*` : ∀(m : Natural) → ∀(n : Natural) → Natural + , `+` : ∀(m : Natural) → ∀(n : Natural) → Natural + , `++` : ∀(m : Text) → ∀(n : Text) → Text + , `==` : ∀(m : Bool) → ∀(n : Bool) → Bool + , `||` : ∀(m : Bool) → ∀(n : Bool) → Bool + } +, Optional : + { all : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool + , any : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool + , build : + ∀(a : Type) → + ∀ ( build + : ∀(optional : Type) → + ∀(some : a → optional) → + ∀(none : optional) → + optional + ) → + Optional a + , concat : ∀(a : Type) → ∀(x : Optional (Optional a)) → Optional a + , concatMap : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → Optional b) → + ∀(o : Optional a) → + Optional b + , default : ∀(a : Type) → ∀(default : a) → ∀(o : Optional a) → a + , equal : + ∀(a : Type) → + ∀(compare : a → a → Bool) → + ∀(ox : Optional a) → + ∀(oy : Optional a) → + Bool + , filter : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Optional a + , fold : + ∀(a : Type) → + ∀(o : Optional a) → + ∀(optional : Type) → + ∀(some : a → optional) → + ∀(none : optional) → + optional + , head : ∀(a : Type) → ∀(xs : List (Optional a)) → Optional a + , last : ∀(a : Type) → ∀(xs : List (Optional a)) → Optional a + , length : ∀(a : Type) → ∀(xs : Optional a) → Natural + , map : + ∀(a : Type) → + ∀(b : Type) → + ∀(f : a → b) → + ∀(o : Optional a) → + Optional b + , null : ∀(a : Type) → ∀(xs : Optional a) → Bool + , toList : ∀(a : Type) → ∀(o : Optional a) → List a + , unzip : + ∀(a : Type) → + ∀(b : Type) → + ∀(xs : Optional { _1 : a, _2 : b }) → + { _1 : Optional a, _2 : Optional b } + } +, Text : + { concat : ∀(xs : List Text) → Text + , concatMap : ∀(a : Type) → ∀(f : a → Text) → ∀(xs : List a) → Text + , concatMapSep : + ∀(separator : Text) → + ∀(a : Type) → + ∀(f : a → Text) → + ∀(elements : List a) → + Text + , concatSep : ∀(separator : Text) → ∀(elements : List Text) → Text + , default : ∀(o : Optional Text) → Text + , defaultMap : ∀(a : Type) → ∀(f : a → Text) → ∀(o : Optional a) → Text + , lowerASCII : ∀(nil : Text) → Text + , replace : + ∀(needle : Text) → ∀(replacement : Text) → ∀(haystack : Text) → Text + , replicate : ∀(num : Natural) → ∀(text : Text) → Text + , shell-escape : ∀(xs : Text) → Text + , show : Text → Text + , spaces : ∀(a : Natural) → Text + , upperASCII : ∀(nil : Text) → Text + } +, Time : { show : Time → Text } +, TimeZone : { show : TimeZone → Text } +, XML : + { Type : Type + , attribute : + ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } + , element : + ∀ ( elem + : { attributes : List { mapKey : Text, mapValue : Text } + , content : + List + ( ∀(XML : Type) → + ∀ ( xml + : { element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + , rawText : Text → XML + , text : Text → XML + } + ) → + XML + ) + , name : Text + } + ) → + ∀(XML : Type) → + ∀ ( xml + : { element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + , rawText : Text → XML + , text : Text → XML + } + ) → + XML + , emptyAttributes : List { mapKey : Text, mapValue : Text } + , leaf : + ∀ ( elem + : { attributes : List { mapKey : Text, mapValue : Text } + , name : Text + } + ) → + ∀(XML : Type) → + ∀ ( xml + : { element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + , rawText : Text → XML + , text : Text → XML + } + ) → + XML + , rawText : + ∀(d : Text) → + ∀(XML : Type) → + ∀ ( xml + : { element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + , rawText : Text → XML + , text : Text → XML + } + ) → + XML + , render : + ∀ ( x + : ∀(XML : Type) → + ∀ ( xml + : { element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + , rawText : Text → XML + , text : Text → XML + } + ) → + XML + ) → + Text + , text : + ∀(d : Text) → + ∀(XML : Type) → + ∀ ( xml + : { element : + { attributes : List { mapKey : Text, mapValue : Text } + , content : List XML + , name : Text + } → + XML + , rawText : Text → XML + , text : Text → XML + } + ) → + XML + } +} diff --git a/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesA.dhall b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesA.dhall @@ -0,0 +1,5 @@ +let types = { Scopes = < Public | Private > } + +let prelude = { types = types } + +in prelude.types.Scopes.Public diff --git a/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesB.dhall b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesB.dhall @@ -0,0 +1,1 @@ +< Private | Public > diff --git a/dhall-lang/tests/type-inference/success/recordOfTypesA.dhall b/dhall-lang/tests/type-inference/success/recordOfTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfTypesA.dhall @@ -0,0 +1,1 @@ +{ x = Text, y = List } diff --git a/dhall-lang/tests/type-inference/success/recordOfTypesB.dhall b/dhall-lang/tests/type-inference/success/recordOfTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfTypesB.dhall @@ -0,0 +1,1 @@ +{ x : Type, y : Type → Type } diff --git a/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping1A.dhall b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping1A.dhall @@ -0,0 +1,1 @@ +let T = 0 in λ(T : Type) → λ(x : T) → 1 diff --git a/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping1B.dhall b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping1B.dhall @@ -0,0 +1,1 @@ +∀(T : Type) → ∀(x : T) → Natural diff --git a/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping2A.dhall b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping2A.dhall @@ -0,0 +1,1 @@ +(λ(T : Type) → let x = 0 in λ(x : T) → x) : ∀(T : Type) → ∀(x : T) → T diff --git a/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping2B.dhall b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/LambdaInLetScoping2B.dhall @@ -0,0 +1,1 @@ +∀(T : Type) → ∀(x : T) → T diff --git a/dhall-lang/tests/type-inference/success/regression/RecursiveRecordTypeMergeTripleCollisionA.dhall b/dhall-lang/tests/type-inference/success/regression/RecursiveRecordTypeMergeTripleCollisionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/RecursiveRecordTypeMergeTripleCollisionA.dhall @@ -0,0 +1,1 @@ +{ x : { a : Bool } } ⩓ { x : { b : Bool } } ⩓ { x : { c : Bool } } diff --git a/dhall-lang/tests/type-inference/success/regression/RecursiveRecordTypeMergeTripleCollisionB.dhall b/dhall-lang/tests/type-inference/success/regression/RecursiveRecordTypeMergeTripleCollisionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/RecursiveRecordTypeMergeTripleCollisionB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/regression/TodoA.dhall b/dhall-lang/tests/type-inference/success/regression/TodoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/TodoA.dhall @@ -0,0 +1,1 @@ +λ(todo : ∀(a : Type) → a) → todo diff --git a/dhall-lang/tests/type-inference/success/regression/TodoB.dhall b/dhall-lang/tests/type-inference/success/regression/TodoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/regression/TodoB.dhall @@ -0,0 +1,1 @@ +∀(todo : ∀(a : Type) → a) → ∀(a : Type) → a diff --git a/dhall-lang/tests/type-inference/success/simple/access/0A.dhall b/dhall-lang/tests/type-inference/success/simple/access/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/0A.dhall @@ -0,0 +1,1 @@ +{ x = Text }.x diff --git a/dhall-lang/tests/type-inference/success/simple/access/0B.dhall b/dhall-lang/tests/type-inference/success/simple/access/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/0B.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/simple/access/1A.dhall b/dhall-lang/tests/type-inference/success/simple/access/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/1A.dhall @@ -0,0 +1,1 @@ +< Foo : Text | Bar : Natural >.Foo diff --git a/dhall-lang/tests/type-inference/success/simple/access/1B.dhall b/dhall-lang/tests/type-inference/success/simple/access/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/1B.dhall @@ -0,0 +1,1 @@ +∀(Foo : Text) → < Bar : Natural | Foo : Text > diff --git a/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesA.dhall b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesA.dhall @@ -0,0 +1,5 @@ + let anonymousFunction = λ(a : Type) → List a + +in λ(HigherOrderType : (Type → Type) → Type) + → λ(x : HigherOrderType anonymousFunction) + → (x : HigherOrderType anonymousFunction) diff --git a/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesB.dhall b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesB.dhall @@ -0,0 +1,3 @@ + ∀(HigherOrderType : (Type → Type) → Type) +→ ∀(x : HigherOrderType (λ(a : Type) → List a)) +→ HigherOrderType (λ(a : Type) → List a) diff --git a/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsA.dhall b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsA.dhall @@ -0,0 +1,1 @@ +{ foo = 1 } ∧ { bar = Text } diff --git a/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsB.dhall b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsB.dhall @@ -0,0 +1,1 @@ +{ bar : Type, foo : Natural } diff --git a/dhall-lang/tests/type-inference/success/simple/completionA.dhall b/dhall-lang/tests/type-inference/success/simple/completionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/completionA.dhall @@ -0,0 +1,25 @@ +let Example = + { Type = { name : Text, id : Optional Natural } + , default = { name = "", id = None Natural } + } + +let ExtraFields = Example ∧ { extra = {=} } + +let RequiredFields = + { Type = { name : Text, id : Optional Natural } + , default = { id = None Natural } + } + +let WrongDefaultType = + { Type = { name : Text, id : Optional Natural } + , default = { id = True } + } + +in { example0 = Example::{=} + , example1 = Example::{ name = "John Doe" } + , example2 = Example::{ id = Some 0 } + , example3 = Example::{ name = "Mary Jane", id = Some 0 } + , example4 = ExtraFields::{=} + , example5 = RequiredFields::{ name = "Jane Smith" } + , example6 = WrongDefaultType::{ name = "Bob Roberts", id = Some 0 } + } diff --git a/dhall-lang/tests/type-inference/success/simple/completionB.dhall b/dhall-lang/tests/type-inference/success/simple/completionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/completionB.dhall @@ -0,0 +1,8 @@ +{ example0 : { id : Optional Natural, name : Text } +, example1 : { id : Optional Natural, name : Text } +, example2 : { id : Optional Natural, name : Text } +, example3 : { id : Optional Natural, name : Text } +, example4 : { id : Optional Natural, name : Text } +, example5 : { id : Optional Natural, name : Text } +, example6 : { id : Optional Natural, name : Text } +} diff --git a/dhall-lang/tests/type-inference/success/simple/complexShadowingA.dhall b/dhall-lang/tests/type-inference/success/simple/complexShadowingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/complexShadowingA.dhall @@ -0,0 +1,6 @@ +let x = Bool +let x = Natural +in \(x: x@1 {- Bool -}) + -> \(x: x@1 {- Natural -}) + -> let x = if x@1 then 0 else 1 + in (x + x@1) : x@3 diff --git a/dhall-lang/tests/type-inference/success/simple/complexShadowingB.dhall b/dhall-lang/tests/type-inference/success/simple/complexShadowingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/complexShadowingB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → ∀(x : Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesA.dhall b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesA.dhall @@ -0,0 +1,1 @@ +{ x = Bool, y = Text, z = List } diff --git a/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesB.dhall b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesB.dhall @@ -0,0 +1,1 @@ +{ x : Type, y : Type, z : Type → Type } diff --git a/dhall-lang/tests/type-inference/success/simple/kindParameterA.dhall b/dhall-lang/tests/type-inference/success/simple/kindParameterA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/kindParameterA.dhall @@ -0,0 +1,1 @@ +λ(k : Kind) → λ(a : k → k → Type) → λ(x : k) → a x diff --git a/dhall-lang/tests/type-inference/success/simple/kindParameterB.dhall b/dhall-lang/tests/type-inference/success/simple/kindParameterB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/kindParameterB.dhall @@ -0,0 +1,1 @@ +∀(k : Kind) → ∀(a : k → k → Type) → ∀(x : k) → k → Type diff --git a/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceA.dhall b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceA.dhall @@ -0,0 +1,6 @@ +let Foo = < Bar : Natural | Baz : Natural > + +in λ(a : Type) + → λ(f : Natural → a) + → λ(ts : Foo) + → merge { Bar = λ(a : Natural) → f a, Baz = f } ts diff --git a/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceB.dhall b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(f : Natural → a) → ∀(ts : < Bar : Natural | Baz : Natural >) → a diff --git a/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessA.dhall b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessA.dhall @@ -0,0 +1,9 @@ +-- Verify that users can use `.` to both access a record field and a union +-- constructor within the same expression. This is a common idiom if a user +-- provides a types package. + +let Scope = < Public | Private > + +let types = { Scope = Scope } + +in types.Scope.Public diff --git a/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessB.dhall b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessB.dhall @@ -0,0 +1,1 @@ +< Private | Public > diff --git a/dhall-lang/tests/type-inference/success/simple/orderInsensitivityA.dhall b/dhall-lang/tests/type-inference/success/simple/orderInsensitivityA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/orderInsensitivityA.dhall @@ -0,0 +1,15 @@ +{- This test caught a regression in the Haskell implementation's typechecker. + + The typechecker was not sorting the fields of a record type inferred from a + projection, meaning that it inferred that the fully normalized type of + the subexpression `{ bar = "", foo = "" }.{ foo, bar }` was + `{ foo : Text, bar : Text }` when according to the standard the inferred type + should have been `{ bar : Text, foo : Text }`. On top of that the Haskell + implementation was sensitive to field order, leading to a type mismatch + when applying a function whose input type had the fields sorted. + + This test ensures that implementations correctly handle order-insensitivity + when projecting fields and/or comparing types, just in case they are + order-sensitive like the Haskell implementation. +-} +λ(f : { bar : Text, foo : Text } → Bool) → f { bar = "", foo = "" }.{ foo, bar } diff --git a/dhall-lang/tests/type-inference/success/simple/orderInsensitivityB.dhall b/dhall-lang/tests/type-inference/success/simple/orderInsensitivityB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/orderInsensitivityB.dhall @@ -0,0 +1,1 @@ +∀(f : { bar : Text, foo : Text } → Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/simple/toMapEmptyNormalizeAnnotationA.dhall b/dhall-lang/tests/type-inference/success/simple/toMapEmptyNormalizeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/toMapEmptyNormalizeAnnotationA.dhall @@ -0,0 +1,3 @@ +toMap + { x = Bool }.{} +: List { mapKey : { t = Text }.t, mapValue : { t = Double }.t } diff --git a/dhall-lang/tests/type-inference/success/simple/toMapEmptyNormalizeAnnotationB.dhall b/dhall-lang/tests/type-inference/success/simple/toMapEmptyNormalizeAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/toMapEmptyNormalizeAnnotationB.dhall @@ -0,0 +1,1 @@ +List { mapKey : Text, mapValue : Double } diff --git a/dhall-lang/tests/type-inference/success/simple/unionsOfTypesA.dhall b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesA.dhall @@ -0,0 +1,1 @@ +< Left : Type → Type | Right : Type >.Left List diff --git a/dhall-lang/tests/type-inference/success/simple/unionsOfTypesB.dhall b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesB.dhall @@ -0,0 +1,1 @@ +< Left : Type → Type | Right : Type > diff --git a/dhall-lang/tests/type-inference/success/unit/AssertAlphaA.dhall b/dhall-lang/tests/type-inference/success/unit/AssertAlphaA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertAlphaA.dhall @@ -0,0 +1,1 @@ +assert : (\(x: Bool) -> x) === (\(y: Bool) -> y) diff --git a/dhall-lang/tests/type-inference/success/unit/AssertAlphaB.dhall b/dhall-lang/tests/type-inference/success/unit/AssertAlphaB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertAlphaB.dhall @@ -0,0 +1,1 @@ +(λ(x : Bool) → x) ≡ (λ(y : Bool) → y) diff --git a/dhall-lang/tests/type-inference/success/unit/AssertNaNA.dhall b/dhall-lang/tests/type-inference/success/unit/AssertNaNA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertNaNA.dhall @@ -0,0 +1,6 @@ +{- + Equivalence must compare the result of the binary encoding, so in + particular comparing Doubles should not use standard float equality (where + NaN != NaN). +-} +assert : NaN === NaN diff --git a/dhall-lang/tests/type-inference/success/unit/AssertNaNB.dhall b/dhall-lang/tests/type-inference/success/unit/AssertNaNB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertNaNB.dhall @@ -0,0 +1,1 @@ +NaN ≡ NaN diff --git a/dhall-lang/tests/type-inference/success/unit/AssertSimpleA.dhall b/dhall-lang/tests/type-inference/success/unit/AssertSimpleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertSimpleA.dhall @@ -0,0 +1,1 @@ +assert : 1 + 1 === 2 diff --git a/dhall-lang/tests/type-inference/success/unit/AssertSimpleB.dhall b/dhall-lang/tests/type-inference/success/unit/AssertSimpleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertSimpleB.dhall @@ -0,0 +1,1 @@ +2 ≡ 2 diff --git a/dhall-lang/tests/type-inference/success/unit/AssertTrivialA.dhall b/dhall-lang/tests/type-inference/success/unit/AssertTrivialA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertTrivialA.dhall @@ -0,0 +1,1 @@ +assert : 1 === 1 diff --git a/dhall-lang/tests/type-inference/success/unit/AssertTrivialB.dhall b/dhall-lang/tests/type-inference/success/unit/AssertTrivialB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/AssertTrivialB.dhall @@ -0,0 +1,1 @@ +1 ≡ 1 diff --git a/dhall-lang/tests/type-inference/success/unit/BoolA.dhall b/dhall-lang/tests/type-inference/success/unit/BoolA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/BoolA.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/BoolB.dhall b/dhall-lang/tests/type-inference/success/unit/BoolB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/BoolB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/BytesLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/BytesLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/BytesLiteralA.dhall @@ -0,0 +1,1 @@ +0x"0123456789abcdefABCDEF" diff --git a/dhall-lang/tests/type-inference/success/unit/BytesLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/BytesLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/BytesLiteralB.dhall @@ -0,0 +1,1 @@ +Bytes diff --git a/dhall-lang/tests/type-inference/success/unit/CompletionA.dhall b/dhall-lang/tests/type-inference/success/unit/CompletionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/CompletionA.dhall @@ -0,0 +1,1 @@ +{ default = {=}, Type = {} }::{=} diff --git a/dhall-lang/tests/type-inference/success/unit/CompletionB.dhall b/dhall-lang/tests/type-inference/success/unit/CompletionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/CompletionB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/ConstructorShiftA.dhall b/dhall-lang/tests/type-inference/success/unit/ConstructorShiftA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ConstructorShiftA.dhall @@ -0,0 +1,1 @@ +λ(t : Type) → < t : t >.t diff --git a/dhall-lang/tests/type-inference/success/unit/ConstructorShiftB.dhall b/dhall-lang/tests/type-inference/success/unit/ConstructorShiftB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ConstructorShiftB.dhall @@ -0,0 +1,1 @@ +∀(t : Type) → ∀(t : t) → < t : t@1 > diff --git a/dhall-lang/tests/type-inference/success/unit/DoubleA.dhall b/dhall-lang/tests/type-inference/success/unit/DoubleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/DoubleA.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/unit/DoubleB.dhall b/dhall-lang/tests/type-inference/success/unit/DoubleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/DoubleB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/DoubleLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/DoubleLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/DoubleLiteralA.dhall @@ -0,0 +1,1 @@ +1.0 diff --git a/dhall-lang/tests/type-inference/success/unit/DoubleLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/DoubleLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/DoubleLiteralB.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/unit/DoubleShowA.dhall b/dhall-lang/tests/type-inference/success/unit/DoubleShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/DoubleShowA.dhall @@ -0,0 +1,1 @@ +Double/show diff --git a/dhall-lang/tests/type-inference/success/unit/DoubleShowB.dhall b/dhall-lang/tests/type-inference/success/unit/DoubleShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/DoubleShowB.dhall @@ -0,0 +1,1 @@ +Double → Text diff --git a/dhall-lang/tests/type-inference/success/unit/EquivalenceA.dhall b/dhall-lang/tests/type-inference/success/unit/EquivalenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/EquivalenceA.dhall @@ -0,0 +1,1 @@ +1 === 2 diff --git a/dhall-lang/tests/type-inference/success/unit/EquivalenceB.dhall b/dhall-lang/tests/type-inference/success/unit/EquivalenceB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/EquivalenceB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/FalseA.dhall b/dhall-lang/tests/type-inference/success/unit/FalseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FalseA.dhall @@ -0,0 +1,1 @@ +False diff --git a/dhall-lang/tests/type-inference/success/unit/FalseB.dhall b/dhall-lang/tests/type-inference/success/unit/FalseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FalseB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionA.dhall @@ -0,0 +1,1 @@ +λ(_ : Bool) → _ diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionApplicationA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationA.dhall @@ -0,0 +1,1 @@ +(λ(_ : Bool) → _) True diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionApplicationB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeArgumentA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeArgumentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeArgumentA.dhall @@ -0,0 +1,1 @@ +List/length (let x = 0 in Bool) diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeArgumentB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeArgumentB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeArgumentB.dhall @@ -0,0 +1,1 @@ +List Bool → Natural diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeResultA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeResultA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeResultA.dhall @@ -0,0 +1,1 @@ +(λ(g : Natural → Bool) → assert : g 0 ≡ g 0) Natural/even diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeResultB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeResultB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionApplicationNormalizeResultB.dhall @@ -0,0 +1,1 @@ +True ≡ True diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionB.dhall @@ -0,0 +1,1 @@ +Bool → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionDependentType1A.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType1A.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionDependentType1B.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType1B.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionDependentType2A.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType2A.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionDependentType2B.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionDependentType2B.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → Kind diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionNamedArgA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionNamedArgA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionNamedArgA.dhall @@ -0,0 +1,1 @@ +λ(x : Bool) → x diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionNamedArgB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionNamedArgB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionNamedArgB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionNormalizeTypeAnnotationA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionNormalizeTypeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionNormalizeTypeAnnotationA.dhall @@ -0,0 +1,1 @@ +λ(x : { t = Bool }.t) → x diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionNormalizeTypeAnnotationB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionNormalizeTypeAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionNormalizeTypeAnnotationB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindKindA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindKindA.dhall @@ -0,0 +1,1 @@ +Kind → Kind diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindKindB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindKindB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTermA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTermA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTermA.dhall @@ -0,0 +1,1 @@ +Kind → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTermB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTermB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTermB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTypeA.dhall @@ -0,0 +1,1 @@ +Kind → Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeKindTypeB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTermTermA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTermTermA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTermTermA.dhall @@ -0,0 +1,1 @@ +Bool → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTermTermB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTermTermB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTermTermB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeKindA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeKindA.dhall @@ -0,0 +1,1 @@ +Type → Kind diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeKindB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeKindB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTermA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTermA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTermA.dhall @@ -0,0 +1,1 @@ +Type → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTermB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTermB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTermB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTypeA.dhall @@ -0,0 +1,1 @@ +Type → Type diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeTypeTypeB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeUsingArgumentA.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeUsingArgumentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeUsingArgumentA.dhall @@ -0,0 +1,1 @@ +Type → _ diff --git a/dhall-lang/tests/type-inference/success/unit/FunctionTypeUsingArgumentB.dhall b/dhall-lang/tests/type-inference/success/unit/FunctionTypeUsingArgumentB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/FunctionTypeUsingArgumentB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/IfA.dhall b/dhall-lang/tests/type-inference/success/unit/IfA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfA.dhall @@ -0,0 +1,1 @@ +if True then False else True diff --git a/dhall-lang/tests/type-inference/success/unit/IfB.dhall b/dhall-lang/tests/type-inference/success/unit/IfB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/IfBranchesKindA.dhall b/dhall-lang/tests/type-inference/success/unit/IfBranchesKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfBranchesKindA.dhall @@ -0,0 +1,1 @@ +if True then (Type -> Type) else Type diff --git a/dhall-lang/tests/type-inference/success/unit/IfBranchesKindB.dhall b/dhall-lang/tests/type-inference/success/unit/IfBranchesKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfBranchesKindB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/IfBranchesTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/IfBranchesTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfBranchesTypeA.dhall @@ -0,0 +1,1 @@ +if True then Bool else Natural diff --git a/dhall-lang/tests/type-inference/success/unit/IfBranchesTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/IfBranchesTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfBranchesTypeB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/IfNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/IfNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfNormalizeArgumentsA.dhall @@ -0,0 +1,9 @@ + if if True then True else True + +then if True then False else True + +else if True + +then True + +else True diff --git a/dhall-lang/tests/type-inference/success/unit/IfNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/IfNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IfNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerA.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerA.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerB.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerClampA.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerClampA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerClampA.dhall @@ -0,0 +1,1 @@ +Integer/clamp diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerClampB.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerClampB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerClampB.dhall @@ -0,0 +1,1 @@ +Integer → Natural diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerLiteralA.dhall @@ -0,0 +1,1 @@ ++1 diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerLiteralB.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerNegateA.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerNegateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerNegateA.dhall @@ -0,0 +1,1 @@ +Integer/negate diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerNegateB.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerNegateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerNegateB.dhall @@ -0,0 +1,1 @@ +Integer → Integer diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerShowA.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerShowA.dhall @@ -0,0 +1,1 @@ +Integer/show diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerShowB.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerShowB.dhall @@ -0,0 +1,1 @@ +Integer → Text diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerToDoubleA.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerToDoubleA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerToDoubleA.dhall @@ -0,0 +1,1 @@ +Integer/toDouble diff --git a/dhall-lang/tests/type-inference/success/unit/IntegerToDoubleB.dhall b/dhall-lang/tests/type-inference/success/unit/IntegerToDoubleB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/IntegerToDoubleB.dhall @@ -0,0 +1,1 @@ +Integer → Double diff --git a/dhall-lang/tests/type-inference/success/unit/KindA.dhall b/dhall-lang/tests/type-inference/success/unit/KindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/KindA.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/KindB.dhall b/dhall-lang/tests/type-inference/success/unit/KindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/KindB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/LetA.dhall b/dhall-lang/tests/type-inference/success/unit/LetA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetA.dhall @@ -0,0 +1,1 @@ +let x = True in x diff --git a/dhall-lang/tests/type-inference/success/unit/LetB.dhall b/dhall-lang/tests/type-inference/success/unit/LetB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/LetNestedTypeSynonymA.dhall b/dhall-lang/tests/type-inference/success/unit/LetNestedTypeSynonymA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetNestedTypeSynonymA.dhall @@ -0,0 +1,1 @@ +let x = Bool let y : x = True in y diff --git a/dhall-lang/tests/type-inference/success/unit/LetNestedTypeSynonymB.dhall b/dhall-lang/tests/type-inference/success/unit/LetNestedTypeSynonymB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetNestedTypeSynonymB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/LetTypeSynonymA.dhall b/dhall-lang/tests/type-inference/success/unit/LetTypeSynonymA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetTypeSynonymA.dhall @@ -0,0 +1,1 @@ +let x = Bool in True : x diff --git a/dhall-lang/tests/type-inference/success/unit/LetTypeSynonymB.dhall b/dhall-lang/tests/type-inference/success/unit/LetTypeSynonymB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetTypeSynonymB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/LetWithAnnotationA.dhall b/dhall-lang/tests/type-inference/success/unit/LetWithAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetWithAnnotationA.dhall @@ -0,0 +1,1 @@ +let x : Bool = True in x diff --git a/dhall-lang/tests/type-inference/success/unit/LetWithAnnotationB.dhall b/dhall-lang/tests/type-inference/success/unit/LetWithAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/LetWithAnnotationB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/ListA.dhall b/dhall-lang/tests/type-inference/success/unit/ListA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListA.dhall @@ -0,0 +1,1 @@ +List diff --git a/dhall-lang/tests/type-inference/success/unit/ListB.dhall b/dhall-lang/tests/type-inference/success/unit/ListB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListB.dhall @@ -0,0 +1,1 @@ +Type → Type diff --git a/dhall-lang/tests/type-inference/success/unit/ListBuildA.dhall b/dhall-lang/tests/type-inference/success/unit/ListBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListBuildA.dhall @@ -0,0 +1,1 @@ +List/build diff --git a/dhall-lang/tests/type-inference/success/unit/ListBuildB.dhall b/dhall-lang/tests/type-inference/success/unit/ListBuildB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListBuildB.dhall @@ -0,0 +1,3 @@ + ∀(a : Type) +→ (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) +→ List a diff --git a/dhall-lang/tests/type-inference/success/unit/ListFoldA.dhall b/dhall-lang/tests/type-inference/success/unit/ListFoldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListFoldA.dhall @@ -0,0 +1,1 @@ +List/fold diff --git a/dhall-lang/tests/type-inference/success/unit/ListFoldB.dhall b/dhall-lang/tests/type-inference/success/unit/ListFoldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListFoldB.dhall @@ -0,0 +1,6 @@ + ∀(a : Type) +→ List a +→ ∀(list : Type) +→ ∀(cons : a → list → list) +→ ∀(nil : list) +→ list diff --git a/dhall-lang/tests/type-inference/success/unit/ListHeadA.dhall b/dhall-lang/tests/type-inference/success/unit/ListHeadA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListHeadA.dhall @@ -0,0 +1,1 @@ +List/head diff --git a/dhall-lang/tests/type-inference/success/unit/ListHeadB.dhall b/dhall-lang/tests/type-inference/success/unit/ListHeadB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListHeadB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → List a → Optional a diff --git a/dhall-lang/tests/type-inference/success/unit/ListIndexedA.dhall b/dhall-lang/tests/type-inference/success/unit/ListIndexedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListIndexedA.dhall @@ -0,0 +1,1 @@ +List/indexed diff --git a/dhall-lang/tests/type-inference/success/unit/ListIndexedB.dhall b/dhall-lang/tests/type-inference/success/unit/ListIndexedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListIndexedB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → List a → List { index : Natural, value : a } diff --git a/dhall-lang/tests/type-inference/success/unit/ListLastA.dhall b/dhall-lang/tests/type-inference/success/unit/ListLastA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLastA.dhall @@ -0,0 +1,1 @@ +List/last diff --git a/dhall-lang/tests/type-inference/success/unit/ListLastB.dhall b/dhall-lang/tests/type-inference/success/unit/ListLastB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLastB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → List a → Optional a diff --git a/dhall-lang/tests/type-inference/success/unit/ListLengthA.dhall b/dhall-lang/tests/type-inference/success/unit/ListLengthA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLengthA.dhall @@ -0,0 +1,1 @@ +List/length diff --git a/dhall-lang/tests/type-inference/success/unit/ListLengthB.dhall b/dhall-lang/tests/type-inference/success/unit/ListLengthB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLengthB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → List a → Natural diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyA.dhall @@ -0,0 +1,1 @@ +[] : List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyB.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyNormalizeAnnotationA.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyNormalizeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyNormalizeAnnotationA.dhall @@ -0,0 +1,1 @@ +[] : { x = List Bool }.x diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyNormalizeAnnotationB.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyNormalizeAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralEmptyNormalizeAnnotationB.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +[ if True then False else True ] diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralOneA.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralOneA.dhall @@ -0,0 +1,1 @@ +[ True ] diff --git a/dhall-lang/tests/type-inference/success/unit/ListLiteralOneB.dhall b/dhall-lang/tests/type-inference/success/unit/ListLiteralOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListLiteralOneB.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/ListReverseA.dhall b/dhall-lang/tests/type-inference/success/unit/ListReverseA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListReverseA.dhall @@ -0,0 +1,1 @@ +List/reverse diff --git a/dhall-lang/tests/type-inference/success/unit/ListReverseB.dhall b/dhall-lang/tests/type-inference/success/unit/ListReverseB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ListReverseB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → List a → List a diff --git a/dhall-lang/tests/type-inference/success/unit/MergeEmptyAlternativeA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeEmptyAlternativeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeEmptyAlternativeA.dhall @@ -0,0 +1,1 @@ +merge { x = 1 } < x >.x diff --git a/dhall-lang/tests/type-inference/success/unit/MergeEmptyAlternativeB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeEmptyAlternativeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeEmptyAlternativeB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/MergeEmptyUnionA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeEmptyUnionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeEmptyUnionA.dhall @@ -0,0 +1,1 @@ +λ(x : <>) → merge {=} x : Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeEmptyUnionB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeEmptyUnionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeEmptyUnionB.dhall @@ -0,0 +1,1 @@ +∀(x : <>) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeNoneA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeNoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeNoneA.dhall @@ -0,0 +1,1 @@ +merge { None = False, Some = \(b : Bool) -> b } (None Bool) diff --git a/dhall-lang/tests/type-inference/success/unit/MergeNoneB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeNoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeNoneB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneA.dhall @@ -0,0 +1,1 @@ +merge { x = λ(_ : Bool) → _ } (< x : Bool >.x True) diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneEmptyA.dhall @@ -0,0 +1,1 @@ +merge { x = 5 } < x >.x diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneEmptyB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation0A.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation0A.dhall @@ -0,0 +1,1 @@ +merge { x = λ(_ : Bool) → _ } (< x : Bool >.x True) : Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation0B.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1A.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1A.dhall @@ -0,0 +1,1 @@ +merge { x = λ(y : Bool) → y } < x >.x : (∀(y : Bool) → Bool) diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1B.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1B.dhall @@ -0,0 +1,1 @@ +∀(y : Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOptionalA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOptionalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOptionalA.dhall @@ -0,0 +1,1 @@ +λ(x : Optional Bool) → merge { None = 0, Some = λ(_ : Bool) → 1 } x diff --git a/dhall-lang/tests/type-inference/success/unit/MergeOptionalB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOptionalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeOptionalB.dhall @@ -0,0 +1,1 @@ +∀(x : Optional Bool) → Natural diff --git a/dhall-lang/tests/type-inference/success/unit/MergeSomeA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeSomeA.dhall @@ -0,0 +1,1 @@ +merge { None = False, Some = \(b : Bool) -> b } (Some True) diff --git a/dhall-lang/tests/type-inference/success/unit/MergeSomeB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeSomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeSomeB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/MergeTrickyShadowingA.dhall b/dhall-lang/tests/type-inference/success/unit/MergeTrickyShadowingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeTrickyShadowingA.dhall @@ -0,0 +1,1 @@ +let _ = Bool in merge {_ = \(x: _) -> x} (<_: Bool>._ True) diff --git a/dhall-lang/tests/type-inference/success/unit/MergeTrickyShadowingB.dhall b/dhall-lang/tests/type-inference/success/unit/MergeTrickyShadowingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/MergeTrickyShadowingB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalA.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalBuildA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalBuildA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalBuildA.dhall @@ -0,0 +1,1 @@ +Natural/build diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalBuildB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalBuildB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalBuildB.dhall @@ -0,0 +1,6 @@ + ( ∀(natural : Type) + → ∀(succ : natural → natural) + → ∀(zero : natural) + → natural + ) +→ Natural diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalEvenA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalEvenA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalEvenA.dhall @@ -0,0 +1,1 @@ +Natural/even diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalEvenB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalEvenB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalEvenB.dhall @@ -0,0 +1,1 @@ +Natural → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalFoldA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalFoldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalFoldA.dhall @@ -0,0 +1,1 @@ +Natural/fold diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalFoldB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalFoldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalFoldB.dhall @@ -0,0 +1,5 @@ + Natural +→ ∀(natural : Type) +→ ∀(succ : natural → natural) +→ ∀(zero : natural) +→ natural diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalIsZeroA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalIsZeroA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalIsZeroA.dhall @@ -0,0 +1,1 @@ +Natural/isZero diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalIsZeroB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalIsZeroB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalIsZeroB.dhall @@ -0,0 +1,1 @@ +Natural → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalLiteralA.dhall @@ -0,0 +1,1 @@ +1 diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalLiteralB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalOddA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalOddA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalOddA.dhall @@ -0,0 +1,1 @@ +Natural/odd diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalOddB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalOddB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalOddB.dhall @@ -0,0 +1,1 @@ +Natural → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalShowA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalShowA.dhall @@ -0,0 +1,1 @@ +Natural/show diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalShowB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalShowB.dhall @@ -0,0 +1,1 @@ +Natural → Text diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalSubtractA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalSubtractA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalSubtractA.dhall @@ -0,0 +1,1 @@ +Natural/subtract diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalSubtractB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalSubtractB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalSubtractB.dhall @@ -0,0 +1,1 @@ +Natural → Natural → Natural diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalToIntegerA.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalToIntegerA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalToIntegerA.dhall @@ -0,0 +1,1 @@ +Natural/toInteger diff --git a/dhall-lang/tests/type-inference/success/unit/NaturalToIntegerB.dhall b/dhall-lang/tests/type-inference/success/unit/NaturalToIntegerB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NaturalToIntegerB.dhall @@ -0,0 +1,1 @@ +Natural → Integer diff --git a/dhall-lang/tests/type-inference/success/unit/NoneA.dhall b/dhall-lang/tests/type-inference/success/unit/NoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NoneA.dhall @@ -0,0 +1,1 @@ +None diff --git a/dhall-lang/tests/type-inference/success/unit/NoneB.dhall b/dhall-lang/tests/type-inference/success/unit/NoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/NoneB.dhall @@ -0,0 +1,1 @@ +∀(A : Type) → Optional A diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorAndA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorAndA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorAndA.dhall @@ -0,0 +1,1 @@ +True && False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorAndB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorAndB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorAndB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorAndNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorAndNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorAndNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +True && False && False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorAndNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorAndNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorAndNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorEqualA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorEqualA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorEqualA.dhall @@ -0,0 +1,1 @@ +True == False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorEqualB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorEqualB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorEqualB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorEqualNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorEqualNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorEqualNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +True == False == False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorEqualNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorEqualNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorEqualNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateA.dhall @@ -0,0 +1,1 @@ +[ True ] # [ True ] diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateB.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +(if True then [ True ] else [ False ]) # (if True then [ True ] else [ False ]) diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorListConcatenateNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualA.dhall @@ -0,0 +1,1 @@ +True != False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +True != False != False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorNotEqualNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorOrA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorOrA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorOrA.dhall @@ -0,0 +1,1 @@ +True || False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorOrB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorOrB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorOrB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorOrNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorOrNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorOrNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +True || False || False diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorOrNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorOrNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorOrNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorPlusA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorPlusA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorPlusA.dhall @@ -0,0 +1,1 @@ +1 + 1 diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorPlusB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorPlusB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorPlusB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorPlusNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorPlusNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorPlusNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +1 + 1 + (1 + 1) diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorPlusNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorPlusNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorPlusNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateA.dhall @@ -0,0 +1,1 @@ +"a" ++ "b" diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +"x" ++ "a" ++ ("y" ++ "b") diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTextConcatenateNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTimesA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTimesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTimesA.dhall @@ -0,0 +1,1 @@ +1 * 1 diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTimesB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTimesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTimesB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTimesNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTimesNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTimesNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +1 * 1 * (1 * 1) diff --git a/dhall-lang/tests/type-inference/success/unit/OperatorTimesNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/OperatorTimesNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OperatorTimesNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/unit/OptionalA.dhall b/dhall-lang/tests/type-inference/success/unit/OptionalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OptionalA.dhall @@ -0,0 +1,1 @@ +Optional diff --git a/dhall-lang/tests/type-inference/success/unit/OptionalB.dhall b/dhall-lang/tests/type-inference/success/unit/OptionalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/OptionalB.dhall @@ -0,0 +1,1 @@ +Type → Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecordEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordEmptyA.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordEmptyB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsA.dhall @@ -0,0 +1,1 @@ +{ x.y.z = 1 } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsB.dhall @@ -0,0 +1,1 @@ +{ x : { y : { z : Natural } } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsMergeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsMergeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsMergeA.dhall @@ -0,0 +1,14 @@ +{- This example verifies that a Dhall interpreter correctly handles a corner + case that other languages sometimes misbehave on + + The expression should desugar like this: + + λ(r : { z : Natural }) → { x.y = 1, x = r } + + λ(r : { z : Natural }) → { x = { y = 1 }, x = r } + + λ(r : { z : Natural }) → { x = { y = 1 } ∧ r } + + ... which type-checks since `{ y = 1 }` and `r` do not collide +-} +λ(r : { z : Natural }) → { x.y = 1, x = r } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsMergeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsMergeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDottedFieldsMergeB.dhall @@ -0,0 +1,1 @@ +∀(r : { z : Natural }) → { x : { y : Natural, z : Natural } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsAbstractA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsAbstractA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsAbstractA.dhall @@ -0,0 +1,12 @@ +{- This test illustrates that duplicate fields need not be literals in order + to be properly normalized. One or both of the duplicate fields can be + abstract because field duplication delegates its behavior to the ∧ operator + + This particular example succeeds because it desugars to: + + λ(r : { z : Natural }) → { x = { y = 1 } ∧ r } + + ... and the `∧` operator can infer the absence of conflicts due to knowing + the type of `r` +-} +λ(r : { z : Natural }) → { x = { y = 1 }, x = r } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsAbstractB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsAbstractB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsAbstractB.dhall @@ -0,0 +1,1 @@ +∀(r : { z : Natural }) → { x : { y : Natural, z : Natural } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsNoCollisionsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsNoCollisionsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsNoCollisionsA.dhall @@ -0,0 +1,12 @@ +{- This type-checks because the expression desugars to: + + { x = { y = 0 } ∧ { z = 0 } } + + ... which in turn type-checks due to the absence of a field collision. + + This expression is analogous to the following common Nix/TOML/Cue idiom, + which we would like to support: + + { x.y = 0, x.z = 0 } +-} +{ x = { y = 0 }, x = { z = 0 } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsNoCollisionsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsNoCollisionsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitDuplicateFieldsNoCollisionsB.dhall @@ -0,0 +1,1 @@ +{ x : { y : Natural, z : Natural } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeA.dhall @@ -0,0 +1,1 @@ +{ x = True : { t = Bool }.t } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeB.dhall @@ -0,0 +1,1 @@ +{ x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitPunA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitPunA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitPunA.dhall @@ -0,0 +1,1 @@ +\(x: Bool) -> { x } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitPunB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitPunB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitPunB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → { x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureA.dhall @@ -0,0 +1,1 @@ +\(x: Bool) -> \(x: Natural) -> { x } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → ∀(x : Natural) → { x : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeA.dhall @@ -0,0 +1,1 @@ +let `None` = 0 let `Some` = \(_: Bool) -> 1 in { None, Some } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeB.dhall @@ -0,0 +1,1 @@ +{ None : Natural, Some : Bool → Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsA.dhall @@ -0,0 +1,1 @@ +{ b = 1, a = 2 } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsB.dhall @@ -0,0 +1,1 @@ +{ a : Natural, b : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordMixedKinds2A.dhall b/dhall-lang/tests/type-inference/success/unit/RecordMixedKinds2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordMixedKinds2A.dhall @@ -0,0 +1,1 @@ +{ x = Type, y = {} } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordMixedKinds2B.dhall b/dhall-lang/tests/type-inference/success/unit/RecordMixedKinds2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordMixedKinds2B.dhall @@ -0,0 +1,1 @@ +{ x : Kind, y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x = {=}, y = Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordMixedKindsB.dhall @@ -0,0 +1,1 @@ +{ x : {}, y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindA.dhall @@ -0,0 +1,1 @@ +{ a = { b = Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindB.dhall @@ -0,0 +1,1 @@ +{ a : { b : Kind } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedKindLikeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindLikeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindLikeA.dhall @@ -0,0 +1,1 @@ +{ a = { b = Type → Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedKindLikeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindLikeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedKindLikeB.dhall @@ -0,0 +1,1 @@ +{ a : { b : Kind } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeA.dhall @@ -0,0 +1,1 @@ +{ a = { b = Bool } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeB.dhall @@ -0,0 +1,1 @@ +{ a : { b : Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeLikeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeLikeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeLikeA.dhall @@ -0,0 +1,1 @@ +{ a = { b = Bool → Bool } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeLikeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeLikeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordNestedTypeLikeB.dhall @@ -0,0 +1,1 @@ +{ a : { b : Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordOneKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordOneKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordOneKindA.dhall @@ -0,0 +1,1 @@ +{ x = Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordOneKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordOneKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordOneKindB.dhall @@ -0,0 +1,1 @@ +{ x : Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordOneTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordOneTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordOneTypeA.dhall @@ -0,0 +1,1 @@ +{ x = {} } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordOneTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordOneTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordOneTypeB.dhall @@ -0,0 +1,1 @@ +{ x : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordOneValueA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordOneValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordOneValueA.dhall @@ -0,0 +1,1 @@ +{ x = {=} } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordOneValueB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordOneValueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordOneValueB.dhall @@ -0,0 +1,1 @@ +{ x : {} } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeA.dhall @@ -0,0 +1,1 @@ +let e = { a = 10, b = "Text" } let s = { a : Natural } in e.(s) diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeB.dhall @@ -0,0 +1,1 @@ +{ a : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeEmptyA.dhall @@ -0,0 +1,1 @@ +let e = { a = 10, b = "Text" } let s = { } in e.(s) diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeEmptyB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeJudgmentalEqualityA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeJudgmentalEqualityA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeJudgmentalEqualityA.dhall @@ -0,0 +1,5 @@ +-- This tests that we prefer the type from the selector over the inferred field +-- type from the record +-- ie the result should be `{ a : Natural → Natural }` +-- not `{ a : ∀(x : Natural) → Natural }` +let e = { a = λ(x : Natural) → x } let s = { a : Natural → Natural } in e.(s) diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeJudgmentalEqualityB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeJudgmentalEqualityB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionByTypeJudgmentalEqualityB.dhall @@ -0,0 +1,1 @@ +{ a : Natural → Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyA.dhall @@ -0,0 +1,1 @@ +{ x = {=} }.{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindA.dhall @@ -0,0 +1,1 @@ +{ x = Type }.{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionKindA.dhall @@ -0,0 +1,1 @@ +{ x = Type, y = Type }.{ x } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionKindB.dhall @@ -0,0 +1,1 @@ +{ x : Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionTypeA.dhall @@ -0,0 +1,1 @@ +{ x = Bool, y = Natural }.{ x } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionTypeB.dhall @@ -0,0 +1,1 @@ +{ x : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionValueA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionValueA.dhall @@ -0,0 +1,1 @@ +{ x = {=}, y = {=} }.{ x } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionValueB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionValueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionValueB.dhall @@ -0,0 +1,1 @@ +{ x : {} } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordSelectionKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordSelectionKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordSelectionKindA.dhall @@ -0,0 +1,1 @@ +{ x = Type }.x diff --git a/dhall-lang/tests/type-inference/success/unit/RecordSelectionKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordSelectionKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordSelectionKindB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/RecordSelectionTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordSelectionTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordSelectionTypeA.dhall @@ -0,0 +1,1 @@ +{ x = {} }.x diff --git a/dhall-lang/tests/type-inference/success/unit/RecordSelectionTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordSelectionTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordSelectionTypeB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecordSelectionValueA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordSelectionValueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordSelectionValueA.dhall @@ -0,0 +1,1 @@ +{ x = {=} }.x diff --git a/dhall-lang/tests/type-inference/success/unit/RecordSelectionValueB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordSelectionValueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordSelectionValueB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeA.dhall @@ -0,0 +1,1 @@ +{ x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeEmptyA.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeEmptyB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindA.dhall @@ -0,0 +1,1 @@ +{ x : Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeKindLikeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindLikeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindLikeA.dhall @@ -0,0 +1,1 @@ +{ a : Kind → Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeKindLikeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindLikeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeKindLikeB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds2A.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds2A.dhall @@ -0,0 +1,1 @@ +{ x : Kind, y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds2B.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds2B.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds3A.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds3A.dhall @@ -0,0 +1,1 @@ +{ x : Kind, y : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds3B.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKinds3B.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x : Bool, y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeMixedKindsB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindA.dhall @@ -0,0 +1,1 @@ +{ a : { b : Kind } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindLikeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindLikeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindLikeA.dhall @@ -0,0 +1,1 @@ +{ a : { b : Kind → Kind } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindLikeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindLikeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeNestedKindLikeB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeTypeA.dhall @@ -0,0 +1,1 @@ +{ x : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordTypeTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordTypeTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordTypeTypeB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeBoolTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeBoolTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeBoolTypeA.dhall @@ -0,0 +1,1 @@ +{ x : Bool } ⩓ { y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeBoolTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeBoolTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeBoolTypeB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeLhsEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeLhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeLhsEmptyA.dhall @@ -0,0 +1,1 @@ +{=} ∧ { x = True } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeLhsEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeLhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeLhsEmptyB.dhall @@ -0,0 +1,1 @@ +{ x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x = True } ∧ { y = Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeMixedKindsB.dhall @@ -0,0 +1,1 @@ +{ x : Bool, y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyA.dhall @@ -0,0 +1,1 @@ +{ x = { a = True } } ∧ { x = { b = True } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyB.dhall @@ -0,0 +1,1 @@ +{ x : { a : Bool, b : Bool } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyKindsA.dhall @@ -0,0 +1,1 @@ +{ x = { a = Type } } ∧ { x = { b = Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyKindsB.dhall @@ -0,0 +1,1 @@ +{ x : { a : Kind, b : Kind } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyTypesA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyTypesA.dhall @@ -0,0 +1,1 @@ +{ x = { a = Bool } } ∧ { x = { b = Natural } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyTypesB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRecursivelyTypesB.dhall @@ -0,0 +1,1 @@ +{ x : { a : Type, b : Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRhsEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRhsEmptyA.dhall @@ -0,0 +1,1 @@ +{ x = True } ∧ {=} diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRhsEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeRhsEmptyB.dhall @@ -0,0 +1,1 @@ +{ x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoA.dhall @@ -0,0 +1,1 @@ +{ x = True } ∧ { y = True } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoB.dhall @@ -0,0 +1,1 @@ +{ x : Bool, y : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoKindsA.dhall @@ -0,0 +1,1 @@ +{ x = Type } ∧ { y = Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoKindsB.dhall @@ -0,0 +1,1 @@ +{ x : Kind, y : Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoTypesA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoTypesA.dhall @@ -0,0 +1,1 @@ +{ x = Bool } ∧ { y = Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoTypesB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordMergeTwoTypesB.dhall @@ -0,0 +1,1 @@ +{ x : Type, y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeDeepA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeDeepA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeDeepA.dhall @@ -0,0 +1,1 @@ +{ a : { b : { x : Bool } } } ⩓ { a : { b : { y : Bool } } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeDeepB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeDeepB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeDeepB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyA.dhall @@ -0,0 +1,1 @@ +{ x : { a : Bool } } ⩓ { y : { b : Bool } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyKindsA.dhall @@ -0,0 +1,1 @@ +{ x : { a : Kind } } ⩓ { y : { b : Kind } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyKindsB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyTypesA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyTypesA.dhall @@ -0,0 +1,1 @@ +{ x : { a : Type } } ⩓ { y : { b : Type } } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyTypesB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRecursivelyTypesB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRhsEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRhsEmptyA.dhall @@ -0,0 +1,1 @@ +{ x : Bool } ⩓ {} diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRhsEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeRhsEmptyB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoA.dhall @@ -0,0 +1,1 @@ +{ x : Bool } ⩓ { y : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoKindsA.dhall @@ -0,0 +1,1 @@ +{ x : Kind } ⩓ { y : Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoKindsB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoTypesA.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoTypesA.dhall @@ -0,0 +1,1 @@ +{ x : Type } ⩓ { y : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoTypesB.dhall b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecursiveRecordTypeMergeTwoTypesB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x = {=} } ⫽ { x = Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeMixedKindsB.dhall @@ -0,0 +1,1 @@ +{ x : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeRhsEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeRhsEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeRhsEmptyA.dhall @@ -0,0 +1,1 @@ +{ x = {=} } ⫽ {=} diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeRhsEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeRhsEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeRhsEmptyB.dhall @@ -0,0 +1,1 @@ +{ x : {} } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoA.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoA.dhall @@ -0,0 +1,1 @@ +{ x = {=} } ⫽ { x = {=} } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoB.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoB.dhall @@ -0,0 +1,1 @@ +{ x : {} } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoDifferentA.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoDifferentA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoDifferentA.dhall @@ -0,0 +1,1 @@ +{ x = {=} } ⫽ { x = True } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoDifferentB.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoDifferentB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoDifferentB.dhall @@ -0,0 +1,1 @@ +{ x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoKindsA.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoKindsA.dhall @@ -0,0 +1,1 @@ +{ x = Type } ⫽ { x = Type } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoKindsB.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoKindsB.dhall @@ -0,0 +1,1 @@ +{ x : Kind } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoTypesA.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoTypesA.dhall @@ -0,0 +1,1 @@ +{ x = Bool } ⫽ { x = Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoTypesB.dhall b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RightBiasedRecordMergeTwoTypesB.dhall @@ -0,0 +1,1 @@ +{ x : Type } diff --git a/dhall-lang/tests/type-inference/success/unit/ShowConstructorEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/ShowConstructorEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ShowConstructorEmptyA.dhall @@ -0,0 +1,1 @@ +showConstructor .A diff --git a/dhall-lang/tests/type-inference/success/unit/ShowConstructorEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/ShowConstructorEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ShowConstructorEmptyB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/ShowConstructorNonEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/ShowConstructorNonEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ShowConstructorNonEmptyA.dhall @@ -0,0 +1,1 @@ +showConstructor (< A : Bool>.A False) diff --git a/dhall-lang/tests/type-inference/success/unit/ShowConstructorNonEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/ShowConstructorNonEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ShowConstructorNonEmptyB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/ShowConstructorOptionalA.dhall b/dhall-lang/tests/type-inference/success/unit/ShowConstructorOptionalA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ShowConstructorOptionalA.dhall @@ -0,0 +1,1 @@ +showConstructor (Some 0) diff --git a/dhall-lang/tests/type-inference/success/unit/ShowConstructorOptionalB.dhall b/dhall-lang/tests/type-inference/success/unit/ShowConstructorOptionalB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ShowConstructorOptionalB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/SomeTrueA.dhall b/dhall-lang/tests/type-inference/success/unit/SomeTrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/SomeTrueA.dhall @@ -0,0 +1,1 @@ +Some True diff --git a/dhall-lang/tests/type-inference/success/unit/SomeTrueB.dhall b/dhall-lang/tests/type-inference/success/unit/SomeTrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/SomeTrueB.dhall @@ -0,0 +1,1 @@ +Optional Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TextA.dhall b/dhall-lang/tests/type-inference/success/unit/TextA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextA.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/TextB.dhall b/dhall-lang/tests/type-inference/success/unit/TextB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/TextLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/TextLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextLiteralA.dhall @@ -0,0 +1,1 @@ +"a" diff --git a/dhall-lang/tests/type-inference/success/unit/TextLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/TextLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextLiteralB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/TextLiteralNormalizeArgumentsA.dhall b/dhall-lang/tests/type-inference/success/unit/TextLiteralNormalizeArgumentsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextLiteralNormalizeArgumentsA.dhall @@ -0,0 +1,1 @@ +"a${if True then "a" else "b"}" diff --git a/dhall-lang/tests/type-inference/success/unit/TextLiteralNormalizeArgumentsB.dhall b/dhall-lang/tests/type-inference/success/unit/TextLiteralNormalizeArgumentsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextLiteralNormalizeArgumentsB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/TextLiteralWithInterpolationA.dhall b/dhall-lang/tests/type-inference/success/unit/TextLiteralWithInterpolationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextLiteralWithInterpolationA.dhall @@ -0,0 +1,1 @@ +"a${"b"}" diff --git a/dhall-lang/tests/type-inference/success/unit/TextLiteralWithInterpolationB.dhall b/dhall-lang/tests/type-inference/success/unit/TextLiteralWithInterpolationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextLiteralWithInterpolationB.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/unit/TextReplaceA.dhall b/dhall-lang/tests/type-inference/success/unit/TextReplaceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextReplaceA.dhall @@ -0,0 +1,1 @@ +Text/replace diff --git a/dhall-lang/tests/type-inference/success/unit/TextReplaceB.dhall b/dhall-lang/tests/type-inference/success/unit/TextReplaceB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextReplaceB.dhall @@ -0,0 +1,1 @@ +∀(needle : Text) → ∀(replacement : Text) → ∀(haystack : Text) → Text diff --git a/dhall-lang/tests/type-inference/success/unit/TextShowA.dhall b/dhall-lang/tests/type-inference/success/unit/TextShowA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextShowA.dhall @@ -0,0 +1,1 @@ +Text/show diff --git a/dhall-lang/tests/type-inference/success/unit/TextShowB.dhall b/dhall-lang/tests/type-inference/success/unit/TextShowB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TextShowB.dhall @@ -0,0 +1,1 @@ +Text → Text diff --git a/dhall-lang/tests/type-inference/success/unit/ToMapA.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ToMapA.dhall @@ -0,0 +1,1 @@ +toMap { foo= 1, bar= 4, baz= 9 } diff --git a/dhall-lang/tests/type-inference/success/unit/ToMapAnnotatedA.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapAnnotatedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ToMapAnnotatedA.dhall @@ -0,0 +1,1 @@ +toMap { foo = 1, bar = 4, baz = 9 } : List { mapKey : Text, mapValue : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/ToMapAnnotatedB.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapAnnotatedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ToMapAnnotatedB.dhall @@ -0,0 +1,1 @@ +List { mapKey : Text, mapValue : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/ToMapB.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ToMapB.dhall @@ -0,0 +1,1 @@ +List { mapKey : Text, mapValue : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordA.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordA.dhall @@ -0,0 +1,1 @@ +toMap { x = λ(x : Bool) → x } : List { mapKey : Text, mapValue : ∀(x : Bool) → Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordB.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordB.dhall @@ -0,0 +1,1 @@ +List { mapKey : Text, mapValue : ∀(x : Bool) → Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/TrueA.dhall b/dhall-lang/tests/type-inference/success/unit/TrueA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TrueA.dhall @@ -0,0 +1,1 @@ +True diff --git a/dhall-lang/tests/type-inference/success/unit/TrueB.dhall b/dhall-lang/tests/type-inference/success/unit/TrueB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TrueB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TypeA.dhall b/dhall-lang/tests/type-inference/success/unit/TypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeA.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationA.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationA.dhall @@ -0,0 +1,1 @@ +True : Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationB.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall @@ -0,0 +1,1 @@ +(λ(x : Bool) → x) : ∀(x : Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionB.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationNormalizeA.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationNormalizeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationNormalizeA.dhall @@ -0,0 +1,1 @@ +True : { x = Bool }.x diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationNormalizeB.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationNormalizeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationNormalizeB.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationSortA.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationSortA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationSortA.dhall @@ -0,0 +1,1 @@ +Kind : Sort diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationSortB.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationSortB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationSortB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/TypeB.dhall b/dhall-lang/tests/type-inference/success/unit/TypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/TypeB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/UnionConstructorEmptyFieldA.dhall b/dhall-lang/tests/type-inference/success/unit/UnionConstructorEmptyFieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionConstructorEmptyFieldA.dhall @@ -0,0 +1,1 @@ +< x | y : Bool >.x diff --git a/dhall-lang/tests/type-inference/success/unit/UnionConstructorEmptyFieldB.dhall b/dhall-lang/tests/type-inference/success/unit/UnionConstructorEmptyFieldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionConstructorEmptyFieldB.dhall @@ -0,0 +1,1 @@ +< x | y : Bool > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionConstructorFieldA.dhall b/dhall-lang/tests/type-inference/success/unit/UnionConstructorFieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionConstructorFieldA.dhall @@ -0,0 +1,1 @@ +< x : Bool >.x diff --git a/dhall-lang/tests/type-inference/success/unit/UnionConstructorFieldB.dhall b/dhall-lang/tests/type-inference/success/unit/UnionConstructorFieldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionConstructorFieldB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → < x : Bool > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeEmptyA.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeEmptyA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeEmptyA.dhall @@ -0,0 +1,1 @@ +<> diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeEmptyB.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeEmptyB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeEmptyB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeKindA.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeKindA.dhall @@ -0,0 +1,1 @@ +< x : Kind > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeKindB.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeKindB.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds1A.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds1A.dhall @@ -0,0 +1,1 @@ +< x : Kind | y : Type > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds1B.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds1B.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds2A.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds2A.dhall @@ -0,0 +1,1 @@ +< x : Kind | y : Bool > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds2B.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds2B.dhall @@ -0,0 +1,1 @@ +Sort diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds3A.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds3A.dhall @@ -0,0 +1,1 @@ +< x : Bool | y : Type > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds3B.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds3B.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds4A.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds4A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds4A.dhall @@ -0,0 +1,1 @@ +< x : Bool | y | z : Type > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds4B.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds4B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeMixedKinds4B.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeOneA.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeOneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeOneA.dhall @@ -0,0 +1,1 @@ +< x : Bool > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeOneB.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeOneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeOneB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeTypeA.dhall @@ -0,0 +1,1 @@ +< x : Type > diff --git a/dhall-lang/tests/type-inference/success/unit/UnionTypeTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/UnionTypeTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/UnionTypeTypeB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/unit/WithCreateIntermediateRecordsA.dhall b/dhall-lang/tests/type-inference/success/unit/WithCreateIntermediateRecordsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithCreateIntermediateRecordsA.dhall @@ -0,0 +1,3 @@ +{- This test illustrates that if an intermediate record does + not exist, the `with` operator can create one -} +{ a = 5 } with b.c = 10 diff --git a/dhall-lang/tests/type-inference/success/unit/WithCreateIntermediateRecordsB.dhall b/dhall-lang/tests/type-inference/success/unit/WithCreateIntermediateRecordsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithCreateIntermediateRecordsB.dhall @@ -0,0 +1,1 @@ +{ a : Natural, b : { c : Natural } } diff --git a/dhall-lang/tests/type-inference/success/unit/WithInfersKindA.dhall b/dhall-lang/tests/type-inference/success/unit/WithInfersKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithInfersKindA.dhall @@ -0,0 +1,1 @@ +Some ({ x = Bool } with x = 0) diff --git a/dhall-lang/tests/type-inference/success/unit/WithInfersKindB.dhall b/dhall-lang/tests/type-inference/success/unit/WithInfersKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithInfersKindB.dhall @@ -0,0 +1,1 @@ +Optional { x : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/WithNestedA.dhall b/dhall-lang/tests/type-inference/success/unit/WithNestedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithNestedA.dhall @@ -0,0 +1,4 @@ +{- This test illustrates that the `with` keyword is permitted to override + existing fields nested within a child record +-} +{ a = { p = 2, q = "hi" }, b = 5.6 } with a.p = True diff --git a/dhall-lang/tests/type-inference/success/unit/WithNestedB.dhall b/dhall-lang/tests/type-inference/success/unit/WithNestedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithNestedB.dhall @@ -0,0 +1,1 @@ +{ a : { p : Bool, q : Text }, b : Double } diff --git a/dhall-lang/tests/type-inference/success/unit/WithNewFieldA.dhall b/dhall-lang/tests/type-inference/success/unit/WithNewFieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithNewFieldA.dhall @@ -0,0 +1,4 @@ +{- This test illustrates how the `with` keyword is permitted to extend a record + with new fields +-} +{ a = 1 } with b = 2 diff --git a/dhall-lang/tests/type-inference/success/unit/WithNewFieldB.dhall b/dhall-lang/tests/type-inference/success/unit/WithNewFieldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithNewFieldB.dhall @@ -0,0 +1,1 @@ +{ a : Natural, b : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/WithNewTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/WithNewTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithNewTypeA.dhall @@ -0,0 +1,4 @@ +{- This test illustrates that the `with` keyword is permitted to override + existing fields with a value of a new type (just like the `//` operator) +-} +{ a = 1 } with a = True diff --git a/dhall-lang/tests/type-inference/success/unit/WithNewTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/WithNewTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithNewTypeB.dhall @@ -0,0 +1,1 @@ +{ a : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/WithOptionalTypeUnchangedA.dhall b/dhall-lang/tests/type-inference/success/unit/WithOptionalTypeUnchangedA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithOptionalTypeUnchangedA.dhall @@ -0,0 +1,1 @@ +(Some 0) with ? = 1 diff --git a/dhall-lang/tests/type-inference/success/unit/WithOptionalTypeUnchangedB.dhall b/dhall-lang/tests/type-inference/success/unit/WithOptionalTypeUnchangedB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/WithOptionalTypeUnchangedB.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateA.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateA.dhall @@ -0,0 +1,1 @@ +Date diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateB.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateLiteralA.dhall @@ -0,0 +1,1 @@ +2000-01-01 diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateLiteralB.dhall @@ -0,0 +1,1 @@ +Date diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateTimeLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateTimeLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateTimeLiteralA.dhall @@ -0,0 +1,1 @@ +2000-01-01T12:00:00 diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateTimeLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateTimeLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateTimeLiteralB.dhall @@ -0,0 +1,1 @@ +{ date : Date, time : Time } diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateTimeTimeZoneLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateTimeTimeZoneLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateTimeTimeZoneLiteralA.dhall @@ -0,0 +1,1 @@ +2000-01-01T12:00:00+08:00 diff --git a/dhall-lang/tests/type-inference/success/unit/time/DateTimeTimeZoneLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/time/DateTimeTimeZoneLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/DateTimeTimeZoneLiteralB.dhall @@ -0,0 +1,1 @@ +{ date : Date, time : Time, timeZone : TimeZone } diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeA.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeA.dhall @@ -0,0 +1,1 @@ +Time diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeB.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeLiteralA.dhall @@ -0,0 +1,1 @@ +12:00:00 diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeLiteralB.dhall @@ -0,0 +1,1 @@ +Time diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeTimeZoneLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeTimeZoneLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeTimeZoneLiteralA.dhall @@ -0,0 +1,1 @@ +12:00:00+08:00 diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeTimeZoneLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeTimeZoneLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeTimeZoneLiteralB.dhall @@ -0,0 +1,1 @@ +{ time : Time, timeZone : TimeZone } diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeZoneA.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneA.dhall @@ -0,0 +1,1 @@ +TimeZone diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeZoneB.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneB.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeZoneLiteralA.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneLiteralA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneLiteralA.dhall @@ -0,0 +1,1 @@ ++08:00 diff --git a/dhall-lang/tests/type-inference/success/unit/time/TimeZoneLiteralB.dhall b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneLiteralB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/time/TimeZoneLiteralB.dhall @@ -0,0 +1,1 @@ +TimeZone diff --git a/dhall-repl/Main.hs b/dhall-repl/Main.hs deleted file mode 100644 --- a/dhall-repl/Main.hs +++ /dev/null @@ -1,249 +0,0 @@ -{-# language FlexibleContexts #-} -{-# language NamedFieldPuns #-} -{-# language OverloadedStrings #-} - -module Main ( main ) where - -import Control.Exception ( SomeException(SomeException), displayException, throwIO ) -import Control.Monad.IO.Class ( MonadIO, liftIO ) -import Control.Monad.State.Class ( MonadState, get, modify ) -import Control.Monad.State.Strict ( evalStateT ) -import Data.List ( foldl' ) - -import qualified Data.Text.Lazy as LazyText -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty ( renderIO ) -import qualified Dhall.Context -import qualified Dhall.Core as Dhall ( Var(V), Expr, normalize ) -import qualified Dhall.Pretty -import qualified Dhall.Core as Expr ( Expr(..) ) -import qualified Dhall.Import as Dhall -import qualified Dhall.Parser as Dhall -import qualified Dhall.TypeCheck as Dhall -import qualified System.Console.ANSI -import qualified System.Console.Haskeline.MonadException as Haskeline -import qualified System.Console.Repline as Repline -import qualified System.IO -import qualified Text.Trifecta.Delta as Trifecta - - -main :: IO () -main = - evalStateT - ( Repline.evalRepl - "⊢ " - ( dontCrash . eval ) - options - ( Repline.Word completer ) - greeter - ) - emptyEnv - - -data Env = Env - { envBindings :: Dhall.Context.Context Binding - , envIt :: Maybe Binding - } - - -emptyEnv :: Env -emptyEnv = - Env - { envBindings = Dhall.Context.empty - , envIt = Nothing - } - - -data Binding = Binding - { bindingExpr :: Dhall.Expr Dhall.Src Dhall.X - , bindingType :: Dhall.Expr Dhall.Src Dhall.X - } - - -envToContext :: Env -> Dhall.Context.Context Binding -envToContext Env{ envBindings, envIt } = - case envIt of - Nothing -> - envBindings - - Just it -> - Dhall.Context.insert "it" it envBindings - - -parseAndLoad - :: ( MonadIO m, MonadState Env m ) - => String -> m ( Dhall.Expr Dhall.Src Dhall.X ) -parseAndLoad src = do - parsed <- - case Dhall.exprFromText ( Trifecta.Columns 0 0 ) ( LazyText.pack src ) of - Left e -> - liftIO ( throwIO e ) - - Right a -> - return a - - liftIO ( Dhall.load parsed ) - - -eval :: ( MonadIO m, MonadState Env m ) => String -> m () -eval src = do - loaded <- - parseAndLoad src - - exprType <- - typeCheck loaded - - expr <- - normalize loaded - - modify ( \e -> e { envIt = Just ( Binding expr exprType ) } ) - - output System.IO.stdout expr - - - -typeOf :: ( MonadIO m, MonadState Env m ) => [String] -> m () -typeOf [] = - liftIO ( putStrLn ":type requires an argument to check the type of" ) - - -typeOf srcs = do - loaded <- - parseAndLoad ( unwords srcs ) - - exprType <- - typeCheck loaded - - exprType' <- - normalize exprType - - output System.IO.stdout ( Expr.Annot loaded exprType' ) - - - -normalize - :: MonadState Env m - => Dhall.Expr Dhall.Src Dhall.X -> m ( Dhall.Expr t Dhall.X ) -normalize e = do - env <- - get - - return - ( Dhall.normalize - ( foldl' - ( \a (k, Binding { bindingType, bindingExpr }) -> - Expr.Let k ( Just bindingType ) bindingExpr a - ) - e - ( Dhall.Context.toList ( envToContext env ) ) - ) - ) - - -typeCheck - :: ( MonadIO m, MonadState Env m ) - => Dhall.Expr Dhall.Src Dhall.X -> m ( Dhall.Expr Dhall.Src Dhall.X ) -typeCheck expr = do - env <- - get - - case Dhall.typeWith ( bindingType <$> envToContext env ) expr of - Left e -> - liftIO ( throwIO e ) - - Right a -> - return a - - -addBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m () -addBinding (k : "=" : srcs) = do - let - varName = - LazyText.pack k - - loaded <- - parseAndLoad ( unwords srcs ) - - t <- - typeCheck loaded - - expr <- - normalize loaded - - modify - ( \e -> - e - { envBindings = - Dhall.Context.insert - varName - Binding { bindingType = t, bindingExpr = expr } - ( envBindings e ) - } - ) - - output - System.IO.stdout - ( Expr.Annot ( Expr.Var ( Dhall.V varName 0 ) ) t ) - -addBinding _ = - liftIO ( fail ":let should be of the form `:let x = y`" ) - -saveBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m () -saveBinding (file : "=" : tokens) = do - loadedExpression <- parseAndLoad (unwords tokens) - - _ <- typeCheck loadedExpression - - normalizedExpression <- normalize loadedExpression - - let handler handle = output handle normalizedExpression - - liftIO (System.IO.withFile file System.IO.WriteMode handler) -saveBinding _ = fail ":save should be of the form `:save x = y`" - - -options - :: ( Haskeline.MonadException m, MonadIO m, MonadState Env m ) - => Repline.Options m -options = - [ ( "type", dontCrash . typeOf ) - , ( "let", dontCrash . addBinding ) - , ( "save", dontCrash . saveBinding ) - ] - - -completer :: Monad m => Repline.WordCompleter m -completer _ = - return [] - - -greeter :: MonadIO m => m () -greeter = - return () - - -dontCrash :: ( MonadIO m, Haskeline.MonadException m ) => m () -> m () -dontCrash m = - Haskeline.catch - m - ( \ e@SomeException{} -> liftIO ( putStrLn ( displayException e ) ) ) - - -output - :: (Pretty.Pretty a, MonadIO m) - => System.IO.Handle -> Dhall.Expr s a -> m () -output handle expr = do - let opts = - Pretty.defaultLayoutOptions - { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } - - let stream = Pretty.layoutSmart opts (Dhall.Pretty.prettyExpr expr) - supportsANSI <- liftIO (System.Console.ANSI.hSupportsANSI handle) - let ansiStream = - if supportsANSI - then fmap Dhall.Pretty.annToAnsiStyle stream - else Pretty.unAnnotateS stream - - liftIO (Pretty.renderIO handle ansiStream) - - liftIO (putStrLn "") -- Pretty printing doesn't end with a new line diff --git a/dhall.cabal b/dhall.cabal --- a/dhall.cabal +++ b/dhall.cabal @@ -1,13 +1,12 @@ +Cabal-Version: 2.4 Name: dhall -Version: 1.11.1 -Cabal-Version: >=1.8.0.2 +Version: 1.42.3 Build-Type: Simple -Tested-With: GHC == 8.0.1 -License: BSD3 +License: BSD-3-Clause License-File: LICENSE -Copyright: 2017 Gabriel Gonzalez -Author: Gabriel Gonzalez -Maintainer: Gabriel439@gmail.com +Copyright: 2017 Gabriella Gonzalez +Author: Gabriella Gonzalez +Maintainer: GenuineGabriella@gmail.com Bug-Reports: https://github.com/dhall-lang/dhall-haskell/issues Synopsis: A configuration language guaranteed to terminate Description: @@ -22,256 +21,477 @@ . Read "Dhall.Tutorial" to learn how to use this library Category: Compiler +Data-Files: + man/dhall.1 Extra-Source-Files: CHANGELOG.md - Prelude/Bool/and - Prelude/Bool/build - Prelude/Bool/even - Prelude/Bool/fold - Prelude/Bool/not - Prelude/Bool/odd - Prelude/Bool/or - Prelude/Bool/show - Prelude/Double/show - Prelude/Integer/show - Prelude/List/all - Prelude/List/any - Prelude/List/build - Prelude/List/concat - Prelude/List/concatMap - Prelude/List/filter - Prelude/List/fold - Prelude/List/generate - Prelude/List/head - Prelude/List/indexed - Prelude/List/iterate - Prelude/List/last - Prelude/List/length - Prelude/List/map - Prelude/List/null - Prelude/List/replicate - Prelude/List/reverse - Prelude/List/shifted - Prelude/List/unzip - Prelude/Monoid - Prelude/Natural/build - Prelude/Natural/enumerate - Prelude/Natural/even - Prelude/Natural/fold - Prelude/Natural/isZero - Prelude/Natural/odd - Prelude/Natural/product - Prelude/Natural/show - Prelude/Natural/sum - Prelude/Natural/toInteger - Prelude/Optional/all - Prelude/Optional/any - Prelude/Optional/build - Prelude/Optional/concat - Prelude/Optional/filter - Prelude/Optional/fold - Prelude/Optional/head - Prelude/Optional/last - Prelude/Optional/length - Prelude/Optional/map - Prelude/Optional/null - Prelude/Optional/toList - Prelude/Optional/unzip - Prelude/Text/concat - Prelude/Text/concatMap - Prelude/Text/concatMapSep - Prelude/Text/concatSep - tests/format/*.dhall - tests/normalization/*.dhall - tests/normalization/examples/Bool/and/*.dhall - tests/normalization/examples/Bool/build/*.dhall - tests/normalization/examples/Bool/even/*.dhall - tests/normalization/examples/Bool/fold/*.dhall - tests/normalization/examples/Bool/not/*.dhall - tests/normalization/examples/Bool/odd/*.dhall - tests/normalization/examples/Bool/or/*.dhall - tests/normalization/examples/Bool/show/*.dhall - tests/normalization/examples/Double/show/*.dhall - tests/normalization/examples/Integer/show/*.dhall - tests/normalization/examples/List/all/*.dhall - tests/normalization/examples/List/any/*.dhall - tests/normalization/examples/List/build/*.dhall - tests/normalization/examples/List/concat/*.dhall - tests/normalization/examples/List/concatMap/*.dhall - tests/normalization/examples/List/filter/*.dhall - tests/normalization/examples/List/fold/*.dhall - tests/normalization/examples/List/generate/*.dhall - tests/normalization/examples/List/head/*.dhall - tests/normalization/examples/List/indexed/*.dhall - tests/normalization/examples/List/iterate/*.dhall - tests/normalization/examples/List/last/*.dhall - tests/normalization/examples/List/length/*.dhall - tests/normalization/examples/List/map/*.dhall - tests/normalization/examples/List/null/*.dhall - tests/normalization/examples/List/replicate/*.dhall - tests/normalization/examples/List/reverse/*.dhall - tests/normalization/examples/List/shifted/*.dhall - tests/normalization/examples/List/unzip/*.dhall - tests/normalization/examples/Natural/build/*.dhall - tests/normalization/examples/Natural/enumerate/*.dhall - tests/normalization/examples/Natural/even/*.dhall - tests/normalization/examples/Natural/fold/*.dhall - tests/normalization/examples/Natural/isZero/*.dhall - tests/normalization/examples/Natural/odd/*.dhall - tests/normalization/examples/Natural/product/*.dhall - tests/normalization/examples/Natural/show/*.dhall - tests/normalization/examples/Natural/sum/*.dhall - tests/normalization/examples/Natural/toInteger/*.dhall - tests/normalization/examples/Optional/all/*.dhall - tests/normalization/examples/Optional/any/*.dhall - tests/normalization/examples/Optional/build/*.dhall - tests/normalization/examples/Optional/concat/*.dhall - tests/normalization/examples/Optional/filter/*.dhall - tests/normalization/examples/Optional/fold/*.dhall - tests/normalization/examples/Optional/head/*.dhall - tests/normalization/examples/Optional/last/*.dhall - tests/normalization/examples/Optional/length/*.dhall - tests/normalization/examples/Optional/map/*.dhall - tests/normalization/examples/Optional/null/*.dhall - tests/normalization/examples/Optional/toList/*.dhall - tests/normalization/examples/Optional/unzip/*.dhall - tests/normalization/examples/Text/concat/*.dhall - tests/normalization/examples/Text/concatMap/*.dhall - tests/normalization/examples/Text/concatMapSep/*.dhall - tests/normalization/examples/Text/concatSep/*.dhall - tests/normalization/simplifications/*.dhall - tests/parser/*.dhall - tests/regression/*.dhall - tests/tutorial/*.dhall - tests/typecheck/*.dhall - tests/typecheck/examples/Monoid/*.dhall + benchmark/**/*.dhall + benchmark/**/*.dhallb + dhall-lang/Prelude/**/*.dhall + dhall-lang/Prelude/Bool/and + dhall-lang/Prelude/Bool/build + dhall-lang/Prelude/Bool/even + dhall-lang/Prelude/Bool/fold + dhall-lang/Prelude/Bool/not + dhall-lang/Prelude/Bool/odd + dhall-lang/Prelude/Bool/or + dhall-lang/Prelude/Bool/show + dhall-lang/Prelude/Double/show + dhall-lang/Prelude/Function/compose + dhall-lang/Prelude/Function/identity + dhall-lang/Prelude/Integer/abs + dhall-lang/Prelude/Integer/add + dhall-lang/Prelude/Integer/clamp + dhall-lang/Prelude/Integer/equal + dhall-lang/Prelude/Integer/greaterThan + dhall-lang/Prelude/Integer/greaterThanEqual + dhall-lang/Prelude/Integer/lessThan + dhall-lang/Prelude/Integer/lessThanEqual + dhall-lang/Prelude/Integer/multiply + dhall-lang/Prelude/Integer/negate + dhall-lang/Prelude/Integer/negative + dhall-lang/Prelude/Integer/nonNegative + dhall-lang/Prelude/Integer/nonPositive + dhall-lang/Prelude/Integer/positive + dhall-lang/Prelude/Integer/show + dhall-lang/Prelude/Integer/subtract + dhall-lang/Prelude/Integer/toDouble + dhall-lang/Prelude/Integer/toNatural + dhall-lang/Prelude/JSON/Format + dhall-lang/Prelude/JSON/Nesting + dhall-lang/Prelude/JSON/Tagged + dhall-lang/Prelude/JSON/Type + dhall-lang/Prelude/JSON/array + dhall-lang/Prelude/JSON/bool + dhall-lang/Prelude/JSON/double + dhall-lang/Prelude/JSON/integer + dhall-lang/Prelude/JSON/keyText + dhall-lang/Prelude/JSON/keyValue + dhall-lang/Prelude/JSON/natural + dhall-lang/Prelude/JSON/null + dhall-lang/Prelude/JSON/number + dhall-lang/Prelude/JSON/object + dhall-lang/Prelude/JSON/omitNullFields + dhall-lang/Prelude/JSON/render + dhall-lang/Prelude/JSON/renderAs + dhall-lang/Prelude/JSON/renderYAML + dhall-lang/Prelude/JSON/string + dhall-lang/Prelude/JSON/tagInline + dhall-lang/Prelude/JSON/tagNested + dhall-lang/Prelude/List/all + dhall-lang/Prelude/List/any + dhall-lang/Prelude/List/build + dhall-lang/Prelude/List/concat + dhall-lang/Prelude/List/concatMap + dhall-lang/Prelude/List/default + dhall-lang/Prelude/List/drop + dhall-lang/Prelude/List/empty + dhall-lang/Prelude/List/filter + dhall-lang/Prelude/List/fold + dhall-lang/Prelude/List/generate + dhall-lang/Prelude/List/head + dhall-lang/Prelude/List/index + dhall-lang/Prelude/List/indexed + dhall-lang/Prelude/List/iterate + dhall-lang/Prelude/List/last + dhall-lang/Prelude/List/length + dhall-lang/Prelude/List/map + dhall-lang/Prelude/List/null + dhall-lang/Prelude/List/partition + dhall-lang/Prelude/List/replicate + dhall-lang/Prelude/List/reverse + dhall-lang/Prelude/List/shifted + dhall-lang/Prelude/List/take + dhall-lang/Prelude/List/unpackOptionals + dhall-lang/Prelude/List/unzip + dhall-lang/Prelude/List/zip + dhall-lang/Prelude/Location/Type + dhall-lang/Prelude/Map/Entry + dhall-lang/Prelude/Map/Type + dhall-lang/Prelude/Map/empty + dhall-lang/Prelude/Map/keyText + dhall-lang/Prelude/Map/keyValue + dhall-lang/Prelude/Map/keys + dhall-lang/Prelude/Map/map + dhall-lang/Prelude/Map/values + dhall-lang/Prelude/Monoid + dhall-lang/Prelude/Natural/build + dhall-lang/Prelude/Natural/enumerate + dhall-lang/Prelude/Natural/equal + dhall-lang/Prelude/Natural/even + dhall-lang/Prelude/Natural/fold + dhall-lang/Prelude/Natural/greaterThan + dhall-lang/Prelude/Natural/greaterThanEqual + dhall-lang/Prelude/Natural/isZero + dhall-lang/Prelude/Natural/lessThan + dhall-lang/Prelude/Natural/lessThanEqual + dhall-lang/Prelude/Natural/listMax + dhall-lang/Prelude/Natural/listMin + dhall-lang/Prelude/Natural/max + dhall-lang/Prelude/Natural/min + dhall-lang/Prelude/Natural/odd + dhall-lang/Prelude/Natural/product + dhall-lang/Prelude/Natural/show + dhall-lang/Prelude/Natural/sort + dhall-lang/Prelude/Natural/subtract + dhall-lang/Prelude/Natural/sum + dhall-lang/Prelude/Natural/toDouble + dhall-lang/Prelude/Natural/toInteger + dhall-lang/Prelude/Optional/all + dhall-lang/Prelude/Optional/any + dhall-lang/Prelude/Optional/build + dhall-lang/Prelude/Optional/concat + dhall-lang/Prelude/Optional/default + dhall-lang/Prelude/Optional/filter + dhall-lang/Prelude/Optional/fold + dhall-lang/Prelude/Optional/head + dhall-lang/Prelude/Optional/last + dhall-lang/Prelude/Optional/length + dhall-lang/Prelude/Optional/map + dhall-lang/Prelude/Optional/null + dhall-lang/Prelude/Optional/toList + dhall-lang/Prelude/Optional/unzip + dhall-lang/Prelude/Text/concat + dhall-lang/Prelude/Text/concatMap + dhall-lang/Prelude/Text/concatMapSep + dhall-lang/Prelude/Text/concatSep + dhall-lang/Prelude/Text/default + dhall-lang/Prelude/Text/defaultMap + dhall-lang/Prelude/Text/replicate + dhall-lang/Prelude/Text/show + dhall-lang/Prelude/Text/spaces + dhall-lang/Prelude/XML/Type + dhall-lang/Prelude/XML/attribute + dhall-lang/Prelude/XML/element + dhall-lang/Prelude/XML/emptyAttributes + dhall-lang/Prelude/XML/leaf + dhall-lang/Prelude/XML/render + dhall-lang/Prelude/XML/text + dhall-lang/tests/**/*.dhall + dhall-lang/tests/**/*.dhallb + dhall-lang/tests/**/*.hash + dhall-lang/tests/**/*.txt + dhall-lang/tests/**/*.bin + dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc + dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21 + tests/**/*.dhall + tests/**/*.tags + tests/**/*.txt Source-Repository head Type: git - Location: https://github.com/dhall-lang/dhall-haskell + Location: https://github.com/dhall-lang/dhall-haskell/tree/master/dhall -Library - Hs-Source-Dirs: src +Flag with-http + Description: Include support for importing dhall modules from HTTP URLs + Default: True + Manual: True + +Flag use-http-client-tls + Description: Use http-client-tls for resolving HTTP imports by default + (requires with-http to be enabled) + Default: True + Manual: True + +Flag cross + Description: Disable TemplateHaskell to make cross-compiling easier + Default: False + Manual: True + +Flag network-tests + Description: Enable tests which depend on an internet connection + Default: True + Manual: True + +Common common Build-Depends: - base >= 4.9.0.0 && < 5 , - ansi-wl-pprint < 0.7 , - base16-bytestring < 0.2 , - bytestring < 0.11, - case-insensitive < 1.3 , - containers >= 0.5.0.0 && < 0.6 , - contravariant < 1.5 , - cryptonite >= 0.23 && < 1.0 , + base >= 4.11.0.0 && < 5 , + aeson >= 1.0.0.0 && < 2.3 , + aeson-pretty < 0.9 , + ansi-terminal >= 0.6.3.1 && < 1.2 , + atomic-write >= 0.2.0.7 && < 0.3 , + base16-bytestring >= 1.0.0.0 , + bytestring < 0.13, + case-insensitive < 1.3 , + cborg >= 0.2.0.0 && < 0.3 , + cborg-json >= 0.2.2.0 && < 0.3 , + containers >= 0.5.8.0 && < 0.9 , + contravariant < 1.6 , + data-fix < 0.4 , + deepseq < 1.6 , + Diff >= 0.2 && < 1.1 , + directory >= 1.3.0.0 && < 1.4 , + dotgen >= 0.4.2 && < 0.5 , + either >= 5 && < 5.1, exceptions >= 0.8.3 && < 0.11, - directory >= 1.3 && < 1.4 , - filepath >= 1.4 && < 1.5 , - http-client >= 0.4.30 && < 0.6 , - http-client-tls >= 0.2.0 && < 0.4 , - insert-ordered-containers >= 0.1.0.1 && < 0.3 , - lens-family-core >= 1.0.0 && < 1.3 , - memory >= 0.14 && < 0.15, + filepath >= 1.4 && < 1.6 , + half >= 0.2.2.3 && < 0.4 , + haskeline >= 0.7.2.1 && < 0.9 , + hashable >= 1.2 && < 1.6 , + indexed-traversable < 0.2 , + microlens >= 0.4.14.0 && < 0.5 , + microlens-mtl >= 0.1 && < 0.3 , + -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469 + megaparsec >= 8 && < 10 , + mmorph < 1.3 , + mtl >= 2.2.1 && < 2.4 , + network-uri >= 2.6 && < 2.7 , + optparse-applicative >= 0.14.0.0 && < 0.20, parsers >= 0.12.4 && < 0.13, - prettyprinter >= 1.2.0.1 && < 1.3 , - prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , + parser-combinators , + prettyprinter >= 1.7.0 && < 1.8 , + prettyprinter-ansi-terminal >= 1.1.2 && < 1.2 , + pretty-simple < 4.2 , + repline >= 0.4.0.0 && < 0.5 , + serialise >= 0.2.0.0 && < 0.3 , scientific >= 0.3.0.0 && < 0.4 , - text >= 0.11.1.0 && < 1.3 , - text-format < 0.4 , - transformers >= 0.2.0.0 && < 0.6 , - trifecta >= 1.6 && < 1.8 , + template-haskell >= 2.13.0.0 && < 2.24, + text >= 0.11.1.0 && < 2.2 , + text-manipulate >= 0.2.0.1 && < 0.4 , + text-short >= 0.1 && < 0.2 , + th-lift-instances >= 0.1.13 && < 0.2 , + time >= 1.9 && < 1.15, + transformers >= 0.5.2.0 && < 0.7 , + unix-compat >= 0.4.2 && < 0.8 , unordered-containers >= 0.1.3.0 && < 0.3 , - vector >= 0.11.0.0 && < 0.13 + vector >= 0.11.0.0 && < 0.14 + + if !os(windows) + Build-Depends: + unix >= 2.7 && < 2.9 , + + if flag(with-http) + CPP-Options: + -DWITH_HTTP + if flag(use-http-client-tls) + CPP-Options: + -DUSE_HTTP_CLIENT_TLS + if flag(network-tests) + CPP-Options: + -DNETWORK_TESTS + if flag(cross) + CPP-Options: -DCROSS + + GHC-Options: -Wall -Wcompat -Wincomplete-uni-patterns -optP-Wno-unicode-homoglyph + +Library + Import: common + Hs-Source-Dirs: src + if impl(ghcjs) + Hs-Source-Dirs: ghcjs-src + Build-Depends: + ghcjs-base , + ghcjs-xhr + else + Hs-Source-Dirs: ghc-src + Build-Depends: + cryptohash-sha256 + if flag(with-http) + Build-Depends: + http-types >= 0.7.0 && < 0.13, + http-client >= 0.5.0 && < 0.8 + if flag(use-http-client-tls) + Build-Depends: + http-client-tls >= 0.2.0 && < 0.4 + + Other-Extensions: + BangPatterns + CPP + DefaultSignatures + DeriveAnyClass + DeriveDataTypeable + DeriveFunctor + DeriveGeneric + DeriveTraversable + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + MultiParamTypeClasses + NamedFieldPuns + OverloadedLists + OverloadedStrings + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeFamilies + TypeOperators + UnicodeSyntax + if !flag(cross) + Other-Extensions: + TemplateHaskell + Exposed-Modules: - Dhall, - Dhall.Context, - Dhall.Core, - Dhall.Import, - Dhall.Parser, - Dhall.Pretty, - Dhall.Tutorial, + Dhall + Dhall.Binary + Dhall.Context + Dhall.Core + Dhall.Crypto + Dhall.Diff + Dhall.DirectoryTree + Dhall.Format + Dhall.Freeze + Dhall.Import + Dhall.Lint + Dhall.Main + Dhall.Marshal.Decode + Dhall.Marshal.Encode + Dhall.Map + Dhall.Optics + Dhall.Package + Dhall.Parser + Dhall.Parser.Expression + Dhall.Parser.Token + Dhall.Pretty + Dhall.Repl + Dhall.Schemas + Dhall.Set + Dhall.Src + Dhall.Substitution + Dhall.Tags + Dhall.Tutorial Dhall.TypeCheck + Dhall.Util + Dhall.Version + if !flag(cross) + Exposed-Modules: + Dhall.TH + if impl(ghc >= 8.6.1) + Exposed-Modules: + Dhall.Deriving Other-Modules: + Dhall.DirectoryTree.Types + Dhall.Eval + Dhall.Import.Types + Dhall.Import.Headers + Dhall.Marshal.Internal + Dhall.Normalize + Dhall.Parser.Combinators Dhall.Pretty.Internal - GHC-Options: -Wall + Dhall.Syntax + Dhall.Syntax.Binding + Dhall.Syntax.Chunks + Dhall.Syntax.Const + Dhall.Syntax.Expr + Dhall.Syntax.FunctionBinding + Dhall.Syntax.Import + Dhall.Syntax.Instances.Applicative + Dhall.Syntax.Instances.Bifunctor + Dhall.Syntax.Instances.Data + Dhall.Syntax.Instances.Eq + Dhall.Syntax.Instances.Foldable + Dhall.Syntax.Instances.Functor + Dhall.Syntax.Instances.Lift + Dhall.Syntax.Instances.Monad + Dhall.Syntax.Instances.NFData + Dhall.Syntax.Instances.Ord + Dhall.Syntax.Instances.Pretty + Dhall.Syntax.Instances.Show + Dhall.Syntax.Instances.Traversable + Dhall.Syntax.MultiLet + Dhall.Syntax.Operations + Dhall.Syntax.RecordField + Dhall.Syntax.Types + Dhall.Syntax.Var + Dhall.URL + Paths_dhall + Autogen-Modules: + Paths_dhall + if flag(with-http) + Other-Modules: + Dhall.Import.HTTP + Dhall.Import.Manager + Default-Language: Haskell2010 + Executable dhall + Import: common Hs-Source-Dirs: dhall Main-Is: Main.hs - Build-Depends: - ansi-terminal >= 0.6.3.1 && < 0.9 , - base >= 4 && < 5 , - dhall , - optparse-generic >= 1.1.1 && < 1.4 , - prettyprinter , - prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , - trifecta >= 1.6 && < 1.8 , - text >= 0.11.1.0 && < 1.3 - GHC-Options: -Wall - Other-Modules: - Paths_dhall + Build-Depends: dhall + GHC-Options: -rtsopts + Default-Language: Haskell2010 -Executable dhall-repl - Hs-Source-Dirs: dhall-repl - Main-Is: Main.hs +Test-Suite tasty + Import: common + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: tests + Main-Is: Dhall/Test/Main.hs + Other-Modules: + Dhall.Test.Dhall + Dhall.Test.Diff + Dhall.Test.DirectoryTree + Dhall.Test.Tags + Dhall.Test.Format + Dhall.Test.Freeze + Dhall.Test.Import + Dhall.Test.Lint + Dhall.Test.Normalization + Dhall.Test.Package + Dhall.Test.Parser + Dhall.Test.QuickCheck + Dhall.Test.Regression + Dhall.Test.Schemas + Dhall.Test.SemanticHash + Dhall.Test.Substitution + Dhall.Test.Tutorial + Dhall.Test.TypeInference + Dhall.Test.Util + if !flag(cross) + Other-Modules: + Dhall.Test.TH Build-Depends: - base >= 4 && < 5 , - ansi-terminal , - dhall , - haskeline >= 0.7.3.0 && < 0.8 , - mtl >= 2.2.1 && < 2.3 , - repline >= 0.1.6.0 && < 0.2 , - prettyprinter , - prettyprinter-ansi-terminal , - text , - trifecta - GHC-Options: -Wall + dhall , + foldl < 1.5 , + generic-random >= 1.3.0.0 && < 1.6 , + http-client , + http-client-tls , + QuickCheck >= 2.14 && < 2.17, + quickcheck-instances >= 0.3.12 && < 0.4 , + special-values < 0.2 , + spoon < 0.4 , + tasty >= 0.11.2 && < 1.6 , + tasty-expected-failure < 0.13, + tasty-hunit >= 0.10 && < 0.11, + tasty-quickcheck >= 0.9.2 && < 0.12, + tasty-silver < 3.4 , + temporary >= 1.2.1 && < 1.4 , + turtle >= 1.6 && < 1.7 , + Default-Language: Haskell2010 -Executable dhall-format - Hs-Source-Dirs: dhall-format +Test-Suite doctest + Import: common + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: doctest Main-Is: Main.hs Build-Depends: - base >= 4 && < 5 , - ansi-terminal >= 0.6.3.1 && < 0.9 , - dhall , - optparse-generic >= 1.1.1 && < 1.4 , - prettyprinter >= 1.2.0.1 && < 1.3 , - prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , - trifecta >= 1.6 && < 1.8 , - text >= 0.11.1.0 && < 1.3 - GHC-Options: -Wall - Other-Modules: - Paths_dhall + mockery < 0.4 , + doctest >= 0.7.0 + if os(windows) + -- https://github.com/dhall-lang/dhall-haskell/issues/2237 + Buildable: False + Default-Language: Haskell2010 -Executable dhall-hash - Hs-Source-Dirs: dhall-hash +Benchmark dhall-parser + Import: common + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: benchmark/parser Main-Is: Main.hs Build-Depends: - base >= 4 && < 5 , - dhall , - optparse-generic >= 1.1.1 && < 1.4, - trifecta >= 1.6 && < 1.8, - text >= 0.11.1.0 && < 1.3 - Other-Modules: - Paths_dhall + dhall , + tasty-bench >= 0.4 && < 0.5, + Default-Language: Haskell2010 + Other-Extensions: + TypeApplications + Ghc-Options: -rtsopts -Test-Suite test +Benchmark deep-nested-large-record + Import: common Type: exitcode-stdio-1.0 - Hs-Source-Dirs: tests - Main-Is: Tests.hs - GHC-Options: -Wall - Other-Modules: - Format - Normalization - Parser - Regression - Tutorial - TypeCheck - Util + Hs-Source-Dirs: benchmark/deep-nested-large-record + Main-Is: Main.hs Build-Depends: - base >= 4 && < 5 , - deepseq >= 1.2.0.1 && < 1.5 , - dhall , - insert-ordered-containers , - prettyprinter , - tasty >= 0.11.2 && < 1.1 , - tasty-hunit >= 0.9.2 && < 0.11, - text >= 0.11.1.0 && < 1.3 , - vector >= 0.11.0.0 && < 0.13 + dhall , + tasty-bench >= 0.4 && < 0.5, + Default-Language: Haskell2010 diff --git a/dhall/Main.hs b/dhall/Main.hs --- a/dhall/Main.hs +++ b/dhall/Main.hs @@ -1,117 +1,6 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeOperators #-} - module Main where -import Control.Exception (SomeException) -import Control.Monad (when) -import Data.Monoid (mempty) -import Data.Version (showVersion) -import Dhall.Core (normalize) -import Dhall.Import (Imported(..), load) -import Dhall.Parser (Src) -import Dhall.Pretty (annToAnsiStyle, prettyExpr) -import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X) -import Options.Generic (Generic, ParseRecord, Wrapped, type ()(..), (:::)) -import System.Exit (exitFailure, exitSuccess) -import Text.Trifecta.Delta (Delta(..)) - -import qualified Paths_dhall as Meta - -import qualified Control.Exception -import qualified Data.Text.Lazy.IO -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty -import qualified Dhall.Parser -import qualified Dhall.TypeCheck -import qualified Options.Generic -import qualified System.Console.ANSI -import qualified System.IO - -data Options w = Options - { explain :: w ::: Bool "Explain error messages in more detail" - , version :: w ::: Bool "Display version and exit" - , plain :: w ::: Bool "Disable syntax highlighting" - } deriving (Generic) - -instance ParseRecord (Options Wrapped) - -opts :: Pretty.LayoutOptions -opts = - Pretty.defaultLayoutOptions - { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } +import qualified Dhall.Main main :: IO () -main = do - Options {..} <- Options.Generic.unwrapRecord "Compiler for the Dhall language" - when version $ do - putStrLn (showVersion Meta.version) - exitSuccess - - let handle = - Control.Exception.handle handler2 - . Control.Exception.handle handler1 - . Control.Exception.handle handler0 - where - handler0 e = do - let _ = e :: TypeError Src X - System.IO.hPutStrLn System.IO.stderr "" - if explain - then Control.Exception.throwIO (DetailedTypeError e) - else do - Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" - Control.Exception.throwIO e - - handler1 (Imported ps e) = do - let _ = e :: TypeError Src X - System.IO.hPutStrLn System.IO.stderr "" - if explain - then Control.Exception.throwIO (Imported ps (DetailedTypeError e)) - else do - Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" - Control.Exception.throwIO (Imported ps e) - - handler2 e = do - let _ = e :: SomeException - System.IO.hSetEncoding System.IO.stderr System.IO.utf8 - System.IO.hPrint System.IO.stderr e - System.Exit.exitFailure - - handle (do - System.IO.hSetEncoding System.IO.stdin System.IO.utf8 - inText <- Data.Text.Lazy.IO.getContents - - expr <- case Dhall.Parser.exprFromText (Directed "(stdin)" 0 0 0 0) inText of - Left err -> Control.Exception.throwIO err - Right x -> return x - - let render h e = do - let doc = prettyExpr e - - let layoutOptions = opts - let stream = Pretty.layoutSmart layoutOptions doc - - supportsANSI <- System.Console.ANSI.hSupportsANSI h - let ansiStream = - if supportsANSI && not plain - then fmap annToAnsiStyle stream - else Pretty.unAnnotateS stream - - Pretty.renderIO h ansiStream - Data.Text.Lazy.IO.hPutStrLn h "" - - - expr' <- load expr - - typeExpr <- case Dhall.TypeCheck.typeOf expr' of - Left err -> Control.Exception.throwIO err - Right typeExpr -> return typeExpr - - render System.IO.stderr (normalize typeExpr) - Data.Text.Lazy.IO.hPutStrLn System.IO.stderr mempty - render System.IO.stdout (normalize expr') ) +main = Dhall.Main.main diff --git a/doctest/Main.hs b/doctest/Main.hs new file mode 100644 --- /dev/null +++ b/doctest/Main.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE CPP #-} + +module Main (main) where + +import System.FilePath (()) + +import qualified GHC.IO.Encoding +import qualified System.Directory +import qualified System.Environment +import qualified System.IO +import qualified Test.DocTest +import qualified Test.Mockery.Directory + +main :: IO () +main = do + GHC.IO.Encoding.setLocaleEncoding System.IO.utf8 + args <- System.Environment.getArgs + pwd <- System.Directory.getCurrentDirectory + prefix <- System.Directory.makeAbsolute pwd + let src = prefix "src" + + System.Environment.setEnv "XDG_CACHE_HOME" (pwd ".cache") + + Test.Mockery.Directory.inTempDirectory $ do + writeFile "makeBools.dhall" "λ(n : Bool) → [ n && True, n && False, n || True, n || False ]" + writeFile "bool1" "True" + writeFile "bool2" "False" + writeFile "both" "./bool1 && ./bool2" + writeFile "file2" "./file1" + writeFile "file1" "./file2" + writeFile "simon.dhall" $ unlines + [ "let Name = Text" + , "let Font = < Arial | `Comic Sans` | Helvetica | `Times New Roman` >" + , "let Person = { name : Name, favoriteFont : Font }" + , "in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person" + ] + + Test.DocTest.doctest $ + [ "-DWITH_HTTP" + , "-DUSE_HTTP_CLIENT_TLS" + , "--fast" + ] <> args <> + [ prefix "ghc-src" + + -- Unfortunately we cannot target the entire @src@ directory. + -- The reason is that src/Dhall/Version.hs depends on + -- the generated Paths_dhall module which is "out-of-scope" + -- when running the testsuite with cabal v1-test. + -- Instead, we target a selection of modules whose combined module + -- dependency tree covers all modules that contain doctests. + + -- , src + , "-i" <> src +#if __GLASGOW_HASKELL__ >= 806 + , src "Dhall/Deriving.hs" +#endif + , src "Dhall/Tags.hs" + , src "Dhall/Tutorial.hs" + ] diff --git a/ghc-src/Dhall/Crypto.hs b/ghc-src/Dhall/Crypto.hs new file mode 100644 --- /dev/null +++ b/ghc-src/Dhall/Crypto.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +{-| This module provides implementations of cryptographic utilities that only + work for GHC (as opposed to GHCJS) +-} + +module Dhall.Crypto ( + SHA256Digest(..) + , sha256DigestFromByteString + , sha256Hash + , toString + ) where + +import Control.DeepSeq (NFData) +import Data.ByteString (ByteString) +import Data.Data (Data) +import GHC.Generics (Generic) + +import qualified Crypto.Hash.SHA256 +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as ByteString.Char8 + +-- | A SHA256 digest +newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } + deriving (Data, Eq, Generic, Ord, NFData) + +instance Show SHA256Digest where + show = toString + +{-| Attempt to interpret a `ByteString` as a `SHA256Digest`, returning + `Nothing` if the conversion fails +-} +sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest +sha256DigestFromByteString bytes + | ByteString.length bytes == 32 = Just (SHA256Digest bytes) + | otherwise = Nothing + +-- | Hash a `ByteString` and return the hash as a `SHA256Digest` +sha256Hash :: ByteString -> SHA256Digest +sha256Hash = SHA256Digest . Crypto.Hash.SHA256.hash + +-- | 'String' representation of a 'SHA256Digest' +toString :: SHA256Digest -> String +toString (SHA256Digest bytes) = ByteString.Char8.unpack $ Base16.encode bytes diff --git a/ghc-src/Dhall/Import/HTTP.hs b/ghc-src/Dhall/Import/HTTP.hs new file mode 100644 --- /dev/null +++ b/ghc-src/Dhall/Import/HTTP.hs @@ -0,0 +1,320 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.Import.HTTP + ( fetchFromHttpUrl + , fetchFromHttpUrlBytes + , originHeadersFileExpr + ) where + +import Control.Exception (Exception) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.State.Strict (StateT) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) +import Data.Dynamic (toDyn) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text.Encoding (decodeUtf8) +import Dhall.Core + ( Expr (..) + , Directory (..) + , File (..) + , FilePrefix (..) + , Import (..) + , ImportHashed (..) + , ImportMode (..) + , ImportType (..) + , Scheme (..) + , URL (..) + ) +import Dhall.Import.Types +import Dhall.Parser (Src) +import Dhall.URL (renderURL) +import System.Directory (getXdgDirectory, XdgDirectory(XdgConfig)) +import System.FilePath (splitDirectories) + + +import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..)) + +import qualified Control.Exception +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.ByteString.Lazy as ByteString.Lazy +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Text as Text +import qualified Data.Text.Encoding +import qualified Dhall.Util +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Types + +mkPrettyHttpException :: String -> HttpException -> PrettyHttpException +mkPrettyHttpException url ex = + PrettyHttpException (renderPrettyHttpException url ex) (toDyn ex) + +renderPrettyHttpException :: String -> HttpException -> String +renderPrettyHttpException _ (InvalidUrlException _ r) = + "\n" + <> "\ESC[1;31mError\ESC[0m: Invalid URL\n" + <> "\n" + <> "URL: " <> show r <> "\n" +renderPrettyHttpException url (HttpExceptionRequest _ e) = + case e of + ConnectionFailure _ -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Remote host not found\n" + <> "\n" + <> "URL: " <> url <> "\n" + InvalidDestinationHost host -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Invalid remote host name:\n" + <> "\n" + <> "Host: " <> show host <> "\n" + ResponseTimeout -> + "\n" + <> "\ESC[1;31mError\ESC[0m: The remote host took too long to respond\n" + <> "\n" + <> "URL: " <> url <> "\n" + ConnectionTimeout -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Connection establishment took too long\n" + <> "\n" + <> "URL: " <> url <> "\n" + StatusCodeException response body -> prefix <> suffix + where + prefix + | statusCode == 401 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Access unauthorized\n" + | statusCode == 403 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Access forbidden\n" + | statusCode == 404 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Remote file not found\n" + | statusCode == 500 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Server-side failure\n" + | statusCode == 502 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Upstream failure\n" + | statusCode == 503 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Server temporarily unavailable\n" + | statusCode == 504 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Upstream timeout\n" + | otherwise = + "\n" + <> "\ESC[1;31mError\ESC[0m: HTTP request failure\n" + + suffix = + "\n" + <> "HTTP status code: " <> show statusCode <> "\n" + <> "\n" + <> "URL: " <> url <> "\n" + <> message + + statusCode = + Network.HTTP.Types.statusCode + (HTTP.responseStatus response) + + message = + case Data.Text.Encoding.decodeUtf8' body of + Left _ -> + "\n" + <> "Message (non-UTF8 bytes):\n" + <> "\n" + <> truncatedBodyString <> "\n" + where + bodyString = show body + + dots = "…" + + truncatedLength = 80 - length dots + + truncatedBodyString + | truncatedLength < length bodyString = + take truncatedLength bodyString <> dots + | otherwise = + bodyString + Right "" -> + "" + Right bodyText -> + "\n" + <> "Message:\n" + <> "\n" + <> Text.unpack prefixedText + where + prefixedLines = + zipWith combine prefixes (Text.lines bodyText) + where + prefixes = + map (Text.pack . show) [(1 ::Int)..7] ++ [ "…" ] + + combine n line = n <> "│ " <> line + + prefixedText = Text.unlines prefixedLines + + e' -> "\n" + <> "\ESC[1;31mError\ESC[0m: " <> show e' + <> "\n" + <> "URL: " <> url <> "\n" + +newManager :: StateT Status IO Manager +newManager = do + Status { _manager = oldManager, ..} <- State.get + + case oldManager of + Nothing -> do + manager <- liftIO _newManager + + State.put (Status { _manager = Just manager , ..}) + + return manager + + Just manager -> + return manager + +data NotCORSCompliant = NotCORSCompliant + { expectedOrigins :: [ByteString] + , actualOrigin :: ByteString + } + +instance Exception NotCORSCompliant + +instance Show NotCORSCompliant where + show (NotCORSCompliant {..}) = + Dhall.Util._ERROR <> ": Not CORS compliant\n" + <> "\n" + <> "Dhall supports transitive imports, meaning that an imported expression can\n" + <> "import other expressions. However, a remote import (the \"parent\" import)\n" + <> "cannot import another remote import (the \"child\" import) unless the child\n" + <> "import grants permission to do using CORS. The child import must respond with\n" + <> "an `Access-Control-Allow-Origin` response header that matches the parent\n" + <> "import, otherwise Dhall rejects the import.\n" + <> "\n" <> prologue + where + prologue = + case expectedOrigins of + [ expectedOrigin ] -> + "The following parent import:\n" + <> "\n" + <> "↳ " <> show actualOrigin <> "\n" + <> "\n" + <> "... did not match the expected origin:\n" + <> "\n" + <> "↳ " <> show expectedOrigin <> "\n" + <> "\n" + <> "... so import resolution failed.\n" + [] -> + "The child response did not include any `Access-Control-Allow-Origin` header,\n" + <> "so import resolution failed.\n" + _:_:_ -> + "The child response included more than one `Access-Control-Allow-Origin` header,\n" + <> "when only one such header should have been present, so import resolution\n" + <> "failed.\n" + <> "\n" + <> "This may indicate that the server for the child import is misconfigured.\n" + +corsCompliant + :: MonadIO io + => ImportType -> URL -> [(CI ByteString, ByteString)] -> io () +corsCompliant (Remote parentURL) childURL responseHeaders = liftIO $ do + let toOrigin (URL {..}) = + Data.Text.Encoding.encodeUtf8 (prefix <> "://" <> authority) + where + prefix = + case scheme of + HTTP -> "http" + HTTPS -> "https" + + let actualOrigin = toOrigin parentURL + + let childOrigin = toOrigin childURL + + let predicate (header, _) = header == "Access-Control-Allow-Origin" + + let originHeaders = filter predicate responseHeaders + + let expectedOrigins = map snd originHeaders + + case expectedOrigins of + [expectedOrigin] + | expectedOrigin == "*" -> + return () + | expectedOrigin == actualOrigin -> + return () + _ | actualOrigin == childOrigin -> + return () + | otherwise -> + Control.Exception.throwIO (NotCORSCompliant {..}) +corsCompliant _ _ _ = return () + +addHeaders :: OriginHeaders -> Maybe [HTTPHeader] -> HTTP.Request -> HTTP.Request +addHeaders originHeaders urlHeaders request = + request { HTTP.requestHeaders = (filterHeaders urlHeaders) <> perOriginHeaders } + where + origin = decodeUtf8 (HTTP.host request) <> ":" <> Text.pack (show (HTTP.port request)) + + perOriginHeaders = HashMap.lookupDefault [] origin originHeaders + + filterHeaders = foldMap (filter (not . overridden)) + + overridden :: HTTPHeader -> Bool + overridden (key, _value) = any (matchesKey key) perOriginHeaders + + matchesKey :: CI ByteString -> HTTPHeader -> Bool + matchesKey key (candidate, _value) = key == candidate + +fetchFromHttpUrlBytes + :: URL -> Maybe [HTTPHeader] -> StateT Status IO ByteString +fetchFromHttpUrlBytes childURL mheaders = do + Status { _loadOriginHeaders } <- State.get + + originHeaders <- _loadOriginHeaders + + manager <- newManager + + let childURLString = Text.unpack (renderURL childURL) + + baseRequest <- liftIO (HTTP.parseUrlThrow childURLString) + + let requestWithHeaders = addHeaders originHeaders mheaders baseRequest + + let io = HTTP.httpLbs requestWithHeaders manager + + let handler e = do + let _ = e :: HttpException + Control.Exception.throwIO (mkPrettyHttpException childURLString e) + + response <- liftIO (Control.Exception.handle handler io) + + Status {..} <- State.get + + case _stack of + -- We ignore the first import in the stack since that is the same import + -- as the `childUrl` + _ :| Chained parentImport : _ -> do + let parentImportType = importType (importHashed parentImport) + + corsCompliant parentImportType childURL (HTTP.responseHeaders response) + _ -> do + return () + + return (ByteString.Lazy.toStrict (HTTP.responseBody response)) + +fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text +fetchFromHttpUrl childURL mheaders = do + bytes <- fetchFromHttpUrlBytes childURL mheaders + + case Data.Text.Encoding.decodeUtf8' bytes of + Left err -> liftIO (Control.Exception.throwIO err) + Right text -> return text + +originHeadersFileExpr :: IO (Expr Src Import) +originHeadersFileExpr = do + directoryStr <- getXdgDirectory XdgConfig "dhall" + let components = map Text.pack (splitDirectories directoryStr) + let directory = Directory (reverse components) + let file = (File directory "headers.dhall") + return (Embed (Import (ImportHashed Nothing (Local Absolute file)) Code)) diff --git a/ghc-src/Dhall/Import/Manager.hs b/ghc-src/Dhall/Import/Manager.hs new file mode 100644 --- /dev/null +++ b/ghc-src/Dhall/Import/Manager.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} + +{-| Both the GHC and GHCJS implementations of 'Dhall.Import.Manager.Manager' + export a `Dhall.Import.Manager.Manager` type suitable for use within the + "Dhall.Import" module + + For the GHC implementation the `Dhall.Import.Manager` type is a real + `Network.HTTP.Client.Manager` from the @http-client@ package. For the + GHCJS implementation the `Dhall.Import.Manager.Manager` type is + a synonym for @`Data.Void.Void`@ since GHCJS does not use a + `Network.HTTP.Client.Manager` for HTTP requests. +-} +module Dhall.Import.Manager + ( -- * Manager + Manager + , defaultNewManager + ) where + +import Network.HTTP.Client (Manager, newManager) +import qualified Network.HTTP.Client as HTTP + +#ifdef USE_HTTP_CLIENT_TLS +import Network.HTTP.Client.TLS (tlsManagerSettings) +#endif + +defaultNewManager :: IO Manager +defaultNewManager = newManager +#ifdef USE_HTTP_CLIENT_TLS + tlsManagerSettings +#else + HTTP.defaultManagerSettings +#endif + { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (30 * 1000 * 1000) } -- 30 seconds diff --git a/ghcjs-src/Dhall/Crypto.hs b/ghcjs-src/Dhall/Crypto.hs new file mode 100644 --- /dev/null +++ b/ghcjs-src/Dhall/Crypto.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE JavaScriptFFI #-} + +{-| This module provides implementations of cryptographic utilities that only + work for GHCJS +-} + +module Dhall.Crypto ( + SHA256Digest(..) + , sha256DigestFromByteString + , sha256Hash + ) where + +import Control.DeepSeq (NFData) +import Data.ByteString (ByteString) +import Data.Data (Data) +import GHC.Generics (Generic) +import JavaScript.TypedArray.ArrayBuffer (ArrayBuffer) +import System.IO.Unsafe (unsafePerformIO) + +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as ByteString.Char8 +import qualified GHCJS.Buffer as Buffer + +-- | A SHA256 digest +newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } + deriving (Data, Eq, Generic, Ord, NFData) + +instance Show SHA256Digest where + show (SHA256Digest bytes) = ByteString.Char8.unpack $ Base16.encode bytes + +{-| Attempt to interpret a `ByteString` as a `SHA256Digest`, returning + `Nothing` if the conversion fails +-} +sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest +sha256DigestFromByteString bytes + | ByteString.length bytes == 32 = Just (SHA256Digest bytes) + | otherwise = Nothing + +-- Use NodeJS' crypto module if there's a 'process' module, e.g. we're running +-- inside GHCJS' THRunner. If we're running in the browser, use the WebCrypto +-- interface. +foreign import javascript interruptible + "if (typeof process === 'undefined') { \ + \ crypto.subtle.digest('SHA-256', $1).then($c) \ + \} else { \ + \ $c(require('crypto').createHash('sha256').update(Buffer.from($1)).digest().buffer) \ + \}" + js_sha256Hash :: ArrayBuffer -> IO ArrayBuffer + +byteStringToArrayBuffer :: ByteString -> ArrayBuffer +byteStringToArrayBuffer b = + js_arrayBufferSlice offset len $ Buffer.getArrayBuffer buffer + where + (buffer, offset, len) = Buffer.fromByteString b + +foreign import javascript unsafe "$3.slice($1, $1 + $2)" + js_arrayBufferSlice :: Int -> Int -> ArrayBuffer -> ArrayBuffer + +arrayBufferToByteString :: ArrayBuffer -> ByteString +arrayBufferToByteString = + Buffer.toByteString 0 Nothing . Buffer.createFromArrayBuffer + +-- | Hash a `ByteString` and return the hash as a `SHA256Digest` +sha256Hash :: ByteString -> SHA256Digest +sha256Hash bytes + | ByteString.length out == 32 = SHA256Digest out + | otherwise = error "sha256Hash: didn't produce 32 bytes" + where + out = + arrayBufferToByteString $ + unsafePerformIO $ js_sha256Hash (byteStringToArrayBuffer bytes) diff --git a/ghcjs-src/Dhall/Import/HTTP.hs b/ghcjs-src/Dhall/Import/HTTP.hs new file mode 100644 --- /dev/null +++ b/ghcjs-src/Dhall/Import/HTTP.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Import.HTTP + ( fetchFromHttpUrl + , fetchFromHttpUrlBytes + , originHeadersFileExpr + ) where + +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.State.Strict (StateT) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) +import Dhall.Core (URL (..), Expr (..)) +import Dhall.Import.Types (Import, Status) +import Dhall.Parser (Src) +import Dhall.URL (renderURL) + +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text.Encoding +import qualified JavaScript.XHR + +fetchFromHttpUrl + :: URL + -> Maybe [(CI ByteString, ByteString)] + -> StateT Status IO Text.Text +fetchFromHttpUrl childURL Nothing = do + let childURLText = renderURL childURL + + let childURLString = Text.unpack childURLText + + -- No need to add a CORS compliance check when using GHCJS. The browser + -- will already check the CORS compliance of the following XHR + (statusCode, body) <- liftIO (JavaScript.XHR.get childURLText) + + case statusCode of + 200 -> return () + _ -> fail (childURLString <> " returned a non-200 status code: " <> show statusCode) + + return body +fetchFromHttpUrl _ _ = + fail "Dhall does not yet support custom headers when built using GHCJS" + +fetchFromHTTPUrlBytes + :: URL + -> Maybe [(CI ByteString, ByteString)] + -> StateT Status IO ByteString +fetchFromHTTPUrlBytes childUrl mheader = do + text <- fetchFromHTTPUrl childUrl mheader + return (Text.Encoding.encodeUtf8 text) + +originHeadersFileExpr :: IO (Expr Src Import) +originHeadersFileExpr = return Missing diff --git a/ghcjs-src/Dhall/Import/Manager.hs b/ghcjs-src/Dhall/Import/Manager.hs new file mode 100644 --- /dev/null +++ b/ghcjs-src/Dhall/Import/Manager.hs @@ -0,0 +1,26 @@ +{-| Both the GHC and GHCJS implementations of `Dhall.Import.Manager.Manager` + export a `Dhall.Import.Manager.Manager` type suitable for use within the + "Dhall.Import" module + + For the GHC implementation the `Dhall.Import.Manager.Manager` type is a real + `Network.HTTP.Client.Manager` from the @http-client@ package. For the GHCJS + implementation the `Dhall.Import.Manager.Manager` type is a synonym for + @`Data.Void.Void`@ since GHCJS does not use a + `Network.HTTP.Client.Manager` for HTTP requests. +-} +module Dhall.Import.Manager + ( -- * Manager + Manager + , defaultNewManager + ) where + +{-| The GHCJS implementation does not require a `Network.HTTP.Client.Manager` + + The purpose of this synonym is so that "Dhall.Import.Types" can import a + `Dhall.Import.Manager.Manager` type from "Dhall.Import.HTTP" that does the + correct thing for both the GHC and GHCJS implementations +-} +type Manager = () + +defaultNewManager :: IO Manager +defaultNewManager = pure () diff --git a/man/dhall.1 b/man/dhall.1 new file mode 100644 --- /dev/null +++ b/man/dhall.1 @@ -0,0 +1,100 @@ +.\" Automatically generated by Pandoc 2.9.2 +.\" +.TH "dhall (1)" "" "" "" "" +.hy +.SH NAME +.PP +dhall - a programmable configuration language +.SH DESCRIPTION +.PP +\f[B]dhall\f[R] is the command-line interface to the Dhall language +.SH SYNOPSIS +.PP +dhall --file check.dhall +.PP +dhall --file error.dhall --explain +.PP +dhall hash --file to-hash.dhall +.PP +dhall freeze --file with-imports.dhall +.PP +dhall repl +.PP +dhall diff \[aq]./file1.dhall\[cq] \[aq]./file2.dhall\[cq] +.PP +dhall type --quiet --file check-ci.dhall +.SH SUBCOMMANDS +.PP +\f[B]version\f[R] - Display version information +.PP +\f[B]resolve\f[R] - Resolve imports +.PP +\f[B]type\f[R] - Infer type of expression +.PP +\f[B]normalize\f[R] - Normalize an expression +.PP +\f[B]repl\f[R] - Open a REPL +.PP +\f[B]diff\f[R] - Show difference between two expressions +.PP +\f[B]hash\f[R] - Compute hash of expression +.PP +\f[B]lint\f[R] - Lint an expression, removing dead code +.PP +\f[B]tags\f[R] - Generate etags (Emacs) file +.PP +\f[B]format\f[R] - Format an expression +.PP +\f[B]freeze\f[R] - Add hashes to import statements +.PP +\f[B]encode\f[R] - Encode a Dhall expression (CBOR) +.PP +\f[B]decode\f[R] - Decode a Dhall expression +.PP +\f[B]text\f[R] - Render a Dhall expression to text +.PP +\f[B]to-directory-tree\f[R] - Convert nested record of Text into a +directory +.SH OPTIONS +.TP +\f[B]-h\f[R] \f[B]--help\f[R] +Display help +.TP +\f[B]--file\f[R] +Name of file containing Dhall source +.TP +\f[B]--output\f[R] +Output file +.TP +\f[B]--annotate\f[R] +Add type annotation to output +.TP +\f[B]--alpha\f[R] +alpha-normalize output +.TP +\f[B]--no-cache\f[R] +Don\[cq]t use cache to resolve imports +.TP +\f[B]--explain\f[R] +Explain error messages in detail +.TP +\f[B]--version\f[R] +Display version information +.TP +\f[B]--plain\f[R] +Disable syntax highlighting in output +.TP +\f[B]--ascii\f[R] +Format code using only ASCII syntax +.TP +\f[B]--censor\f[R] +Hide source code from error messages +.SH EDITOR INTEGRATION +.PP +Up-to-date information on editor integration is available at: +.PP +https://docs.dhall-lang.org/howtos/Text-Editor-Configuration.html +.SH BUGS +.PP +Please report any bugs you may come across to +https://github.com/dhall-lang/dhall-haskell/issues. diff --git a/src/Dhall.hs b/src/Dhall.hs --- a/src/Dhall.hs +++ b/src/Dhall.hs @@ -1,1060 +1,579 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - -{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining - how to use the language, the compiler, and this library --} - -module Dhall - ( - -- * Input - input - , inputWith - , detailed - - -- * Types - , Type(..) - , InputType(..) - , Interpret(..) - , InvalidType(..) - , auto - , genericAuto - , InterpretOptions(..) - , defaultInterpretOptions - , bool - , natural - , integer - , scientific - , double - , lazyText - , strictText - , maybe - , sequence - , list - , vector - , unit - , string - , pair - , GenericInterpret(..) - , GenericInject(..) - - , Inject(..) - , inject - - -- * Miscellaneous - , rawInput - - -- * Re-exports - , Natural - , Seq - , Text - , Vector - , Generic - ) where - -import Control.Applicative (empty, liftA2, (<|>), Alternative) -import Control.Exception (Exception) -import Control.Monad.Trans.State.Strict -import Data.Functor.Contravariant (Contravariant(..)) -import Data.Monoid ((<>)) -import Data.Scientific (Scientific) -import Data.Sequence (Seq) -import Data.Text.Buildable (Buildable(..)) -import Data.Text.Lazy (Text) -import Data.Typeable (Typeable) -import Data.Vector (Vector) -import Data.Word (Word8, Word16, Word32, Word64) -import Dhall.Core (Expr(..), Chunks(..)) -import Dhall.Import (Imported(..)) -import Dhall.Parser (Src(..)) -import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X) -import GHC.Generics -import Numeric.Natural (Natural) -import Prelude hiding (maybe, sequence) -import Text.Trifecta.Delta (Delta(..)) - -import qualified Control.Exception -import qualified Data.ByteString.Lazy -import qualified Data.Foldable -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.Scientific -import qualified Data.Sequence -import qualified Data.Set -import qualified Data.Text -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Builder -import qualified Data.Text.Lazy.Encoding -import qualified Data.Vector -import qualified Dhall.Context -import qualified Dhall.Core -import qualified Dhall.Import -import qualified Dhall.Parser -import qualified Dhall.TypeCheck - -throws :: Exception e => Either e a -> IO a -throws (Left e) = Control.Exception.throwIO e -throws (Right r) = return r - -{-| Every `Type` must obey the contract that if an expression's type matches the - the `expected` type then the `extract` function must succeed. If not, then - this exception is thrown - - This exception indicates that an invalid `Type` was provided to the `input` - function --} -data InvalidType = InvalidType deriving (Typeable) - -_ERROR :: String -_ERROR = "\ESC[1;31mError\ESC[0m" - -instance Show InvalidType where - show InvalidType = - _ERROR <> ": Invalid Dhall.Type \n\ - \ \n\ - \Every Type must provide an extract function that succeeds if an expression \n\ - \matches the expected type. You provided a Type that disobeys this contract \n" - -instance Exception InvalidType - -{-| Type-check and evaluate a Dhall program, decoding the result into Haskell - - The first argument determines the type of value that you decode: - ->>> input integer "2" -2 ->>> input (vector double) "[1.0, 2.0]" -[1.0,2.0] - - Use `auto` to automatically select which type to decode based on the - inferred return type: - ->>> input auto "True" :: IO Bool -True --} -input - :: Type a - -- ^ The type of value to decode from Dhall to Haskell - -> Text - -- ^ The Dhall program - -> IO a - -- ^ The decoded value in Haskell -input ty txt = - inputWith ty Dhall.Context.empty (const Nothing) txt - -{-| Extend 'input' with a custom typing context and normalization process. - --} -inputWith - :: Type a - -- ^ The type of value to decode from Dhall to Haskell - -> Dhall.Context.Context (Expr Src X) - -- ^ The starting context for type-checking - -> Dhall.Core.Normalizer X - -> Text - -- ^ The Dhall program - -> IO a - -- ^ The decoded value in Haskell -inputWith (Type {..}) ctx n txt = do - let delta = Directed "(input)" 0 0 0 0 - expr <- throws (Dhall.Parser.exprFromText delta txt) - expr' <- Dhall.Import.loadWithContext ctx expr - let suffix = - ( Data.ByteString.Lazy.toStrict - . Data.Text.Lazy.Encoding.encodeUtf8 - . Data.Text.Lazy.Builder.toLazyText - . build - ) expected - let annot = case expr' of - Note (Src begin end bytes) _ -> - Note (Src begin end bytes') (Annot expr' expected) - where - bytes' = bytes <> " : " <> suffix - _ -> - Annot expr' expected - _ <- throws (Dhall.TypeCheck.typeWith ctx annot) - case extract (Dhall.Core.normalizeWith n expr') of - Just x -> return x - Nothing -> Control.Exception.throwIO InvalidType - --- | Use this function to extract Haskell values directly from Dhall AST. --- The intended use case is to allow easy extraction of Dhall values for --- making the function `Dhall.Core.normalizeWith` easier to use. --- --- For other use cases, use `input` from `Dhall` module. It will give you --- a much better user experience. -rawInput - :: Alternative f - => Type a - -- ^ The type of value to decode from Dhall to Haskell - -> Expr s X - -- ^ a closed form Dhall program, which evaluates to the expected type - -> f a - -- ^ The decoded value in Haskell -rawInput (Type {..}) expr = do - case extract (Dhall.Core.normalize expr) of - Just x -> pure x - Nothing -> empty - - - -{-| Use this to provide more detailed error messages - ->> input auto "True" :: IO Integer -> *** Exception: Error: Expression doesn't match annotation -> -> True : Integer -> -> (input):1:1 - ->> detailed (input auto "True") :: IO Integer -> *** Exception: Error: Expression doesn't match annotation -> -> Explanation: You can annotate an expression with its type or kind using the -> ❰:❱ symbol, like this: -> -> -> ┌───────┐ -> │ x : t │ ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱ -> └───────┘ -> -> The type checker verifies that the expression's type or kind matches the -> provided annotation -> -> For example, all of the following are valid annotations that the type checker -> accepts: -> -> -> ┌─────────────┐ -> │ 1 : Integer │ ❰1❱ is an expression that has type ❰Integer❱, so the type -> └─────────────┘ checker accepts the annotation -> -> -> ┌────────────────────────┐ -> │ Natural/even +2 : Bool │ ❰Natural/even +2❱ has type ❰Bool❱, so the type -> └────────────────────────┘ checker accepts the annotation -> -> -> ┌────────────────────┐ -> │ List : Type → Type │ ❰List❱ is an expression that has kind ❰Type → Type❱, -> └────────────────────┘ so the type checker accepts the annotation -> -> -> ┌──────────────────┐ -> │ List Text : Type │ ❰List Text❱ is an expression that has kind ❰Type❱, so -> └──────────────────┘ the type checker accepts the annotation -> -> -> However, the following annotations are not valid and the type checker will -> reject them: -> -> -> ┌──────────┐ -> │ 1 : Text │ The type checker rejects this because ❰1❱ does not have type -> └──────────┘ ❰Text❱ -> -> -> ┌─────────────┐ -> │ List : Type │ ❰List❱ does not have kind ❰Type❱ -> └─────────────┘ -> -> -> You or the interpreter annotated this expression: -> -> ↳ True -> -> ... with this type or kind: -> -> ↳ Integer -> -> ... but the inferred type or kind of the expression is actually: -> -> ↳ Bool -> -> Some common reasons why you might get this error: -> -> ● The Haskell Dhall interpreter implicitly inserts a top-level annotation -> matching the expected type -> -> For example, if you run the following Haskell code: -> -> -> ┌───────────────────────────────┐ -> │ >>> input auto "1" :: IO Text │ -> └───────────────────────────────┘ -> -> -> ... then the interpreter will actually type check the following annotated -> expression: -> -> -> ┌──────────┐ -> │ 1 : Text │ -> └──────────┘ -> -> -> ... and then type-checking will fail -> -> ──────────────────────────────────────────────────────────────────────────────── -> -> True : Integer -> -> (input):1:1 - --} -detailed :: IO a -> IO a -detailed = - Control.Exception.handle handler1 . Control.Exception.handle handler0 - where - handler0 :: Imported (TypeError Src X) -> IO a - handler0 (Imported ps e) = - Control.Exception.throwIO (Imported ps (DetailedTypeError e)) - - handler1 :: TypeError Src X -> IO a - handler1 e = Control.Exception.throwIO (DetailedTypeError e) - -{-| A @(Type a)@ represents a way to marshal a value of type @\'a\'@ from Dhall - into Haskell - - You can produce `Type`s either explicitly: - -> example :: Type (Vector Text) -> example = vector text - - ... or implicitly using `auto`: - -> example :: Type (Vector Text) -> example = auto - - You can consume `Type`s using the `input` function: - -> input :: Type a -> Text -> IO a --} -data Type a = Type - { extract :: Expr Src X -> Maybe a - -- ^ Extracts Haskell value from the Dhall expression - , expected :: Expr Src X - -- ^ Dhall type of the Haskell value - } - deriving (Functor) - -{-| Decode a `Bool` - ->>> input bool "True" -True --} -bool :: Type Bool -bool = Type {..} - where - extract (BoolLit b) = pure b - extract _ = Nothing - - expected = Bool - -{-| Decode a `Natural` - ->>> input natural "+42" -42 --} -natural :: Type Natural -natural = Type {..} - where - extract (NaturalLit n) = pure n - extract _ = empty - - expected = Natural - -{-| Decode an `Integer` - ->>> input integer "42" -42 --} -integer :: Type Integer -integer = Type {..} - where - extract (IntegerLit n) = pure n - extract _ = empty - - expected = Integer - -{-| Decode a `Scientific` - ->>> input scientific "1e1000000000" -1.0e1000000000 --} -scientific :: Type Scientific -scientific = Type {..} - where - extract (DoubleLit n) = pure n - extract _ = empty - - expected = Double - -{-| Decode a `Double` - ->>> input double "42.0" -42.0 --} -double :: Type Double -double = fmap Data.Scientific.toRealFloat scientific - -{-| Decode lazy `Text` - ->>> input lazyText "\"Test\"" -"Test" --} -lazyText :: Type Text -lazyText = Type {..} - where - extract (TextLit (Chunks [] t)) = pure (Data.Text.Lazy.Builder.toLazyText t) - extract _ = empty - - expected = Text - -{-| Decode strict `Text` - ->>> input strictText "\"Test\"" -"Test" --} -strictText :: Type Data.Text.Text -strictText = fmap Data.Text.Lazy.toStrict lazyText - -{-| Decode a `Maybe` - ->>> input (maybe integer) "[1] : Optional Integer" -Just 1 --} -maybe :: Type a -> Type (Maybe a) -maybe (Type extractIn expectedIn) = Type extractOut expectedOut - where - extractOut (OptionalLit _ es) = traverse extractIn es - extractOut _ = Nothing - - expectedOut = App Optional expectedIn - -{-| Decode a `Seq` - - ->>> input (sequence integer) "[1, 2, 3]" -[1,2,3] --} -sequence :: Type a -> Type (Seq a) -sequence (Type extractIn expectedIn) = Type extractOut expectedOut - where - extractOut (ListLit _ es) = traverse extractIn es - extractOut _ = Nothing - - expectedOut = App List expectedIn - -{-| Decode a list - ->>> input (list integer) "[1, 2, 3]" -[1,2,3] --} -list :: Type a -> Type [a] -list = fmap Data.Foldable.toList . sequence - -{-| Decode a `Vector` - ->>> input (vector integer) "[1, 2, 3]" -[1,2,3] --} -vector :: Type a -> Type (Vector a) -vector = fmap Data.Vector.fromList . list - -{-| Decode `()` from an empty record. - ->>> input unit "{=}" -() --} -unit :: Type () -unit = Type extractOut expectedOut - where - extractOut (RecordLit fields) - | Data.HashMap.Strict.InsOrd.null fields = return () - extractOut _ = Nothing - - expectedOut = Record Data.HashMap.Strict.InsOrd.empty - -{-| Decode a `String` - ->>> input string "\"ABC\"" -"ABC" - -"-} -string :: Type String -string = Data.Text.Lazy.unpack <$> lazyText - -{-| Given a pair of `Type`s, decode a tuple-record into their pairing. - ->>> input (pair natural bool) "{ _1 = +42, _2 = False }" -(42, False) --} -pair :: Type a -> Type b -> Type (a, b) -pair l r = Type extractOut expectedOut - where - extractOut (RecordLit fields) = - (,) <$> ( Data.HashMap.Strict.InsOrd.lookup "_1" fields >>= extract l ) - <*> ( Data.HashMap.Strict.InsOrd.lookup "_2" fields >>= extract r ) - extractOut _ = Nothing - - expectedOut = - Record - (Data.HashMap.Strict.InsOrd.fromList - [ ("_1", expected l) - , ("_2", expected r) - ] - ) - -{-| Any value that implements `Interpret` can be automatically decoded based on - the inferred return type of `input` - ->>> input auto "[1, 2, 3]" :: IO (Vector Integer) -[1,2,3] - - This class auto-generates a default implementation for records that - implement `Generic`. This does not auto-generate an instance for recursive - types. --} -class Interpret a where - autoWith:: InterpretOptions -> Type a - default autoWith - :: (Generic a, GenericInterpret (Rep a)) => InterpretOptions -> Type a - autoWith options = fmap GHC.Generics.to (evalState (genericAutoWith options) 1) - -instance Interpret Bool where - autoWith _ = bool - -instance Interpret Natural where - autoWith _ = natural - -instance Interpret Integer where - autoWith _ = integer - -instance Interpret Scientific where - autoWith _ = scientific - -instance Interpret Double where - autoWith _ = double - -instance {-# OVERLAPS #-} Interpret [Char] where - autoWith _ = string - -instance Interpret Text where - autoWith _ = lazyText - -instance Interpret Data.Text.Text where - autoWith _ = strictText - -instance Interpret a => Interpret (Maybe a) where - autoWith opts = maybe (autoWith opts) - -instance Interpret a => Interpret (Seq a) where - autoWith opts = sequence (autoWith opts) - -instance Interpret a => Interpret [a] where - autoWith = fmap (fmap Data.Vector.toList) autoWith - -instance Interpret a => Interpret (Vector a) where - autoWith opts = vector (autoWith opts) - -instance (Inject a, Interpret b) => Interpret (a -> b) where - autoWith opts = Type extractOut expectedOut - where - extractOut e = Just (\i -> case extractIn (Dhall.Core.normalize (App e (embed i))) of - Just o -> o - Nothing -> error "Interpret: You cannot decode a function if it does not have the correct type" ) - - expectedOut = Pi "_" declared expectedIn - - InputType {..} = inject - - Type extractIn expectedIn = autoWith opts - -deriving instance (Interpret a, Interpret b) => Interpret (a, b) - -{-| Use the default options for interpreting a configuration file - -> auto = autoWith defaultInterpretOptions --} -auto :: Interpret a => Type a -auto = autoWith defaultInterpretOptions - -{-| `genericAuto` is the default implementation for `auto` if you derive - `Interpret`. The difference is that you can use `genericAuto` without - having to explicitly provide an `Interpret` instance for a type as long as - the type derives `Generic` --} -genericAuto :: (Generic a, GenericInterpret (Rep a)) => Type a -genericAuto = fmap to (evalState (genericAutoWith defaultInterpretOptions) 1) - -{-| Use these options to tweak how Dhall derives a generic implementation of - `Interpret` --} -data InterpretOptions = InterpretOptions - { fieldModifier :: Text -> Text - -- ^ Function used to transform Haskell field names into their corresponding - -- Dhall field names - , constructorModifier :: Text -> Text - -- ^ Function used to transform Haskell constructor names into their - -- corresponding Dhall alternative names - } - -{-| Default interpret options, which you can tweak or override, like this: - -> autoWith -> (defaultInterpretOptions { fieldModifier = Data.Text.Lazy.dropWhile (== '_') }) --} -defaultInterpretOptions :: InterpretOptions -defaultInterpretOptions = InterpretOptions - { fieldModifier = id - , constructorModifier = id - } - -{-| This is the underlying class that powers the `Interpret` class's support - for automatically deriving a generic implementation --} -class GenericInterpret f where - genericAutoWith :: InterpretOptions -> State Int (Type (f a)) - -instance GenericInterpret f => GenericInterpret (M1 D d f) where - genericAutoWith options = do - res <- genericAutoWith options - pure (fmap M1 res) - -instance GenericInterpret V1 where - genericAutoWith _ = pure Type {..} - where - extract _ = Nothing - - expected = Union Data.HashMap.Strict.InsOrd.empty - -instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret f2) => GenericInterpret (M1 C c1 f1 :+: M1 C c2 f2) where - genericAutoWith options@(InterpretOptions {..}) = pure (Type {..}) - where - nL :: M1 i c1 f1 a - nL = undefined - - nR :: M1 i c2 f2 a - nR = undefined - - nameL = constructorModifier (Data.Text.Lazy.pack (conName nL)) - nameR = constructorModifier (Data.Text.Lazy.pack (conName nR)) - - extract (UnionLit name e _) - | name == nameL = fmap (L1 . M1) (extractL e) - | name == nameR = fmap (R1 . M1) (extractR e) - | otherwise = Nothing - extract _ = Nothing - - expected = - Union (Data.HashMap.Strict.InsOrd.fromList [(nameL, expectedL), (nameR, expectedR)]) - - Type extractL expectedL = evalState (genericAutoWith options) 1 - Type extractR expectedR = evalState (genericAutoWith options) 1 - -instance (Constructor c, GenericInterpret (f :+: g), GenericInterpret h) => GenericInterpret ((f :+: g) :+: M1 C c h) where - genericAutoWith options@(InterpretOptions {..}) = pure (Type {..}) - where - n :: M1 i c h a - n = undefined - - name = constructorModifier (Data.Text.Lazy.pack (conName n)) - - extract u@(UnionLit name' e _) - | name == name' = fmap (R1 . M1) (extractR e) - | otherwise = fmap L1 (extractL u) - extract _ = Nothing - - expected = - Union (Data.HashMap.Strict.InsOrd.insert name expectedR expectedL) - - Type extractL (Union expectedL) = evalState (genericAutoWith options) 1 - Type extractR expectedR = evalState (genericAutoWith options) 1 - -instance (Constructor c, GenericInterpret f, GenericInterpret (g :+: h)) => GenericInterpret (M1 C c f :+: (g :+: h)) where - genericAutoWith options@(InterpretOptions {..}) = pure (Type {..}) - where - n :: M1 i c f a - n = undefined - - name = constructorModifier (Data.Text.Lazy.pack (conName n)) - - extract u@(UnionLit name' e _) - | name == name' = fmap (L1 . M1) (extractL e) - | otherwise = fmap R1 (extractR u) - extract _ = Nothing - - expected = - Union (Data.HashMap.Strict.InsOrd.insert name expectedL expectedR) - - Type extractL expectedL = evalState (genericAutoWith options) 1 - Type extractR (Union expectedR) = evalState (genericAutoWith options) 1 - -instance (GenericInterpret (f :+: g), GenericInterpret (h :+: i)) => GenericInterpret ((f :+: g) :+: (h :+: i)) where - genericAutoWith options = pure (Type {..}) - where - extract e = fmap L1 (extractL e) <|> fmap R1 (extractR e) - - expected = Union (Data.HashMap.Strict.InsOrd.union expectedL expectedR) - - Type extractL (Union expectedL) = evalState (genericAutoWith options) 1 - Type extractR (Union expectedR) = evalState (genericAutoWith options) 1 - -instance GenericInterpret f => GenericInterpret (M1 C c f) where - genericAutoWith options = do - res <- genericAutoWith options - pure (fmap M1 res) - -instance GenericInterpret U1 where - genericAutoWith _ = pure (Type {..}) - where - extract _ = Just U1 - - expected = Record (Data.HashMap.Strict.InsOrd.fromList []) - -instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g) where - genericAutoWith options = do - Type extractL expectedL <- genericAutoWith options - Type extractR expectedR <- genericAutoWith options - let Record ktsL = expectedL - let Record ktsR = expectedR - pure - (Type - { extract = liftA2 (liftA2 (:*:)) extractL extractR - , expected = Record (Data.HashMap.Strict.InsOrd.union ktsL ktsR) - } - ) - -getSelName :: Selector s => M1 i s f a -> State Int String -getSelName n = case selName n of - "" -> do i <- get - put (i + 1) - pure ("_" ++ show i) - nn -> pure nn - -instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where - genericAutoWith opts@(InterpretOptions {..}) = do - name <- getSelName n - let extract (RecordLit m) = do - let name' = fieldModifier (Data.Text.Lazy.pack name) - e <- Data.HashMap.Strict.InsOrd.lookup name' m - fmap (M1 . K1) (extract' e) - extract _ = Nothing - let expected = - Record (Data.HashMap.Strict.InsOrd.fromList [(key, expected')]) - where - key = fieldModifier (Data.Text.Lazy.pack name) - pure (Type {..}) - where - n :: M1 i s f a - n = undefined - - Type extract' expected' = autoWith opts - -{-| An @(InputType a)@ represents a way to marshal a value of type @\'a\'@ from - Haskell into Dhall --} -data InputType a = InputType - { embed :: a -> Expr Src X - -- ^ Embeds a Haskell value as a Dhall expression - , declared :: Expr Src X - -- ^ Dhall type of the Haskell value - } - -instance Contravariant InputType where - contramap f (InputType embed declared) = InputType embed' declared - where - embed' x = embed (f x) - -{-| This class is used by `Interpret` instance for functions: - -> instance (Inject a, Interpret b) => Interpret (a -> b) - - You can convert Dhall functions with "simple" inputs (i.e. instances of this - class) into Haskell functions. This works by: - - * Marshaling the input to the Haskell function into a Dhall expression (i.e. - @x :: Expr Src X@) - * Applying the Dhall function (i.e. @f :: Expr Src X@) to the Dhall input - (i.e. @App f x@) - * Normalizing the syntax tree (i.e. @normalize (App f x)@) - * Marshaling the resulting Dhall expression back into a Haskell value --} -class Inject a where - injectWith :: InterpretOptions -> InputType a - default injectWith - :: (Generic a, GenericInject (Rep a)) => InterpretOptions -> InputType a - injectWith options - = contramap GHC.Generics.from (evalState (genericInjectWith options) 1) - -{-| Use the default options for injecting a value - -> inject = inject defaultInterpretOptions --} -inject :: Inject a => InputType a -inject = injectWith defaultInterpretOptions - -instance Inject Bool where - injectWith _ = InputType {..} - where - embed = BoolLit - - declared = Bool - -instance Inject Text where - injectWith _ = InputType {..} - where - embed text = - TextLit (Chunks [] (Data.Text.Lazy.Builder.fromLazyText text)) - - declared = Text - -instance Inject Data.Text.Text where - injectWith _ = InputType {..} - where - embed text = TextLit (Chunks [] (Data.Text.Lazy.Builder.fromText text)) - - declared = Text - -instance Inject Natural where - injectWith _ = InputType {..} - where - embed = NaturalLit - - declared = Natural - -instance Inject Integer where - injectWith _ = InputType {..} - where - embed = IntegerLit - - declared = Integer - -instance Inject Int where - injectWith _ = InputType {..} - where - embed = IntegerLit . toInteger - - declared = Integer - -instance Inject Word8 where - injectWith _ = InputType {..} - where - embed = IntegerLit . toInteger - - declared = Integer - -instance Inject Word16 where - injectWith _ = InputType {..} - where - embed = IntegerLit . toInteger - - declared = Integer - -instance Inject Word32 where - injectWith _ = InputType {..} - where - embed = IntegerLit . toInteger - - declared = Integer - -instance Inject Word64 where - injectWith _ = InputType {..} - where - embed = IntegerLit . toInteger - - declared = Integer - -instance Inject Scientific where - injectWith _ = InputType {..} - where - embed = DoubleLit - - declared = Double - -instance Inject Double where - injectWith = - fmap (contramap (Data.Scientific.fromFloatDigits @Double)) injectWith - -instance Inject () where - injectWith _ = InputType {..} - where - embed = const (RecordLit Data.HashMap.Strict.InsOrd.empty) - - declared = Record Data.HashMap.Strict.InsOrd.empty - -instance Inject a => Inject (Maybe a) where - injectWith options = InputType embedOut declaredOut - where - embedOut (Just x) = - OptionalLit declaredIn (pure (embedIn x)) - embedOut Nothing = - OptionalLit declaredIn empty - - InputType embedIn declaredIn = injectWith options - - declaredOut = App Optional declaredIn - -instance Inject a => Inject (Seq a) where - injectWith options = InputType embedOut declaredOut - where - embedOut xs = ListLit (Just declaredIn) (fmap embedIn xs) - - declaredOut = App List declaredIn - - InputType embedIn declaredIn = injectWith options - -instance Inject a => Inject [a] where - injectWith = fmap (contramap Data.Sequence.fromList) injectWith - -instance Inject a => Inject (Vector a) where - injectWith = fmap (contramap Data.Vector.toList) injectWith - -instance Inject a => Inject (Data.Set.Set a) where - injectWith = fmap (contramap Data.Set.toList) injectWith - -deriving instance (Inject a, Inject b) => Inject (a, b) - -{-| This is the underlying class that powers the `Interpret` class's support - for automatically deriving a generic implementation --} -class GenericInject f where - genericInjectWith :: InterpretOptions -> State Int (InputType (f a)) - -instance GenericInject f => GenericInject (M1 D d f) where - genericInjectWith options = do - res <- genericInjectWith options - pure (contramap unM1 res) - -instance GenericInject f => GenericInject (M1 C c f) where - genericInjectWith options = do - res <- genericInjectWith options - pure (contramap unM1 res) - -instance (Constructor c1, Constructor c2, GenericInject f1, GenericInject f2) => GenericInject (M1 C c1 f1 :+: M1 C c2 f2) where - genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) - where - embed (L1 (M1 l)) = - UnionLit keyL (embedL l) Data.HashMap.Strict.InsOrd.empty - - embed (R1 (M1 r)) = - UnionLit keyR (embedR r) Data.HashMap.Strict.InsOrd.empty - - declared = - Union (Data.HashMap.Strict.InsOrd.fromList [(keyL, declaredL), (keyR, declaredR)]) - - nL :: M1 i c1 f1 a - nL = undefined - - nR :: M1 i c2 f2 a - nR = undefined - - keyL = constructorModifier (Data.Text.Lazy.pack (conName nL)) - keyR = constructorModifier (Data.Text.Lazy.pack (conName nR)) - - InputType embedL declaredL = evalState (genericInjectWith options) 1 - InputType embedR declaredR = evalState (genericInjectWith options) 1 - -instance (Constructor c, GenericInject (f :+: g), GenericInject h) => GenericInject ((f :+: g) :+: M1 C c h) where - genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) - where - embed (L1 l) = - UnionLit keyL valL (Data.HashMap.Strict.InsOrd.insert keyR declaredR ktsL') - where - UnionLit keyL valL ktsL' = embedL l - embed (R1 (M1 r)) = UnionLit keyR (embedR r) ktsL - - nR :: M1 i c h a - nR = undefined - - keyR = constructorModifier (Data.Text.Lazy.pack (conName nR)) - - declared = Union (Data.HashMap.Strict.InsOrd.insert keyR declaredR ktsL) - - InputType embedL (Union ktsL) = evalState (genericInjectWith options) 1 - InputType embedR declaredR = evalState (genericInjectWith options) 1 - -instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInject (M1 C c f :+: (g :+: h)) where - genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) - where - embed (L1 (M1 l)) = UnionLit keyL (embedL l) ktsR - embed (R1 r) = - UnionLit keyR valR (Data.HashMap.Strict.InsOrd.insert keyL declaredL ktsR') - where - UnionLit keyR valR ktsR' = embedR r - - nL :: M1 i c f a - nL = undefined - - keyL = constructorModifier (Data.Text.Lazy.pack (conName nL)) - - declared = Union (Data.HashMap.Strict.InsOrd.insert keyL declaredL ktsR) - - InputType embedL declaredL = evalState (genericInjectWith options) 1 - InputType embedR (Union ktsR) = evalState (genericInjectWith options) 1 - -instance (GenericInject (f :+: g), GenericInject (h :+: i)) => GenericInject ((f :+: g) :+: (h :+: i)) where - genericInjectWith options = pure (InputType {..}) - where - embed (L1 l) = - UnionLit keyL valR (Data.HashMap.Strict.InsOrd.union ktsL' ktsR) - where - UnionLit keyL valR ktsL' = embedL l - embed (R1 r) = - UnionLit keyR valR (Data.HashMap.Strict.InsOrd.union ktsL ktsR') - where - UnionLit keyR valR ktsR' = embedR r - - declared = Union (Data.HashMap.Strict.InsOrd.union ktsL ktsR) - - InputType embedL (Union ktsL) = evalState (genericInjectWith options) 1 - InputType embedR (Union ktsR) = evalState (genericInjectWith options) 1 - -instance (GenericInject f, GenericInject g) => GenericInject (f :*: g) where - genericInjectWith options = do - InputType embedInL declaredInL <- genericInjectWith options - InputType embedInR declaredInR <- genericInjectWith options - - let embed (l :*: r) = - RecordLit (Data.HashMap.Strict.InsOrd.union mapL mapR) - where - RecordLit mapL = embedInL l - RecordLit mapR = embedInR r - - let declared = Record (Data.HashMap.Strict.InsOrd.union mapL mapR) - where - Record mapL = declaredInL - Record mapR = declaredInR - - pure (InputType {..}) - -instance GenericInject U1 where - genericInjectWith _ = pure (InputType {..}) - where - embed _ = RecordLit Data.HashMap.Strict.InsOrd.empty - - declared = Record Data.HashMap.Strict.InsOrd.empty - -instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where - genericInjectWith opts@(InterpretOptions {..}) = do - name <- fieldModifier . Data.Text.Lazy.pack <$> getSelName n - let embed (M1 (K1 x)) = - RecordLit (Data.HashMap.Strict.InsOrd.singleton name (embedIn x)) - let declared = - Record (Data.HashMap.Strict.InsOrd.singleton name declaredIn) - pure (InputType {..}) - where - n :: M1 i s f a - n = undefined - - InputType embedIn declaredIn = injectWith opts +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining + how to use the language, the compiler, and this library +-} + +module Dhall + ( + -- * Input + input + , inputWithSettings + , inputFile + , inputFileWithSettings + , inputExpr + , inputExprWithSettings + , interpretExpr + , interpretExprWithSettings + , fromExpr + , fromExprWithSettings + , rootDirectory + , sourceName + , startingContext + , substitutions + , normalizer + , newManager + , defaultInputSettings + , InputSettings + , defaultEvaluateSettings + , EvaluateSettings + , HasEvaluateSettings(..) + , detailed + + -- * Decoders + , module Dhall.Marshal.Decode + + -- * Encoders + , module Dhall.Marshal.Encode + + -- * Individual phases + , parseWithSettings + , resolveWithSettings + , resolveAndStatusWithSettings + , typecheckWithSettings + , checkWithSettings + , expectWithSettings + , normalizeWithSettings + + -- * Miscellaneous + , rawInput + ) where + +import Control.Applicative (Alternative, empty) +import Control.Monad.Catch (MonadThrow, throwM) +import Data.Either.Validation (Validation (..)) +import Data.Void (Void) +import Dhall.Import (Imported (..), Status) +import Dhall.Parser (Src (..)) +import Dhall.Syntax (Expr (..), Import) +import Dhall.TypeCheck (DetailedTypeError (..), TypeError) +import GHC.Generics +import Lens.Micro (Lens', lens) +import Lens.Micro.Extras (view) +import Prelude hiding (maybe, sequence) +import System.FilePath (takeDirectory) + +import qualified Control.Exception +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Text.IO +import qualified Dhall.Context +import qualified Dhall.Core as Core +import qualified Dhall.Import +import qualified Dhall.Parser +import qualified Dhall.Pretty.Internal +import qualified Dhall.Substitution +import qualified Dhall.TypeCheck +import qualified Lens.Micro as Lens + +import Dhall.Marshal.Decode +import Dhall.Marshal.Encode + +-- | @since 1.16 +data InputSettings = InputSettings + { _rootDirectory :: FilePath + , _sourceName :: FilePath + , _evaluateSettings :: EvaluateSettings + } + +-- | Default input settings: resolves imports relative to @.@ (the +-- current working directory), report errors as coming from @(input)@, +-- and default evaluation settings from 'defaultEvaluateSettings'. +-- +-- @since 1.16 +defaultInputSettings :: InputSettings +defaultInputSettings = InputSettings + { _rootDirectory = "." + , _sourceName = "(input)" + , _evaluateSettings = defaultEvaluateSettings + } + + +-- | Access the directory to resolve imports relative to. +-- +-- @since 1.16 +rootDirectory :: Lens' InputSettings FilePath +rootDirectory = lens _rootDirectory (\s x -> s { _rootDirectory = x }) + +-- | Access the name of the source to report locations from; this is +-- only used in error messages, so it's okay if this is a best guess +-- or something symbolic. +-- +-- @since 1.16 +sourceName :: Lens' InputSettings FilePath +sourceName = lens _sourceName (\s x -> s { _sourceName = x}) + +-- | @since 1.16 +data EvaluateSettings = EvaluateSettings + { _substitutions :: Dhall.Substitution.Substitutions Src Void + , _startingContext :: Dhall.Context.Context (Expr Src Void) + , _normalizer :: Maybe (Core.ReifiedNormalizer Void) + , _newManager :: IO Dhall.Import.Manager + } + +-- | Default evaluation settings: no extra entries in the initial +-- context, and no special normalizer behaviour. +-- +-- @since 1.16 +defaultEvaluateSettings :: EvaluateSettings +defaultEvaluateSettings = EvaluateSettings + { _substitutions = Dhall.Substitution.empty + , _startingContext = Dhall.Context.empty + , _normalizer = Nothing + , _newManager = Dhall.Import.defaultNewManager + } + +-- | Access the starting context used for evaluation and type-checking. +-- +-- @since 1.16 +startingContext + :: (HasEvaluateSettings s) + => Lens' s (Dhall.Context.Context (Expr Src Void)) +startingContext = + evaluateSettings + . lens _startingContext (\s x -> s { _startingContext = x}) + +-- | Access the custom substitutions. +-- +-- @since 1.30 +substitutions + :: (HasEvaluateSettings s) + => Lens' s (Dhall.Substitution.Substitutions Src Void) +substitutions = + evaluateSettings + . lens _substitutions (\s x -> s { _substitutions = x }) + +-- | Access the custom normalizer. +-- +-- @since 1.16 +normalizer + :: (HasEvaluateSettings s) + => Lens' s (Maybe (Core.ReifiedNormalizer Void)) +normalizer = + evaluateSettings + . lens _normalizer (\s x -> s { _normalizer = x }) + +-- | Access the HTTP manager initializer. +-- +-- @since 1.36 +newManager + :: (HasEvaluateSettings s) + => Lens' s (IO Dhall.Import.Manager) +newManager = + evaluateSettings + . lens _newManager (\s x -> s { _newManager = x }) + +-- | @since 1.16 +class HasEvaluateSettings s where + evaluateSettings :: Lens' s EvaluateSettings + +instance HasEvaluateSettings InputSettings where + evaluateSettings = + lens _evaluateSettings (\s x -> s { _evaluateSettings = x }) + +instance HasEvaluateSettings EvaluateSettings where + evaluateSettings = id + +-- | Parse an expression, using the supplied `InputSettings` +parseWithSettings :: MonadThrow m => InputSettings -> Text -> m (Expr Src Import) +parseWithSettings settings text = + either throwM return (Dhall.Parser.exprFromText (view sourceName settings) text) + +-- | Type-check an expression, using the supplied `InputSettings` +typecheckWithSettings :: MonadThrow m => InputSettings -> Expr Src Void -> m () +typecheckWithSettings settings expression = + either throwM (return . const ()) (Dhall.TypeCheck.typeWith (view startingContext settings) expression) + +{-| Type-check an expression against a type provided as a Dhall expreession, + using the supplied `InputSettings` +-} +checkWithSettings :: + MonadThrow m => + -- | The input settings + InputSettings -> + -- | The expected type of the expression + Expr Src Void -> + -- | The expression to check + Expr Src Void -> + m () +checkWithSettings settings type_ expression = do + let suffix = Dhall.Pretty.Internal.prettyToStrictText type_ + + let annotated = case expression of + Note (Src begin end bytes) _ -> + Note (Src begin end bytes') (Annot expression type_) + where + bytes' = bytes <> " : " <> suffix + _ -> + Annot expression type_ + + typecheckWithSettings settings annotated + +{-| Type-check an expression against a `Decoder`'s expected type, using the + supplied `InputSettings`. + This is equivalent of using the 'expected' type of a @Decoder@ as the second + argument to 'checkWithSettings'. +-} +expectWithSettings :: MonadThrow m => InputSettings -> Decoder a -> Expr Src Void -> m () +expectWithSettings settings Decoder{..} expression = do + expected' <- case expected of + Success x -> return x + Failure e -> throwM e + + checkWithSettings settings expected' expression + +{-| Resolve an expression, using the supplied `InputSettings` + + Note that this also applies any substitutions specified in the + `InputSettings` +-} +resolveWithSettings :: InputSettings -> Expr Src Import -> IO (Expr Src Void) +resolveWithSettings settings expression = + fst <$> resolveAndStatusWithSettings settings expression + +-- | A version of 'resolveWithSettings' that also returns the import 'Status' +-- together with the resolved expression. +resolveAndStatusWithSettings + :: InputSettings + -> Expr Src Import + -> IO (Expr Src Void, Status) +resolveAndStatusWithSettings settings expression = do + let InputSettings{..} = settings + + let EvaluateSettings{..} = _evaluateSettings + + let transform = + Lens.set Dhall.Import.substitutions _substitutions + . Lens.set Dhall.Import.normalizer _normalizer + . Lens.set Dhall.Import.startingContext _startingContext + + let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory) + + (resolved, status') <- State.runStateT (Dhall.Import.loadWith expression) status + + let substituted = Dhall.Substitution.substitute resolved (view substitutions settings) + + pure (substituted, status') + +-- | Normalize an expression, using the supplied `InputSettings` +normalizeWithSettings :: InputSettings -> Expr Src Void -> Expr Src Void +normalizeWithSettings settings = + Core.normalizeWith (view normalizer settings) + +{-| Type-check and evaluate a Dhall program, decoding the result into Haskell + + The first argument determines the type of value that you decode: + +>>> input integer "+2" +2 +>>> input (vector double) "[1.0, 2.0]" +[1.0,2.0] + + Use `auto` to automatically select which type to decode based on the + inferred return type: + +>>> input auto "True" :: IO Bool +True + + This uses the settings from 'defaultInputSettings'. +-} +input + :: Decoder a + -- ^ The decoder for the Dhall value + -> Text + -- ^ The Dhall program + -> IO a + -- ^ The decoded value in Haskell +input = + inputWithSettings defaultInputSettings + +{-| Extend 'input' with a root directory to resolve imports relative + to, a file to mention in errors as the source, a custom typing + context, and a custom normalization process. + +@since 1.16 +-} +inputWithSettings + :: InputSettings + -> Decoder a + -- ^ The decoder for the Dhall value + -> Text + -- ^ The Dhall program + -> IO a + -- ^ The decoded value in Haskell +inputWithSettings settings decoder@Decoder{..} text = do + parsed <- parseWithSettings settings text + + resolved <- resolveWithSettings settings parsed + + expectWithSettings settings decoder resolved + + let normalized = normalizeWithSettings settings resolved + + case extract normalized of + Success x -> return x + Failure e -> Control.Exception.throwIO e + +{-| Type-check and evaluate a Dhall program that is read from the + file-system. + + This uses the settings from 'defaultEvaluateSettings'. + + @since 1.16 +-} +inputFile + :: Decoder a + -- ^ The decoder for the Dhall value + -> FilePath + -- ^ The path to the Dhall program. + -> IO a + -- ^ The decoded value in Haskell. +inputFile = + inputFileWithSettings defaultEvaluateSettings + +{-| Extend 'inputFile' with a custom typing context and a custom + normalization process. + +@since 1.16 +-} +inputFileWithSettings + :: EvaluateSettings + -> Decoder a + -- ^ The decoder for the Dhall value + -> FilePath + -- ^ The path to the Dhall program. + -> IO a + -- ^ The decoded value in Haskell. +inputFileWithSettings settings ty path = do + text <- Data.Text.IO.readFile path + let inputSettings = InputSettings + { _rootDirectory = takeDirectory path + , _sourceName = path + , _evaluateSettings = settings + } + inputWithSettings inputSettings ty text + +{-| Similar to `input`, but without interpreting the Dhall `Expr` into a Haskell + type. + + Uses the settings from 'defaultInputSettings'. +-} +inputExpr + :: Text + -- ^ The Dhall program + -> IO (Expr Src Void) + -- ^ The fully normalized AST +inputExpr = + inputExprWithSettings defaultInputSettings + +{-| Extend 'inputExpr' with a root directory to resolve imports relative + to, a file to mention in errors as the source, a custom typing + context, and a custom normalization process. + +@since 1.16 +-} +inputExprWithSettings + :: InputSettings + -> Text + -- ^ The Dhall program + -> IO (Expr Src Void) + -- ^ The fully normalized AST +inputExprWithSettings settings text = do + parsed <- parseWithSettings settings text + + resolved <- resolveWithSettings settings parsed + + _ <- typecheckWithSettings settings resolved + + pure (Core.normalizeWith (view normalizer settings) resolved) + +{-| Interpret a Dhall Expression + + This takes care of import resolution, type-checking, and normalization +-} +interpretExpr :: Expr Src Import -> IO (Expr Src Void) +interpretExpr = interpretExprWithSettings defaultInputSettings + +-- | Like `interpretExpr`, but customizable using `InputSettings` +interpretExprWithSettings + :: InputSettings -> Expr Src Import -> IO (Expr Src Void) +interpretExprWithSettings settings parsed = do + resolved <- resolveWithSettings settings parsed + + typecheckWithSettings settings resolved + + pure (Core.normalizeWith (view normalizer settings) resolved) + +{- | Decode a Dhall expression + + This takes care of import resolution, type-checking and normalization +-} +fromExpr :: Decoder a -> Expr Src Import -> IO a +fromExpr = fromExprWithSettings defaultInputSettings + +-- | Like `fromExpr`, but customizable using `InputSettings` +fromExprWithSettings :: InputSettings -> Decoder a -> Expr Src Import -> IO a +fromExprWithSettings settings decoder@Decoder{..} expression = do + resolved <- resolveWithSettings settings expression + + expectWithSettings settings decoder resolved + + let normalized = Core.normalizeWith (view normalizer settings) resolved + + case extract normalized of + Success x -> return x + Failure e -> Control.Exception.throwIO e + +-- | Use this function to extract Haskell values directly from Dhall AST. +-- The intended use case is to allow easy extraction of Dhall values for +-- making the function `Core.normalizeWith` easier to use. +-- +-- For other use cases, use `input` from "Dhall" module. It will give you +-- a much better user experience. +rawInput + :: Alternative f + => Decoder a + -- ^ The decoder for the Dhall value + -> Expr s Void + -- ^ a closed form Dhall program, which evaluates to the expected type + -> f a + -- ^ The decoded value in Haskell +rawInput (Decoder {..}) expr = + case extract (Core.normalize expr) of + Success x -> pure x + Failure _e -> empty + +{-| Use this to provide more detailed error messages + +>> input auto "True" :: IO Integer +> *** Exception: Error: Expression doesn't match annotation +> +> True : Integer +> +> (input):1:1 + +>> detailed (input auto "True") :: IO Integer +> *** Exception: Error: Expression doesn't match annotation +> +> Explanation: You can annotate an expression with its type or kind using the +> ❰:❱ symbol, like this: +> +> +> ┌───────┐ +> │ x : t │ ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱ +> └───────┘ +> +> The type checker verifies that the expression's type or kind matches the +> provided annotation +> +> For example, all of the following are valid annotations that the type checker +> accepts: +> +> +> ┌─────────────┐ +> │ 1 : Natural │ ❰1❱ is an expression that has type ❰Natural❱, so the type +> └─────────────┘ checker accepts the annotation +> +> +> ┌───────────────────────┐ +> │ Natural/even 2 : Bool │ ❰Natural/even 2❱ has type ❰Bool❱, so the type +> └───────────────────────┘ checker accepts the annotation +> +> +> ┌────────────────────┐ +> │ List : Type → Type │ ❰List❱ is an expression that has kind ❰Type → Type❱, +> └────────────────────┘ so the type checker accepts the annotation +> +> +> ┌──────────────────┐ +> │ List Text : Type │ ❰List Text❱ is an expression that has kind ❰Type❱, so +> └──────────────────┘ the type checker accepts the annotation +> +> +> However, the following annotations are not valid and the type checker will +> reject them: +> +> +> ┌──────────┐ +> │ 1 : Text │ The type checker rejects this because ❰1❱ does not have type +> └──────────┘ ❰Text❱ +> +> +> ┌─────────────┐ +> │ List : Type │ ❰List❱ does not have kind ❰Type❱ +> └─────────────┘ +> +> +> You or the interpreter annotated this expression: +> +> ↳ True +> +> ... with this type or kind: +> +> ↳ Integer +> +> ... but the inferred type or kind of the expression is actually: +> +> ↳ Bool +> +> Some common reasons why you might get this error: +> +> ● The Haskell Dhall interpreter implicitly inserts a top-level annotation +> matching the expected type +> +> For example, if you run the following Haskell code: +> +> +> ┌───────────────────────────────┐ +> │ >>> input auto "1" :: IO Text │ +> └───────────────────────────────┘ +> +> +> ... then the interpreter will actually type check the following annotated +> expression: +> +> +> ┌──────────┐ +> │ 1 : Text │ +> └──────────┘ +> +> +> ... and then type-checking will fail +> +> ──────────────────────────────────────────────────────────────────────────────── +> +> True : Integer +> +> (input):1:1 + +-} +detailed :: IO a -> IO a +detailed = + Control.Exception.handle handler1 . Control.Exception.handle handler0 + where + handler0 :: Imported (TypeError Src Void) -> IO a + handler0 (Imported ps e) = + Control.Exception.throwIO (Imported ps (DetailedTypeError e)) + + handler1 :: TypeError Src Void -> IO a + handler1 e = Control.Exception.throwIO (DetailedTypeError e) diff --git a/src/Dhall/Binary.hs b/src/Dhall/Binary.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Binary.hs @@ -0,0 +1,1437 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-| This module contains logic for converting Dhall expressions to and from + CBOR expressions which can in turn be converted to and from a binary + representation +-} + +module Dhall.Binary + ( -- * Encoding and decoding + encodeExpression + , decodeExpression + + -- * Exceptions + , DecodingFailure(..) + ) where + +import Codec.CBOR.Decoding (Decoder, TokenType (..)) +import Codec.CBOR.Encoding (Encoding) +import Codec.Serialise (Serialise (decode, encode)) +import Control.Applicative (empty, (<|>)) +import Control.Exception (Exception) +import Data.ByteString.Lazy (ByteString) +import Dhall.Syntax + ( Binding (..) + , Chunks (..) + , Const (..) + , DhallDouble (..) + , Directory (..) + , Expr (..) + , File (..) + , FilePrefix (..) + , FunctionBinding (..) + , Import (..) + , ImportHashed (..) + , ImportMode (..) + , ImportType (..) + , MultiLet (..) + , PreferAnnotation (..) + , RecordField (..) + , Scheme (..) + , URL (..) + , Var (..) + , WithComponent (..) + ) + +import Data.Foldable (toList) +import Data.Ratio ((%)) +import Data.Void (Void, absurd) +import GHC.Float (double2Float, float2Double) +import Numeric.Half (fromHalf, toHalf) +import Prelude hiding (exponent) + +import qualified Codec.CBOR.ByteArray +import qualified Codec.CBOR.Decoding as Decoding +import qualified Codec.CBOR.Encoding as Encoding +import qualified Codec.CBOR.Read as Read +import qualified Codec.Serialise as Serialise +import qualified Data.ByteString +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import qualified Data.Foldable as Foldable +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Sequence +import qualified Data.Time as Time +import qualified Dhall.Crypto +import qualified Dhall.Map +import qualified Dhall.Syntax as Syntax +import qualified Text.Printf as Printf + +{-| Convert a function applied to multiple arguments to the base function and + the list of arguments +-} +unApply :: Expr s a -> (Expr s a, [Expr s a]) +unApply e₀ = (baseFunction₀, diffArguments₀ []) + where + ~(baseFunction₀, diffArguments₀) = go e₀ + + go (App f a) = (baseFunction, diffArguments . (a :)) + where + ~(baseFunction, diffArguments) = go f + + go (Note _ e) = go e + + go baseFunction = (baseFunction, id) + +decodeExpressionInternal :: (Int -> Decoder s a) -> Decoder s (Expr t a) +decodeExpressionInternal decodeEmbed = go + where + go = do + let die message = fail ("Dhall.Binary.decodeExpressionInternal: " <> message) + + tokenType₀ <- Decoding.peekTokenType + + case tokenType₀ of + TypeUInt -> do + !n <- fromIntegral <$> Decoding.decodeWord + + return (Var (V "_" n)) + + TypeUInt64 -> do + !n <- fromIntegral <$> Decoding.decodeWord64 + + return (Var (V "_" n)) + + TypeFloat16 -> do + !n <- float2Double <$> Decoding.decodeFloat + + return (DoubleLit (DhallDouble n)) + + TypeFloat32 -> do + !n <- float2Double <$> Decoding.decodeFloat + + return (DoubleLit (DhallDouble n)) + + TypeFloat64 -> do + !n <- Decoding.decodeDouble + + return (DoubleLit (DhallDouble n)) + + TypeBool -> do + !b <- Decoding.decodeBool + + return (BoolLit b) + + TypeString -> do + !ba <- Decoding.decodeUtf8ByteArray + + let sb = Codec.CBOR.ByteArray.toShortByteString ba + + case Data.ByteString.Short.length sb of + 4 | sb == "Bool" -> return Bool + | sb == "Date" -> return Date + | sb == "List" -> return List + | sb == "None" -> return None + | sb == "Text" -> return Text + | sb == "Time" -> return Time + | sb == "Type" -> return (Const Type) + | sb == "Kind" -> return (Const Kind) + | sb == "Sort" -> return (Const Sort) + 5 | sb == "Bytes" -> return Bytes + 6 | sb == "Double" -> return Double + 7 | sb == "Integer" -> return Integer + | sb == "Natural" -> return Natural + 8 | sb == "Optional" -> return Optional + | sb == "TimeZone" -> return TimeZone + 9 | sb == "Date/show" -> return DateShow + | sb == "List/fold" -> return ListFold + | sb == "List/head" -> return ListHead + | sb == "List/last" -> return ListLast + | sb == "Text/show" -> return TextShow + | sb == "Time/show" -> return TimeShow + 10 | sb == "List/build" -> return ListBuild + 11 | sb == "Double/show" -> return DoubleShow + | sb == "List/length" -> return ListLength + | sb == "Natural/odd" -> return NaturalOdd + 12 | sb == "Integer/show" -> return IntegerShow + | sb == "List/indexed" -> return ListIndexed + | sb == "List/reverse" -> return ListReverse + | sb == "Natural/even" -> return NaturalEven + | sb == "Natural/fold" -> return NaturalFold + | sb == "Natural/show" -> return NaturalShow + | sb == "Text/replace" -> return TextReplace + 13 | sb == "Integer/clamp" -> return IntegerClamp + | sb == "Natural/build" -> return NaturalBuild + | sb == "TimeZone/show" -> return TimeZoneShow + 14 | sb == "Integer/negate" -> return IntegerNegate + | sb == "Natural/isZero" -> return NaturalIsZero + 16 | sb == "Integer/toDouble" -> return IntegerToDouble + | sb == "Natural/subtract" -> return NaturalSubtract + 17 | sb == "Natural/toInteger" -> return NaturalToInteger + _ -> die ("Unrecognized built-in: " <> show sb) + + TypeListLen -> do + len <- Decoding.decodeListLen + + case len of + 0 -> die "Missing tag" + _ -> return () + + tokenType₁ <- Decoding.peekTokenType + + case tokenType₁ of + TypeString -> do + x <- Decoding.decodeString + + if x == "_" + then die "Non-standard encoding of an α-normalized variable" + else return () + + tokenType₂ <- Decoding.peekTokenType + + case tokenType₂ of + TypeUInt -> do + !n <- fromIntegral <$> Decoding.decodeWord + + return (Var (V x n)) + + TypeUInt64 -> do + !n <- fromIntegral <$> Decoding.decodeWord64 + + return (Var (V x n)) + + _ -> + die ("Unexpected token type for variable index: " <> show tokenType₂) + + TypeUInt -> do + tag <- Decoding.decodeWord + + case tag of + 0 -> do + !f <- go + + let loop n !acc + | n <= 0 = return acc + | otherwise = do + !x <- go + loop (n - 1) (App acc x) + + let nArgs = len - 2 + + if nArgs <= 0 + then die "Non-standard encoding of a function with no arguments" + else loop nArgs f + + 1 -> + case len of + 3 -> do + _A <- go + + b <- go + + return (Lam mempty (Syntax.makeFunctionBinding "_" _A) b) + + 4 -> do + x <- Decoding.decodeString + + if x == "_" + then die "Non-standard encoding of a λ expression" + else return () + + _A <- go + + b <- go + + return (Lam mempty (Syntax.makeFunctionBinding x _A) b) + + _ -> + die ("Incorrect number of tokens used to encode a λ expression: " <> show len) + + 2 -> + case len of + 3 -> do + _A <- go + + _B <- go + + return (Pi mempty "_" _A _B) + + 4 -> do + x <- Decoding.decodeString + + if x == "_" + then die "Non-standard encoding of a ∀ expression" + else return () + + _A <- go + + _B <- go + + return (Pi mempty x _A _B) + + _ -> + die ("Incorrect number of tokens used to encode a ∀ expression: " <> show len) + + 3 -> do + opcode <- Decoding.decodeWord + + op <- case opcode of + 0 -> return BoolOr + 1 -> return BoolAnd + 2 -> return BoolEQ + 3 -> return BoolNE + 4 -> return NaturalPlus + 5 -> return NaturalTimes + 6 -> return TextAppend + 7 -> return ListAppend + 8 -> return (Combine mempty Nothing) + 9 -> return (Prefer mempty PreferFromSource) + 10 -> return (CombineTypes mempty) + 11 -> return ImportAlt + 12 -> return (Equivalent mempty) + 13 -> return RecordCompletion + _ -> die ("Unrecognized operator code: " <> show opcode) + + l <- go + + r <- go + + return (op l r) + + 4 -> + case len of + 2 -> do + _T <- go + + return (ListLit (Just (App List _T)) empty) + + _ -> do + Decoding.decodeNull + + xs <- Data.Sequence.replicateA (len - 2) go + return (ListLit Nothing xs) + + 5 -> do + Decoding.decodeNull + + t <- go + + return (Some t) + + 6 -> do + t <- go + + u <- go + + case len of + 3 -> + return (Merge t u Nothing) + + 4 -> do + _T <- go + + return (Merge t u (Just _T)) + + _ -> + die ("Incorrect number of tokens used to encode a `merge` expression: " <> show len) + + 7 -> do + mapLength <- Decoding.decodeMapLen + + xTs <- replicateDecoder mapLength $ do + x <- Decoding.decodeString + + _T <- go + + return (x, Syntax.makeRecordField _T) + + return (Record (Dhall.Map.fromList xTs)) + + 8 -> do + mapLength <- Decoding.decodeMapLen + + xts <- replicateDecoder mapLength $ do + x <- Decoding.decodeString + + t <- go + + return (x, Syntax.makeRecordField t) + + return (RecordLit (Dhall.Map.fromList xts)) + + 9 -> do + t <- go + + x <- Decoding.decodeString + + return (Field t (Syntax.makeFieldSelection x)) + + 10 -> do + t <- go + + xs <- case len of + 3 -> do + tokenType₂ <- Decoding.peekTokenType + + case tokenType₂ of + TypeListLen -> do + _ <- Decoding.decodeListLen + + _T <- go + + return (Right _T) + + TypeString -> do + x <- Decoding.decodeString + return (Left [x]) + + _ -> + die ("Unexpected token type for projection: " <> show tokenType₂) + + _ -> do + xs <- replicateDecoder (len - 2) Decoding.decodeString + + return (Left xs) + + return (Project t xs) + + 11 -> do + mapLength <- Decoding.decodeMapLen + + xTs <- replicateDecoder mapLength $ do + x <- Decoding.decodeString + + tokenType₂ <- Decoding.peekTokenType + + mT <- case tokenType₂ of + TypeNull -> do + Decoding.decodeNull + + return Nothing + + _ -> do + _T <- go + + return (Just _T) + + return (x, mT) + + return (Union (Dhall.Map.fromList xTs)) + + 14 -> do + t <- go + + l <- go + + r <- go + + return (BoolIf t l r) + + 15 -> do + tokenType₂ <- Decoding.peekTokenType + + case tokenType₂ of + TypeUInt -> do + !n <- fromIntegral <$> Decoding.decodeWord + + return (NaturalLit n) + + TypeUInt64 -> do + !n <- fromIntegral <$> Decoding.decodeWord64 + + return (NaturalLit n) + + TypeInteger -> do + !n <- fromIntegral <$> Decoding.decodeInteger + return (NaturalLit n) + + _ -> + die ("Unexpected token type for Natural literal: " <> show tokenType₂) + + 16 -> do + tokenType₂ <- Decoding.peekTokenType + + case tokenType₂ of + TypeUInt -> do + !n <- fromIntegral <$> Decoding.decodeWord + + return (IntegerLit n) + + TypeUInt64 -> do + !n <- fromIntegral <$> Decoding.decodeWord64 + + return (IntegerLit n) + + TypeNInt -> do + !n <- fromIntegral <$> Decoding.decodeNegWord + + return (IntegerLit $! (-1 - n)) + + TypeNInt64 -> do + !n <- fromIntegral <$> Decoding.decodeNegWord64 + + return (IntegerLit $! (-1 - n)) + TypeInteger -> do + n <- Decoding.decodeInteger + return (IntegerLit n) + + _ -> + die ("Unexpected token type for Integer literal: " <> show tokenType₂) + + 18 -> do + xys <- replicateDecoder ((len - 2) `quot` 2) $ do + x <- Decoding.decodeString + + y <- go + + return (x, y) + + z <- Decoding.decodeString + + return (TextLit (Chunks xys z)) + + 19 -> do + t <- go + + return (Assert t) + + 24 -> + fmap Embed (decodeEmbed len) + + 25 -> do + bindings <- replicateDecoder ((len - 2) `quot` 3) $ do + x <- Decoding.decodeString + + tokenType₂ <- Decoding.peekTokenType + + mA <- case tokenType₂ of + TypeNull -> do + Decoding.decodeNull + + return Nothing + + _ -> do + _A <- go + + return (Just (Nothing, _A)) + + a <- go + + return (Binding Nothing x Nothing mA Nothing a) + + b <- go + + return (foldr Let b bindings) + + 26 -> do + t <- go + + _T <- go + + return (Annot t _T) + + 27 -> do + t <- go + + mT <- case len of + 2 -> + return Nothing + + 3 -> do + _T <- go + + return (Just _T) + + _ -> + die ("Incorrect number of tokens used to encode a type annotation: " <> show len) + + return (ToMap t mT) + + 28 -> do + _T <- go + + return (ListLit (Just _T) empty) + + 29 -> do + l <- go + + n <- Decoding.decodeListLen + + let decodeWithComponent = do + tokenType₂ <- Decoding.peekTokenType + case tokenType₂ of + TypeString -> do + fmap WithLabel Decoding.decodeString + _ -> do + m <- Decoding.decodeInt + + case m of + 0 -> return WithQuestion + _ -> die ("Unexpected integer encoding a with expression: " <> show n) + ks₀ <- replicateDecoder n decodeWithComponent + + ks₁ <- case NonEmpty.nonEmpty ks₀ of + Nothing -> + die "0 field labels in decoded with expression" + Just ks₁ -> + return ks₁ + + r <- go + + return (With l ks₁ r) + + 30 -> do + _YYYY <- Decoding.decodeInt + _MM <- Decoding.decodeInt + _HH <- Decoding.decodeInt + + case Time.fromGregorianValid (fromIntegral _YYYY) _MM _HH of + Nothing -> + die "Invalid date" + Just day -> + return (DateLiteral day) + 31 -> do + hh <- Decoding.decodeInt + mm <- Decoding.decodeInt + tag₂ <- Decoding.decodeTag + + case tag₂ of + 4 -> do + return () + _ -> do + die ("Unexpected tag for decimal fraction: " <> show tag) + n <- Decoding.decodeListLen + + case n of + 2 -> do + return () + _ -> do + die ("Invalid list length for decimal fraction: " <> show n) + + exponent <- Decoding.decodeInt + + tokenType₂ <- Decoding.peekTokenType + + mantissa <- case tokenType₂ of + TypeUInt -> do + fromIntegral <$> Decoding.decodeWord + + TypeUInt64 -> do + fromIntegral <$> Decoding.decodeWord64 + + TypeNInt -> do + !i <- fromIntegral <$> Decoding.decodeNegWord + + return (-1 - i) + + TypeNInt64 -> do + !i <- fromIntegral <$> Decoding.decodeNegWord64 + + return (-1 - i) + TypeInteger -> do + Decoding.decodeInteger + _ -> + die ("Unexpected token type for mantissa: " <> show tokenType₂) + let precision = fromIntegral (negate exponent) + + let ss = fromRational (mantissa % (10 ^ precision)) + + return (TimeLiteral (Time.TimeOfDay hh mm ss) precision) + 32 -> do + b <- Decoding.decodeBool + _HH <- Decoding.decodeInt + _MM <- Decoding.decodeInt + + let sign = if b then id else negate + + let minutes = sign (_HH * 60 + _MM) + + return (TimeZoneLiteral (Time.TimeZone minutes False "")) + + 33 -> do + b <- Decoding.decodeBytes + + return (BytesLit b) + + 34 -> do + t <- go + return (ShowConstructor t) + _ -> + die ("Unexpected tag: " <> show tag) + + _ -> + die ("Unexpected tag type: " <> show tokenType₁) + + _ -> + die ("Unexpected initial token: " <> show tokenType₀) + +encodeExpressionInternal :: (a -> Encoding) -> Expr Void a -> Encoding +encodeExpressionInternal encodeEmbed = go + where + go e = case e of + Var (V "_" n) -> + Encoding.encodeInt n + + Var (V x n) -> + Encoding.encodeListLen 2 + <> Encoding.encodeString x + <> Encoding.encodeInt n + + NaturalBuild -> + Encoding.encodeUtf8ByteArray "Natural/build" + + NaturalFold -> + Encoding.encodeUtf8ByteArray "Natural/fold" + + NaturalIsZero -> + Encoding.encodeUtf8ByteArray "Natural/isZero" + + NaturalEven -> + Encoding.encodeUtf8ByteArray "Natural/even" + + NaturalOdd -> + Encoding.encodeUtf8ByteArray "Natural/odd" + + NaturalToInteger -> + Encoding.encodeUtf8ByteArray "Natural/toInteger" + + NaturalShow -> + Encoding.encodeUtf8ByteArray "Natural/show" + + NaturalSubtract -> + Encoding.encodeUtf8ByteArray "Natural/subtract" + + IntegerToDouble -> + Encoding.encodeUtf8ByteArray "Integer/toDouble" + + IntegerClamp -> + Encoding.encodeUtf8ByteArray "Integer/clamp" + + IntegerNegate -> + Encoding.encodeUtf8ByteArray "Integer/negate" + + IntegerShow -> + Encoding.encodeUtf8ByteArray "Integer/show" + + DoubleShow -> + Encoding.encodeUtf8ByteArray "Double/show" + + ListBuild -> + Encoding.encodeUtf8ByteArray "List/build" + + ListFold -> + Encoding.encodeUtf8ByteArray "List/fold" + + ListLength -> + Encoding.encodeUtf8ByteArray "List/length" + + ListHead -> + Encoding.encodeUtf8ByteArray "List/head" + + ListLast -> + Encoding.encodeUtf8ByteArray "List/last" + + ListIndexed -> + Encoding.encodeUtf8ByteArray "List/indexed" + + ListReverse -> + Encoding.encodeUtf8ByteArray "List/reverse" + + Bool -> + Encoding.encodeUtf8ByteArray "Bool" + + Bytes -> + Encoding.encodeUtf8ByteArray "Bytes" + + Optional -> + Encoding.encodeUtf8ByteArray "Optional" + + None -> + Encoding.encodeUtf8ByteArray "None" + + Natural -> + Encoding.encodeUtf8ByteArray "Natural" + + Integer -> + Encoding.encodeUtf8ByteArray "Integer" + + Double -> + Encoding.encodeUtf8ByteArray "Double" + + Text -> + Encoding.encodeUtf8ByteArray "Text" + + TextReplace -> + Encoding.encodeUtf8ByteArray "Text/replace" + + TextShow -> + Encoding.encodeUtf8ByteArray "Text/show" + + Date -> + Encoding.encodeUtf8ByteArray "Date" + + DateShow -> + Encoding.encodeUtf8ByteArray "Date/show" + + Time -> + Encoding.encodeUtf8ByteArray "Time" + + TimeShow -> + Encoding.encodeUtf8ByteArray "Time/show" + + TimeZone -> + Encoding.encodeUtf8ByteArray "TimeZone" + + TimeZoneShow -> + Encoding.encodeUtf8ByteArray "TimeZone/show" + + List -> + Encoding.encodeUtf8ByteArray "List" + + Const Type -> + Encoding.encodeUtf8ByteArray "Type" + + Const Kind -> + Encoding.encodeUtf8ByteArray "Kind" + + Const Sort -> + Encoding.encodeUtf8ByteArray "Sort" + + a@App{} -> + encodeListN + (2 + length arguments) + ( Encoding.encodeInt 0 + : go function + : map go arguments + ) + where + (function, arguments) = unApply a + + Lam _ (FunctionBinding { functionBindingVariable = "_", functionBindingAnnotation = _A }) b -> + encodeList3 + (Encoding.encodeInt 1) + (go _A) + (go b) + + Lam _ (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A }) b -> + encodeList4 + (Encoding.encodeInt 1) + (Encoding.encodeString x) + (go _A) + (go b) + + Pi _ "_" _A _B -> + encodeList3 + (Encoding.encodeInt 2) + (go _A) + (go _B) + + Pi _ x _A _B -> + encodeList4 + (Encoding.encodeInt 2) + (Encoding.encodeString x) + (go _A) + (go _B) + + BoolOr l r -> + encodeOperator 0 l r + + BoolAnd l r -> + encodeOperator 1 l r + + BoolEQ l r -> + encodeOperator 2 l r + + BoolNE l r -> + encodeOperator 3 l r + + BytesLit b -> + encodeList2 + (Encoding.encodeInt 33) + (Encoding.encodeBytes b) + + NaturalPlus l r -> + encodeOperator 4 l r + + NaturalTimes l r -> + encodeOperator 5 l r + + TextAppend l r -> + encodeOperator 6 l r + + ListAppend l r -> + encodeOperator 7 l r + + Combine _ _ l r -> + encodeOperator 8 l r + + Prefer _ _ l r -> + encodeOperator 9 l r + + CombineTypes _ l r -> + encodeOperator 10 l r + + ImportAlt l r -> + encodeOperator 11 l r + + Equivalent _ l r -> + encodeOperator 12 l r + + RecordCompletion l r -> + encodeOperator 13 l r + + ListLit _T₀ xs + | null xs -> + encodeList2 (Encoding.encodeInt label) _T₁ + | otherwise -> + encodeListN + (2 + length xs) + ( Encoding.encodeInt 4 + : Encoding.encodeNull + : map go (Data.Foldable.toList xs) + ) + where + (label, _T₁) = case _T₀ of + Nothing -> (4 , Encoding.encodeNull) + Just (App List t) -> (4 , go t ) + Just t -> (28, go t ) + + Some t -> + encodeList3 + (Encoding.encodeInt 5) + Encoding.encodeNull + (go t) + + Merge t u Nothing -> + encodeList3 + (Encoding.encodeInt 6) + (go t) + (go u) + + Merge t u (Just _T) -> + encodeList4 + (Encoding.encodeInt 6) + (go t) + (go u) + (go _T) + + Record xTs -> + encodeList2 + (Encoding.encodeInt 7) + (encodeMapWith (go . recordFieldValue) xTs) + + RecordLit xts -> + encodeList2 + (Encoding.encodeInt 8) + (encodeMapWith (go. recordFieldValue) xts) + + Field t (Syntax.fieldSelectionLabel -> x) -> + encodeList3 + (Encoding.encodeInt 9) + (go t) + (Encoding.encodeString x) + + Project t (Left xs) -> + encodeListN + (2 + length xs) + ( Encoding.encodeInt 10 + : go t + : map Encoding.encodeString xs + ) + + Project t (Right _T) -> + encodeList3 + (Encoding.encodeInt 10) + (go t) + (encodeList1 (go _T)) + + Union xTs -> + encodeList2 + (Encoding.encodeInt 11) + (encodeMapWith encodeValue xTs) + where + encodeValue Nothing = Encoding.encodeNull + encodeValue (Just _T) = go _T + + BoolLit b -> + Encoding.encodeBool b + + BoolIf t l r -> + encodeList4 + (Encoding.encodeInt 14) + (go t) + (go l) + (go r) + + NaturalLit n -> + encodeList2 + (Encoding.encodeInt 15) + (Encoding.encodeInteger (fromIntegral n)) + + IntegerLit n -> + encodeList2 + (Encoding.encodeInt 16) + (Encoding.encodeInteger (fromIntegral n)) + + DoubleLit (DhallDouble n64) + | useHalf -> Encoding.encodeFloat16 n32 + | useFloat -> Encoding.encodeFloat n32 + | otherwise -> Encoding.encodeDouble n64 + where + n32 = double2Float n64 + + n16 = toHalf n32 + + useFloat = n64 == float2Double n32 + + useHalf = n64 == (float2Double $ fromHalf n16) + + -- Fast path for the common case of an uninterpolated string + TextLit (Chunks [] z) -> + encodeList2 + (Encoding.encodeInt 18) + (Encoding.encodeString z) + + TextLit (Chunks xys z) -> + encodeListN + (2 + 2 * length xys) + ( Encoding.encodeInt 18 + : concatMap encodePair xys ++ [ Encoding.encodeString z ] + ) + where + encodePair (x, y) = [ Encoding.encodeString x, go y ] + + Assert t -> + encodeList2 + (Encoding.encodeInt 19) + (go t) + + Embed x -> + encodeEmbed x + + Let a₀ b₀ -> + encodeListN + (2 + 3 * length as) + ( Encoding.encodeInt 25 + : concatMap encodeBinding (toList as) ++ [ go b₁ ] + ) + where + MultiLet as b₁ = Syntax.multiLet a₀ b₀ + + encodeBinding (Binding _ x _ mA₀ _ a) = + [ Encoding.encodeString x + , mA₁ + , go a + ] + where + mA₁ = case mA₀ of + Nothing -> Encoding.encodeNull + Just (_, _A) -> go _A + + Annot t _T -> + encodeList3 + (Encoding.encodeInt 26) + (go t) + (go _T) + + ToMap t Nothing -> + encodeList2 + (Encoding.encodeInt 27) + (go t) + + ToMap t (Just _T) -> + encodeList3 + (Encoding.encodeInt 27) + (go t) + (go _T) + + With l ks r -> + encodeList4 + (Encoding.encodeInt 29) + (go l) + (encodeList (fmap encodeWithComponent ks)) + (go r) + where + encodeWithComponent WithQuestion = Encoding.encodeInt 0 + encodeWithComponent (WithLabel k ) = Encoding.encodeString k + + DateLiteral day -> + encodeList4 + (Encoding.encodeInt 30) + (Encoding.encodeInt (fromInteger _YYYY)) + (Encoding.encodeInt _MM) + (Encoding.encodeInt _DD) + where + (_YYYY, _MM, _DD) = Time.toGregorian day + + TimeLiteral (Time.TimeOfDay hh mm ss) precision -> + encodeList4 + (Encoding.encodeInt 31) + (Encoding.encodeInt hh) + (Encoding.encodeInt mm) + ( Encoding.encodeTag 4 + <> encodeList2 + (Encoding.encodeInt exponent) + encodedMantissa + ) + where + exponent = negate (fromIntegral precision) + + mantissa :: Integer + mantissa = truncate (ss * 10 ^ precision) + + encodedMantissa + | fromIntegral (minBound :: Int) <= mantissa + && mantissa <= fromIntegral (maxBound :: Int) = + Encoding.encodeInt (fromInteger mantissa) + | otherwise = + Encoding.encodeInteger mantissa + + TimeZoneLiteral (Time.TimeZone minutes _ _) -> + encodeList4 + (Encoding.encodeInt 32) + (Encoding.encodeBool sign) + (Encoding.encodeInt _HH) + (Encoding.encodeInt _MM) + where + sign = 0 <= minutes + + (_HH, _MM) = abs minutes `divMod` 60 + + ShowConstructor t -> + encodeList2 + (Encoding.encodeInt 34) + (go t) + + Note _ b -> + go b + + encodeOperator n l r = + encodeList4 + (Encoding.encodeInt 3) + (Encoding.encodeInt n) + (go l) + (go r) + + encodeMapWith encodeValue m = + Encoding.encodeMapLen (fromIntegral (Dhall.Map.size m)) + <> foldMap encodeKeyValue (Dhall.Map.toList (Dhall.Map.sort m)) + where + encodeKeyValue (k, v) = Encoding.encodeString k <> encodeValue v + +encodeList1 :: Encoding -> Encoding +encodeList1 a = Encoding.encodeListLen 1 <> a +{-# INLINE encodeList1 #-} + +encodeList2 :: Encoding -> Encoding -> Encoding +encodeList2 a b = Encoding.encodeListLen 2 <> a <> b +{-# INLINE encodeList2 #-} + +encodeList3 :: Encoding -> Encoding -> Encoding -> Encoding +encodeList3 a b c = Encoding.encodeListLen 3 <> a <> b <> c +{-# INLINE encodeList3 #-} + +encodeList4 :: Encoding -> Encoding -> Encoding -> Encoding -> Encoding +encodeList4 a b c d = Encoding.encodeListLen 4 <> a <> b <> c <> d +{-# INLINE encodeList4 #-} + +encodeListN :: Foldable f => Int -> f Encoding -> Encoding +encodeListN len xs = + Encoding.encodeListLen (fromIntegral len) <> Foldable.fold xs +{-# INLINE encodeListN #-} + +encodeList :: Foldable f => f Encoding -> Encoding +encodeList xs = encodeListN (length xs) xs +{-# INLINE encodeList #-} + +decodeImport :: Int -> Decoder s Import +decodeImport len = do + let die message = fail ("Dhall.Binary.decodeImport: " <> message) + + tokenType₀ <- Decoding.peekTokenType + + hash <- case tokenType₀ of + TypeNull -> do + Decoding.decodeNull + + return Nothing + + TypeBytes -> do + bytes <- Decoding.decodeBytes + + let (prefix, suffix) = Data.ByteString.splitAt 2 bytes + + case prefix of + "\x12\x20" -> return () + _ -> die ("Unrecognized multihash prefix: " <> show prefix) + case Dhall.Crypto.sha256DigestFromByteString suffix of + Nothing -> die ("Invalid sha256 digest: " <> show bytes) + Just digest -> return (Just digest) + + _ -> + die ("Unexpected hash token: " <> show tokenType₀) + + m <- Decoding.decodeWord + + importMode <- case m of + 0 -> return Code + 1 -> return RawText + 2 -> return Location + 3 -> return RawBytes + _ -> die ("Unexpected code for import mode: " <> show m) + + let remote scheme = do + tokenType₁ <- Decoding.peekTokenType + + headers <- case tokenType₁ of + TypeNull -> do + Decoding.decodeNull + return Nothing + + _ -> do + headers <- decodeExpressionInternal decodeImport + + return (Just headers) + + authority <- Decoding.decodeString + + paths <- replicateDecoder (len - 8) Decoding.decodeString + + file <- Decoding.decodeString + + tokenType₂ <- Decoding.peekTokenType + + query <- case tokenType₂ of + TypeNull -> do + Decoding.decodeNull + return Nothing + _ -> + fmap Just Decoding.decodeString + + let components = reverse paths + let directory = Directory {..} + let path = File {..} + + return (Remote (URL {..})) + + let local prefix = do + paths <- replicateDecoder (len - 5) Decoding.decodeString + + file <- Decoding.decodeString + + let components = reverse paths + let directory = Directory {..} + + return (Local prefix (File {..})) + + let missing = return Missing + + let env = do + x <- Decoding.decodeString + + return (Env x) + + n <- Decoding.decodeWord + + importType <- case n of + 0 -> remote HTTP + 1 -> remote HTTPS + 2 -> local Absolute + 3 -> local Here + 4 -> local Parent + 5 -> local Home + 6 -> env + 7 -> missing + _ -> fail ("Unrecognized import type code: " <> show n) + + let importHashed = ImportHashed {..} + + return (Import {..}) + +encodeImport :: Import -> Encoding +encodeImport import_ = + case importType of + Remote (URL { scheme = scheme₀, .. }) -> + encodeList + ( prefix + ++ [ Encoding.encodeInt scheme₁ + , using + , Encoding.encodeString authority + ] + ++ map Encoding.encodeString (reverse components) + ++ [ Encoding.encodeString file ] + ++ [ case query of + Nothing -> Encoding.encodeNull + Just q -> Encoding.encodeString q + ] + ) + where + using = case headers of + Nothing -> + Encoding.encodeNull + Just h -> + encodeExpressionInternal encodeImport (Syntax.denote h) + + scheme₁ = case scheme₀ of + HTTP -> 0 + HTTPS -> 1 + + File{..} = path + + Directory {..} = directory + + Local prefix₀ path -> + encodeList + ( prefix + ++ [ Encoding.encodeInt prefix₁ ] + ++ map Encoding.encodeString components₁ + ++ [ Encoding.encodeString file ] + ) + where + File{..} = path + + Directory{..} = directory + + prefix₁ = case prefix₀ of + Absolute -> 2 + Here -> 3 + Parent -> 4 + Home -> 5 + + components₁ = reverse components + + Env x -> + encodeList + (prefix ++ [ Encoding.encodeInt 6, Encoding.encodeString x ]) + + Missing -> + encodeList (prefix ++ [ Encoding.encodeInt 7 ]) + where + prefix = [ Encoding.encodeInt 24, h, m ] + where + h = case hash of + Nothing -> + Encoding.encodeNull + + Just digest -> + Encoding.encodeBytes ("\x12\x20" <> Dhall.Crypto.unSHA256Digest digest) + + m = Encoding.encodeInt (case importMode of + Code -> 0 + RawText -> 1 + Location -> 2 + RawBytes -> 3 ) + + Import{..} = import_ + + ImportHashed{..} = importHashed + +decodeVoid :: Int -> Decoder s Void +decodeVoid _ = fail "Dhall.Binary.decodeVoid: Cannot decode an uninhabited type" + +encodeVoid :: Void -> Encoding +encodeVoid = absurd + +instance Serialise (Expr Void Void) where + encode = encodeExpressionInternal encodeVoid + + decode = decodeExpressionInternal decodeVoid + +instance Serialise (Expr Void Import) where + encode = encodeExpressionInternal encodeImport + + decode = decodeExpressionInternal decodeImport + +-- | Encode a Dhall expression as a CBOR-encoded `ByteString` +encodeExpression :: Serialise (Expr Void a) => Expr Void a -> ByteString +encodeExpression = Serialise.serialise + +-- | Decode a Dhall expression from a CBOR `Codec.CBOR.Term.Term` +decodeExpression + :: Serialise (Expr s a) => ByteString -> Either DecodingFailure (Expr s a) +decodeExpression bytes = + case decodeWithoutVersion <|> decodeWithVersion of + Just expression -> Right expression + Nothing -> Left (CBORIsNotDhall bytes) + where + adapt (Right ("", x)) = Just x + adapt _ = Nothing + + decode' = decodeWith55799Tag decode + + -- This is the behavior specified by the standard + decodeWithoutVersion = adapt (Read.deserialiseFromBytes decode' bytes) + + -- tag to ease the migration + decodeWithVersion = adapt (Read.deserialiseFromBytes decodeWithTag bytes) + where + decodeWithTag = do + 2 <- Decoding.decodeListLen + + version <- Decoding.decodeString + + + -- "_" has never been a valid version string, and this ensures that + -- we don't interpret `[ "_", 0 ]` as the expression `_` (encoded as + -- `0`) tagged with a version string of `"_"` + if (version == "_") + then fail "Dhall.Binary.decodeExpression: \"_\" is not a valid version string" + else return () + + decode' + +decodeWith55799Tag :: Decoder s a -> Decoder s a +decodeWith55799Tag decoder = do + tokenType <- Decoding.peekTokenType + + case tokenType of + TypeTag -> do + w <- Decoding.decodeTag + + if w /= 55799 + then fail ("Dhall.Binary.decodeWith55799Tag: Unexpected tag: " <> show w) + else return () + + decoder + _ -> + decoder + +{-| This indicates that a given CBOR-encoded `ByteString` did not correspond to + a valid Dhall expression +-} +newtype DecodingFailure = CBORIsNotDhall ByteString + deriving (Eq) + +instance Exception DecodingFailure + +_ERROR :: String +_ERROR = "\ESC[1;31mError\ESC[0m" + +instance Show DecodingFailure where + show (CBORIsNotDhall bytes) = + _ERROR <> ": Cannot decode CBOR to Dhall\n" + <> "\n" + <> "The following bytes do not encode a valid Dhall expression\n" + <> "\n" + <> "↳ 0x" <> concatMap toHex (Data.ByteString.Lazy.unpack bytes) <> "\n" + where + toHex = Printf.printf "%02x " + +-- | This specialized version of 'Control.Monad.replicateM' reduces +-- decoding timings by roughly 10%. +replicateDecoder :: Int -> Decoder s a -> Decoder s [a] +replicateDecoder n0 decoder = go n0 + where + go n + | n <= 0 = pure [] + | otherwise = do + x <- decoder + xs <- go (n - 1) + pure (x:xs) diff --git a/src/Dhall/Context.hs b/src/Dhall/Context.hs --- a/src/Dhall/Context.hs +++ b/src/Dhall/Context.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFunctor #-} -- | This is a utility module that consolidates all `Context`-related operations @@ -14,11 +12,11 @@ , toList ) where -import Data.Text.Lazy (Text) -import Prelude hiding (lookup) +import Data.Text (Text) +import Prelude hiding (lookup) -{-| A @(Context a)@ associates `Text` labels with values of type @a@. Each - `Text` label can correspond to multiple values of type @a@ +{-| A @(Context a)@ associates `Data.Text.Text` labels with values of type @a@. + Each `Data.Text.Text` label can correspond to multiple values of type @a@ The `Context` is used for type-checking when @(a = Expr X)@ @@ -50,7 +48,6 @@ match :: Context a -> Maybe (Text, a, Context a) match (Context ((k, v) : kvs)) = Just (k, v, Context kvs) match (Context [] ) = Nothing - {-# INLINABLE match #-} {-| Look up a key by name and index @@ -60,10 +57,10 @@ > lookup k n (insert k v c) = lookup k (n - 1) c > lookup k n (insert j v c) = lookup k n c -- k /= j -} -lookup :: Text -> Integer -> Context a -> Maybe a -lookup _ !_ (Context [] ) = +lookup :: Text -> Int -> Context a -> Maybe a +lookup _ _ (Context [] ) = Nothing -lookup x !n (Context ((k, v):kvs)) = +lookup x n (Context ((k, v):kvs)) = if x == k then if n == 0 then Just v diff --git a/src/Dhall/Core.hs b/src/Dhall/Core.hs --- a/src/Dhall/Core.hs +++ b/src/Dhall/Core.hs @@ -1,1807 +1,156 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UnicodeSyntax #-} -{-# OPTIONS_GHC -Wall #-} - -{-| This module contains the core calculus for the Dhall language. - - Dhall is essentially a fork of the @morte@ compiler but with more built-in - functionality, better error messages, and Haskell integration --} - -module Dhall.Core ( - -- * Syntax - Const(..) - , HasHome(..) - , PathType(..) - , PathHashed(..) - , PathMode(..) - , Path(..) - , Var(..) - , Chunks(..) - , Expr(..) - - -- * Normalization - , alphaNormalize - , normalize - , normalizeWith - , Normalizer - , judgmentallyEqual - , subst - , shift - , isNormalized - , isNormalizedWith - , denote - - -- * Pretty-printing - , pretty - - -- * Miscellaneous - , internalError - , reservedIdentifiers - , escapeText - ) where - -#if MIN_VERSION_base(4,8,0) -#else -import Control.Applicative (Applicative(..), (<$>)) -#endif -import Control.Applicative (empty) -import Crypto.Hash (SHA256) -import Data.Bifunctor (Bifunctor(..)) -import Data.Foldable -import Data.HashMap.Strict.InsOrd (InsOrdHashMap) -import Data.HashSet (HashSet) -import Data.Monoid ((<>)) -import Data.String (IsString(..)) -import Data.Scientific (Scientific) -import Data.Sequence (Seq, ViewL(..), ViewR(..)) -import Data.Text.Buildable (Buildable(..)) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Builder (Builder) -import Data.Text.Prettyprint.Doc (Pretty) -import Data.Traversable -import {-# SOURCE #-} Dhall.Pretty.Internal -import Numeric.Natural (Natural) -import Prelude hiding (succ) - -import qualified Control.Monad -import qualified Crypto.Hash -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.HashSet -import qualified Data.Sequence -import qualified Data.Text -import qualified Data.Text.Lazy as Text -import qualified Data.Text.Lazy.Builder as Builder -import qualified Data.Text.Prettyprint.Doc as Pretty - -{-| Constants for a pure type system - - The only axiom is: - -> ⊦ Type : Kind - - ... and the valid rule pairs are: - -> ⊦ Type ↝ Type : Type -- Functions from terms to terms (ordinary functions) -> ⊦ Kind ↝ Type : Type -- Functions from types to terms (polymorphic functions) -> ⊦ Kind ↝ Kind : Kind -- Functions from types to types (type constructors) - - These are the same rule pairs as System Fω - - Note that Dhall does not support functions from terms to types and therefore - Dhall is not a dependently typed language --} -data Const = Type | Kind deriving (Show, Eq, Bounded, Enum) - -instance Buildable Const where - build = buildConst - --- | Whether or not a path is relative to the user's home directory -data HasHome = Home | Homeless deriving (Eq, Ord, Show) - --- | The type of path to import (i.e. local vs. remote vs. environment) -data PathType - = File HasHome FilePath - -- ^ Local path - | URL Text (Maybe PathHashed) - -- ^ URL of emote resource and optional headers stored in a path - | Env Text - -- ^ Environment variable - deriving (Eq, Ord, Show) - -instance Buildable PathType where - build (File Home file) - = "~/" <> build (Text.pack file) - build (File Homeless file) - | Text.isPrefixOf "./" txt - || Text.isPrefixOf "/" txt - || Text.isPrefixOf "../" txt - = build txt <> " " - | otherwise - = "./" <> build txt <> " " - where - txt = Text.pack file - build (URL str Nothing ) = build str <> " " - build (URL str (Just headers)) = build str <> " using " <> build headers <> " " - build (Env env) = "env:" <> build env - --- | How to interpret the path's contents (i.e. as Dhall code or raw text) -data PathMode = Code | RawText deriving (Eq, Ord, Show) - --- | A `PathType` extended with an optional hash for semantic integrity checks -data PathHashed = PathHashed - { hash :: Maybe (Crypto.Hash.Digest SHA256) - , pathType :: PathType - } deriving (Eq, Ord, Show) - -instance Buildable PathHashed where - build (PathHashed Nothing p) = build p - build (PathHashed (Just h) p) = build p <> "sha256:" <> build (show h) <> " " - --- | Path to an external resource -data Path = Path - { pathHashed :: PathHashed - , pathMode :: PathMode - } deriving (Eq, Ord, Show) - -instance Buildable Path where - build (Path {..}) = build pathHashed <> suffix - where - suffix = case pathMode of - RawText -> "as Text" - Code -> "" - -instance Pretty Path where - pretty path = Pretty.pretty (Builder.toLazyText (build path)) - -{-| Label for a bound variable - - The `Text` field is the variable's name (i.e. \"@x@\"). - - The `Int` field disambiguates variables with the same name if there are - multiple bound variables of the same name in scope. Zero refers to the - nearest bound variable and the index increases by one for each bound - variable of the same name going outward. The following diagram may help: - -> ┌──refers to──┐ -> │ │ -> v │ -> λ(x : Type) → λ(y : Type) → λ(x : Type) → x@0 -> -> ┌─────────────────refers to─────────────────┐ -> │ │ -> v │ -> λ(x : Type) → λ(y : Type) → λ(x : Type) → x@1 - - This `Int` behaves like a De Bruijn index in the special case where all - variables have the same name. - - You can optionally omit the index if it is @0@: - -> ┌─refers to─┐ -> │ │ -> v │ -> λ(x : Type) → λ(y : Type) → λ(x : Type) → x - - Zero indices are omitted when pretty-printing `Var`s and non-zero indices - appear as a numeric suffix. --} -data Var = V Text !Integer - deriving (Eq, Show) - -instance IsString Var where - fromString str = V (fromString str) 0 - -instance Buildable Var where - build = buildVar - --- | Syntax tree for expressions -data Expr s a - -- | > Const c ~ c - = Const Const - -- | > Var (V x 0) ~ x - -- > Var (V x n) ~ x@n - | Var Var - -- | > Lam x A b ~ λ(x : A) -> b - | Lam Text (Expr s a) (Expr s a) - -- | > Pi "_" A B ~ A -> B - -- > Pi x A B ~ ∀(x : A) -> B - | Pi Text (Expr s a) (Expr s a) - -- | > App f a ~ f a - | App (Expr s a) (Expr s a) - -- | > Let x Nothing r e ~ let x = r in e - -- > Let x (Just t) r e ~ let x : t = r in e - | Let Text (Maybe (Expr s a)) (Expr s a) (Expr s a) - -- | > Annot x t ~ x : t - | Annot (Expr s a) (Expr s a) - -- | > Bool ~ Bool - | Bool - -- | > BoolLit b ~ b - | BoolLit Bool - -- | > BoolAnd x y ~ x && y - | BoolAnd (Expr s a) (Expr s a) - -- | > BoolOr x y ~ x || y - | BoolOr (Expr s a) (Expr s a) - -- | > BoolEQ x y ~ x == y - | BoolEQ (Expr s a) (Expr s a) - -- | > BoolNE x y ~ x != y - | BoolNE (Expr s a) (Expr s a) - -- | > BoolIf x y z ~ if x then y else z - | BoolIf (Expr s a) (Expr s a) (Expr s a) - -- | > Natural ~ Natural - | Natural - -- | > NaturalLit n ~ +n - | NaturalLit Natural - -- | > NaturalFold ~ Natural/fold - | NaturalFold - -- | > NaturalBuild ~ Natural/build - | NaturalBuild - -- | > NaturalIsZero ~ Natural/isZero - | NaturalIsZero - -- | > NaturalEven ~ Natural/even - | NaturalEven - -- | > NaturalOdd ~ Natural/odd - | NaturalOdd - -- | > NaturalToInteger ~ Natural/toInteger - | NaturalToInteger - -- | > NaturalShow ~ Natural/show - | NaturalShow - -- | > NaturalPlus x y ~ x + y - | NaturalPlus (Expr s a) (Expr s a) - -- | > NaturalTimes x y ~ x * y - | NaturalTimes (Expr s a) (Expr s a) - -- | > Integer ~ Integer - | Integer - -- | > IntegerLit n ~ n - | IntegerLit Integer - -- | > IntegerShow ~ Integer/show - | IntegerShow - -- | > Double ~ Double - | Double - -- | > DoubleLit n ~ n - | DoubleLit Scientific - -- | > DoubleShow ~ Double/show - | DoubleShow - -- | > Text ~ Text - | Text - -- | > TextLit (Chunks [(t1, e1), (t2, e2)] t3) ~ "t1${e1}t2${e2}t3" - | TextLit (Chunks s a) - -- | > TextAppend x y ~ x ++ y - | TextAppend (Expr s a) (Expr s a) - -- | > List ~ List - | List - -- | > ListLit (Just t ) [x, y, z] ~ [x, y, z] : List t - -- > ListLit Nothing [x, y, z] ~ [x, y, z] - | ListLit (Maybe (Expr s a)) (Seq (Expr s a)) - -- | > ListAppend x y ~ x # y - | ListAppend (Expr s a) (Expr s a) - -- | > ListBuild ~ List/build - | ListBuild - -- | > ListFold ~ List/fold - | ListFold - -- | > ListLength ~ List/length - | ListLength - -- | > ListHead ~ List/head - | ListHead - -- | > ListLast ~ List/last - | ListLast - -- | > ListIndexed ~ List/indexed - | ListIndexed - -- | > ListReverse ~ List/reverse - | ListReverse - -- | > Optional ~ Optional - | Optional - -- | > OptionalLit t (Just e) ~ [e] : Optional t - -- > OptionalLit t Nothing ~ [] : Optional t - | OptionalLit (Expr s a) (Maybe (Expr s a)) - -- | > OptionalFold ~ Optional/fold - | OptionalFold - -- | > OptionalBuild ~ Optional/build - | OptionalBuild - -- | > Record [(k1, t1), (k2, t2)] ~ { k1 : t1, k2 : t1 } - | Record (InsOrdHashMap Text (Expr s a)) - -- | > RecordLit [(k1, v1), (k2, v2)] ~ { k1 = v1, k2 = v2 } - | RecordLit (InsOrdHashMap Text (Expr s a)) - -- | > Union [(k1, t1), (k2, t2)] ~ < k1 : t1 | k2 : t2 > - | Union (InsOrdHashMap Text (Expr s a)) - -- | > UnionLit (k1, v1) [(k2, t2), (k3, t3)] ~ < k1 = t1 | k2 : t2 | k3 : t3 > - | UnionLit Text (Expr s a) (InsOrdHashMap Text (Expr s a)) - -- | > Combine x y ~ x ∧ y - | Combine (Expr s a) (Expr s a) - -- | > CombineRight x y ~ x ⫽ y - | Prefer (Expr s a) (Expr s a) - -- | > Merge x y (Just t ) ~ merge x y : t - -- > Merge x y Nothing ~ merge x y - | Merge (Expr s a) (Expr s a) (Maybe (Expr s a)) - -- | > Constructors e ~ constructors e - | Constructors (Expr s a) - -- | > Field e x ~ e.x - | Field (Expr s a) Text - -- | > Note s x ~ e - | Note s (Expr s a) - -- | > Embed path ~ path - | Embed a - deriving (Functor, Foldable, Traversable, Show, Eq) - -instance Applicative (Expr s) where - pure = Embed - - (<*>) = Control.Monad.ap - -instance Monad (Expr s) where - return = pure - - Const a >>= _ = Const a - Var a >>= _ = Var a - Lam a b c >>= k = Lam a (b >>= k) (c >>= k) - Pi a b c >>= k = Pi a (b >>= k) (c >>= k) - App a b >>= k = App (a >>= k) (b >>= k) - Let a b c d >>= k = Let a (fmap (>>= k) b) (c >>= k) (d >>= k) - Annot a b >>= k = Annot (a >>= k) (b >>= k) - Bool >>= _ = Bool - BoolLit a >>= _ = BoolLit a - BoolAnd a b >>= k = BoolAnd (a >>= k) (b >>= k) - BoolOr a b >>= k = BoolOr (a >>= k) (b >>= k) - BoolEQ a b >>= k = BoolEQ (a >>= k) (b >>= k) - BoolNE a b >>= k = BoolNE (a >>= k) (b >>= k) - BoolIf a b c >>= k = BoolIf (a >>= k) (b >>= k) (c >>= k) - Natural >>= _ = Natural - NaturalLit a >>= _ = NaturalLit a - NaturalFold >>= _ = NaturalFold - NaturalBuild >>= _ = NaturalBuild - NaturalIsZero >>= _ = NaturalIsZero - NaturalEven >>= _ = NaturalEven - NaturalOdd >>= _ = NaturalOdd - NaturalToInteger >>= _ = NaturalToInteger - NaturalShow >>= _ = NaturalShow - NaturalPlus a b >>= k = NaturalPlus (a >>= k) (b >>= k) - NaturalTimes a b >>= k = NaturalTimes (a >>= k) (b >>= k) - Integer >>= _ = Integer - IntegerLit a >>= _ = IntegerLit a - IntegerShow >>= _ = IntegerShow - Double >>= _ = Double - DoubleLit a >>= _ = DoubleLit a - DoubleShow >>= _ = DoubleShow - Text >>= _ = Text - TextLit (Chunks a b) >>= k = TextLit (Chunks (fmap (fmap (>>= k)) a) b) - TextAppend a b >>= k = TextAppend (a >>= k) (b >>= k) - List >>= _ = List - ListLit a b >>= k = ListLit (fmap (>>= k) a) (fmap (>>= k) b) - ListAppend a b >>= k = ListAppend (a >>= k) (b >>= k) - ListBuild >>= _ = ListBuild - ListFold >>= _ = ListFold - ListLength >>= _ = ListLength - ListHead >>= _ = ListHead - ListLast >>= _ = ListLast - ListIndexed >>= _ = ListIndexed - ListReverse >>= _ = ListReverse - Optional >>= _ = Optional - OptionalLit a b >>= k = OptionalLit (a >>= k) (fmap (>>= k) b) - OptionalFold >>= _ = OptionalFold - OptionalBuild >>= _ = OptionalBuild - Record a >>= k = Record (fmap (>>= k) a) - RecordLit a >>= k = RecordLit (fmap (>>= k) a) - Union a >>= k = Union (fmap (>>= k) a) - UnionLit a b c >>= k = UnionLit a (b >>= k) (fmap (>>= k) c) - Combine a b >>= k = Combine (a >>= k) (b >>= k) - Prefer a b >>= k = Prefer (a >>= k) (b >>= k) - Merge a b c >>= k = Merge (a >>= k) (b >>= k) (fmap (>>= k) c) - Constructors a >>= k = Constructors (a >>= k) - Field a b >>= k = Field (a >>= k) b - Note a b >>= k = Note a (b >>= k) - Embed a >>= k = k a - -instance Bifunctor Expr where - first _ (Const a ) = Const a - first _ (Var a ) = Var a - first k (Lam a b c ) = Lam a (first k b) (first k c) - first k (Pi a b c ) = Pi a (first k b) (first k c) - first k (App a b ) = App (first k a) (first k b) - first k (Let a b c d ) = Let a (fmap (first k) b) (first k c) (first k d) - first k (Annot a b ) = Annot (first k a) (first k b) - first _ Bool = Bool - first _ (BoolLit a ) = BoolLit a - first k (BoolAnd a b ) = BoolAnd (first k a) (first k b) - first k (BoolOr a b ) = BoolOr (first k a) (first k b) - first k (BoolEQ a b ) = BoolEQ (first k a) (first k b) - first k (BoolNE a b ) = BoolNE (first k a) (first k b) - first k (BoolIf a b c ) = BoolIf (first k a) (first k b) (first k c) - first _ Natural = Natural - first _ (NaturalLit a ) = NaturalLit a - first _ NaturalFold = NaturalFold - first _ NaturalBuild = NaturalBuild - first _ NaturalIsZero = NaturalIsZero - first _ NaturalEven = NaturalEven - first _ NaturalOdd = NaturalOdd - first _ NaturalToInteger = NaturalToInteger - first _ NaturalShow = NaturalShow - first k (NaturalPlus a b ) = NaturalPlus (first k a) (first k b) - first k (NaturalTimes a b ) = NaturalTimes (first k a) (first k b) - first _ Integer = Integer - first _ (IntegerLit a ) = IntegerLit a - first _ IntegerShow = IntegerShow - first _ Double = Double - first _ (DoubleLit a ) = DoubleLit a - first _ DoubleShow = DoubleShow - first _ Text = Text - first k (TextLit (Chunks a b)) = TextLit (Chunks (fmap (fmap (first k)) a) b) - first k (TextAppend a b ) = TextAppend (first k a) (first k b) - first _ List = List - first k (ListLit a b ) = ListLit (fmap (first k) a) (fmap (first k) b) - first k (ListAppend a b ) = ListAppend (first k a) (first k b) - first _ ListBuild = ListBuild - first _ ListFold = ListFold - first _ ListLength = ListLength - first _ ListHead = ListHead - first _ ListLast = ListLast - first _ ListIndexed = ListIndexed - first _ ListReverse = ListReverse - first _ Optional = Optional - first k (OptionalLit a b ) = OptionalLit (first k a) (fmap (first k) b) - first _ OptionalFold = OptionalFold - first _ OptionalBuild = OptionalBuild - first k (Record a ) = Record (fmap (first k) a) - first k (RecordLit a ) = RecordLit (fmap (first k) a) - first k (Union a ) = Union (fmap (first k) a) - first k (UnionLit a b c ) = UnionLit a (first k b) (fmap (first k) c) - first k (Combine a b ) = Combine (first k a) (first k b) - first k (Prefer a b ) = Prefer (first k a) (first k b) - first k (Merge a b c ) = Merge (first k a) (first k b) (fmap (first k) c) - first k (Constructors a ) = Constructors (first k a) - first k (Field a b ) = Field (first k a) b - first k (Note a b ) = Note (k a) (first k b) - first _ (Embed a ) = Embed a - - second = fmap - -instance IsString (Expr s a) where - fromString str = Var (fromString str) - --- | The body of an interpolated @Text@ literal -data Chunks s a = Chunks [(Builder, Expr s a)] Builder - deriving (Functor, Foldable, Traversable, Show, Eq) - -instance Monoid (Chunks s a) where - mempty = Chunks [] mempty - -#if MIN_VERSION_base(4,11,0) -instance Semigroup (Chunks s a) where - (<>) (Chunks xysL zL) (Chunks [] zR) = - Chunks xysL (zL <> zR) - (<>) (Chunks xysL zL) (Chunks ((x, y):xysR) zR) = - Chunks (xysL ++ (zL <> x, y):xysR) zR -#else - mappend (Chunks xysL zL) (Chunks [] zR) = - Chunks xysL (zL <> zR) - mappend (Chunks xysL zL) (Chunks ((x, y):xysR) zR) = - Chunks (xysL ++ (zL <> x, y):xysR) zR -#endif - -instance IsString (Chunks s a) where - fromString str = Chunks [] (fromString str) - -{- There is a one-to-one correspondence between the builders in this section - and the sub-parsers in "Dhall.Parser". Each builder is named after the - corresponding parser and the relationship between builders exactly matches - the relationship between parsers. This leads to the nice emergent property - of automatically getting all the parentheses and precedences right. - - This approach has one major disadvantage: you can get an infinite loop if - you add a new constructor to the syntax tree without adding a matching - case the corresponding builder. --} - --- | Generates a syntactically valid Dhall program -instance Buildable a => Buildable (Expr s a) where - build = buildExpr - -instance Pretty a => Pretty (Expr s a) where - pretty = Pretty.unAnnotate . prettyExpr - -{-| `shift` is used by both normalization and type-checking to avoid variable - capture by shifting variable indices - - For example, suppose that you were to normalize the following expression: - -> λ(a : Type) → λ(x : a) → (λ(y : a) → λ(x : a) → y) x - - If you were to substitute @y@ with @x@ without shifting any variable - indices, then you would get the following incorrect result: - -> λ(a : Type) → λ(x : a) → λ(x : a) → x -- Incorrect normalized form - - In order to substitute @x@ in place of @y@ we need to `shift` @x@ by @1@ in - order to avoid being misinterpreted as the @x@ bound by the innermost - lambda. If we perform that `shift` then we get the correct result: - -> λ(a : Type) → λ(x : a) → λ(x : a) → x@1 - - As a more worked example, suppose that you were to normalize the following - expression: - -> λ(a : Type) -> → λ(f : a → a → a) -> → λ(x : a) -> → λ(x : a) -> → (λ(x : a) → f x x@1) x@1 - - The correct normalized result would be: - -> λ(a : Type) -> → λ(f : a → a → a) -> → λ(x : a) -> → λ(x : a) -> → f x@1 x - - The above example illustrates how we need to both increase and decrease - variable indices as part of substitution: - - * We need to increase the index of the outer @x\@1@ to @x\@2@ before we - substitute it into the body of the innermost lambda expression in order - to avoid variable capture. This substitution changes the body of the - lambda expression to @(f x\@2 x\@1)@ - - * We then remove the innermost lambda and therefore decrease the indices of - both @x@s in @(f x\@2 x\@1)@ to @(f x\@1 x)@ in order to reflect that one - less @x@ variable is now bound within that scope - - Formally, @(shift d (V x n) e)@ modifies the expression @e@ by adding @d@ to - the indices of all variables named @x@ whose indices are greater than - @(n + m)@, where @m@ is the number of bound variables of the same name - within that scope - - In practice, @d@ is always @1@ or @-1@ because we either: - - * increment variables by @1@ to avoid variable capture during substitution - * decrement variables by @1@ when deleting lambdas after substitution - - @n@ starts off at @0@ when substitution begins and increments every time we - descend into a lambda or let expression that binds a variable of the same - name in order to avoid shifting the bound variables by mistake. --} -shift :: Integer -> Var -> Expr s a -> Expr s a -shift _ _ (Const a) = Const a -shift d (V x n) (Var (V x' n')) = Var (V x' n'') - where - n'' = if x == x' && n <= n' then n' + d else n' -shift d (V x n) (Lam x' _A b) = Lam x' _A' b' - where - _A' = shift d (V x n ) _A - b' = shift d (V x n') b - where - n' = if x == x' then n + 1 else n -shift d (V x n) (Pi x' _A _B) = Pi x' _A' _B' - where - _A' = shift d (V x n ) _A - _B' = shift d (V x n') _B - where - n' = if x == x' then n + 1 else n -shift d v (App f a) = App f' a' - where - f' = shift d v f - a' = shift d v a -shift d (V x n) (Let f mt r e) = Let f mt' r' e' - where - e' = shift d (V x n') e - where - n' = if x == f then n + 1 else n - - mt' = fmap (shift d (V x n)) mt - r' = shift d (V x n) r -shift d v (Annot a b) = Annot a' b' - where - a' = shift d v a - b' = shift d v b -shift _ _ Bool = Bool -shift _ _ (BoolLit a) = BoolLit a -shift d v (BoolAnd a b) = BoolAnd a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (BoolOr a b) = BoolOr a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (BoolEQ a b) = BoolEQ a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (BoolNE a b) = BoolNE a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (BoolIf a b c) = BoolIf a' b' c' - where - a' = shift d v a - b' = shift d v b - c' = shift d v c -shift _ _ Natural = Natural -shift _ _ (NaturalLit a) = NaturalLit a -shift _ _ NaturalFold = NaturalFold -shift _ _ NaturalBuild = NaturalBuild -shift _ _ NaturalIsZero = NaturalIsZero -shift _ _ NaturalEven = NaturalEven -shift _ _ NaturalOdd = NaturalOdd -shift _ _ NaturalToInteger = NaturalToInteger -shift _ _ NaturalShow = NaturalShow -shift d v (NaturalPlus a b) = NaturalPlus a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (NaturalTimes a b) = NaturalTimes a' b' - where - a' = shift d v a - b' = shift d v b -shift _ _ Integer = Integer -shift _ _ (IntegerLit a) = IntegerLit a -shift _ _ IntegerShow = IntegerShow -shift _ _ Double = Double -shift _ _ (DoubleLit a) = DoubleLit a -shift _ _ DoubleShow = DoubleShow -shift _ _ Text = Text -shift d v (TextLit (Chunks a b)) = TextLit (Chunks a' b) - where - a' = fmap (fmap (shift d v)) a -shift d v (TextAppend a b) = TextAppend a' b' - where - a' = shift d v a - b' = shift d v b -shift _ _ List = List -shift d v (ListLit a b) = ListLit a' b' - where - a' = fmap (shift d v) a - b' = fmap (shift d v) b -shift _ _ ListBuild = ListBuild -shift d v (ListAppend a b) = ListAppend a' b' - where - a' = shift d v a - b' = shift d v b -shift _ _ ListFold = ListFold -shift _ _ ListLength = ListLength -shift _ _ ListHead = ListHead -shift _ _ ListLast = ListLast -shift _ _ ListIndexed = ListIndexed -shift _ _ ListReverse = ListReverse -shift _ _ Optional = Optional -shift d v (OptionalLit a b) = OptionalLit a' b' - where - a' = shift d v a - b' = fmap (shift d v) b -shift _ _ OptionalFold = OptionalFold -shift _ _ OptionalBuild = OptionalBuild -shift d v (Record a) = Record a' - where - a' = fmap (shift d v) a -shift d v (RecordLit a) = RecordLit a' - where - a' = fmap (shift d v) a -shift d v (Union a) = Union a' - where - a' = fmap (shift d v) a -shift d v (UnionLit a b c) = UnionLit a b' c' - where - b' = shift d v b - c' = fmap (shift d v) c -shift d v (Combine a b) = Combine a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (Prefer a b) = Prefer a' b' - where - a' = shift d v a - b' = shift d v b -shift d v (Merge a b c) = Merge a' b' c' - where - a' = shift d v a - b' = shift d v b - c' = fmap (shift d v) c -shift d v (Constructors a) = Constructors a' - where - a' = shift d v a -shift d v (Field a b) = Field a' b - where - a' = shift d v a -shift d v (Note a b) = Note a b' - where - b' = shift d v b --- The Dhall compiler enforces that all embedded values are closed expressions --- and `shift` does nothing to a closed expression -shift _ _ (Embed p) = Embed p - -{-| Substitute all occurrences of a variable with an expression - -> subst x C B ~ B[x := C] --} -subst :: Var -> Expr s a -> Expr s a -> Expr s a -subst _ _ (Const a) = Const a -subst (V x n) e (Lam y _A b) = Lam y _A' b' - where - _A' = subst (V x n ) e _A - b' = subst (V x n') (shift 1 (V y 0) e) b - n' = if x == y then n + 1 else n -subst (V x n) e (Pi y _A _B) = Pi y _A' _B' - where - _A' = subst (V x n ) e _A - _B' = subst (V x n') (shift 1 (V y 0) e) _B - n' = if x == y then n + 1 else n -subst v e (App f a) = App f' a' - where - f' = subst v e f - a' = subst v e a -subst v e (Var v') = if v == v' then e else Var v' -subst (V x n) e (Let f mt r b) = Let f mt' r' b' - where - b' = subst (V x n') (shift 1 (V f 0) e) b - where - n' = if x == f then n + 1 else n - - mt' = fmap (subst (V x n) e) mt - r' = subst (V x n) e r -subst x e (Annot a b) = Annot a' b' - where - a' = subst x e a - b' = subst x e b -subst _ _ Bool = Bool -subst _ _ (BoolLit a) = BoolLit a -subst x e (BoolAnd a b) = BoolAnd a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (BoolOr a b) = BoolOr a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (BoolEQ a b) = BoolEQ a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (BoolNE a b) = BoolNE a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (BoolIf a b c) = BoolIf a' b' c' - where - a' = subst x e a - b' = subst x e b - c' = subst x e c -subst _ _ Natural = Natural -subst _ _ (NaturalLit a) = NaturalLit a -subst _ _ NaturalFold = NaturalFold -subst _ _ NaturalBuild = NaturalBuild -subst _ _ NaturalIsZero = NaturalIsZero -subst _ _ NaturalEven = NaturalEven -subst _ _ NaturalOdd = NaturalOdd -subst _ _ NaturalToInteger = NaturalToInteger -subst _ _ NaturalShow = NaturalShow -subst x e (NaturalPlus a b) = NaturalPlus a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (NaturalTimes a b) = NaturalTimes a' b' - where - a' = subst x e a - b' = subst x e b -subst _ _ Integer = Integer -subst _ _ (IntegerLit a) = IntegerLit a -subst _ _ IntegerShow = IntegerShow -subst _ _ Double = Double -subst _ _ (DoubleLit a) = DoubleLit a -subst _ _ DoubleShow = DoubleShow -subst _ _ Text = Text -subst x e (TextLit (Chunks a b)) = TextLit (Chunks a' b) - where - a' = fmap (fmap (subst x e)) a -subst x e (TextAppend a b) = TextAppend a' b' - where - a' = subst x e a - b' = subst x e b -subst _ _ List = List -subst x e (ListLit a b) = ListLit a' b' - where - a' = fmap (subst x e) a - b' = fmap (subst x e) b -subst x e (ListAppend a b) = ListAppend a' b' - where - a' = subst x e a - b' = subst x e b -subst _ _ ListBuild = ListBuild -subst _ _ ListFold = ListFold -subst _ _ ListLength = ListLength -subst _ _ ListHead = ListHead -subst _ _ ListLast = ListLast -subst _ _ ListIndexed = ListIndexed -subst _ _ ListReverse = ListReverse -subst _ _ Optional = Optional -subst x e (OptionalLit a b) = OptionalLit a' b' - where - a' = subst x e a - b' = fmap (subst x e) b -subst _ _ OptionalFold = OptionalFold -subst _ _ OptionalBuild = OptionalBuild -subst x e (Record kts) = Record (fmap (subst x e) kts) -subst x e (RecordLit kvs) = RecordLit (fmap (subst x e) kvs) -subst x e (Union kts) = Union (fmap (subst x e) kts) -subst x e (UnionLit a b kts) = UnionLit a (subst x e b) (fmap (subst x e) kts) -subst x e (Combine a b) = Combine a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (Prefer a b) = Prefer a' b' - where - a' = subst x e a - b' = subst x e b -subst x e (Merge a b c) = Merge a' b' c' - where - a' = subst x e a - b' = subst x e b - c' = fmap (subst x e) c -subst x e (Constructors a) = Constructors a' - where - a' = subst x e a -subst x e (Field a b) = Field a' b - where - a' = subst x e a -subst x e (Note a b) = Note a b' - where - b' = subst x e b --- The Dhall compiler enforces that all embedded values are closed expressions --- and `subst` does nothing to a closed expression -subst _ _ (Embed p) = Embed p - -{-| α-normalize an expression by renaming all variables to @\"_\"@ and using - De Bruijn indices to distinguish them --} -alphaNormalize :: Expr s a -> Expr s a -alphaNormalize (Const c) = - Const c -alphaNormalize (Var v) = - Var v -alphaNormalize (Lam x _A₀ b₀) = - Lam "_" _A₁ b₃ - where - _A₁ = alphaNormalize _A₀ - - v₀ = Var (V "_" 0) - v₁ = shift 1 (V x 0) v₀ - b₁ = subst (V x 0) v₁ b₀ - b₂ = shift (-1) (V x 0) b₁ - b₃ = alphaNormalize b₂ -alphaNormalize (Pi x _A₀ _B₀) = - Pi "_" _A₁ _B₃ - where - _A₁ = alphaNormalize _A₀ - - v₀ = Var (V "_" 0) - v₁ = shift 1 (V x 0) v₀ - _B₁ = subst (V x 0) v₁ _B₀ - _B₂ = shift (-1) (V x 0) _B₁ - _B₃ = alphaNormalize _B₂ -alphaNormalize (App f₀ a₀) = - App f₁ a₁ - where - f₁ = alphaNormalize f₀ - - a₁ = alphaNormalize a₀ -alphaNormalize (Let x (Just _A₀) a₀ b₀) = - Let "_" (Just _A₁) a₁ b₃ - where - _A₁ = alphaNormalize _A₀ - - a₁ = alphaNormalize a₀ - - v₀ = Var (V "_" 0) - v₁ = shift 1 (V x 0) v₀ - b₁ = subst (V x 0) v₁ b₀ - b₂ = shift (-1) (V x 0) b₁ - b₃ = alphaNormalize b₂ -alphaNormalize (Let x Nothing a₀ b₀) = - Let "_" Nothing a₁ b₃ - where - a₁ = alphaNormalize a₀ - - v₀ = Var (V "_" 0) - v₁ = shift 1 (V x 0) v₀ - b₁ = subst (V x 0) v₁ b₀ - b₂ = shift (-1) (V x 0) b₁ - b₃ = alphaNormalize b₂ -alphaNormalize (Annot t₀ _T₀) = - Annot t₁ _T₁ - where - t₁ = alphaNormalize t₀ - - _T₁ = alphaNormalize _T₀ -alphaNormalize Bool = - Bool -alphaNormalize (BoolLit b) = - BoolLit b -alphaNormalize (BoolAnd l₀ r₀) = - BoolAnd l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (BoolOr l₀ r₀) = - BoolOr l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (BoolEQ l₀ r₀) = - BoolEQ l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (BoolNE l₀ r₀) = - BoolNE l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (BoolIf t₀ l₀ r₀) = - BoolIf t₁ l₁ r₁ - where - t₁ = alphaNormalize t₀ - - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize Natural = - Natural -alphaNormalize (NaturalLit n) = - NaturalLit n -alphaNormalize NaturalFold = - NaturalFold -alphaNormalize NaturalBuild = - NaturalBuild -alphaNormalize NaturalIsZero = - NaturalIsZero -alphaNormalize NaturalEven = - NaturalEven -alphaNormalize NaturalOdd = - NaturalOdd -alphaNormalize NaturalToInteger = - NaturalToInteger -alphaNormalize NaturalShow = - NaturalShow -alphaNormalize (NaturalPlus l₀ r₀) = - NaturalPlus l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (NaturalTimes l₀ r₀) = - NaturalTimes l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize Integer = - Integer -alphaNormalize (IntegerLit n) = - IntegerLit n -alphaNormalize IntegerShow = - IntegerShow -alphaNormalize Double = - Double -alphaNormalize (DoubleLit n) = - DoubleLit n -alphaNormalize DoubleShow = - DoubleShow -alphaNormalize Text = - Text -alphaNormalize (TextLit (Chunks xys₀ z)) = - TextLit (Chunks xys₁ z) - where - xys₁ = do - (x, y₀) <- xys₀ - let y₁ = alphaNormalize y₀ - return (x, y₁) -alphaNormalize (TextAppend l₀ r₀) = - TextAppend l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize List = - List -alphaNormalize (ListLit (Just _T₀) ts₀) = - ListLit (Just _T₁) ts₁ - where - _T₁ = alphaNormalize _T₀ - - ts₁ = fmap alphaNormalize ts₀ -alphaNormalize (ListLit Nothing ts₀) = - ListLit Nothing ts₁ - where - ts₁ = fmap alphaNormalize ts₀ -alphaNormalize (ListAppend l₀ r₀) = - ListAppend l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize ListBuild = - ListBuild -alphaNormalize ListFold = - ListFold -alphaNormalize ListLength = - ListLength -alphaNormalize ListHead = - ListHead -alphaNormalize ListLast = - ListLast -alphaNormalize ListIndexed = - ListIndexed -alphaNormalize ListReverse = - ListReverse -alphaNormalize Optional = - Optional -alphaNormalize (OptionalLit _T₀ ts₀) = - OptionalLit _T₁ ts₁ - where - _T₁ = alphaNormalize _T₀ - - ts₁ = fmap alphaNormalize ts₀ -alphaNormalize OptionalFold = - OptionalFold -alphaNormalize OptionalBuild = - OptionalBuild -alphaNormalize (Record kts₀) = - Record kts₁ - where - kts₁ = fmap alphaNormalize kts₀ -alphaNormalize (RecordLit kvs₀) = - RecordLit kvs₁ - where - kvs₁ = fmap alphaNormalize kvs₀ -alphaNormalize (Union kts₀) = - Union kts₁ - where - kts₁ = fmap alphaNormalize kts₀ -alphaNormalize (UnionLit k v₀ kts₀) = - UnionLit k v₁ kts₁ - where - v₁ = alphaNormalize v₀ - - kts₁ = fmap alphaNormalize kts₀ -alphaNormalize (Combine l₀ r₀) = - Combine l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (Prefer l₀ r₀) = - Prefer l₁ r₁ - where - l₁ = alphaNormalize l₀ - - r₁ = alphaNormalize r₀ -alphaNormalize (Merge t₀ u₀ _T₀) = - Merge t₁ u₁ _T₁ - where - t₁ = alphaNormalize t₀ - - u₁ = alphaNormalize u₀ - - _T₁ = fmap alphaNormalize _T₀ -alphaNormalize (Constructors u₀) = - Constructors u₁ - where - u₁ = alphaNormalize u₀ -alphaNormalize (Field e₀ a) = - Field e₁ a - where - e₁ = alphaNormalize e₀ -alphaNormalize (Note s e₀) = - Note s e₁ - where - e₁ = alphaNormalize e₀ -alphaNormalize (Embed a) = - Embed a - -{-| Reduce an expression to its normal form, performing beta reduction - - `normalize` does not type-check the expression. You may want to type-check - expressions before normalizing them since normalization can convert an - ill-typed expression into a well-typed expression. - - However, `normalize` will not fail if the expression is ill-typed and will - leave ill-typed sub-expressions unevaluated. --} -normalize :: Eq a => Expr s a -> Expr t a -normalize = normalizeWith (const Nothing) - -{-| This function is used to determine whether folds like @Natural/fold@ or - @List/fold@ should be lazy or strict in their accumulator based on the type - of the accumulator - - If this function returns `True`, then they will be strict in their - accumulator since we can guarantee an upper bound on the amount of work to - normalize the accumulator on each step of the loop. If this function - returns `False` then they will be lazy in their accumulator and only - normalize the final result at the end of the fold --} -boundedType :: Expr s a -> Bool -boundedType Bool = True -boundedType Natural = True -boundedType Integer = True -boundedType Double = True -boundedType Text = True -boundedType (App List _) = False -boundedType (App Optional t) = boundedType t -boundedType (Record kvs) = all boundedType kvs -boundedType (Union kvs) = all boundedType kvs -boundedType _ = False - --- | Remove all `Note` constructors from an `Expr` (i.e. de-`Note`) -denote :: Expr s a -> Expr t a -denote (Note _ b ) = denote b -denote (Const a ) = Const a -denote (Var a ) = Var a -denote (Lam a b c ) = Lam a (denote b) (denote c) -denote (Pi a b c ) = Pi a (denote b) (denote c) -denote (App a b ) = App (denote a) (denote b) -denote (Let a b c d ) = Let a (fmap denote b) (denote c) (denote d) -denote (Annot a b ) = Annot (denote a) (denote b) -denote Bool = Bool -denote (BoolLit a ) = BoolLit a -denote (BoolAnd a b ) = BoolAnd (denote a) (denote b) -denote (BoolOr a b ) = BoolOr (denote a) (denote b) -denote (BoolEQ a b ) = BoolEQ (denote a) (denote b) -denote (BoolNE a b ) = BoolNE (denote a) (denote b) -denote (BoolIf a b c ) = BoolIf (denote a) (denote b) (denote c) -denote Natural = Natural -denote (NaturalLit a ) = NaturalLit a -denote NaturalFold = NaturalFold -denote NaturalBuild = NaturalBuild -denote NaturalIsZero = NaturalIsZero -denote NaturalEven = NaturalEven -denote NaturalOdd = NaturalOdd -denote NaturalToInteger = NaturalToInteger -denote NaturalShow = NaturalShow -denote (NaturalPlus a b ) = NaturalPlus (denote a) (denote b) -denote (NaturalTimes a b ) = NaturalTimes (denote a) (denote b) -denote Integer = Integer -denote (IntegerLit a ) = IntegerLit a -denote IntegerShow = IntegerShow -denote Double = Double -denote (DoubleLit a ) = DoubleLit a -denote DoubleShow = DoubleShow -denote Text = Text -denote (TextLit (Chunks a b)) = TextLit (Chunks (fmap (fmap denote) a) b) -denote (TextAppend a b ) = TextAppend (denote a) (denote b) -denote List = List -denote (ListLit a b ) = ListLit (fmap denote a) (fmap denote b) -denote (ListAppend a b ) = ListAppend (denote a) (denote b) -denote ListBuild = ListBuild -denote ListFold = ListFold -denote ListLength = ListLength -denote ListHead = ListHead -denote ListLast = ListLast -denote ListIndexed = ListIndexed -denote ListReverse = ListReverse -denote Optional = Optional -denote (OptionalLit a b ) = OptionalLit (denote a) (fmap denote b) -denote OptionalFold = OptionalFold -denote OptionalBuild = OptionalBuild -denote (Record a ) = Record (fmap denote a) -denote (RecordLit a ) = RecordLit (fmap denote a) -denote (Union a ) = Union (fmap denote a) -denote (UnionLit a b c ) = UnionLit a (denote b) (fmap denote c) -denote (Combine a b ) = Combine (denote a) (denote b) -denote (Prefer a b ) = Prefer (denote a) (denote b) -denote (Merge a b c ) = Merge (denote a) (denote b) (fmap denote c) -denote (Constructors a ) = Constructors (denote a) -denote (Field a b ) = Field (denote a) b -denote (Embed a ) = Embed a - -{-| Reduce an expression to its normal form, performing beta reduction and applying - any custom definitions. - - `normalizeWith` is designed to be used with function `typeWith`. The `typeWith` - function allows typing of Dhall functions in a custom typing context whereas - `normalizeWith` allows evaluating Dhall expressions in a custom context. - - To be more precise `normalizeWith` applies the given normalizer when it finds an - application term that it cannot reduce by other means. - - Note that the context used in normalization will determine the properties of normalization. - That is, if the functions in custom context are not total then the Dhall language, evaluated - with those functions is not total either. - --} -normalizeWith :: Eq a => Normalizer a -> Expr s a -> Expr t a -normalizeWith ctx e0 = loop (denote e0) - where - loop e = case e of - Const k -> Const k - Var v -> Var v - Lam x _A b -> Lam x _A' b' - where - _A' = loop _A - b' = loop b - Pi x _A _B -> Pi x _A' _B' - where - _A' = loop _A - _B' = loop _B - App f a -> case loop f of - Lam x _A b -> loop b'' -- Beta reduce - where - a' = shift 1 (V x 0) a - b' = subst (V x 0) a' b - b'' = shift (-1) (V x 0) b' - f' -> case App f' a' of - -- build/fold fusion for `List` - App (App ListBuild _) (App (App ListFold _) e') -> loop e' - - -- build/fold fusion for `Natural` - App NaturalBuild (App NaturalFold e') -> loop e' - - -- build/fold fusion for `Optional` - App (App OptionalBuild _) (App (App OptionalFold _) e') -> loop e' - - App (App (App (App NaturalFold (NaturalLit n0)) t) succ') zero -> - if boundedType (loop t) then strict else lazy - where - strict = strictLoop n0 - lazy = loop ( lazyLoop n0) - - strictLoop !0 = loop zero - strictLoop !n = loop (App succ' (strictLoop (n - 1))) - - lazyLoop !0 = zero - lazyLoop !n = App succ' (lazyLoop (n - 1)) - App NaturalBuild g -> loop (App (App (App g Natural) succ) zero) - where - succ = Lam "x" Natural (NaturalPlus "x" (NaturalLit 1)) - - zero = NaturalLit 0 - App NaturalIsZero (NaturalLit n) -> BoolLit (n == 0) - App NaturalEven (NaturalLit n) -> BoolLit (even n) - App NaturalOdd (NaturalLit n) -> BoolLit (odd n) - App NaturalToInteger (NaturalLit n) -> IntegerLit (toInteger n) - App NaturalShow (NaturalLit n) -> - TextLit (Chunks [] ("+" <> buildNatural n)) - App IntegerShow (IntegerLit n) -> - TextLit (Chunks [] (buildNumber n)) - App DoubleShow (DoubleLit n) -> - TextLit (Chunks [] (buildScientific n)) - App (App OptionalBuild _A₀) g -> - loop (App (App (App g optional) just) nothing) - where - _A₁ = shift 1 "a" _A₀ - - optional = App Optional _A₀ - - just = Lam "a" _A₀ (OptionalLit _A₁ (pure "a")) - - nothing = OptionalLit _A₀ empty - App (App ListBuild _A₀) g -> loop (App (App (App g list) cons) nil) - where - _A₁ = shift 1 "a" _A₀ - - list = App List _A₀ - - cons = - Lam "a" _A₀ - (Lam "as" - (App List _A₁) - (ListAppend (ListLit Nothing (pure "a")) "as") - ) - - nil = ListLit (Just _A₀) empty - App (App (App (App (App ListFold _) (ListLit _ xs)) t) cons) nil -> - if boundedType (loop t) then strict else lazy - where - strict = foldr strictCons strictNil xs - lazy = loop (foldr lazyCons lazyNil xs) - - strictNil = loop nil - lazyNil = nil - - strictCons y ys = loop (App (App cons y) ys) - lazyCons y ys = App (App cons y) ys - App (App ListLength _) (ListLit _ ys) -> - NaturalLit (fromIntegral (Data.Sequence.length ys)) - App (App ListHead t) (ListLit _ ys) -> loop (OptionalLit t m) - where - m = case Data.Sequence.viewl ys of - y :< _ -> Just y - _ -> Nothing - App (App ListLast t) (ListLit _ ys) -> loop (OptionalLit t m) - where - m = case Data.Sequence.viewr ys of - _ :> y -> Just y - _ -> Nothing - App (App ListIndexed _A₀) (ListLit _A₁ as₀) -> - loop (ListLit (Just _A₂) as₁) - where - as₁ = Data.Sequence.mapWithIndex adapt as₀ - - _A₂ = Record (Data.HashMap.Strict.InsOrd.fromList kts) - where - kts = [ ("index", Natural) - , ("value", _A₀) - ] - - adapt n a_ = - RecordLit (Data.HashMap.Strict.InsOrd.fromList kvs) - where - kvs = [ ("index", NaturalLit (fromIntegral n)) - , ("value", a_) - ] - App (App ListReverse t) (ListLit _ xs) -> - loop (ListLit m (Data.Sequence.reverse xs)) - where - m = if Data.Sequence.null xs then Just t else Nothing - App (App (App (App (App OptionalFold _) (OptionalLit _ xs)) _) just) nothing -> - loop (maybe nothing just' xs) - where - just' = App just - _ -> case ctx (App f' a') of - Nothing -> App f' a' - Just app' -> loop app' - where - a' = loop a - Let f _ r b -> loop b'' - where - r' = shift 1 (V f 0) r - b' = subst (V f 0) r' b - b'' = shift (-1) (V f 0) b' - Annot x _ -> loop x - Bool -> Bool - BoolLit b -> BoolLit b - BoolAnd x y -> decide (loop x) (loop y) - where - decide (BoolLit True ) r = r - decide (BoolLit False) _ = BoolLit False - decide l (BoolLit True ) = l - decide _ (BoolLit False) = BoolLit False - decide l r - | judgmentallyEqual l r = l - | otherwise = BoolAnd l r - BoolOr x y -> decide (loop x) (loop y) - where - decide (BoolLit False) r = r - decide (BoolLit True ) _ = BoolLit True - decide l (BoolLit False) = l - decide _ (BoolLit True ) = BoolLit True - decide l r - | judgmentallyEqual l r = l - | otherwise = BoolOr l r - BoolEQ x y -> decide (loop x) (loop y) - where - decide (BoolLit True ) r = r - decide l (BoolLit True ) = l - decide l r - | judgmentallyEqual l r = BoolLit True - | otherwise = BoolEQ l r - BoolNE x y -> decide (loop x) (loop y) - where - decide (BoolLit False) r = r - decide l (BoolLit False) = l - decide l r - | judgmentallyEqual l r = BoolLit False - | otherwise = BoolNE l r - BoolIf bool true false -> decide (loop bool) (loop true) (loop false) - where - decide (BoolLit True ) l _ = l - decide (BoolLit False) _ r = r - decide b (BoolLit True) (BoolLit False) = b - decide b l r - | judgmentallyEqual l r = l - | otherwise = BoolIf b l r - Natural -> Natural - NaturalLit n -> NaturalLit n - NaturalFold -> NaturalFold - NaturalBuild -> NaturalBuild - NaturalIsZero -> NaturalIsZero - NaturalEven -> NaturalEven - NaturalOdd -> NaturalOdd - NaturalToInteger -> NaturalToInteger - NaturalShow -> NaturalShow - NaturalPlus x y -> decide (loop x) (loop y) - where - decide (NaturalLit 0) r = r - decide l (NaturalLit 0) = l - decide (NaturalLit m) (NaturalLit n) = NaturalLit (m + n) - decide l r = NaturalPlus l r - NaturalTimes x y -> decide (loop x) (loop y) - where - decide (NaturalLit 1) r = r - decide l (NaturalLit 1) = l - decide (NaturalLit 0) _ = NaturalLit 0 - decide _ (NaturalLit 0) = NaturalLit 0 - decide (NaturalLit m) (NaturalLit n) = NaturalLit (m * n) - decide l r = NaturalTimes l r - Integer -> Integer - IntegerLit n -> IntegerLit n - IntegerShow -> IntegerShow - Double -> Double - DoubleLit n -> DoubleLit n - DoubleShow -> DoubleShow - Text -> Text - TextLit (Chunks xys z) -> - case mconcat chunks of - Chunks [("", x)] "" -> x - c -> TextLit c - where - chunks = concatMap process xys ++ [Chunks [] z] - - process (x, y) = case loop y of - TextLit c -> [Chunks [] x, c] - y' -> [Chunks [(x, y')] mempty] - TextAppend x y -> decide (loop x) (loop y) - where - isEmpty (Chunks [] "") = True - isEmpty _ = False - - decide (TextLit m) r | isEmpty m = r - decide l (TextLit n) | isEmpty n = l - decide (TextLit m) (TextLit n) = TextLit (m <> n) - decide l r = TextAppend l r - List -> List - ListLit t es -> ListLit t' es' - where - t' = fmap loop t - es' = fmap loop es - ListAppend x y -> decide (loop x) (loop y) - where - decide (ListLit _ m) r | Data.Sequence.null m = r - decide l (ListLit _ n) | Data.Sequence.null n = l - decide (ListLit t m) (ListLit _ n) = ListLit t (m <> n) - decide l r = ListAppend l r - ListBuild -> ListBuild - ListFold -> ListFold - ListLength -> ListLength - ListHead -> ListHead - ListLast -> ListLast - ListIndexed -> ListIndexed - ListReverse -> ListReverse - Optional -> Optional - OptionalLit t es -> OptionalLit t' es' - where - t' = loop t - es' = fmap loop es - OptionalFold -> OptionalFold - OptionalBuild -> OptionalBuild - Record kts -> Record kts' - where - kts' = fmap loop kts - RecordLit kvs -> RecordLit kvs' - where - kvs' = fmap loop kvs - Union kts -> Union kts' - where - kts' = fmap loop kts - UnionLit k v kvs -> UnionLit k v' kvs' - where - v' = loop v - kvs' = fmap loop kvs - Combine x y -> decide (loop x) (loop y) - where - decide (RecordLit m) r | Data.HashMap.Strict.InsOrd.null m = - r - decide l (RecordLit n) | Data.HashMap.Strict.InsOrd.null n = - l - decide (RecordLit m) (RecordLit n) = - RecordLit (Data.HashMap.Strict.InsOrd.unionWith decide m n) - decide l r = - Combine l r - Prefer x y -> decide (loop x) (loop y) - where - decide (RecordLit m) r | Data.HashMap.Strict.InsOrd.null m = - r - decide l (RecordLit n) | Data.HashMap.Strict.InsOrd.null n = - l - decide (RecordLit m) (RecordLit n) = - RecordLit (Data.HashMap.Strict.InsOrd.union n m) - decide l r = - Prefer l r - Merge x y t -> - case x' of - RecordLit kvsX -> - case y' of - UnionLit kY vY _ -> - case Data.HashMap.Strict.InsOrd.lookup kY kvsX of - Just vX -> loop (App vX vY) - Nothing -> Merge x' y' t' - _ -> Merge x' y' t' - _ -> Merge x' y' t' - where - x' = loop x - y' = loop y - t' = fmap loop t - Constructors t -> - case t' of - Union kts -> RecordLit kvs - where - kvs = Data.HashMap.Strict.InsOrd.mapWithKey adapt kts - - adapt k t_ = Lam k t_ (UnionLit k (Var (V k 0)) rest) - where - rest = Data.HashMap.Strict.InsOrd.delete k kts - _ -> Constructors t' - where - t' = loop t - Field r x -> - case loop r of - RecordLit kvs -> - case Data.HashMap.Strict.InsOrd.lookup x kvs of - Just v -> loop v - Nothing -> Field (RecordLit (fmap loop kvs)) x - r' -> Field r' x - Note _ e' -> loop e' - Embed a -> Embed a - -{-| Returns `True` if two expressions are α-equivalent and β-equivalent and - `False` otherwise --} -judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool -judgmentallyEqual eL0 eR0 = alphaBetaNormalize eL0 == alphaBetaNormalize eR0 - where - alphaBetaNormalize :: Eq a => Expr s a -> Expr () a - alphaBetaNormalize = alphaNormalize . normalize - --- | Use this to wrap you embedded functions (see `normalizeWith`) to make them --- polymorphic enough to be used. -type Normalizer a = forall s. Expr s a -> Maybe (Expr s a) - --- | Check if an expression is in a normal form given a context of evaluation. --- Unlike `isNormalized`, this will fully normalize and traverse through the expression. --- --- It is much more efficient to use `isNormalized`. -isNormalizedWith :: (Eq s, Eq a) => Normalizer a -> Expr s a -> Bool -isNormalizedWith ctx e = e == (normalizeWith ctx e) - - --- | Quickly check if an expression is in normal form -isNormalized :: Expr s a -> Bool -isNormalized e = case denote e of - Const _ -> True - Var _ -> True - Lam _ a b -> isNormalized a && isNormalized b - Pi _ a b -> isNormalized a && isNormalized b - App f a -> isNormalized f && isNormalized a && case App f a of - App (Lam _ _ _) _ -> False - - -- build/fold fusion for `List` - App (App ListBuild _) (App (App ListFold _) _) -> False - - -- build/fold fusion for `Natural` - App NaturalBuild (App NaturalFold _) -> False - - -- build/fold fusion for `Optional` - App (App OptionalBuild _) (App (App OptionalFold _) _) -> False - - App (App (App (App NaturalFold (NaturalLit _)) _) _) _ -> False - App NaturalBuild _ -> False - App NaturalIsZero (NaturalLit _) -> False - App NaturalEven (NaturalLit _) -> False - App NaturalOdd (NaturalLit _) -> False - App NaturalShow (NaturalLit _) -> False - App NaturalToInteger (NaturalLit _) -> False - App IntegerShow (IntegerLit _) -> False - App DoubleShow (DoubleLit _) -> False - App (App OptionalBuild _) _ -> False - App (App ListBuild _) _ -> False - App (App (App (App (App ListFold _) (ListLit _ _)) _) _) _ -> - False - App (App ListLength _) (ListLit _ _) -> False - App (App ListHead _) (ListLit _ _) -> False - App (App ListLast _) (ListLit _ _) -> False - App (App ListIndexed _) (ListLit _ _) -> False - App (App ListReverse _) (ListLit _ _) -> False - App (App (App (App (App OptionalFold _) (OptionalLit _ _)) _) _) _ -> - False - _ -> True - Let _ _ _ _ -> False - Annot _ _ -> False - Bool -> True - BoolLit _ -> True - BoolAnd x y -> isNormalized x && isNormalized y && - case x of - BoolLit _ -> - case y of - BoolLit _ -> False - _ -> True - _ -> True - BoolOr x y -> isNormalized x && isNormalized y && - case x of - BoolLit _ -> - case y of - BoolLit _ -> False - _ -> True - _ -> True - BoolEQ x y -> isNormalized x && isNormalized y && - case x of - BoolLit _ -> - case y of - BoolLit _ -> False - _ -> True - _ -> True - BoolNE x y -> isNormalized x && isNormalized y && - case x of - BoolLit _ -> - case y of - BoolLit _ -> False - _ -> True - _ -> True - BoolIf b true false -> isNormalized b && case b of - BoolLit _ -> False - _ -> isNormalized true && isNormalized false - Natural -> True - NaturalLit _ -> True - NaturalFold -> True - NaturalBuild -> True - NaturalIsZero -> True - NaturalEven -> True - NaturalOdd -> True - NaturalShow -> True - NaturalToInteger -> True - NaturalPlus x y -> isNormalized x && isNormalized y && - case x of - NaturalLit _ -> - case y of - NaturalLit _ -> False - _ -> True - _ -> True - NaturalTimes x y -> isNormalized x && isNormalized y && - case x of - NaturalLit _ -> - case y of - NaturalLit _ -> False - _ -> True - _ -> True - Integer -> True - IntegerLit _ -> True - IntegerShow -> True - Double -> True - DoubleLit _ -> True - DoubleShow -> True - Text -> True - TextLit (Chunks xys _) -> all (all isNormalized) xys - TextAppend x y -> isNormalized x && isNormalized y && - case x of - TextLit _ -> - case y of - TextLit _ -> False - _ -> True - _ -> True - List -> True - ListLit t es -> all isNormalized t && all isNormalized es - ListAppend x y -> isNormalized x && isNormalized y && - case x of - ListLit _ _ -> - case y of - ListLit _ _ -> False - _ -> True - _ -> True - ListBuild -> True - ListFold -> True - ListLength -> True - ListHead -> True - ListLast -> True - ListIndexed -> True - ListReverse -> True - Optional -> True - OptionalLit t es -> isNormalized t && all isNormalized es - OptionalFold -> True - OptionalBuild -> True - Record kts -> all isNormalized kts - RecordLit kvs -> all isNormalized kvs - Union kts -> all isNormalized kts - UnionLit _ v kvs -> isNormalized v && all isNormalized kvs - Combine x y -> isNormalized x && isNormalized y && combine - where - combine = case x of - RecordLit _ -> case y of - RecordLit _ -> False - _ -> True - _ -> True - Prefer x y -> isNormalized x && isNormalized y && combine - where - combine = case x of - RecordLit _ -> case y of - RecordLit _ -> False - _ -> True - _ -> True - Merge x y t -> isNormalized x && isNormalized y && any isNormalized t && - case x of - RecordLit kvsX -> - case y of - UnionLit kY _ _ -> - case Data.HashMap.Strict.InsOrd.lookup kY kvsX of - Just _ -> False - Nothing -> True - _ -> True - _ -> True - Constructors t -> isNormalized t && - case t of - Union _ -> False - _ -> True - Field r x -> isNormalized r && - case r of - RecordLit kvs -> - case Data.HashMap.Strict.InsOrd.lookup x kvs of - Just _ -> False - Nothing -> True - _ -> True - Note _ e' -> isNormalized e' - Embed _ -> True - -_ERROR :: String -_ERROR = "\ESC[1;31mError\ESC[0m" - -{-| Utility function used to throw internal errors that should never happen - (in theory) but that are not enforced by the type system --} -internalError :: Data.Text.Text -> forall b . b -internalError text = error (unlines - [ _ERROR <> ": Compiler bug " - , " " - , "Explanation: This error message means that there is a bug in the Dhall compiler." - , "You didn't do anything wrong, but if you would like to see this problem fixed " - , "then you should report the bug at: " - , " " - , "https://github.com/dhall-lang/dhall-haskell/issues " - , " " - , "Please include the following text in your bug report: " - , " " - , "``` " - , Data.Text.unpack text <> " " - , "``` " - ] ) - --- | The set of reserved identifiers for the Dhall language -reservedIdentifiers :: HashSet Text -reservedIdentifiers = - Data.HashSet.fromList - [ "let" - , "in" - , "Type" - , "Kind" - , "forall" - , "Bool" - , "True" - , "False" - , "merge" - , "if" - , "then" - , "else" - , "as" - , "using" - , "constructors" - , "Natural" - , "Natural/fold" - , "Natural/build" - , "Natural/isZero" - , "Natural/even" - , "Natural/odd" - , "Natural/toInteger" - , "Natural/show" - , "Integer" - , "Integer/show" - , "Double" - , "Double/show" - , "Text" - , "List" - , "List/build" - , "List/fold" - , "List/length" - , "List/head" - , "List/last" - , "List/indexed" - , "List/reverse" - , "Optional" - , "Optional/build" - , "Optional/fold" - ] +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} + +{-| This module contains the core calculus for the Dhall language. + + Dhall is essentially a fork of the @morte@ compiler but with more built-in + functionality, better error messages, and Haskell integration +-} + +module Dhall.Core ( + -- * Syntax + Const(..) + , Directory(..) + , File(..) + , FilePrefix(..) + , Import(..) + , ImportHashed(..) + , ImportMode(..) + , ImportType(..) + , URL(..) + , Scheme(..) + , DhallDouble(..) + , Var(..) + , Binding(..) + , makeBinding + , Chunks(..) + , PreferAnnotation(..) + , RecordField(..) + , makeRecordField + , FunctionBinding(..) + , makeFunctionBinding + , FieldSelection (..) + , makeFieldSelection + , WithComponent (..) + , Expr(..) + + -- * Normalization + , alphaNormalize + , normalize + , normalizeWith + , normalizeWithM + , Normalizer + , NormalizerM + , ReifiedNormalizer (..) + , judgmentallyEqual + , subst + , shift + , isNormalized + , isNormalizedWith + , denote + , renote + , shallowDenote + , freeIn + + -- * Pretty-printing + , pretty + + -- * Optics + , subExpressions + , subExpressionsWith + , chunkExprs + , bindingExprs + , recordFieldExprs + , functionBindingExprs + + -- * Let-blocks + , multiLet + , wrapInLets + , MultiLet(..) + + -- * Miscellaneous + , internalError + , reservedIdentifiers + , escapeText + , pathCharacter + , throws + , Eval.textShow + , censorExpression + , censorText + ) where + +import Control.Exception (Exception) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Text (Text) +import Dhall.Normalize +import Dhall.Pretty.Internal +import Dhall.Src (Src (..)) +import Dhall.Syntax +import Instances.TH.Lift () +import Lens.Micro (over) +import Prettyprinter (Pretty) + +import qualified Control.Exception +import qualified Data.Text +import qualified Dhall.Eval as Eval + +-- | Pretty-print a value +pretty :: Pretty a => a -> Text +pretty = pretty_ +{-# INLINE pretty #-} + +{-| Escape a `Data.Text.Text` literal using Dhall's escaping rules + + Note that the result does not include surrounding quotes +-} +escapeText :: Text -> Text +escapeText = escapeText_ +{-# INLINE escapeText #-} + + +{-| Utility used to implement the @--censor@ flag, by: + + * Replacing all `Src` text with spaces + * Replacing all `Dhall.Syntax.Text` literals inside type errors with spaces +-} +censorExpression :: Expr Src a -> Expr Src a +censorExpression (TextLit chunks) = TextLit (censorChunks chunks) +censorExpression (Note src e) = Note (censorSrc src) (censorExpression e) +censorExpression e = over subExpressions censorExpression e + +censorChunks :: Chunks Src a -> Chunks Src a +censorChunks (Chunks xys z) = Chunks xys' z' + where + z' = censorText z + + xys' = [ (censorText x, censorExpression y) | (x, y) <- xys ] + +{-| Utility used to censor `Data.Text.Text` by replacing all characters with a + space +-} +censorText :: Text -> Text +censorText = Data.Text.map (\_ -> ' ') + +censorSrc :: Src -> Src +censorSrc (Src { srcText = oldText, .. }) = Src { srcText = newText, .. } + where + newText = censorText oldText + +{-| Convenience utility for converting `Either`-based exceptions to `IO`-based + exceptions +-} +throws :: (Exception e, MonadIO io) => Either e a -> io a +throws (Left e) = liftIO (Control.Exception.throwIO e) +throws (Right r) = return r +{-# INLINABLE throws #-} + +{- $setup +>>> import qualified Codec.Serialise +>>> import qualified Dhall.Binary +>>> import Data.SpecialValues +>>> import Test.QuickCheck (Arbitrary(..), oneof, elements) +>>> :{ + instance Arbitrary DhallDouble where + arbitrary = fmap DhallDouble (oneof [ arbitrary, elements specialValues ]) +:} +-} diff --git a/src/Dhall/Core.hs-boot b/src/Dhall/Core.hs-boot deleted file mode 100644 --- a/src/Dhall/Core.hs-boot +++ /dev/null @@ -1,7 +0,0 @@ -module Dhall.Core where - -data Const - -data Var - -data Expr s a diff --git a/src/Dhall/Deriving.hs b/src/Dhall/Deriving.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Deriving.hs @@ -0,0 +1,547 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +{-| Newtypes for writing customizable 'FromDhall' and 'ToDhall' instances + through the DerivingVia strategy. + + Inspired by Matt Parson's blog post + [Mirror Mirror: Reflection and Encoding Via](https://www.parsonsmatt.org/2020/02/04/mirror_mirror.html), + but applied to Dhall instead of JSON. + + This module is intended to be used with + [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) + so it's only available for GHC >= v8.6.1. + + Check the section /Letting DerivingVia do the work/ if you want to see this module in action. (Click "Dhall.Deriving#derivingVia" to jump there) + +-} + +module Dhall.Deriving + ( + -- * Introduction + -- $introduction + + -- * Writing FromDhall instances by hand + -- $instancesByHand + + -- * Letting DerivingVia do the work + -- $derivingVia + + -- * Behind the scenes of Codec + -- $behindTheScenes + + -- * DerivingVia newtype + Codec (..) + + -- * Type-level functions on InterpretOptions + , ModifyOptions (..) + , Field + , Constructor + , SetSingletonConstructors + + -- * Type-level functions on Text + , TextFunction (..) + , DropPrefix + , TitleCase + , CamelCase + , PascalCase + , SnakeCase + , SpinalCase + , TrainCase + + -- * Type-level versions of SingletonConstructors + , ToSingletonConstructors(..) + , Bare + , Wrapped + , Smart + + -- * Identity and Composition for ModifyOptions and TextFunction + , AsIs + , type (<<<) + + -- * Helper function on Text + , dropPrefix + + -- * InterpretOptions setters + , addFieldModifier + , addConstructorModifier + , setSingletonConstructors + + ) where + +import Data.Proxy (Proxy (..)) +import Dhall +import GHC.Generics (Generic (Rep)) +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) + +import qualified Data.Text as Text +import qualified Data.Text.Manipulate as Case + +-- | Intended for use on @deriving via@ clauses for types with a +-- 'Generic' instance. The @tag@ argument is used to construct an +-- 'InterpretOptions' value which is used as the first argument +-- to 'genericAutoWith'. +newtype Codec tag a = Codec { unCodec :: a } + +instance (Generic a, GenericFromDhall a (Rep a), ModifyOptions tag) => FromDhall (Codec tag a) where + autoWith _ = Codec <$> genericAutoWith (modifyOptions @tag defaultInterpretOptions) + +instance (Generic a, GenericToDhall (Rep a), ModifyOptions tag) => ToDhall (Codec tag a) where + injectWith _ = unCodec >$< genericToDhallWith (modifyOptions @tag defaultInterpretOptions) + +-- | Convert a type into a @InterpretOptions -> InterpretOptions@ function +class ModifyOptions a where + modifyOptions :: InterpretOptions -> InterpretOptions + + +-- | The identity for functions on 'InterpretOptions' and on @Text@. +-- Useful for deriving @FromDhall@ and @ToDhall@ with the default options. +type AsIs = () + +instance ModifyOptions AsIs where + modifyOptions = id + +instance TextFunction AsIs where + textFunction = id + + +-- | Composition for functions on 'InterpretOptions' and on @Text@. +-- We use @<<<@ since @.@ isn't a valid type operator yet +-- (it will be valid starting from ghc-8.8.1) +data a <<< b +infixr 1 <<< + +instance (ModifyOptions a, ModifyOptions b) => ModifyOptions (a <<< b) where + modifyOptions = modifyOptions @a . modifyOptions @b + +instance (TextFunction a, TextFunction b) => TextFunction (a <<< b) where + textFunction = textFunction @a . textFunction @b + + +-- | @Field t@ post-composes the @fieldModifier@ from @options@ with the +-- value-level version of @t@, obtained with @TextFunction@ +data Field a +instance TextFunction a => ModifyOptions (Field a) where + modifyOptions = addFieldModifier (textFunction @a) + +-- | @Constructor t@ post-composes the @constructorModifier@ from @options@ +-- with the value-level version of @t@, obtained with @TextFunction@ +data Constructor a +instance TextFunction a => ModifyOptions (Constructor a) where + modifyOptions = addConstructorModifier (textFunction @a) + + +-- * Text Functions + +-- | Convert a type into a @Text -> Text@ function +class TextFunction a where + textFunction :: Text -> Text + +-- | @DropPrefix prefix@ corresponds to the value level +-- function @'dropPrefix' prefix@ +data DropPrefix (s :: Symbol) +instance KnownSymbol s => TextFunction (DropPrefix s) where + textFunction = dropPrefix (Text.pack (symbolVal @s Proxy)) + +-- | Convert casing to @Title Cased Phrase@ +data TitleCase +instance TextFunction TitleCase where + textFunction = Case.toTitle + +-- | Convert casing to @camelCasedPhrase@ +data CamelCase +instance TextFunction CamelCase where + textFunction = Case.toCamel + +-- | Convert casing to @PascalCasedPhrase@ +data PascalCase +instance TextFunction PascalCase where + textFunction = Case.toPascal + +-- | Convert casing to @snake_cased_phrase@ +data SnakeCase +instance TextFunction SnakeCase where + textFunction = Case.toSnake + +-- | Convert casing to @spinal-cased-phrase@ +data SpinalCase +instance TextFunction SpinalCase where + textFunction = Case.toSpinal + +-- | Convert casing to @Train-Cased-Phrase@ +data TrainCase +instance TextFunction TrainCase where + textFunction = Case.toTrain + + +-- | @SetSingletonConstructors t@ replaces the @singletonConstructors@ +-- from @options@ with the value-level version of @t@. +data SetSingletonConstructors a +instance ToSingletonConstructors a => ModifyOptions (SetSingletonConstructors a) where + modifyOptions = setSingletonConstructors (asSingletonConstructors @a) + +-- | Convert a type of kind @SingletonConstructors@ +-- into a value of type @SingletonConstructors@ +class ToSingletonConstructors (a :: SingletonConstructors) where + asSingletonConstructors :: SingletonConstructors + +-- | Type-level version of 'Dhall.Bare'. +-- Never wrap the field of a singleton constructor in a record +type Bare = 'Bare +instance ToSingletonConstructors Bare where + asSingletonConstructors = Bare + +-- | Type-level version of 'Dhall.Wrapped' +-- Always wrap the field of a singleton constructor in a record +type Wrapped = 'Wrapped +instance ToSingletonConstructors Wrapped where + asSingletonConstructors = Wrapped + +-- | Type-level version of 'Dhall.Smart' +-- Wrap the field of a singleton constructor in a record +-- only if the field is named +type Smart = 'Smart +instance ToSingletonConstructors Smart where + asSingletonConstructors = Smart + + +-- * Text helper + +-- | @dropPrefix prefix text@ returns the suffix of @text@ if its prefix +-- matches @prefix@, or the entire @text@ otherwise +dropPrefix :: Text -> (Text -> Text) +dropPrefix prefix text = case Text.stripPrefix prefix text of + Nothing -> text + Just e -> e + +-- * InterpretOptions setters + +-- | @addFieldModifier f options@ post-composes the @fieldModifier@ +-- from @options@ with @f@. +addFieldModifier :: (Text -> Text) -> InterpretOptions -> InterpretOptions +addFieldModifier f options = options + { fieldModifier = f . fieldModifier options } + +-- | @addConstructorModifier f options@ post-composes the @constructorModifier@ +-- from @options@ with @f@. +addConstructorModifier :: (Text -> Text) -> InterpretOptions -> InterpretOptions +addConstructorModifier f options = options + { constructorModifier = f . constructorModifier options } + +-- | @setSingletonConstructors v options@ replaces the @singletonConstructors@ +-- from @options@ with @v@. +setSingletonConstructors :: SingletonConstructors -> InterpretOptions -> InterpretOptions +setSingletonConstructors v options = options + { singletonConstructors = v } + +{- $introduction + +Let's take the following Haskell data types: + +>>> :set -XDerivingStrategies + +>>> :{ +newtype Name = Name { getName :: Text } + deriving stock (Show) +:} + +>>> :{ +data Font = Arial | ComicSans | Helvetica | TimesNewRoman + deriving stock (Show) +:} + +>>> :{ +data Person = Person + { personName :: Name + , personFavoriteFont :: Font + } + deriving stock (Show) +:} + +And assume we want to read the following Dhall file as a @Person@: + +@ +-- ./simon.dhall +let Name = Text +let Font = \< Arial | `Comic Sans` | Helvetica | `Times New Roman` \> +let Person = { name : Name, favoriteFont : Font } +in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person +@ + +Usually, you would build a 'Decoder' by hand, like this + +>>> :{ +font :: Decoder Font +font = + union + ( (Arial <$ constructor "Arial" unit) + <> (ComicSans <$ constructor "Comic Sans" unit) + <> (Helvetica <$ constructor "Helvetica" unit) + <> (TimesNewRoman <$ constructor "Times New Roman" unit) + ) +:} + +>>> :{ +name :: Decoder Name +name = Name <$> strictText +:} + +>>> :{ +person :: Decoder Person +person = + record + ( Person <$> field "name" name + <*> field "favoriteFont" font + ) +:} + +and then you use it like this + +>>> input person "./simon.dhall" +Person {personName = Name {getName = "Simon"}, personFavoriteFont = ComicSans} + +So, it works! However, this is quite mechanic, and the compiler has pretty +much all the information it needs to do it for you. Besides, you'd like to +provide an instance of 'FromDhall' so you can use the polymorphic 'Decoder' +'auto' instead of explicitly calling @person@. +-} + +{- $instancesByHand +"Aha!," you think, "I'll write an empty @instance 'FromDhall' Person@". +That in turn requires you to add two other instances for @Font@ and for @Name@, +plus 'Generic' instances for each of those, but that's okay. + +>>> :set -XStandaloneDeriving +>>> :set -XDeriveGeneric + +>>> :{ +deriving stock instance Generic Name +deriving stock instance Generic Font +deriving stock instance Generic Person +:} + +>>> :{ +instance FromDhall Name +instance FromDhall Font +instance FromDhall Person +:} + +However, when you try to read the same file with 'auto', you get this: + +>>> input auto "./simon.dhall" :: IO Person +*** Exception: +...Error...: Expression doesn't match annotation +... +{ - personFavoriteFont : … +, - personName : … +, + favoriteFont : … +, + name : … +} +... +1│ ./simon.dhall : { personName : { getName : Text } +2│ , personFavoriteFont : < Arial | ComicSans | Helvetica | TimesNewRoman > +3│ } +... + +What happened? The field names don't quite match, since we're using prefixed +field names in Haskell but no prefixes in Dhall. "Okay," you think, +"I can write a custom instance which builds on 'Generic' thanks to +'genericAutoWith', I only need to supply a function to drop the prefixes +and @camelCase@ the rest". So, using 'Data.Text.Manipulate.toCamel': + +>>> import Data.Text.Manipulate (toCamel) +>>> import qualified Data.Text as Text +>>> :{ +instance FromDhall Person where + autoWith _ = + genericAutoWith defaultInterpretOptions + { fieldModifier = toCamel . Text.drop (Text.length "person") } +:} + +Let's try to read that again: + +>>> input auto "./simon.dhall":: IO Person +*** Exception: +...Error...: Expression doesn't match annotation +... +{ favoriteFont : < - ComicSans : … + | - TimesNewRoman : … + | + `Comic Sans` : … + | + `Times New Roman` : … + | … + > +, name : - { … : … } (a record type) + + Text +} +... +1│ ./simon.dhall : { name : { getName : Text } +2│ , favoriteFont : < Arial | ComicSans | Helvetica | TimesNewRoman > +3│ } +... + +Okay, we're almost there. We have two things to solve now. +First, the @Font@ constructors are @PascalCased@ in Haskell, +but @Title Cased@ in Dhall. We can communicate this to our +'FromDhall' instance using 'Data.Text.Manipulate.toTitle': + +>>> import Data.Text.Manipulate (toTitle) +>>> :{ +instance FromDhall Font where + autoWith _ = + genericAutoWith defaultInterpretOptions + { constructorModifier = toTitle } +:} + +Second, we defined the @Name@ type in Haskell as a newtype over @Text@, with a +@getName@ field for unwrapping. In Dhall, however, @Name@ is a synonym of +'Data.Text.Text', which is why 'Dhall.input' above was expecting a record. +The 'Dhall.Bare' option for 'singletonConstructors' is a perfect fit here: +it translates Haskell singleton constructors into the Dhall version of the +nested type, without wrapping it into a record. +We can then tweak our 'FromDhall' instance like this: + +>>> :{ +instance FromDhall Name where + autoWith _ = + genericAutoWith defaultInterpretOptions + { singletonConstructors = Bare } +:} + +Since we're running this interactively, we also need to update the +instance for @Person@, but it's the same as before. + +>>> :{ +instance FromDhall Person where + autoWith _ = + genericAutoWith defaultInterpretOptions + { fieldModifier = toCamel . Text.drop (Text.length "person") } +:} + +Now, for the moment of truth: + +>>> input auto "./simon.dhall":: IO Person +Person {personName = Name {getName = "Simon"}, personFavoriteFont = ComicSans} + +That took a bit more work than we wanted, though, and a lot of it was just +boilerplate for defining the instances through `genericAutoWith`, tweaking +a single parameter at a time. Even worse, if we also wanted to provide +'ToDhall' instances we would need to keep the options in sync between both +instances, since otherwise the values wouldn't be able to round-trip from +Dhall to Dhall through Haskell. + +-} + +{- $derivingVia + #derivingVia# + +Starting with this dhall file: + +@ +-- ./simon.dhall +let Name = Text +let Font = \< Arial | `Comic Sans` | Helvetica | `Times New Roman` \> +let Person = { name : Name, favoriteFont : Font } +in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person +@ + +We can define the equivalent Haskell types as follows. Note that we +derive the 'FromDhall' and 'ToDhall' instances @via 'Codec' tag TheType@, +using a different @tag@ depending on the transformations we need to apply to +the Haskell type to get the Dhall equivalent: + +>>> :set -XDataKinds +>>> :set -XDeriveGeneric +>>> :set -XDerivingVia +>>> :set -XTypeOperators + +>>> :{ +newtype Name = Name { getName :: Text } + deriving stock (Generic, Show) + deriving (FromDhall, ToDhall) + via Codec (SetSingletonConstructors Bare) Name +:} + +>>> :{ +data Font = Arial | ComicSans | Helvetica | TimesNewRoman + deriving stock (Generic, Show) + deriving (FromDhall, ToDhall) + via Codec (Constructor TitleCase) Font +:} + +>>> :{ +data Person = Person + { personName :: Name + , personFavoriteFont :: Font + } + deriving stock (Generic, Show) + deriving (FromDhall, ToDhall) + via Codec (Field (CamelCase <<< DropPrefix "person")) Person +:} + +we can then read the file using 'auto': + +>>> simon <- input auto "./simon.dhall":: IO Person +>>> print simon +Person {personName = Name {getName = "Simon"}, personFavoriteFont = ComicSans} + +And using 'inject' we can get @simon@ back as a Dhall value: + +>>> import qualified Data.Text.IO as Text +>>> import Dhall.Core (pretty) +>>> Text.putStrLn . pretty . embed inject $ simon +{ name = "Simon" +, favoriteFont = + < Arial | `Comic Sans` | Helvetica | `Times New Roman` >.`Comic Sans` +} + +-} + +{- $behindTheScenes + +@'Codec' tag a@ is really just a newtype over @a@, equipped with a +phantom @tag@. The 'FromDhall' instance for 'Codec' uses the generic +representation of @a@, together with the 'InterpretOptions' defined by @tag@ as +a series of modifications to be applied on 'defaultInterpretOptions'. + +For the default behavior, using 'AsIs' (a synonym for @()@) as the @tag@ +leaves the interpret options alone, so it's equivalent to the empty instance +we first tried to use. + +@'Field' a@ and @'Constructor' a@ can be used to modify, respectively, the +'fieldModifier' and 'constructorModifier' options of 'InterpretOptions', by +post-composing the modifier with @'textFunction' \@a@, that is, the value-level +equivalent of @a@, obtained through the 'TextFunction' class. + +In the case of @Person@, we used + +@ + Codec (Field (CamelCase <<< DropPrefix "person")) Person +@ + +which means that the @Text -> Text@ version of + +@ + CamelCase <<< DropPrefix "person" +@ + +was used to modify the @fieldModifier@ option. + +In the value level, this translates to composing ('<<<') +'Data.Text.Manipulate.toCamel' ('CamelCase') with @'dropPrefix' "person"@ +(@'DropPrefix' "person"@). + +Finally, @'SetSingletonConstructors' a@ can be used to set the +'singletonConstructors' option of 'InterpretOptions', by replacing the option +with the value-level equivalent of @a@. +-} + +{- $setup +>>> :set -XOverloadedStrings +-} diff --git a/src/Dhall/Diff.hs b/src/Dhall/Diff.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Diff.hs @@ -0,0 +1,1477 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + +{-| This module provides functionality for concisely displaying the difference + between two expressions + + For example, this is used in type errors to explain why the actual type does + not match the expected type +-} + +module Dhall.Diff ( + -- * Diff + Diff (..) + , diffNormalized + , diff + ) where + +import Data.ByteString (ByteString) +import Data.Foldable (fold, toList) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Monoid (Any (..)) +import Data.Sequence (Seq) +import Data.String (IsString (..)) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Map (Map) +import Dhall.Pretty.Internal (Ann) +import Dhall.Syntax + ( Binding (..) + , Chunks (..) + , Const (..) + , DhallDouble (..) + , Expr (..) + , FunctionBinding (..) + , RecordField (..) + , Var (..) + , WithComponent (..) + ) +import Numeric.Natural (Natural) +import Prettyprinter (Doc, Pretty) + +import qualified Data.Algorithm.Diff as Algo.Diff +import qualified Data.List.NonEmpty +import qualified Data.Set +import qualified Data.Text +import qualified Data.Time as Time +import qualified Dhall.Map +import qualified Dhall.Normalize as Normalize +import qualified Dhall.Pretty.Internal as Internal +import qualified Dhall.Syntax as Syntax +import qualified Prettyprinter as Pretty + +{-| This type is a `Doc` enriched with a `same` flag to efficiently track if + any difference was detected +-} +data Diff = + Diff + { same :: Bool + , doc :: Doc Ann + } + +instance Semigroup Diff where + Diff sameL docL <> Diff sameR docR = Diff (sameL && sameR) (docL <> docR) + +instance Monoid (Diff) where + mempty = Diff {..} + where + same = True + + doc = mempty + +instance IsString (Diff) where + fromString string = Diff {..} + where + same = True + + doc = fromString string + +ignore :: Diff +ignore = "…" + +align :: Diff -> Diff +align (Diff {doc = docOld, ..}) = Diff {doc = Pretty.align docOld, .. } + +hardline :: Diff +hardline = token Pretty.hardline + +minus :: Diff -> Diff +minus l = ("- " <> l) { same = False } + +plus :: Diff -> Diff +plus r = ("+ " <> r) { same = False } + +difference :: Diff -> Diff -> Diff +difference l r = align (minus l <> hardline <> plus r) + +token :: Doc Ann -> Diff +token doc = Diff {..} + where + same = True + +format :: Diff -> Diff -> Diff +format suffix doc = doc <> (if same doc then suffix else hardline) + +builtin :: Doc Ann -> Diff +builtin doc = token (Internal.builtin doc) + +keyword :: Doc Ann -> Diff +keyword doc = token (Internal.keyword doc) + +operator :: Doc Ann -> Diff +operator doc = token (Internal.operator doc) + +colon :: Diff +colon = token Internal.colon + +comma :: Diff +comma = token Internal.comma + +dot :: Diff +dot = token Internal.dot + +equals :: Diff +equals = token Internal.equals + +forall_ :: Diff +forall_ = token (Internal.forall_ Internal.Unicode) + +lambda :: Diff +lambda = token (Internal.lambda Internal.Unicode) + +langle :: Diff +langle = token Internal.langle + +lbrace :: Diff +lbrace = token Internal.lbrace + +lbracket :: Diff +lbracket = token Internal.lbracket + +lparen :: Diff +lparen = token Internal.lparen + +pipe :: Diff +pipe = token Internal.pipe + +rangle :: Diff +rangle = token Internal.rangle + +rarrow :: Diff +rarrow = token (Internal.rarrow Internal.Unicode) + +rbrace :: Diff +rbrace = token Internal.rbrace + +rbracket :: Diff +rbracket = token Internal.rbracket + +rparen :: Diff +rparen = token Internal.rparen + +-- | Render the difference between the normal form of two expressions +diffNormalized :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff +diffNormalized l0 r0 = Dhall.Diff.diff l1 r1 + where + l1 = Normalize.alphaNormalize (Normalize.normalize l0) + r1 = Normalize.alphaNormalize (Normalize.normalize r0) + +diffPrimitive :: Eq a => (a -> Diff) -> a -> a -> Diff +diffPrimitive f l r + | l == r = ignore + | otherwise = difference (f l) (f r) + +diffLabel :: Text -> Text -> Diff +diffLabel = diffPrimitive (token . Internal.prettyLabel) + +diffLabels :: [Text] -> [Text] -> Diff +diffLabels ksL ksR = + braced (diffFieldNames <> (if anyEqual then [ ignore ] else [])) + where + setL = Data.Set.fromList ksL + setR = Data.Set.fromList ksR + + extraL = Data.Set.difference setL setR + extraR = Data.Set.difference setR setL + + diffFieldNames = foldMap (adapt minus) extraL <> foldMap (adapt plus) extraR + where + adapt sign key = [ sign (token (Internal.prettyLabel key)) ] + + anyEqual = not (Data.Set.null (Data.Set.intersection setL setR)) + +diffNatural :: Natural -> Natural -> Diff +diffNatural = diffPrimitive (token . Internal.prettyNatural) + +diffDouble :: DhallDouble -> DhallDouble -> Diff +diffDouble = diffPrimitive (token . Internal.prettyDouble . getDhallDouble) + +diffDateLiteral :: Time.Day -> Time.Day -> Diff +diffDateLiteral = + diffPrimitive (token . Internal.prettyExpr @(Expr Void Void) . DateLiteral) + +diffTimeLiteral :: Time.TimeOfDay -> Word -> Time.TimeOfDay -> Word -> Diff +diffTimeLiteral tL pL tR pR = + diffPrimitive + (token . Internal.prettyExpr @(Expr Void Void) . uncurry TimeLiteral) + (tL, pL) + (tR, pR) + +diffTimeZoneLiteral :: Time.TimeZone -> Time.TimeZone -> Diff +diffTimeZoneLiteral = + diffPrimitive + (token . Internal.prettyExpr @(Expr Void Void) . TimeZoneLiteral) + +diffConst :: Const -> Const -> Diff +diffConst = diffPrimitive (token . Internal.prettyConst) + +diffBool :: Bool -> Bool -> Diff +diffBool = diffPrimitive bool + where + bool True = builtin "True" + bool False = builtin "False" + +diffInteger :: Integer -> Integer -> Diff +diffInteger = diffPrimitive (token . Internal.prettyNumber) + +diffInt :: Int -> Int -> Diff +diffInt = diffPrimitive (token . Internal.prettyInt) + +diffVar :: Var -> Var -> Diff +diffVar (V xL nL) (V xR nR) = + format mempty label <> if same natural then mempty else "@" <> natural + where + label = diffLabel xL xR + + natural = diffInt nL nR + +diffPretty :: (Eq a, Pretty a) => a -> a -> Diff +diffPretty = diffPrimitive (token . Pretty.pretty) + +diffMaybe :: Diff -> (a -> a -> Diff) -> (Maybe a -> Maybe a -> Diff) +diffMaybe _ _ Nothing Nothing = + mempty +diffMaybe prefix _ Nothing (Just _) = + difference mempty (prefix <> ignore) +diffMaybe prefix _ (Just _) Nothing = + difference (prefix <> ignore) mempty +diffMaybe prefix f (Just l) (Just r) = + prefix <> f l r + +enclosed + :: Diff + -> Diff + -> Diff + -> [Diff] + -> Diff +enclosed l _ r [] = l <> r +enclosed l m r docs = align (fold (zipWith (<>) prefixes docs) <> suffix) + where + prefixes = l : repeat (hardline <> m) + + suffix = hardline <> r + +enclosed' + :: Diff + -> Diff + -> NonEmpty (Diff) + -> Diff +enclosed' l m docs = + align (fold (Data.List.NonEmpty.zipWith (<>) prefixes docs)) + where + prefixes = l :| repeat (hardline <> m) + +diffKeyVals + :: (Eq a, Pretty a) + => Diff + -> Map Text (RecordField Void a) + -> Map Text (RecordField Void a) + -> [Diff] +diffKeyVals assign kvsL kvsR = diffKeysWith assign diff + (recordFieldValue <$> kvsL) + (recordFieldValue <$> kvsR) + +diffKeysWith + :: Diff + -> (a -> a -> Diff) + -> Map Text a + -> Map Text a + -> [Diff] +diffKeysWith assign diffVals kvsL kvsR = + diffFieldNames <> diffFieldValues <> (if anyEqual then [ ignore ] else []) + where + ksL = Dhall.Map.keysSet kvsL + ksR = Dhall.Map.keysSet kvsR + + extraL = Data.Set.difference ksL ksR + extraR = Data.Set.difference ksR ksL + + diffFieldNames = foldMap (adapt minus) extraL <> foldMap (adapt plus) extraR + where + adapt sign key = + [ sign (token (Internal.prettyLabel key)) + <> " " + <> assign + <> " " + <> ignore + ] + + shared = Dhall.Map.intersectionWith diffVals kvsL kvsR + + diffFieldValues = + filter (not . same) (Dhall.Map.foldMapWithKey adapt shared) + where + adapt key doc = + [ (if ksL == ksR then mempty else " ") + <> token (Internal.prettyLabel key) + <> " " + <> assign + <> " " + <> doc + ] + + anyEqual = getAny (foldMap (Any . same) shared) + +braced :: [Diff] -> Diff +braced = enclosed (lbrace <> " ") (comma <> " ") rbrace + +angled :: [Diff] -> Diff +angled = enclosed (langle <> " ") (pipe <> " ") rangle + +bracketed :: [Diff] -> Diff +bracketed = enclosed (lbracket <> " ") (comma <> " ") rbracket + +diffText :: Text -> Text -> Diff +diffText l r = "\"" <> foldMap prettyPart parts <> "\"" + where + -- TODO: check for color support from the TTY + colorDiff colorCode chars = + "\ESC[" + <> colorCode + <> "m" + <> fromString chars + <> "\ESC[0m" + + prettyPart part = + case part of + -- Only present in left + Algo.Diff.First chars -> + -- Red background + (colorDiff "41" chars) { same = False } + + -- Only present in right + Algo.Diff.Second chars -> + -- Green background + (colorDiff "42" chars) { same = False } + + -- Present in both + Algo.Diff.Both _ chars -> + -- Dim foreground + colorDiff "2" chars + + parts = Algo.Diff.getGroupedDiff (Data.Text.unpack l) (Data.Text.unpack r) + +diffChunks + :: (Eq a, Pretty a) + => Chunks Void a -> Chunks Void a -> Diff +diffChunks cL cR + | null chunks = "\"\"" + | [c] <- chunks = c + | otherwise = align (enclosed " " "++ " "" chunks) + where + toEitherList (Chunks te t) = + concatMap (\(a, b) -> [Left a, Right b]) te ++ [Left t] + + diffTextSkeleton = difference textSkeleton textSkeleton + + chunks = zipWith chunkDiff (toEitherList cL) (toEitherList cR) + + chunkDiff a b = + case (a, b) of + (Left x, Left y ) -> diffText x y + (Right x, Right y) -> diff x y + _ -> diffTextSkeleton + +diffBytes :: ByteString -> ByteString -> Diff +diffBytes l r = + "0x" <> diffText (Internal.prettyBase16 l) (Internal.prettyBase16 r) + +diffList + :: (Eq a, Pretty a) + => Seq (Expr Void a) -> Seq (Expr Void a) -> Diff +diffList l r = bracketed (loop parts₀) + where + -- Sections of the list that are only in left, only in right, or in both + parts₀ = Algo.Diff.getGroupedDiffBy equal (toList l) (toList r) + + equal a b = same (diff a b) + + -- Render each element of a list using an extra rendering function f + prettyElems f = map (f . token . Internal.prettyExpr) + + loop [] = + mempty + loop (Algo.Diff.First as : Algo.Diff.Second bs : parts) + | length as == length bs = zipWith diff as bs <> loop parts + loop (part : parts) = + diffPart part <> loop parts + + diffPart part = + case part of + -- Only present in left + Algo.Diff.First elements -> + prettyElems minus elements + + -- Only present in right + Algo.Diff.Second elements -> + prettyElems plus elements + + -- Present in both + Algo.Diff.Both _ _ -> + pure ignore + +diffRecord + :: (Eq a, Pretty a) + => Map Text (RecordField Void a) -> Map Text (RecordField Void a) -> Diff +diffRecord kvsL kvsR = braced (diffKeyVals colon kvsL kvsR) + +diffRecordLit + :: (Eq a, Pretty a) + => Map Text (RecordField Void a) -> Map Text (RecordField Void a) -> Diff +diffRecordLit kvsL kvsR = braced (diffKeyVals equals kvsL kvsR) + +diffUnion + :: (Eq a, Pretty a) + => Map Text (Maybe (Expr Void a)) -> Map Text (Maybe (Expr Void a)) -> Diff +diffUnion kvsL kvsR = angled (diffKeysWith colon diffVals kvsL kvsR) + where + diffVals = diffMaybe (colon <> " ") diff + +textSkeleton :: Diff +textSkeleton = + "\"" + <> ignore + <> "\"" + +skeleton :: Pretty a => Expr s a -> Diff +skeleton (Lam {}) = + lambda + <> lparen + <> ignore + <> " " + <> colon + <> " " + <> ignore + <> rparen + <> " " + <> rarrow + <> " " + <> ignore + <> " (a function)" +skeleton (Pi {}) = + ignore + <> " " + <> rarrow + <> " " + <> ignore + <> " (a function type)" +skeleton (App Optional _) = + "Optional " + <> ignore +skeleton (App None _) = + "None " + <> ignore +skeleton (Some _) = + "Some " + <> ignore +skeleton (App List _) = + "List " + <> ignore +skeleton (App {}) = + ignore + <> " " + <> ignore +skeleton (Let {}) = + keyword "let" + <> " " + <> ignore + <> " " + <> equals + <> " " + <> ignore + <> " " + <> keyword "in" + <> " " + <> ignore +skeleton (Annot {}) = + ignore + <> " " + <> colon + <> " " + <> ignore +skeleton (BoolAnd {}) = + ignore + <> " " + <> operator "&&" + <> " " + <> ignore +skeleton (BoolOr {}) = + ignore + <> " " + <> operator "||" + <> " " + <> ignore +skeleton (BoolEQ {}) = + ignore + <> " " + <> operator "==" + <> " " + <> ignore +skeleton (BoolNE {}) = + ignore + <> " " + <> operator "!=" + <> " " + <> ignore +skeleton (BoolIf {}) = + keyword "if" + <> " " + <> ignore + <> " " + <> keyword "then" + <> " " + <> ignore + <> " " + <> keyword "else" + <> " " + <> ignore +skeleton (BytesLit {}) = + "0x\"" + <> ignore + <> "\"" +skeleton (NaturalPlus {}) = + ignore + <> " " + <> operator "+" + <> " " + <> ignore +skeleton (NaturalTimes {}) = + ignore + <> " " + <> operator "*" + <> " " + <> ignore +skeleton (TextLit {}) = + textSkeleton +skeleton (TextAppend {}) = + ignore + <> " " + <> operator "++" + <> " " + <> ignore +skeleton (ListLit _ elems) + | null elems = + lbracket + <> rbracket + <> " " + <> colon + <> " " + <> ignore + | otherwise = + lbracket + <> " " + <> ignore + <> " " + <> rbracket +skeleton (ListAppend {}) = + ignore + <> " " + <> operator "#" + <> " " + <> ignore +skeleton (Record {}) = + lbrace + <> " " + <> ignore + <> " " + <> colon + <> " " + <> ignore + <> " " + <> rbrace + <> " (a record type)" +skeleton (RecordLit {}) = + lbrace + <> " " + <> ignore + <> " " + <> equals + <> " " + <> ignore + <> " " + <> rbrace + <> " (a record)" +skeleton (Union {}) = + langle + <> " " + <> ignore + <> " " + <> colon + <> " " + <> ignore + <> " " + <> rangle + <> " (a union type)" +skeleton (Combine {}) = + ignore + <> " " + <> operator "∧" + <> " " + <> ignore +skeleton (CombineTypes {}) = + ignore + <> " " + <> operator "⩓" + <> " " + <> ignore +skeleton (Prefer {}) = + ignore + <> " " + <> operator "⫽" + <> " " + <> ignore +skeleton (RecordCompletion {}) = + ignore + <> operator "::" + <> ignore +skeleton (Merge {}) = + keyword "merge" + <> " " + <> ignore + <> " " + <> ignore +skeleton (ToMap {}) = + keyword "toMap" + <> " " + <> ignore +skeleton (ShowConstructor {}) = + keyword "showConstructor" + <> " " + <> ignore +skeleton (Field {}) = + ignore + <> dot + <> ignore +skeleton (Project {}) = + ignore + <> dot + <> lbrace + <> " " + <> ignore + <> " " + <> rbrace +skeleton (With {}) = + ignore + <> " " + <> keyword "with" + <> " " + <> ignore +skeleton x = token (Pretty.pretty x) + +mismatch :: Pretty a => Expr s a -> Expr s a -> Diff +mismatch l r = difference (skeleton l) (skeleton r) + +-- | Render the difference between two expressions +diff :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diff l@(Lam {}) r@(Lam {}) = + enclosed' " " (rarrow <> " ") (docs l r) + where + docs + (Lam _ (FunctionBinding { functionBindingVariable = aL, functionBindingAnnotation = bL }) cL) + (Lam _ (FunctionBinding { functionBindingVariable = aR, functionBindingAnnotation = bR }) cR) = + Data.List.NonEmpty.cons (align doc) (docs cL cR) + where + doc = lambda + <> lparen + <> format " " (diffLabel aL aR) + <> colon + <> " " + <> format mempty (diff bL bR) + <> rparen + + docs aL aR = + pure (diff aL aR) +diff l@(Lam {}) r = + mismatch l r +diff l r@(Lam {}) = + mismatch l r +diff l@(BoolIf {}) r@(BoolIf {}) = + enclosed' " " (keyword "else" <> " ") (docs l r) + where + docs (BoolIf aL bL cL) (BoolIf aR bR cR) = + Data.List.NonEmpty.cons (align doc) (docs cL cR) + where + doc = keyword "if" + <> " " + <> format " " (diff aL aR) + <> keyword "then" + <> " " + <> diff bL bR + docs aL aR = + pure (diff aL aR) +diff l@(BoolIf {}) r = + mismatch l r +diff l r@(BoolIf {}) = + mismatch l r +diff l@(Let {}) r@(Let {}) = + enclosed' " " (keyword "in" <> " ") (docs l r) + where + docs (Let (Binding _ aL _ bL _ cL) dL) (Let (Binding _ aR _ bR _ cR) dR) = + Data.List.NonEmpty.cons (align doc) (docs dL dR) + where + bL' = fmap snd bL + bR' = fmap snd bR + + doc = keyword "let" + <> " " + <> format " " (diffLabel aL aR) + <> format " " (diffMaybe (colon <> " ") diff bL' bR') + <> equals + <> " " + <> diff cL cR + docs aL aR = pure (diff aL aR) +diff l@(Let {}) r = + mismatch l r +diff l r@(Let {}) = + mismatch l r +diff l@(Pi {}) r@(Pi {}) = + enclosed' " " (rarrow <> " ") (docs l r) + where + docs (Pi _ aL bL cL) (Pi _ aR bR cR) = + Data.List.NonEmpty.cons (align doc) (docs cL cR) + where + doc | same docA && same docB = ignore + | same docA = + format mempty docB + | otherwise = + forall_ + <> lparen + <> format " " docA + <> colon + <> " " + <> format mempty docB + <> rparen + where + docA = diffLabel aL aR + + docB = diff bL bR + + docs aL aR = pure (diff aL aR) +diff l@(Pi {}) r = + mismatch l r +diff l r@(Pi {}) = + mismatch l r +diff (Assert aL) (Assert aR) = + align + ( " " <> keyword "assert" + <> hardline <> colon <> " " <> diff aL aR + ) +diff l@(Assert {}) r = + mismatch l r +diff l r@(Assert {}) = + mismatch l r +diff l r = + diffAnnotatedExpression l r + +diffAnnotatedExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffAnnotatedExpression (Merge aL bL cL) (Merge aR bR cR) = align doc + where + doc = keyword "merge" + <> " " + <> format " " (diffWithExpression aL aR) + <> format " " (diffWithExpression bL bR) + <> diffMaybe (colon <> " ") diffApplicationExpression cL cR +diffAnnotatedExpression l@(Merge {}) r = + mismatch l r +diffAnnotatedExpression l r@(Merge {}) = + mismatch l r +diffAnnotatedExpression (ToMap aL bL) (ToMap aR bR) = align doc + where + doc = keyword "toMap" + <> " " + <> format " " (diffWithExpression aL aR) + <> diffMaybe (colon <> " ") diffApplicationExpression bL bR +diffAnnotatedExpression l@(ToMap {}) r = + mismatch l r +diffAnnotatedExpression l r@(ToMap {}) = + mismatch l r +diffAnnotatedExpression (ShowConstructor aL) (ShowConstructor aR) = align doc + where + doc = keyword "showConstructor" + <> " " + <> format " " (diffWithExpression aL aR) +diffAnnotatedExpression l@(ShowConstructor {}) r = + mismatch l r +diffAnnotatedExpression l r@(ShowConstructor {}) = + mismatch l r +diffAnnotatedExpression (ListLit aL@(Just _) bL) (ListLit aR bR) = align doc + where + doc = format " " (diffList bL bR) + <> format " " (diffMaybe (colon <> " ") diffApplicationExpression aL aR) +diffAnnotatedExpression (ListLit aL bL) (ListLit aR@(Just _) bR) = align doc + where + doc = format " " (diffList bL bR) + <> format " " (diffMaybe (colon <> " ") diffApplicationExpression aL aR) +diffAnnotatedExpression l@(Annot {}) r@(Annot {}) = + enclosed' " " (colon <> " ") (docs l r) + where + docs (Annot aL bL) (Annot aR bR) = + Data.List.NonEmpty.cons (align doc) (docs bL bR) + where + doc = diffOperatorExpression aL aR + docs aL aR = + diff aL aR :| [] +diffAnnotatedExpression l@(Annot {}) r = + mismatch l r +diffAnnotatedExpression l r@(Annot {}) = + mismatch l r +diffAnnotatedExpression l r = + diffOperatorExpression l r + +{- Whitespace in diffs of operator expressions: + +All indentation (whether pretty-printing or diffing) is a multiple of two +spaces, so if the operator is one character long (like ?) then the diff pads +the left margin to two space: + + ␣␣e₀ + ?␣e₁ + +... but if the operator is two characters long (like ||) then the diff pads +the left margin to four spaces: + + ␣␣␣␣e₀ + ||␣␣e₁ +-} +diffOperatorExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffOperatorExpression = diffImportAltExpression + +diffImportAltExpression :: (Pretty a, Eq a) => Expr Void a -> Expr Void a -> Diff +diffImportAltExpression l@(ImportAlt {}) r@(ImportAlt {}) = + enclosed' " " (operator "?" <> " ") (docs l r) + where + docs (ImportAlt aL bL) (ImportAlt aR bR) = + Data.List.NonEmpty.cons (diffOrExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffOrExpression aL aR) +diffImportAltExpression l@(ImportAlt {}) r = + mismatch l r +diffImportAltExpression l r@(ImportAlt {}) = + mismatch l r +diffImportAltExpression l r = + diffOrExpression l r + +diffOrExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffOrExpression l@(BoolOr {}) r@(BoolOr {}) = + enclosed' " " (operator "||" <> " ") (docs l r) + where + docs (BoolOr aL bL) (BoolOr aR bR) = + Data.List.NonEmpty.cons (diffPlusExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffPlusExpression aL aR) +diffOrExpression l@(BoolOr {}) r = + mismatch l r +diffOrExpression l r@(BoolOr {}) = + mismatch l r +diffOrExpression l r = + diffPlusExpression l r + +diffPlusExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffPlusExpression l@(NaturalPlus {}) r@(NaturalPlus {}) = + enclosed' " " (operator "+" <> " ") (docs l r) + where + docs (NaturalPlus aL bL) (NaturalPlus aR bR) = + Data.List.NonEmpty.cons (diffTextAppendExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffTextAppendExpression aL aR) +diffPlusExpression l@(NaturalPlus {}) r = + mismatch l r +diffPlusExpression l r@(NaturalPlus {}) = + mismatch l r +diffPlusExpression l r = + diffTextAppendExpression l r + +diffTextAppendExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffTextAppendExpression l@(TextAppend {}) r@(TextAppend {}) = + enclosed' " " (operator "++" <> " ") (docs l r) + where + docs (TextAppend aL bL) (TextAppend aR bR) = + Data.List.NonEmpty.cons (diffListAppendExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffListAppendExpression aL aR) +diffTextAppendExpression l@(TextAppend {}) r = + mismatch l r +diffTextAppendExpression l r@(TextAppend {}) = + mismatch l r +diffTextAppendExpression l r = + diffListAppendExpression l r + +diffListAppendExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffListAppendExpression l@(ListAppend {}) r@(ListAppend {}) = + enclosed' " " (operator "#" <> " ") (docs l r) + where + docs (ListAppend aL bL) (ListAppend aR bR) = + Data.List.NonEmpty.cons (diffAndExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffAndExpression aL aR) +diffListAppendExpression l@(ListAppend {}) r = + mismatch l r +diffListAppendExpression l r@(ListAppend {}) = + mismatch l r +diffListAppendExpression l r = + diffAndExpression l r + +diffAndExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffAndExpression l@(BoolAnd {}) r@(BoolAnd {}) = + enclosed' " " (operator "&&" <> " ") (docs l r) + where + docs (BoolAnd aL bL) (BoolAnd aR bR) = + Data.List.NonEmpty.cons (diffCombineExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffCombineExpression aL aR) +diffAndExpression l@(BoolAnd {}) r = + mismatch l r +diffAndExpression l r@(BoolAnd {}) = + mismatch l r +diffAndExpression l r = + diffCombineExpression l r + +diffCombineExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffCombineExpression l@(Combine {}) r@(Combine {}) = + enclosed' " " (operator "∧" <> " ") (docs l r) + where + docs (Combine _ _ aL bL) (Combine _ _ aR bR) = + Data.List.NonEmpty.cons (diffPreferExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffPreferExpression aL aR) +diffCombineExpression l@(Combine {}) r = + mismatch l r +diffCombineExpression l r@(Combine {}) = + mismatch l r +diffCombineExpression l r = + diffPreferExpression l r + +diffPreferExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffPreferExpression l@(Prefer {}) r@(Prefer {}) = + enclosed' " " (operator "⫽" <> " ") (docs l r) + where + docs (Prefer _ _ aL bL) (Prefer _ _ aR bR) = + Data.List.NonEmpty.cons (diffCombineTypesExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffCombineTypesExpression aL aR) +diffPreferExpression l@(Prefer {}) r = + mismatch l r +diffPreferExpression l r@(Prefer {}) = + mismatch l r +diffPreferExpression l r = + diffCombineTypesExpression l r + +diffCombineTypesExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffCombineTypesExpression l@(CombineTypes {}) r@(CombineTypes {}) = + enclosed' " " (operator "*" <> " ") (docs l r) + where + docs (CombineTypes _ aL bL) (CombineTypes _ aR bR) = + Data.List.NonEmpty.cons (diffTimesExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffTimesExpression aL aR) +diffCombineTypesExpression l@(CombineTypes {}) r = + mismatch l r +diffCombineTypesExpression l r@(CombineTypes {}) = + mismatch l r +diffCombineTypesExpression l r = + diffTimesExpression l r + +diffTimesExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffTimesExpression l@(NaturalTimes {}) r@(NaturalTimes {}) = + enclosed' " " (operator "*" <> " ") (docs l r) + where + docs (NaturalTimes aL bL) (NaturalTimes aR bR) = + Data.List.NonEmpty.cons (diffEqualExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffEqualExpression aL aR) +diffTimesExpression l@(NaturalTimes {}) r = + mismatch l r +diffTimesExpression l r@(NaturalTimes {}) = + mismatch l r +diffTimesExpression l r = + diffEqualExpression l r + +diffEqualExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffEqualExpression l@(BoolEQ {}) r@(BoolEQ {}) = + enclosed' " " (operator "==" <> " ") (docs l r) + where + docs (BoolEQ aL bL) (BoolEQ aR bR) = + Data.List.NonEmpty.cons (diffNotEqualExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffNotEqualExpression aL aR) +diffEqualExpression l@(BoolEQ {}) r = + mismatch l r +diffEqualExpression l r@(BoolEQ {}) = + mismatch l r +diffEqualExpression l r = + diffNotEqualExpression l r + +diffNotEqualExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffNotEqualExpression l@(BoolNE {}) r@(BoolNE {}) = + enclosed' " " (operator "!=" <> " ") (docs l r) + where + docs (BoolNE aL bL) (BoolNE aR bR) = + Data.List.NonEmpty.cons (diffEquivalentExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffEquivalentExpression aL aR) +diffNotEqualExpression l@(BoolNE {}) r = + mismatch l r +diffNotEqualExpression l r@(BoolNE {}) = + mismatch l r +diffNotEqualExpression l r = + diffEquivalentExpression l r + +diffEquivalentExpression + :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffEquivalentExpression l@(Equivalent {}) r@(Equivalent {}) = + enclosed' " " (operator "≡" <> " ") (docs l r) + where + docs (Equivalent _ aL bL) (Equivalent _ aR bR) = + Data.List.NonEmpty.cons (diffApplicationExpression aL aR) (docs bL bR) + docs aL aR = + pure (diffApplicationExpression aL aR) +diffEquivalentExpression l@(Equivalent {}) r = + mismatch l r +diffEquivalentExpression l r@(Equivalent {}) = + mismatch l r +diffEquivalentExpression l r = + diffApplicationExpression l r + +diffApplicationExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffApplicationExpression l@(App {}) r@(App {}) = + enclosed' mempty mempty (Data.List.NonEmpty.reverse (docs l r)) + where + docs (App aL bL) (App aR bR) = + Data.List.NonEmpty.cons (diffWithExpression bL bR) (docs aL aR) + docs (Some aL) (Some aR) = + diffWithExpression aL aR :| [ builtin "Some" ] + docs aL aR@(Some {}) = + pure (mismatch aL aR) + docs aL@(Some {}) aR = + pure (mismatch aL aR) + docs aL aR = + pure (diffWithExpression aL aR) +diffApplicationExpression l@(App {}) r = + mismatch l r +diffApplicationExpression l r@(App {}) = + mismatch l r +diffApplicationExpression (Some l) (Some r) = + enclosed' mempty mempty (builtin "Some" :| [ diffWithExpression l r ]) +diffApplicationExpression l@(Some {}) r = + mismatch l r +diffApplicationExpression l r@(Some {}) = + mismatch l r +diffApplicationExpression l r = + diffWithExpression l r + +diffWithExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffWithExpression (With eL ksL vL) (With eR ksR vR) = + align + ( format " " (diffImportExpression eL eR) + <> "with " + <> align + ( format " " (diffPath (fmap toText ksL) (fmap toText ksR)) + <> "= " + <> diffOperatorExpression vL vR + ) + ) + where + toText WithQuestion = "?" + toText (WithLabel k ) = k + + diffPath (kL :| []) (kR :| []) = + diffLabel kL kR + diffPath (kL₀ :| kL₁ : ksL') (kR₀ :| kR₁ : ksR') = + format "" (diffLabel kL₀ kR₀) + <> dot + <> diffPath (kL₁ :| ksL') (kR₁ :| ksR') + diffPath (kL :| []) (kR₀ :| kR₁ : ksR') = + format "" (diffLabel kL kR₀) + <> plus (foldMap (\k -> dot <> token (Internal.prettyLabel k)) (kR₁ :| ksR')) + diffPath (kL₀ :| kL₁ : ksL') (kR :| []) = + format "" (diffLabel kL₀ kR) + <> minus (foldMap (\k -> dot <> token (Internal.prettyLabel k)) (kL₁ :| ksL')) +diffWithExpression l r@With{} = + mismatch l r +diffWithExpression l@With{} r = + mismatch l r +diffWithExpression l r = + diffImportExpression l r + +diffImportExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffImportExpression (Embed l) (Embed r) = + diffPretty l r +diffImportExpression l@(Embed {}) r = + mismatch l r +diffImportExpression l r@(Embed {}) = + mismatch l r +diffImportExpression l r = + diffRecordCompletionExpression l r + +diffRecordCompletionExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffRecordCompletionExpression (RecordCompletion aL bL) (RecordCompletion aR bR) = + diffSelectorExpression aL aR <> "::" <> diffSelectorExpression bL bR +diffRecordCompletionExpression l@(RecordCompletion {}) r = + mismatch l r +diffRecordCompletionExpression l r@(RecordCompletion {}) = + mismatch l r +diffRecordCompletionExpression l r = + diffSelectorExpression l r + +diffSelectorExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffSelectorExpression l@(Field {}) r@(Field {}) = + enclosed' " " (dot <> " ") (Data.List.NonEmpty.reverse (docs l r)) + where + docs (Field aL (Syntax.fieldSelectionLabel -> bL)) (Field aR (Syntax.fieldSelectionLabel -> bR)) = + Data.List.NonEmpty.cons (diffLabel bL bR) (docs aL aR) + docs (Project aL (Left bL)) (Project aR (Left bR)) = + Data.List.NonEmpty.cons (diffLabels bL bR) (docs aL aR) + docs (Project aL (Right bL)) (Project aR (Right bR)) = + Data.List.NonEmpty.cons (diff bL bR) (docs aL aR) + docs aL aR = + pure (diffPrimitiveExpression aL aR) +diffSelectorExpression l@(Field {}) r = + mismatch l r +diffSelectorExpression l r@(Field {}) = + mismatch l r +diffSelectorExpression l@(Project {}) r@(Project {}) = + enclosed' " " (dot <> " ") (Data.List.NonEmpty.reverse (docs l r)) + where + docs (Field aL (Syntax.fieldSelectionLabel -> bL)) (Field aR (Syntax.fieldSelectionLabel ->bR)) = + Data.List.NonEmpty.cons (diffLabel bL bR) (docs aL aR) + docs (Project aL (Left bL)) (Project aR (Left bR)) = + Data.List.NonEmpty.cons (diffLabels bL bR) (docs aL aR) + docs (Project aL (Right bL)) (Project aR (Right bR)) = + Data.List.NonEmpty.cons (diff bL bR) (docs aL aR) + docs aL aR = + pure (diffPrimitiveExpression aL aR) +diffSelectorExpression l@(Project {}) r = + mismatch l r +diffSelectorExpression l r@(Project {}) = + mismatch l r +diffSelectorExpression l r = + diffPrimitiveExpression l r + +diffPrimitiveExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff +diffPrimitiveExpression (Var aL) (Var aR) = + diffVar aL aR +diffPrimitiveExpression l@(Var {}) r = + mismatch l r +diffPrimitiveExpression l r@(Var {}) = + mismatch l r +diffPrimitiveExpression (Const aL) (Const aR) = + diffConst aL aR +diffPrimitiveExpression l@(Const {}) r = + mismatch l r +diffPrimitiveExpression l r@(Const {}) = + mismatch l r +diffPrimitiveExpression Bool Bool = + "…" +diffPrimitiveExpression l@Bool r = + mismatch l r +diffPrimitiveExpression l r@Bool = + mismatch l r +diffPrimitiveExpression Bytes Bytes = + "…" +diffPrimitiveExpression l@Bytes r = + mismatch l r +diffPrimitiveExpression l r@Bytes = + mismatch l r +diffPrimitiveExpression (BytesLit l) (BytesLit r) = + diffBytes l r +diffPrimitiveExpression l@(BytesLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(BytesLit {}) = + mismatch l r +diffPrimitiveExpression Natural Natural = + "…" +diffPrimitiveExpression l@Natural r = + mismatch l r +diffPrimitiveExpression l r@Natural = + mismatch l r +diffPrimitiveExpression NaturalFold NaturalFold = + "…" +diffPrimitiveExpression l@NaturalFold r = + mismatch l r +diffPrimitiveExpression l r@NaturalFold = + mismatch l r +diffPrimitiveExpression NaturalBuild NaturalBuild = + "…" +diffPrimitiveExpression l@NaturalBuild r = + mismatch l r +diffPrimitiveExpression l r@NaturalBuild = + mismatch l r +diffPrimitiveExpression NaturalIsZero NaturalIsZero = + "…" +diffPrimitiveExpression l@NaturalIsZero r = + mismatch l r +diffPrimitiveExpression l r@NaturalIsZero = + mismatch l r +diffPrimitiveExpression NaturalEven NaturalEven = + "…" +diffPrimitiveExpression l@NaturalEven r = + mismatch l r +diffPrimitiveExpression l r@NaturalEven = + mismatch l r +diffPrimitiveExpression NaturalOdd NaturalOdd = + "…" +diffPrimitiveExpression l@NaturalOdd r = + mismatch l r +diffPrimitiveExpression l r@NaturalOdd = + mismatch l r +diffPrimitiveExpression NaturalToInteger NaturalToInteger = + "…" +diffPrimitiveExpression l@NaturalToInteger r = + mismatch l r +diffPrimitiveExpression l r@NaturalToInteger = + mismatch l r +diffPrimitiveExpression NaturalShow NaturalShow = + "…" +diffPrimitiveExpression l@NaturalShow r = + mismatch l r +diffPrimitiveExpression l r@NaturalShow = + mismatch l r +diffPrimitiveExpression NaturalSubtract NaturalSubtract = + "…" +diffPrimitiveExpression l@NaturalSubtract r = + mismatch l r +diffPrimitiveExpression l r@NaturalSubtract = + mismatch l r +diffPrimitiveExpression Integer Integer = + "…" +diffPrimitiveExpression l@Integer r = + mismatch l r +diffPrimitiveExpression l r@Integer = + mismatch l r +diffPrimitiveExpression IntegerClamp IntegerClamp = + "…" +diffPrimitiveExpression l@IntegerClamp r = + mismatch l r +diffPrimitiveExpression l r@IntegerClamp = + mismatch l r +diffPrimitiveExpression IntegerNegate IntegerNegate = + "…" +diffPrimitiveExpression l@IntegerNegate r = + mismatch l r +diffPrimitiveExpression l r@IntegerNegate = + mismatch l r +diffPrimitiveExpression IntegerShow IntegerShow = + "…" +diffPrimitiveExpression l@IntegerShow r = + mismatch l r +diffPrimitiveExpression l r@IntegerShow = + mismatch l r +diffPrimitiveExpression IntegerToDouble IntegerToDouble = + "…" +diffPrimitiveExpression l@IntegerToDouble r = + mismatch l r +diffPrimitiveExpression l r@IntegerToDouble = + mismatch l r +diffPrimitiveExpression Double Double = + "…" +diffPrimitiveExpression l@Double r = + mismatch l r +diffPrimitiveExpression l r@Double = + mismatch l r +diffPrimitiveExpression DoubleShow DoubleShow = + "…" +diffPrimitiveExpression l@DoubleShow r = + mismatch l r +diffPrimitiveExpression l r@DoubleShow = + mismatch l r +diffPrimitiveExpression Text Text = + "…" +diffPrimitiveExpression l@Text r = + mismatch l r +diffPrimitiveExpression l r@Text = + mismatch l r +diffPrimitiveExpression TextReplace TextReplace = + "…" +diffPrimitiveExpression l@TextReplace r = + mismatch l r +diffPrimitiveExpression l r@TextReplace = + mismatch l r +diffPrimitiveExpression TextShow TextShow = + "…" +diffPrimitiveExpression l@TextShow r = + mismatch l r +diffPrimitiveExpression l r@TextShow = + mismatch l r +diffPrimitiveExpression Date Date = + "…" +diffPrimitiveExpression l r@Date = + mismatch l r +diffPrimitiveExpression l@Date r= + mismatch l r +diffPrimitiveExpression DateShow DateShow = + "…" +diffPrimitiveExpression l r@DateShow = + mismatch l r +diffPrimitiveExpression l@DateShow r= + mismatch l r +diffPrimitiveExpression Time Time = + "…" +diffPrimitiveExpression l r@Time = + mismatch l r +diffPrimitiveExpression l@Time r= + mismatch l r +diffPrimitiveExpression TimeShow TimeShow = + "…" +diffPrimitiveExpression l r@TimeShow = + mismatch l r +diffPrimitiveExpression l@TimeShow r= + mismatch l r +diffPrimitiveExpression TimeZone TimeZone = + "…" +diffPrimitiveExpression l r@TimeZone = + mismatch l r +diffPrimitiveExpression l@TimeZone r= + mismatch l r +diffPrimitiveExpression TimeZoneShow TimeZoneShow = + "…" +diffPrimitiveExpression l r@TimeZoneShow = + mismatch l r +diffPrimitiveExpression l@TimeZoneShow r= + mismatch l r +diffPrimitiveExpression List List = + "…" +diffPrimitiveExpression l@List r = + mismatch l r +diffPrimitiveExpression l r@List = + mismatch l r +diffPrimitiveExpression (ListLit Nothing bL) (ListLit Nothing bR) = align doc + where + doc = format " " (diffList bL bR) +diffPrimitiveExpression ListBuild ListBuild = + "…" +diffPrimitiveExpression l@ListBuild r = + mismatch l r +diffPrimitiveExpression l r@ListBuild = + mismatch l r +diffPrimitiveExpression ListFold ListFold = + "…" +diffPrimitiveExpression l@ListFold r = + mismatch l r +diffPrimitiveExpression l r@ListFold = + mismatch l r +diffPrimitiveExpression ListLength ListLength = + "…" +diffPrimitiveExpression l@ListLength r = + mismatch l r +diffPrimitiveExpression l r@ListLength = + mismatch l r +diffPrimitiveExpression ListHead ListHead = + "…" +diffPrimitiveExpression l@ListHead r = + mismatch l r +diffPrimitiveExpression l r@ListHead = + mismatch l r +diffPrimitiveExpression ListLast ListLast = + "…" +diffPrimitiveExpression l@ListLast r = + mismatch l r +diffPrimitiveExpression l r@ListLast = + mismatch l r +diffPrimitiveExpression ListIndexed ListIndexed = + "…" +diffPrimitiveExpression l@ListIndexed r = + mismatch l r +diffPrimitiveExpression l r@ListIndexed = + mismatch l r +diffPrimitiveExpression ListReverse ListReverse = + "…" +diffPrimitiveExpression l@ListReverse r = + mismatch l r +diffPrimitiveExpression l r@ListReverse = + mismatch l r +diffPrimitiveExpression Optional Optional = + "…" +diffPrimitiveExpression l@Optional r = + mismatch l r +diffPrimitiveExpression l r@Optional = + mismatch l r +diffPrimitiveExpression None None = + "…" +diffPrimitiveExpression l@None r = + mismatch l r +diffPrimitiveExpression l r@None = + mismatch l r +diffPrimitiveExpression (BoolLit aL) (BoolLit aR) = + diffBool aL aR +diffPrimitiveExpression l@(BoolLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(BoolLit {}) = + mismatch l r +diffPrimitiveExpression (IntegerLit aL) (IntegerLit aR) = + diffInteger aL aR +diffPrimitiveExpression l@(IntegerLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(IntegerLit {}) = + mismatch l r +diffPrimitiveExpression (NaturalLit aL) (NaturalLit aR) = + diffNatural aL aR +diffPrimitiveExpression l@(NaturalLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(NaturalLit {}) = + mismatch l r +diffPrimitiveExpression (DoubleLit aL) (DoubleLit aR) = + diffDouble aL aR +diffPrimitiveExpression l@(DoubleLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(DoubleLit {}) = + mismatch l r +diffPrimitiveExpression (TextLit l) (TextLit r) = + diffChunks l r +diffPrimitiveExpression l@(TextLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(TextLit {}) = + mismatch l r +diffPrimitiveExpression (DateLiteral l) (DateLiteral r) = + diffDateLiteral l r +diffPrimitiveExpression l@(DateLiteral {}) r = + mismatch l r +diffPrimitiveExpression l r@(DateLiteral {}) = + mismatch l r +diffPrimitiveExpression (TimeLiteral tL pL) (TimeLiteral tR pR) = + diffTimeLiteral tL pL tR pR +diffPrimitiveExpression l@(TimeLiteral {}) r = + mismatch l r +diffPrimitiveExpression l r@(TimeLiteral {}) = + mismatch l r +diffPrimitiveExpression (TimeZoneLiteral l) (TimeZoneLiteral r) = + diffTimeZoneLiteral l r +diffPrimitiveExpression l@(TimeZoneLiteral {}) r = + mismatch l r +diffPrimitiveExpression l r@(TimeZoneLiteral {}) = + mismatch l r +diffPrimitiveExpression (Record aL) (Record aR) = + diffRecord aL aR +diffPrimitiveExpression l@(Record {}) r = + mismatch l r +diffPrimitiveExpression l r@(Record {}) = + mismatch l r +diffPrimitiveExpression (RecordLit aL) (RecordLit aR) = + diffRecordLit aL aR +diffPrimitiveExpression l@(RecordLit {}) r = + mismatch l r +diffPrimitiveExpression l r@(RecordLit {}) = + mismatch l r +diffPrimitiveExpression (Union aL) (Union aR) = + diffUnion aL aR +diffPrimitiveExpression l@(Union {}) r = + mismatch l r +diffPrimitiveExpression l r@(Union {}) = + mismatch l r +diffPrimitiveExpression aL aR = + if same doc + then ignore + else align ("( " <> doc <> hardline <> ")") + where + doc = diff aL aR diff --git a/src/Dhall/DirectoryTree.hs b/src/Dhall/DirectoryTree.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/DirectoryTree.hs @@ -0,0 +1,515 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Implementation of the @dhall to-directory-tree@ subcommand +module Dhall.DirectoryTree + ( -- * Filesystem + toDirectoryTree + , FilesystemError(..) + + -- * Low-level types and functions + , module Dhall.DirectoryTree.Types + , decodeDirectoryTree + , directoryTreeType + ) where + +import Control.Applicative (empty) +import Control.Exception (Exception) +import Control.Monad (unless, when) +import Data.Either.Validation (Validation (..)) +import Data.Functor.Identity (Identity (..)) +import Data.Maybe (fromMaybe, isJust) +import Data.Sequence (Seq) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.DirectoryTree.Types +import Dhall.Marshal.Decode (Decoder (..), Expector) +import Dhall.Src (Src) +import Dhall.Syntax + ( Chunks (..) + , Const (..) + , Expr (..) + , RecordField (..) + , Var (..) + ) +import System.FilePath (()) +import System.PosixCompat.Types (FileMode, GroupID, UserID) + +import qualified Control.Exception as Exception +import qualified Data.ByteString as ByteString +import qualified Data.Foldable as Foldable +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Map as Map +import qualified Dhall.Marshal.Decode as Decode +import qualified Dhall.Pretty +import qualified Dhall.TypeCheck as TypeCheck +import qualified Dhall.Util as Util +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.String as Pretty +import qualified System.Directory as Directory +import qualified System.FilePath as FilePath +#ifdef mingw32_HOST_OS +import System.IO.Error (illegalOperationErrorType, mkIOError) +#else +import qualified System.Posix.User as Posix +#endif +import qualified System.PosixCompat.Files as Posix + +{-| Attempt to transform a Dhall record into a directory tree where: + + * Records are translated into directories + + * @Map@s are also translated into directories + + * @Text@ values or fields are translated into files + + * @Optional@ values are omitted if @None@ + + * There is a more advanced way to construct directory trees using a fixpoint + encoding. See the documentation below on that. + + For example, the following Dhall record: + + > { dir = { `hello.txt` = "Hello\n" } + > , `goodbye.txt`= Some "Goodbye\n" + > , `missing.txt` = None Text + > } + + ... should translate to this directory tree: + + > $ tree result + > result + > ├── dir + > │ └── hello.txt + > └── goodbye.txt + > + > $ cat result/dir/hello.txt + > Hello + > + > $ cat result/goodbye.txt + > Goodbye + + Use this in conjunction with the Prelude's support for rendering JSON/YAML + in "pure Dhall" so that you can generate files containing JSON. For example: + + > let JSON = + > https://prelude.dhall-lang.org/v12.0.0/JSON/package.dhall sha256:843783d29e60b558c2de431ce1206ce34bdfde375fcf06de8ec5bf77092fdef7 + > + > in { `example.json` = + > JSON.render (JSON.array [ JSON.number 1.0, JSON.bool True ]) + > , `example.yaml` = + > JSON.renderYAML + > (JSON.object (toMap { foo = JSON.string "Hello", bar = JSON.null })) + > } + + ... which would generate: + + > $ cat result/example.json + > [ 1.0, true ] + > + > $ cat result/example.yaml + > ! "bar": null + > ! "foo": "Hello" + + /Advanced construction of directory trees/ + + In addition to the ways described above using "simple" Dhall values to + construct the directory tree there is one based on a fixpoint encoding. It + works by passing a value of the following type to the interpreter: + + > let User = < UserId : Natural | UserName : Text > + > + > let Group = < GroupId : Natural | GroupName : Text > + > + > let Access = + > { execute : Optional Bool + > , read : Optional Bool + > , write : Optional Bool + > } + > + > let Mode = + > { user : Optional Access + > , group : Optional Access + > , other : Optional Access + > } + > + > let Entry = + > \(content : Type) -> + > { name : Text + > , content : content + > , user : Optional User + > , group : Optional Group + > , mode : Optional Mode + > } + > + > in forall (tree : Type) -> + > forall ( make + > : { directory : Entry (List tree) -> tree + > , file : Entry Text -> tree + > } + > ) -> + > List tree + + The fact that the metadata for filesystem entries is modeled after the POSIX + permission model comes with the unfortunate downside that it might not apply + to other systems: There, changes to the metadata (user, group, permissions) + might be a no-op and __no warning will be issued__. + This is a leaking abstraction of the + [unix-compat](https://hackage.haskell.org/package/unix-compat) package used + internally. + + __NOTE__: This utility does not take care of type-checking and normalizing + the provided expression. This will raise a `FilesystemError` exception or a + `Dhall.Marshal.Decode.DhallErrors` exception upon encountering an expression + that cannot be converted as-is. +-} +toDirectoryTree + :: Bool -- ^ Whether to allow path separators in file names or not + -> FilePath + -> Expr Void Void + -> IO () +toDirectoryTree allowSeparators path expression = case expression of + RecordLit keyValues -> + Map.unorderedTraverseWithKey_ process $ recordFieldValue <$> keyValues + + ListLit (Just (App List (Record [ ("mapKey", recordFieldValue -> Text), ("mapValue", _) ]))) [] -> + Directory.createDirectoryIfMissing allowSeparators path + + ListLit _ records + | not (null records) + , Just keyValues <- extract (Foldable.toList records) -> + Foldable.traverse_ (uncurry process) keyValues + + TextLit (Chunks [] text) -> + Text.IO.writeFile path text + + Some value -> + toDirectoryTree allowSeparators path value + + App (Field (Union _) _) value -> do + toDirectoryTree allowSeparators path value + + App None _ -> + return () + + -- If this pattern matches we assume the user wants to use the fixpoint + -- approach, hence we typecheck it and output error messages like we would + -- do for every other Dhall program. + Lam _ _ (Lam _ _ _) -> do + entries <- decodeDirectoryTree expression + + processFilesystemEntryList allowSeparators path entries + + _ -> + die + where + extract [] = + return [] + + extract (RecordLit [ ("mapKey", recordFieldValue -> TextLit (Chunks [] key)) + , ("mapValue", recordFieldValue -> value)] : records) = + fmap ((key, value) :) (extract records) + + extract _ = + empty + + process key value = do + when (not allowSeparators && Text.isInfixOf (Text.pack [ FilePath.pathSeparator ]) key) $ + die + + Directory.createDirectoryIfMissing allowSeparators path + + toDirectoryTree allowSeparators (path Text.unpack key) value + + die = Exception.throwIO FilesystemError{..} + where + unexpectedExpression = expression + +-- | Decode a fixpoint directory tree from a Dhall expression. +decodeDirectoryTree :: Expr s Void -> IO (Seq FilesystemEntry) +decodeDirectoryTree (Core.alphaNormalize . Core.denote -> expression@(Lam _ _ (Lam _ _ body))) = do + expected' <- case directoryTreeType of + Success x -> return x + Failure e -> Exception.throwIO e + + _ <- Core.throws $ TypeCheck.typeOf $ Annot expression expected' + + case Decode.extract decoder body of + Success x -> return x + Failure e -> Exception.throwIO e + where + decoder :: Decoder (Seq FilesystemEntry) + decoder = Decode.auto +decodeDirectoryTree expr = Exception.throwIO $ FilesystemError $ Core.denote expr + +-- | The type of a fixpoint directory tree expression. +directoryTreeType :: Expector (Expr Src Void) +directoryTreeType = Pi Nothing "tree" (Const Type) + <$> (Pi Nothing "make" <$> makeType <*> pure (App List (Var (V "tree" 0)))) + +-- | The type of make part of a fixpoint directory tree expression. +makeType :: Expector (Expr Src Void) +makeType = Record . Map.fromList <$> sequenceA + [ makeConstructor "directory" (Decode.auto :: Decoder DirectoryEntry) + , makeConstructor "file" (Decode.auto :: Decoder TextFileEntry) + , makeConstructor "binary-file" (Decode.auto :: Decoder BinaryFileEntry) + ] + where + makeConstructor :: Text -> Decoder b -> Expector (Text, RecordField Src Void) + makeConstructor name dec = (name,) . Core.makeRecordField + <$> (Pi Nothing "_" <$> expected dec <*> pure (Var (V "tree" 0))) + +-- | Resolve a `User` to a numerical id. +getUser :: User -> IO UserID +getUser (UserId uid) = return uid +getUser (UserName name) = +#ifdef mingw32_HOST_OS + ioError $ mkIOError illegalOperationErrorType x Nothing Nothing + where x = "System.Posix.User.getUserEntryForName: not supported" +#else + Posix.userID <$> Posix.getUserEntryForName name +#endif + +-- | Resolve a `Group` to a numerical id. +getGroup :: Group -> IO GroupID +getGroup (GroupId gid) = return gid +getGroup (GroupName name) = +#ifdef mingw32_HOST_OS + ioError $ mkIOError illegalOperationErrorType x Nothing Nothing + where x = "System.Posix.User.getGroupEntryForName: not supported" +#else + Posix.groupID <$> Posix.getGroupEntryForName name +#endif + +-- | Process a `FilesystemEntry`. Writes the content to disk and apply the +-- metadata to the newly created item. +processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO () +processFilesystemEntry allowSeparators path (DirectoryEntry entry) = + processEntryWith path entry $ \path' content -> do + Directory.createDirectoryIfMissing allowSeparators path' + processFilesystemEntryList allowSeparators path' content +processFilesystemEntry allowSeparators path (BinaryFileEntry entry) = + processEntryWith path entry $ \path' content -> do + when allowSeparators $ do + Directory.createDirectoryIfMissing True (FilePath.takeDirectory path') + ByteString.writeFile path' content +processFilesystemEntry allowSeparators path (TextFileEntry entry) = + processEntryWith path entry $ \path' content -> do + when allowSeparators $ do + Directory.createDirectoryIfMissing True (FilePath.takeDirectory path') + Text.IO.writeFile path' content + +-- | A helper function used by 'processFilesystemEntry'. +processEntryWith + :: FilePath + -> Entry a + -> (FilePath -> a -> IO ()) + -> IO () +processEntryWith path entry f = do + let path' = path entryName entry + when (hasMetadata entry && not isMetadataSupported) $ + Exception.throwIO (MetadataUnsupportedError path') + f path' (entryContent entry) + -- It is important that we write the metadata after we wrote the content of + -- the file as we might lock ourself out by changing ownership or + -- permissions. + applyMetadata entry path' + +-- | Process a list of `FilesystemEntry`s. +processFilesystemEntryList :: Bool -> FilePath -> Seq FilesystemEntry -> IO () +processFilesystemEntryList allowSeparators path = Foldable.traverse_ + (processFilesystemEntry allowSeparators path) + +-- | Does this entry have some metadata set? +hasMetadata :: Entry a -> Bool +hasMetadata entry + = isJust (entryUser entry) + || isJust (entryGroup entry) + || maybe False hasMode (entryMode entry) + where + hasMode :: Mode Maybe -> Bool + hasMode mode + = maybe False hasAccess (modeUser mode) + || maybe False hasAccess (modeGroup mode) + || maybe False hasAccess (modeOther mode) + + hasAccess :: Access Maybe -> Bool + hasAccess access + = isJust (accessExecute access) + || isJust (accessRead access) + || isJust (accessWrite access) + +-- | Set the metadata of an object referenced by a path. +applyMetadata :: Entry a -> FilePath -> IO () +applyMetadata entry fp = do + s <- Posix.getFileStatus fp + let user = Posix.fileOwner s + group = Posix.fileGroup s + mode = fileModeToMode $ Posix.fileMode s + + user' <- getUser $ fromMaybe (UserId user) (entryUser entry) + group' <- getGroup $ fromMaybe (GroupId group) (entryGroup entry) + unless ((user', group') == (user, group)) $ + Posix.setOwnerAndGroup fp user' group' + + let mode' = maybe mode (updateModeWith mode) (entryMode entry) + unless (mode' == mode) $ + setFileMode fp $ modeToFileMode mode' + +-- | Calculate the new `Mode` from the current mode and the changes specified by +-- the user. +updateModeWith :: Mode Identity -> Mode Maybe -> Mode Identity +updateModeWith x y = Mode + { modeUser = combine modeUser modeUser + , modeGroup = combine modeGroup modeGroup + , modeOther = combine modeOther modeOther + } + where + combine f g = maybe (f x) (Identity . updateAccessWith (runIdentity $ f x)) (g y) + +-- | Calculate the new `Access` from the current permissions and the changes +-- specified by the user. +updateAccessWith :: Access Identity -> Access Maybe -> Access Identity +updateAccessWith x y = Access + { accessExecute = combine accessExecute accessExecute + , accessRead = combine accessRead accessRead + , accessWrite = combine accessWrite accessWrite + } + where + combine f g = maybe (f x) Identity (g y) + +-- | Convert a filesystem mode given as a bitmask (`FileMode`) to an ADT +-- (`Mode`). +fileModeToMode :: FileMode -> Mode Identity +fileModeToMode mode = Mode + { modeUser = Identity $ Access + { accessExecute = Identity $ mode `hasFileMode` Posix.ownerExecuteMode + , accessRead = Identity $ mode `hasFileMode` Posix.ownerReadMode + , accessWrite = Identity $ mode `hasFileMode` Posix.ownerReadMode + } + , modeGroup = Identity $ Access + { accessExecute = Identity $ mode `hasFileMode` Posix.groupExecuteMode + , accessRead = Identity $ mode `hasFileMode` Posix.groupReadMode + , accessWrite = Identity $ mode `hasFileMode` Posix.groupReadMode + } + , modeOther = Identity $ Access + { accessExecute = Identity $ mode `hasFileMode` Posix.otherExecuteMode + , accessRead = Identity $ mode `hasFileMode` Posix.otherReadMode + , accessWrite = Identity $ mode `hasFileMode` Posix.otherReadMode + } + } + +-- | Convert a filesystem mode given as an ADT (`Mode`) to a bitmask +-- (`FileMode`). +modeToFileMode :: Mode Identity -> FileMode +modeToFileMode mode = foldr Posix.unionFileModes Posix.nullFileMode $ + [ Posix.ownerExecuteMode | runIdentity $ accessExecute (runIdentity $ modeUser mode) ] <> + [ Posix.ownerReadMode | runIdentity $ accessRead (runIdentity $ modeUser mode) ] <> + [ Posix.ownerWriteMode | runIdentity $ accessWrite (runIdentity $ modeUser mode) ] <> + [ Posix.groupExecuteMode | runIdentity $ accessExecute (runIdentity $ modeGroup mode) ] <> + [ Posix.groupReadMode | runIdentity $ accessRead (runIdentity $ modeGroup mode) ] <> + [ Posix.groupWriteMode | runIdentity $ accessWrite (runIdentity $ modeGroup mode) ] <> + [ Posix.otherExecuteMode | runIdentity $ accessExecute (runIdentity $ modeOther mode) ] <> + [ Posix.otherReadMode | runIdentity $ accessRead (runIdentity $ modeOther mode) ] <> + [ Posix.otherWriteMode | runIdentity $ accessWrite (runIdentity $ modeOther mode) ] + +-- | Check whether the second `FileMode` is contained in the first one. +hasFileMode :: FileMode -> FileMode -> Bool +hasFileMode mode x = (mode `Posix.intersectFileModes` x) == x + +{- | This error indicates that you supplied an invalid Dhall expression to the + `toDirectoryTree` function. The Dhall expression could not be translated + to a directory tree. +-} +newtype FilesystemError = + FilesystemError { unexpectedExpression :: Expr Void Void } + +instance Exception FilesystemError + +instance Show FilesystemError where + show FilesystemError{..} = + Pretty.renderString (Dhall.Pretty.layout message) + where + message = + Util._ERROR <> ": Not a valid directory tree expression \n\\ + \ \n\\ + \Explanation: Only a subset of Dhall expressions can be converted to a directory \n\\ + \tree. Specifically, record literals or maps can be converted to directories, \n\\ + \❰Text❱ literals can be converted to files, and ❰Optional❱ values are included if \n\\ + \❰Some❱ and omitted if ❰None❱. Values of union types can also be converted if \n\\ + \they are an alternative which has a non-nullary constructor whose argument is of \n\\ + \an otherwise convertible type. Furthermore, there is a more advanced approach to \n\\ + \constructing a directory tree utilizing a fixpoint encoding. Consult the upstream \n\\ + \documentation of the `toDirectoryTree` function in the Dhall.Directory module for \n\\ + \further information on that. \n\\ + \No other type of value can be translated to a directory tree. \n\\ + \ \n\\ + \For example, this is a valid expression that can be translated to a directory \n\\ + \tree: \n\\ + \ \n\\ + \ \n\\ + \ ┌──────────────────────────────────┐ \n\\ + \ │ { `example.json` = \"[1, true]\" } │ \n\\ + \ └──────────────────────────────────┘ \n\\ + \ \n\\ + \ \n\\ + \In contrast, the following expression is not allowed due to containing a \n\\ + \❰Natural❱ field, which cannot be translated in this way: \n\\ + \ \n\\ + \ \n\\ + \ ┌───────────────────────┐ \n\\ + \ │ { `example.txt` = 1 } │ \n\\ + \ └───────────────────────┘ \n\\ + \ \n\\ + \ \n\\ + \Note that key names cannot contain path separators: \n\\ + \ \n\\ + \ \n\\ + \ ┌─────────────────────────────────────┐ \n\\ + \ │ { `directory/example.txt` = \"ABC\" } │ Invalid: Key contains a forward slash\n\\ + \ └─────────────────────────────────────┘ \n\\ + \ \n\\ + \ \n\\ + \Instead, you need to refactor the expression to use nested records instead: \n\\ + \ \n\\ + \ \n\\ + \ ┌───────────────────────────────────────────┐ \n\\ + \ │ { directory = { `example.txt` = \"ABC\" } } │ \n\\ + \ └───────────────────────────────────────────┘ \n\\ + \ \n\\ + \ \n\\ + \You tried to translate the following expression to a directory tree: \n\\ + \ \n\\ + \" <> Util.insert unexpectedExpression <> "\n\\ + \ \n\\ + \... which is not an expression that can be translated to a directory tree. \n" + +{- | This error indicates that you want to set some metadata for a file or + directory, but that operation is not supported on your platform. +-} +newtype MetadataUnsupportedError = + MetadataUnsupportedError { metadataForPath :: FilePath } + +instance Exception MetadataUnsupportedError + +instance Show MetadataUnsupportedError where + show MetadataUnsupportedError{..} = + Pretty.renderString (Dhall.Pretty.layout message) + where + message = + Util._ERROR <> ": Setting metadata is not supported on this platform. \n\\ + \ \n\\ + \Explanation: Your Dhall expression indicates that you intend to set some metadata \n\\ + \like ownership or permissions for the following file or directory: \n\\ + \ \n\\ + \" <> Pretty.pretty metadataForPath <> "\n\\ + \ \n\\ + \... which is not supported on your platform. \n" diff --git a/src/Dhall/DirectoryTree/Types.hs b/src/Dhall/DirectoryTree/Types.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/DirectoryTree/Types.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Types used by the implementation of the @to-directory-tree@ subcommand +module Dhall.DirectoryTree.Types + ( FilesystemEntry(DirectoryEntry, BinaryFileEntry, TextFileEntry, FileEntry) + , DirectoryEntry + , FileEntry + , BinaryFileEntry + , TextFileEntry + , Entry(..) + , User(..) + , Group(..) + , Mode(..) + , Access(..) + + , setFileMode + , prettyFileMode + + , isMetadataSupported + ) where + +import Data.ByteString (ByteString) +import Data.Functor.Identity (Identity (..)) +import Data.Sequence (Seq) +import Data.Text (Text) +import Dhall.Marshal.Decode + ( Decoder (..) + , FromDhall (..) + , Generic + , InputNormalizer + , InterpretOptions (..) + ) +import Dhall.Syntax (Expr (..), FieldSelection (..), Var (..)) +import System.PosixCompat.Types (GroupID, UserID) + +import qualified Data.Text as Text +import qualified Dhall.Marshal.Decode as Decode +import qualified System.PosixCompat.Files as Posix + +#ifdef mingw32_HOST_OS +import Control.Monad (unless) +import Data.Word (Word32) +import System.IO (hPutStrLn, stderr) +import System.PosixCompat.Types (CMode) + +import qualified Unsafe.Coerce + +type FileMode = CMode +#else +import System.PosixCompat.Types (FileMode) + +import qualified System.PosixCompat.Types as Posix +#endif + +pattern Make :: Text -> Expr s a -> Expr s a +pattern Make label entry <- App (Field (Var (V "_" 0)) (fieldSelectionLabel -> label)) entry + +-- | A directory in the filesystem. +type DirectoryEntry = Entry (Seq FilesystemEntry) + +-- | A file in the filesystem. +{-# DEPRECATED FileEntry "`FileEntry` is deprecated and will be removed eventually. Please use `TextFileEntry` instead." #-} +type FileEntry = Entry Text + +-- | A binary file in the filesystem. +type BinaryFileEntry = Entry ByteString + +-- | A text file in the filesystem. +type TextFileEntry = Entry Text + +-- | A filesystem entry. +data FilesystemEntry + = DirectoryEntry (Entry (Seq FilesystemEntry)) + | BinaryFileEntry BinaryFileEntry + | TextFileEntry TextFileEntry + deriving (Eq, Generic, Ord, Show) + +pattern FileEntry :: Entry Text -> FilesystemEntry +pattern FileEntry entry = TextFileEntry entry + +instance FromDhall FilesystemEntry where + autoWith normalizer = Decoder + { expected = pure $ Var (V "tree" 0) + , extract = \case + Make "directory" entry -> + DirectoryEntry <$> extract (autoWith normalizer) entry + Make "file" entry -> + TextFileEntry <$> extract (autoWith normalizer) entry + Make "binary-file" entry -> + BinaryFileEntry <$> extract (autoWith normalizer) entry + expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) expr + } + +-- | A generic filesystem entry. This type holds the metadata that apply to all +-- entries. It is parametric over the content of such an entry. +data Entry a = Entry + { entryName :: String + , entryContent :: a + , entryUser :: Maybe User + , entryGroup :: Maybe Group + , entryMode :: Maybe (Mode Maybe) + } + deriving (Eq, Generic, Ord, Show) + +instance FromDhall a => FromDhall (Entry a) where + autoWith = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions + { fieldModifier = Text.toLower . Text.drop (Text.length "entry") + } + +-- | A user identified either by id or name. +data User + = UserId UserID + | UserName String + deriving (Eq, Generic, Ord, Show) + +instance FromDhall User + +#ifdef mingw32_HOST_OS +instance FromDhall UserID where + autoWith normalizer = Unsafe.Coerce.unsafeCoerce <$> autoWith @Word32 normalizer +#else +instance FromDhall Posix.CUid where + autoWith normalizer = Posix.CUid <$> autoWith normalizer +#endif + +-- | A group identified either by id or name. +data Group + = GroupId GroupID + | GroupName String + deriving (Eq, Generic, Ord, Show) + +instance FromDhall Group + +#ifdef mingw32_HOST_OS +instance FromDhall GroupID where + autoWith normalizer = Unsafe.Coerce.unsafeCoerce <$> autoWith @Word32 normalizer +#else +instance FromDhall Posix.CGid where + autoWith normalizer = Posix.CGid <$> autoWith normalizer +#endif + +-- | A filesystem mode. See chmod(1). +-- The parameter is meant to be instantiated by either `Identity` or `Maybe` +-- depending on the completeness of the information: +-- * For data read from the filesystem it will be `Identity`. +-- * For user-supplied data it will be `Maybe` as we want to be able to set +-- only specific bits. +data Mode f = Mode + { modeUser :: f (Access f) + , modeGroup :: f (Access f) + , modeOther :: f (Access f) + } + deriving Generic + +deriving instance Eq (Mode Identity) +deriving instance Eq (Mode Maybe) +deriving instance Ord (Mode Identity) +deriving instance Ord (Mode Maybe) +deriving instance Show (Mode Identity) +deriving instance Show (Mode Maybe) + +instance FromDhall (Mode Identity) where + autoWith = modeDecoder + +instance FromDhall (Mode Maybe) where + autoWith = modeDecoder + +modeDecoder :: FromDhall (f (Access f)) => InputNormalizer -> Decoder (Mode f) +modeDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions + { fieldModifier = Text.toLower . Text.drop (Text.length "mode") + } + +-- | The permissions for a subject (user/group/other). +data Access f = Access + { accessExecute :: f Bool + , accessRead :: f Bool + , accessWrite :: f Bool + } + deriving Generic + +deriving instance Eq (Access Identity) +deriving instance Eq (Access Maybe) +deriving instance Ord (Access Identity) +deriving instance Ord (Access Maybe) +deriving instance Show (Access Identity) +deriving instance Show (Access Maybe) + +instance FromDhall (Access Identity) where + autoWith = accessDecoder + +instance FromDhall (Access Maybe) where + autoWith = accessDecoder + +accessDecoder :: FromDhall (f Bool) => InputNormalizer -> Decoder (Access f) +accessDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions + { fieldModifier = Text.toLower . Text.drop (Text.length "access") + } + + + +-- | A wrapper around `Posix.setFileMode`. On Windows, it does check the +-- resulting file mode of the file/directory and emits a warning if it doesn't +-- match the desired file mode. On all other OS it is identical to +-- `Posix.setFileMode` as it is assumed to work correctly. +setFileMode :: FilePath -> FileMode -> IO () +#ifdef mingw32_HOST_OS +setFileMode fp mode = do + Posix.setFileMode fp mode + mode' <- Posix.fileMode <$> Posix.getFileStatus fp + unless (mode' == mode) $ hPutStrLn stderr $ + "Warning: Setting file mode did not succeed for " <> fp <> "\n" <> + " Expected: " <> prettyFileMode mode <> "\n" <> + " Actual: " <> prettyFileMode mode' +#else +setFileMode fp mode = Posix.setFileMode fp mode +#endif + +-- | Pretty-print a `FileMode`. The format is similar to the one ls(1): +-- It is display as three blocks of three characters. The first block are the +-- permissions of the user, the second one are the ones of the group and the +-- third one the ones of other subjects. A @r@ denotes that the file or +-- directory is readable by the subject, a @w@ denotes that it is writable and +-- an @x@ denotes that it is executable. Unset permissions are represented by +-- @-@. +prettyFileMode :: FileMode -> String +prettyFileMode mode = userPP <> groupPP <> otherPP + where + userPP :: String + userPP = + isBitSet 'r' Posix.ownerReadMode <> + isBitSet 'w' Posix.ownerWriteMode <> + isBitSet 'x' Posix.ownerExecuteMode + + groupPP :: String + groupPP = + isBitSet 'r' Posix.groupReadMode <> + isBitSet 'w' Posix.groupWriteMode <> + isBitSet 'x' Posix.groupExecuteMode + + otherPP :: String + otherPP = + isBitSet 'r' Posix.otherReadMode <> + isBitSet 'w' Posix.otherWriteMode <> + isBitSet 'x' Posix.otherExecuteMode + + isBitSet :: Char -> FileMode -> String + isBitSet c mask = if mask `Posix.intersectFileModes` mode /= Posix.nullFileMode + then [c] + else "-" + +-- | Is setting metadata supported on this platform or not. +isMetadataSupported :: Bool +#ifdef mingw32_HOST_OS +isMetadataSupported = False +#else +isMetadataSupported = True +#endif diff --git a/src/Dhall/Eval.hs b/src/Dhall/Eval.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Eval.hs @@ -0,0 +1,1567 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} + +{-| Eval-apply environment machine with conversion checking and quoting to + normal forms. Fairly similar to GHCI's STG machine algorithmically, but much + simpler, with no known call optimization or environment trimming. + + Potential optimizations without changing Expr: + + * In conversion checking, get non-shadowing variables not by linear + Env-walking, but by keeping track of Env size, and generating names which + are known to be illegal as source-level names (to rule out shadowing). + + * Use HashMap Text chunks for large let-definitions blocks. "Large" vs + "Small" is fairly cheap to determine at evaluation time. + + Potential optimizations with changing Expr: + + * Use actual full de Bruijn indices in Var instead of Text counting indices. + Then, we'd switch to full de Bruijn levels in Val as well, and use proper + constant time non-shadowing name generation. +-} + +module Dhall.Eval ( + judgmentallyEqual + , normalize + , alphaNormalize + , eval + , quote + , envNames + , countNames + , conv + , toVHPi + , Closure(..) + , Names(..) + , Environment(..) + , Val(..) + , (~>) + , textShow + , dateShow + , timeShow + , timezoneShow + ) where + +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import Data.Foldable (foldr', toList) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Sequence (Seq, ViewL (..), ViewR (..)) +import Data.Text (Text) +import Data.Time (Day, TimeOfDay (..), TimeZone) +import Data.Void (Void) +import Dhall.Map (Map) +import Dhall.Set (Set) +import GHC.Natural (Natural) +import Prelude hiding (succ) + +import Dhall.Syntax + ( Binding (..) + , Chunks (..) + , Const (..) + , DhallDouble (..) + , Expr (..) + , FunctionBinding (..) + , PreferAnnotation (..) + , RecordField (..) + , Var (..) + , WithComponent (..) + ) + +import qualified Data.Char +import qualified Data.Sequence as Sequence +import qualified Data.Set +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Dhall.Map as Map +import qualified Dhall.Set +import qualified Dhall.Syntax as Syntax +import qualified Text.Printf as Printf + +data Environment a + = Empty + | Skip !(Environment a) {-# UNPACK #-} !Text + | Extend !(Environment a) {-# UNPACK #-} !Text (Val a) + +deriving instance (Show a, Show (Val a -> Val a)) => Show (Environment a) + +errorMsg :: String +errorMsg = unlines + [ _ERROR <> ": Compiler bug " + , " " + , "An ill-typed expression was encountered during normalization. " + , "Explanation: This error message means that there is a bug in the Dhall compiler." + , "You didn't do anything wrong, but if you would like to see this problem fixed " + , "then you should report the bug at: " + , " " + , "https://github.com/dhall-lang/dhall-haskell/issues " + ] + where + _ERROR :: String + _ERROR = "\ESC[1;31mError\ESC[0m" + + +data Closure a = Closure !Text !(Environment a) !(Expr Void a) + +deriving instance (Show a, Show (Val a -> Val a)) => Show (Closure a) + +data VChunks a = VChunks ![(Text, Val a)] !Text + +deriving instance (Show a, Show (Val a -> Val a)) => Show (VChunks a) + +instance Semigroup (VChunks a) where + VChunks xys z <> VChunks [] z' = VChunks xys (z <> z') + VChunks xys z <> VChunks ((x', y'):xys') z' = VChunks (xys ++ (z <> x', y'):xys') z' + +instance Monoid (VChunks a) where + mempty = VChunks [] mempty + +{-| Some information is lost when `eval` converts a `Lam` or a built-in function + from the `Expr` type to a `VHLam` of the `Val` type and `quote` needs that + information in order to reconstruct an equivalent `Expr`. This `HLamInfo` + type holds that extra information necessary to perform that reconstruction +-} +data HLamInfo a + = Prim + -- ^ Don't store any information + | Typed !Text (Val a) + -- ^ Store the original name and type of the variable bound by the `Lam` + | NaturalSubtractZero + -- ^ The original function was a @Natural/subtract 0@. We need to preserve + -- this information in case the @Natural/subtract@ ends up not being fully + -- saturated, in which case we need to recover the unsaturated built-in + | TextReplaceEmpty + -- ^ The original function was a @Text/replace ""@ + | TextReplaceEmptyArgument (Val a) + -- ^ The original function was a @Text/replace "" replacement@ + +deriving instance (Show a, Show (Val a -> Val a)) => Show (HLamInfo a) + +pattern VPrim :: (Val a -> Val a) -> Val a +pattern VPrim f = VHLam Prim f + +toVHPi :: Eq a => Val a -> Maybe (Text, Val a, Val a -> Val a) +toVHPi (VPi a b@(Closure x _ _)) = Just (x, a, instantiate b) +toVHPi (VHPi x a b ) = Just (x, a, b) +toVHPi _ = Nothing +{-# INLINABLE toVHPi #-} + +data Val a + = VConst !Const + | VVar !Text !Int + | VPrimVar + | VApp !(Val a) !(Val a) + + | VLam (Val a) {-# UNPACK #-} !(Closure a) + | VHLam !(HLamInfo a) !(Val a -> Val a) + + | VPi (Val a) {-# UNPACK #-} !(Closure a) + | VHPi !Text (Val a) !(Val a -> Val a) + + | VBool + | VBoolLit !Bool + | VBoolAnd !(Val a) !(Val a) + | VBoolOr !(Val a) !(Val a) + | VBoolEQ !(Val a) !(Val a) + | VBoolNE !(Val a) !(Val a) + | VBoolIf !(Val a) !(Val a) !(Val a) + + | VBytes + | VBytesLit ByteString + + | VNatural + | VNaturalLit !Natural + | VNaturalFold !(Val a) !(Val a) !(Val a) !(Val a) + | VNaturalBuild !(Val a) + | VNaturalIsZero !(Val a) + | VNaturalEven !(Val a) + | VNaturalOdd !(Val a) + | VNaturalToInteger !(Val a) + | VNaturalShow !(Val a) + | VNaturalSubtract !(Val a) !(Val a) + | VNaturalPlus !(Val a) !(Val a) + | VNaturalTimes !(Val a) !(Val a) + + | VInteger + | VIntegerLit !Integer + | VIntegerClamp !(Val a) + | VIntegerNegate !(Val a) + | VIntegerShow !(Val a) + | VIntegerToDouble !(Val a) + + | VDouble + | VDoubleLit !DhallDouble + | VDoubleShow !(Val a) + + | VText + | VTextLit !(VChunks a) + | VTextAppend !(Val a) !(Val a) + | VTextShow !(Val a) + | VTextReplace !(Val a) !(Val a) !(Val a) + + | VDate + | VDateLiteral Time.Day + | VDateShow !(Val a) + | VTime + | VTimeLiteral Time.TimeOfDay Word + | VTimeShow !(Val a) + | VTimeZone + | VTimeZoneLiteral Time.TimeZone + | VTimeZoneShow !(Val a) + + | VList !(Val a) + | VListLit !(Maybe (Val a)) !(Seq (Val a)) + | VListAppend !(Val a) !(Val a) + | VListBuild (Val a) !(Val a) + | VListFold (Val a) !(Val a) !(Val a) !(Val a) !(Val a) + | VListLength (Val a) !(Val a) + | VListHead (Val a) !(Val a) + | VListLast (Val a) !(Val a) + | VListIndexed (Val a) !(Val a) + | VListReverse (Val a) !(Val a) + + | VOptional (Val a) + | VSome (Val a) + | VNone (Val a) + | VRecord !(Map Text (Val a)) + | VRecordLit !(Map Text (Val a)) + | VUnion !(Map Text (Maybe (Val a))) + | VCombine !(Maybe Text) !(Val a) !(Val a) + | VCombineTypes !(Val a) !(Val a) + | VPrefer !(Val a) !(Val a) + | VMerge !(Val a) !(Val a) !(Maybe (Val a)) + | VToMap !(Val a) !(Maybe (Val a)) + | VShowConstructor !(Val a) + | VField !(Val a) !Text + | VInject !(Map Text (Maybe (Val a))) !Text !(Maybe (Val a)) + | VProject !(Val a) !(Either (Set Text) (Val a)) + | VAssert !(Val a) + | VEquivalent !(Val a) !(Val a) + | VWith !(Val a) (NonEmpty WithComponent) !(Val a) + | VEmbed a + +-- | For use with "Text.Show.Functions". +deriving instance (Show a, Show (Val a -> Val a)) => Show (Val a) + +(~>) :: Val a -> Val a -> Val a +(~>) a b = VHPi "_" a (\_ -> b) +{-# INLINE (~>) #-} + +infixr 5 ~> + +countEnvironment :: Text -> Environment a -> Int +countEnvironment x = go (0 :: Int) + where + go !acc Empty = acc + go acc (Skip env x' ) = go (if x == x' then acc + 1 else acc) env + go acc (Extend env x' _) = go (if x == x' then acc + 1 else acc) env + +instantiate :: Eq a => Closure a -> Val a -> Val a +instantiate (Closure x env t) !u = eval (Extend env x u) t +{-# INLINE instantiate #-} + +-- Out-of-env variables have negative de Bruijn levels. +vVar :: Environment a -> Var -> Val a +vVar env0 (V x i0) = go env0 i0 + where + go (Extend env x' v) i + | x == x' = + if i == 0 then v else go env (i - 1) + | otherwise = + go env i + go (Skip env x') i + | x == x' = + if i == 0 then VVar x (countEnvironment x env) else go env (i - 1) + | otherwise = + go env i + go Empty i = + VVar x (negate i - 1) + +vApp :: Eq a => Val a -> Val a -> Val a +vApp !t !u = + case t of + VLam _ t' -> instantiate t' u + VHLam _ t' -> t' u + t' -> VApp t' u +{-# INLINE vApp #-} + +vPrefer :: Eq a => Environment a -> Val a -> Val a -> Val a +vPrefer env t u = + case (t, u) of + (VRecordLit m, u') | null m -> + u' + (t', VRecordLit m) | null m -> + t' + (VRecordLit m, VRecordLit m') -> + VRecordLit (Map.union m' m) + (t', u') | conv env t' u' -> + t' + (t', u') -> + VPrefer t' u' +{-# INLINE vPrefer #-} + +vCombine :: Maybe Text -> Val a -> Val a -> Val a +vCombine mk t u = + case (t, u) of + (VRecordLit m, u') | null m -> + u' + (t', VRecordLit m) | null m -> + t' + (VRecordLit m, VRecordLit m') -> + VRecordLit (Map.unionWith (vCombine Nothing) m m') + (t', u') -> + VCombine mk t' u' + +vCombineTypes :: Val a -> Val a -> Val a +vCombineTypes t u = + case (t, u) of + (VRecord m, u') | null m -> + u' + (t', VRecord m) | null m -> + t' + (VRecord m, VRecord m') -> + VRecord (Map.unionWith vCombineTypes m m') + (t', u') -> + VCombineTypes t' u' + +vListAppend :: Val a -> Val a -> Val a +vListAppend t u = + case (t, u) of + (VListLit _ xs, u') | null xs -> + u' + (t', VListLit _ ys) | null ys -> + t' + (VListLit t' xs, VListLit _ ys) -> + VListLit t' (xs <> ys) + (t', u') -> + VListAppend t' u' +{-# INLINE vListAppend #-} + +vNaturalPlus :: Val a -> Val a -> Val a +vNaturalPlus t u = + case (t, u) of + (VNaturalLit 0, u') -> + u' + (t', VNaturalLit 0) -> + t' + (VNaturalLit m, VNaturalLit n) -> + VNaturalLit (m + n) + (t', u') -> + VNaturalPlus t' u' +{-# INLINE vNaturalPlus #-} + +vField :: Val a -> Text -> Val a +vField t0 k = go t0 + where + go = \case + VUnion m -> case Map.lookup k m of + Just (Just _) -> VPrim $ \ ~u -> VInject m k (Just u) + Just Nothing -> VInject m k Nothing + _ -> error errorMsg + VRecordLit m + | Just v <- Map.lookup k m -> v + | otherwise -> error errorMsg + VProject t _ -> go t + VPrefer (VRecordLit m) r -> case Map.lookup k m of + Just v -> VField (VPrefer (singletonVRecordLit v) r) k + Nothing -> go r + VPrefer l (VRecordLit m) -> case Map.lookup k m of + Just v -> v + Nothing -> go l + VCombine mk (VRecordLit m) r -> case Map.lookup k m of + Just v -> VField (VCombine mk (singletonVRecordLit v) r) k + Nothing -> go r + VCombine mk l (VRecordLit m) -> case Map.lookup k m of + Just v -> VField (VCombine mk l (singletonVRecordLit v)) k + Nothing -> go l + t -> VField t k + + singletonVRecordLit v = VRecordLit (Map.singleton k v) +{-# INLINE vField #-} + +vTextReplace :: Text -> Val a -> Text -> VChunks a +vTextReplace needle replacement haystack = go haystack + where + go t + | Text.null suffix = VChunks [] t + | otherwise = + let remainder = Text.drop (Text.length needle) suffix + + rest = go remainder + + in case replacement of + VTextLit replacementChunks -> + VChunks [] prefix <> replacementChunks <> rest + _ -> + VChunks [(prefix, replacement)] "" <> rest + where + (prefix, suffix) = Text.breakOn needle t + +vProjectByFields :: Eq a => Environment a -> Val a -> Set Text -> Val a +vProjectByFields env t ks = + if null ks + then VRecordLit mempty + else case t of + VRecordLit kvs -> + let kvs' = Map.restrictKeys kvs (Dhall.Set.toSet ks) + in VRecordLit kvs' + VProject t' _ -> + vProjectByFields env t' ks + VPrefer l (VRecordLit kvs) -> + let ksSet = Dhall.Set.toSet ks + + kvs' = Map.restrictKeys kvs ksSet + + ks' = + Dhall.Set.fromSet + (Data.Set.difference ksSet (Map.keysSet kvs')) + + in vPrefer env (vProjectByFields env l ks') (VRecordLit kvs') + t' -> + VProject t' (Left ks) + +vWith :: Val a -> NonEmpty WithComponent -> Val a -> Val a +vWith (VRecordLit kvs) (WithLabel k :| [] ) v = VRecordLit (Map.insert k v kvs) +vWith (VRecordLit kvs) (WithLabel k₀ :| k₁ : ks) v = VRecordLit (Map.insert k₀ e₂ kvs) + where + e₁ = + case Map.lookup k₀ kvs of + Nothing -> VRecordLit mempty + Just e₁' -> e₁' + + e₂ = vWith e₁ (k₁ :| ks) v +vWith (VNone _T) (WithQuestion :| _ ) _ = VNone _T +vWith (VSome _) (WithQuestion :| [] ) v = VSome v +vWith (VSome t) (WithQuestion :| k₁ : ks) v = VSome (vWith t (k₁ :| ks) v) +vWith e₀ ks v₀ = VWith e₀ ks v₀ + +eval :: forall a. Eq a => Environment a -> Expr Void a -> Val a +eval !env t0 = + case t0 of + Const k -> + VConst k + Var v -> + vVar env v + Lam _ (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = a }) t -> + VLam (eval env a) (Closure x env t) + Pi _ x a b -> + VPi (eval env a) (Closure x env b) + App t u -> + vApp (eval env t) (eval env u) + Let (Binding _ x _ _mA _ a) b -> + let !env' = Extend env x (eval env a) + in eval env' b + Annot t _ -> + eval env t + Bool -> + VBool + BoolLit b -> + VBoolLit b + BoolAnd t u -> + case (eval env t, eval env u) of + (VBoolLit True, u') -> u' + (VBoolLit False, _) -> VBoolLit False + (t', VBoolLit True) -> t' + (_ , VBoolLit False) -> VBoolLit False + (t', u') | conv env t' u' -> t' + (t', u') -> VBoolAnd t' u' + BoolOr t u -> + case (eval env t, eval env u) of + (VBoolLit False, u') -> u' + (VBoolLit True, _) -> VBoolLit True + (t', VBoolLit False) -> t' + (_ , VBoolLit True) -> VBoolLit True + (t', u') | conv env t' u' -> t' + (t', u') -> VBoolOr t' u' + BoolEQ t u -> + case (eval env t, eval env u) of + (VBoolLit True, u') -> u' + (t', VBoolLit True) -> t' + (t', u') | conv env t' u' -> VBoolLit True + (t', u') -> VBoolEQ t' u' + BoolNE t u -> + case (eval env t, eval env u) of + (VBoolLit False, u') -> u' + (t', VBoolLit False) -> t' + (t', u') | conv env t' u' -> VBoolLit False + (t', u') -> VBoolNE t' u' + BoolIf b t f -> + case (eval env b, eval env t, eval env f) of + (VBoolLit True, t', _ ) -> t' + (VBoolLit False, _ , f') -> f' + (b', VBoolLit True, VBoolLit False) -> b' + (_, t', f') | conv env t' f' -> t' + (b', t', f') -> VBoolIf b' t' f' + Bytes -> + VBytes + BytesLit b -> + VBytesLit b + Natural -> + VNatural + NaturalLit n -> + VNaturalLit n + NaturalFold -> + VPrim $ \n -> + VPrim $ \natural -> + VPrim $ \succ -> + VPrim $ \zero -> + let inert = VNaturalFold n natural succ zero + in case zero of + VPrimVar -> inert + _ -> case succ of + VPrimVar -> inert + _ -> case natural of + VPrimVar -> inert + _ -> case n of + VNaturalLit n' -> + -- Use an `Integer` for the loop, due to the + -- following issue: + -- + -- https://github.com/ghcjs/ghcjs/issues/782 + go zero (fromIntegral n' :: Integer) where + go !acc 0 = acc + go acc m = + -- Detect a shortcut: if succ acc == acc then return acc immediately. + let next = vApp succ acc + in if conv env next acc then acc else go next (m - 1) + _ -> inert + NaturalBuild -> + VPrim $ \case + VPrimVar -> + VNaturalBuild VPrimVar + t -> t + `vApp` VNatural + `vApp` VHLam (Typed "n" VNatural) (\n -> vNaturalPlus n (VNaturalLit 1)) + `vApp` VNaturalLit 0 + + NaturalIsZero -> VPrim $ \case + VNaturalLit n -> VBoolLit (n == 0) + n -> VNaturalIsZero n + NaturalEven -> VPrim $ \case + VNaturalLit n -> VBoolLit (even n) + n -> VNaturalEven n + NaturalOdd -> VPrim $ \case + VNaturalLit n -> VBoolLit (odd n) + n -> VNaturalOdd n + NaturalToInteger -> VPrim $ \case + VNaturalLit n -> VIntegerLit (fromIntegral n) + n -> VNaturalToInteger n + NaturalShow -> VPrim $ \case + VNaturalLit n -> VTextLit (VChunks [] (Text.pack (show n))) + n -> VNaturalShow n + NaturalSubtract -> VPrim $ \case + VNaturalLit 0 -> + VHLam NaturalSubtractZero id + x@(VNaturalLit m) -> + VPrim $ \case + VNaturalLit n + | n >= m -> + -- Use an `Integer` for the subtraction, due to the + -- following issue: + -- + -- https://github.com/ghcjs/ghcjs/issues/782 + VNaturalLit (fromIntegral (subtract (fromIntegral m :: Integer) (fromIntegral n :: Integer))) + | otherwise -> VNaturalLit 0 + y -> VNaturalSubtract x y + x -> + VPrim $ \case + VNaturalLit 0 -> VNaturalLit 0 + y | conv env x y -> VNaturalLit 0 + y -> VNaturalSubtract x y + NaturalPlus t u -> + vNaturalPlus (eval env t) (eval env u) + NaturalTimes t u -> + case (eval env t, eval env u) of + (VNaturalLit 1, u' ) -> u' + (t' , VNaturalLit 1) -> t' + (VNaturalLit 0, _ ) -> VNaturalLit 0 + (_ , VNaturalLit 0) -> VNaturalLit 0 + (VNaturalLit m, VNaturalLit n) -> VNaturalLit (m * n) + (t' , u' ) -> VNaturalTimes t' u' + Integer -> + VInteger + IntegerLit n -> + VIntegerLit n + IntegerClamp -> + VPrim $ \case + VIntegerLit n + | 0 <= n -> VNaturalLit (fromInteger n) + | otherwise -> VNaturalLit 0 + n -> VIntegerClamp n + IntegerNegate -> + VPrim $ \case + VIntegerLit n -> VIntegerLit (negate n) + n -> VIntegerNegate n + IntegerShow -> + VPrim $ \case + VIntegerLit n + | 0 <= n -> VTextLit (VChunks [] (Text.pack ('+':show n))) + | otherwise -> VTextLit (VChunks [] (Text.pack (show n))) + n -> VIntegerShow n + IntegerToDouble -> + VPrim $ \case + VIntegerLit n -> VDoubleLit (DhallDouble (read (show n))) + -- `(read . show)` is used instead of `fromInteger` + -- because `read` uses the correct rounding rule. + -- See https://gitlab.haskell.org/ghc/ghc/issues/17231. + n -> VIntegerToDouble n + Double -> + VDouble + DoubleLit n -> + VDoubleLit n + DoubleShow -> + VPrim $ \case + VDoubleLit (DhallDouble n) -> VTextLit (VChunks [] (Text.pack (show n))) + n -> VDoubleShow n + Text -> + VText + TextLit cs -> + case evalChunks cs of + VChunks [("", t)] "" -> t + vcs -> VTextLit vcs + TextAppend t u -> + eval env (TextLit (Chunks [("", t), ("", u)] "")) + TextShow -> + VPrim $ \case + VTextLit (VChunks [] x) -> VTextLit (VChunks [] (textShow x)) + t -> VTextShow t + TextReplace -> + VPrim $ \needle -> + let hLamInfo0 = case needle of + VTextLit (VChunks [] "") -> TextReplaceEmpty + _ -> Prim + + in VHLam hLamInfo0 $ \replacement -> + let hLamInfo1 = case needle of + VTextLit (VChunks [] "") -> + TextReplaceEmptyArgument replacement + _ -> + Prim + in VHLam hLamInfo1 $ \haystack -> + case needle of + VTextLit (VChunks [] "") -> + haystack + + VTextLit (VChunks [] needleText) -> + case haystack of + VTextLit (VChunks [] haystackText) -> + case replacement of + VTextLit (VChunks [] replacementText) -> + VTextLit $ VChunks [] + (Text.replace + needleText + replacementText + haystackText + ) + _ -> + VTextLit + (vTextReplace + needleText + replacement + haystackText + ) + _ -> + VTextReplace needle replacement haystack + _ -> + VTextReplace needle replacement haystack + Date -> + VDate + DateLiteral d -> + VDateLiteral d + DateShow -> + VPrim $ \case + VDateLiteral d -> VTextLit (VChunks [] (dateShow d)) + t -> VDateShow t + Time -> + VTime + TimeLiteral t p -> + VTimeLiteral t p + TimeShow -> + VPrim $ \case + VTimeLiteral d p -> VTextLit (VChunks [] (timeShow d p)) + t -> VTimeShow t + TimeZone -> + VTimeZone + TimeZoneLiteral z -> + VTimeZoneLiteral z + TimeZoneShow -> + VPrim $ \case + VTimeZoneLiteral d -> VTextLit (VChunks [] (timezoneShow d)) + t -> VTimeZoneShow t + List -> + VPrim VList + ListLit ma ts -> + VListLit (fmap (eval env) ma) (fmap (eval env) ts) + ListAppend t u -> + vListAppend (eval env t) (eval env u) + ListBuild -> + VPrim $ \a -> + VPrim $ \case + VPrimVar -> + VListBuild a VPrimVar + t -> t + `vApp` VList a + `vApp` VHLam (Typed "a" a) (\x -> + VHLam (Typed "as" (VList a)) (\as -> + vListAppend (VListLit Nothing (pure x)) as)) + `vApp` VListLit (Just (VList a)) mempty + + ListFold -> + VPrim $ \a -> + VPrim $ \as -> + VPrim $ \list -> + VPrim $ \cons -> + VPrim $ \nil -> + let inert = VListFold a as list cons nil + in case nil of + VPrimVar -> inert + _ -> case cons of + VPrimVar -> inert + _ -> case list of + VPrimVar -> inert + _ -> case a of + VPrimVar -> inert + _ -> case as of + VListLit _ as' -> + foldr' (\x b -> cons `vApp` x `vApp` b) nil as' + _ -> inert + ListLength -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> VNaturalLit (fromIntegral (Sequence.length as)) + as -> VListLength a as + ListHead -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> + case Sequence.viewl as of + y :< _ -> VSome y + _ -> VNone a + as -> + VListHead a as + ListLast -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> + case Sequence.viewr as of + _ :> t -> VSome t + _ -> VNone a + as -> VListLast a as + ListIndexed -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> + let a' = + if null as + then Just (VList (VRecord (Map.unorderedFromList [("index", VNatural), ("value", a)]))) + else Nothing + + as' = + Sequence.mapWithIndex + (\i t -> + VRecordLit + (Map.unorderedFromList + [ ("index", VNaturalLit (fromIntegral i)) + , ("value", t) + ] + ) + ) + as + + in VListLit a' as' + t -> + VListIndexed a t + ListReverse -> + VPrim $ \ ~a -> + VPrim $ \case + VListLit t as | null as -> + VListLit t as + VListLit _ as -> + VListLit Nothing (Sequence.reverse as) + t -> + VListReverse a t + Optional -> + VPrim VOptional + Some t -> + VSome (eval env t) + None -> + VPrim $ \ ~a -> VNone a + Record kts -> + VRecord (Map.sort (eval env . recordFieldValue <$> kts)) + RecordLit kts -> + VRecordLit (Map.sort (eval env . recordFieldValue <$> kts)) + Union kts -> + VUnion (Map.sort (fmap (fmap (eval env)) kts)) + Combine _ mk t u -> + vCombine mk (eval env t) (eval env u) + CombineTypes _ t u -> + vCombineTypes (eval env t) (eval env u) + Prefer _ _ t u -> + vPrefer env (eval env t) (eval env u) + RecordCompletion t u -> + eval env (Annot (Prefer mempty PreferFromCompletion (Field t def) u) (Field t typ)) + where + def = Syntax.makeFieldSelection "default" + typ = Syntax.makeFieldSelection "Type" + Merge x y ma -> + case (eval env x, eval env y, fmap (eval env) ma) of + (VRecordLit m, VInject _ k mt, _) + | Just f <- Map.lookup k m -> maybe f (vApp f) mt + | otherwise -> error errorMsg + (VRecordLit m, VSome t, _) + | Just f <- Map.lookup "Some" m -> vApp f t + | otherwise -> error errorMsg + (VRecordLit m, VNone _, _) + | Just t <- Map.lookup "None" m -> t + | otherwise -> error errorMsg + (x', y', ma') -> VMerge x' y' ma' + ToMap x ma -> + case (eval env x, fmap (eval env) ma) of + (VRecordLit m, ma'@(Just _)) | null m -> + VListLit ma' Sequence.empty + (VRecordLit m, _) -> + let entry (k, v) = + VRecordLit + (Map.unorderedFromList + [ ("mapKey", VTextLit $ VChunks [] k) + , ("mapValue", v) + ] + ) + + s = (Sequence.fromList . map entry . Map.toAscList) m + + in VListLit Nothing s + (x', ma') -> + VToMap x' ma' + ShowConstructor x -> + case eval env x of + VInject m k _ + | Just _ <- Map.lookup k m -> VTextLit (VChunks [] k) + | otherwise -> error errorMsg + VSome _ -> VTextLit (VChunks [] "Some") + VNone _ -> VTextLit (VChunks [] "None") + x' -> VShowConstructor x' + Field t (Syntax.fieldSelectionLabel -> k) -> + vField (eval env t) k + Project t (Left ks) -> + vProjectByFields env (eval env t) (Dhall.Set.sort (Dhall.Set.fromList ks)) + Project t (Right e) -> + case eval env e of + VRecord kts -> + vProjectByFields env (eval env t) (Dhall.Set.fromSet (Map.keysSet kts)) + e' -> + VProject (eval env t) (Right e') + Assert t -> + VAssert (eval env t) + Equivalent _ t u -> + VEquivalent (eval env t) (eval env u) + With e₀ ks v -> + vWith (eval env e₀) ks (eval env v) + Note _ e -> + eval env e + ImportAlt t _ -> + eval env t + Embed a -> + VEmbed a + where + evalChunks :: Chunks Void a -> VChunks a + evalChunks (Chunks xys z) = foldr' cons nil xys + where + cons (x, t) vcs = + case eval env t of + VTextLit vcs' -> VChunks [] x <> vcs' <> vcs + t' -> VChunks [(x, t')] mempty <> vcs + + nil = VChunks [] z + {-# INLINE evalChunks #-} + +eqListBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool +eqListBy f = go + where + go (x:xs) (y:ys) | f x y = go xs ys + go [] [] = True + go _ _ = False +{-# INLINE eqListBy #-} + +eqMapsBy :: Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool +eqMapsBy f mL mR = + Map.size mL == Map.size mR + && eqListBy eq (Map.toAscList mL) (Map.toAscList mR) + where + eq (kL, vL) (kR, vR) = kL == kR && f vL vR +{-# INLINE eqMapsBy #-} + +eqMaybeBy :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool +eqMaybeBy f = go + where + go (Just x) (Just y) = f x y + go Nothing Nothing = True + go _ _ = False +{-# INLINE eqMaybeBy #-} + +-- | Utility that powers the @Text/show@ built-in +textShow :: Text -> Text +textShow text = "\"" <> Text.concatMap f text <> "\"" + where + f '"' = "\\\"" + f '$' = "\\u0024" + f '\\' = "\\\\" + f '\b' = "\\b" + f '\n' = "\\n" + f '\r' = "\\r" + f '\t' = "\\t" + f '\f' = "\\f" + f c | c <= '\x1F' = Text.pack (Printf.printf "\\u%04x" (Data.Char.ord c)) + | otherwise = Text.singleton c + +-- | Utility that powers the @Date/show@ built-in +dateShow :: Day -> Text +dateShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d" + +-- | Utility that powers the @Time/show@ built-in +timeShow :: TimeOfDay -> Word -> Text +timeShow (TimeOfDay hh mm seconds) precision = + Text.pack (Printf.printf "%02d:%02d:%02d" hh mm ss <> suffix) + where + magnitude :: Integer + magnitude = 10 ^ precision + + (ss, fraction) = + truncate (seconds * fromInteger magnitude) `divMod` magnitude + + suffix + | precision == 0 = "" + | otherwise = Printf.printf ".%0*d" precision fraction + +-- | Utility that powers the @TimeZone/show@ built-in +timezoneShow :: TimeZone -> Text +timezoneShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%Ez" + +conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool +conv !env t0 t0' = + case (t0, t0') of + (VConst k, VConst k') -> + k == k' + (VVar x i, VVar x' i') -> + x == x' && i == i' + (VLam _ (freshClosure -> (x, v, t)), VLam _ t' ) -> + convSkip x (instantiate t v) (instantiate t' v) + (VLam _ (freshClosure -> (x, v, t)), VHLam _ t') -> + convSkip x (instantiate t v) (t' v) + (VLam _ (freshClosure -> (x, v, t)), t' ) -> + convSkip x (instantiate t v) (vApp t' v) + (VHLam _ t, VLam _ (freshClosure -> (x, v, t'))) -> + convSkip x (t v) (instantiate t' v) + (VHLam _ t, VHLam _ t' ) -> + let (x, v) = fresh "x" in convSkip x (t v) (t' v) + (VHLam _ t, t' ) -> + let (x, v) = fresh "x" in convSkip x (t v) (vApp t' v) + (t, VLam _ (freshClosure -> (x, v, t'))) -> + convSkip x (vApp t v) (instantiate t' v) + (t, VHLam _ t' ) -> + let (x, v) = fresh "x" in convSkip x (vApp t v) (t' v) + (VApp t u, VApp t' u') -> + conv env t t' && conv env u u' + (VPi a b, VPi a' (freshClosure -> (x, v, b'))) -> + conv env a a' && convSkip x (instantiate b v) (instantiate b' v) + (VPi a b, VHPi (fresh -> (x, v)) a' b') -> + conv env a a' && convSkip x (instantiate b v) (b' v) + (VHPi _ a b, VPi a' (freshClosure -> (x, v, b'))) -> + conv env a a' && convSkip x (b v) (instantiate b' v) + (VHPi _ a b, VHPi (fresh -> (x, v)) a' b') -> + conv env a a' && convSkip x (b v) (b' v) + (VBool, VBool) -> + True + (VBoolLit b, VBoolLit b') -> + b == b' + (VBoolAnd t u, VBoolAnd t' u') -> + conv env t t' && conv env u u' + (VBoolOr t u, VBoolOr t' u') -> + conv env t t' && conv env u u' + (VBoolEQ t u, VBoolEQ t' u') -> + conv env t t' && conv env u u' + (VBoolNE t u, VBoolNE t' u') -> + conv env t t' && conv env u u' + (VBoolIf t u v, VBoolIf t' u' v') -> + conv env t t' && conv env u u' && conv env v v' + (VBytes, VBytes) -> + True + (VBytesLit l, VBytesLit r) -> + l == r + (VNatural, VNatural) -> + True + (VNaturalLit n, VNaturalLit n') -> + n == n' + (VNaturalFold t _ u v, VNaturalFold t' _ u' v') -> + conv env t t' && conv env u u' && conv env v v' + (VNaturalBuild t, VNaturalBuild t') -> + conv env t t' + (VNaturalIsZero t, VNaturalIsZero t') -> + conv env t t' + (VNaturalEven t, VNaturalEven t') -> + conv env t t' + (VNaturalOdd t, VNaturalOdd t') -> + conv env t t' + (VNaturalToInteger t, VNaturalToInteger t') -> + conv env t t' + (VNaturalShow t, VNaturalShow t') -> + conv env t t' + (VNaturalSubtract x y, VNaturalSubtract x' y') -> + conv env x x' && conv env y y' + (VNaturalPlus t u, VNaturalPlus t' u') -> + conv env t t' && conv env u u' + (VNaturalTimes t u, VNaturalTimes t' u') -> + conv env t t' && conv env u u' + (VInteger, VInteger) -> + True + (VIntegerLit t, VIntegerLit t') -> + t == t' + (VIntegerClamp t, VIntegerClamp t') -> + conv env t t' + (VIntegerNegate t, VIntegerNegate t') -> + conv env t t' + (VIntegerShow t, VIntegerShow t') -> + conv env t t' + (VIntegerToDouble t, VIntegerToDouble t') -> + conv env t t' + (VDouble, VDouble) -> + True + (VDoubleLit n, VDoubleLit n') -> + n == n' + (VDoubleShow t, VDoubleShow t') -> + conv env t t' + (VText, VText) -> + True + (VTextLit cs, VTextLit cs') -> + convChunks cs cs' + (VTextAppend t u, VTextAppend t' u') -> + conv env t t' && conv env u u' + (VTextShow t, VTextShow t') -> + conv env t t' + (VTextReplace a b c, VTextReplace a' b' c') -> + conv env a a' && conv env b b' && conv env c c' + (VDate, VDate) -> + True + (VDateLiteral l, VDateLiteral r) -> + l == r + (VDateShow t, VDateShow t') -> + conv env t t' + (VTime, VTime) -> + True + (VTimeLiteral tl pl, VTimeLiteral tr pr) -> + tl == tr && pl == pr + (VTimeShow t, VTimeShow t') -> + conv env t t' + (VTimeZone, VTimeZone) -> + True + (VTimeZoneLiteral l, VTimeZoneLiteral r) -> + l == r + (VTimeZoneShow t, VTimeZoneShow t') -> + conv env t t' + (VList a, VList a') -> + conv env a a' + (VListLit _ xs, VListLit _ xs') -> + eqListBy (conv env) (toList xs) (toList xs') + (VListAppend t u, VListAppend t' u') -> + conv env t t' && conv env u u' + (VListBuild _ t, VListBuild _ t') -> + conv env t t' + (VListLength a t, VListLength a' t') -> + conv env a a' && conv env t t' + (VListHead _ t, VListHead _ t') -> + conv env t t' + (VListLast _ t, VListLast _ t') -> + conv env t t' + (VListIndexed _ t, VListIndexed _ t') -> + conv env t t' + (VListReverse _ t, VListReverse _ t') -> + conv env t t' + (VListFold a l _ t u, VListFold a' l' _ t' u') -> + conv env a a' && conv env l l' && conv env t t' && conv env u u' + (VOptional a, VOptional a') -> + conv env a a' + (VSome t, VSome t') -> + conv env t t' + (VNone _, VNone _) -> + True + (VRecord m, VRecord m') -> + eqMapsBy (conv env) m m' + (VRecordLit m, VRecordLit m') -> + eqMapsBy (conv env) m m' + (VUnion m, VUnion m') -> + eqMapsBy (eqMaybeBy (conv env)) m m' + (VCombine _ t u, VCombine _ t' u') -> + conv env t t' && conv env u u' + (VCombineTypes t u, VCombineTypes t' u') -> + conv env t t' && conv env u u' + (VPrefer t u, VPrefer t' u') -> + conv env t t' && conv env u u' + (VMerge t u _, VMerge t' u' _) -> + conv env t t' && conv env u u' + (VToMap t _, VToMap t' _) -> + conv env t t' + (VShowConstructor t, VShowConstructor t') -> + conv env t t' + (VField t k, VField t' k') -> + conv env t t' && k == k' + (VProject t (Left ks), VProject t' (Left ks')) -> + conv env t t' && ks == ks' + (VProject t (Right e), VProject t' (Right e')) -> + conv env t t' && conv env e e' + (VAssert t, VAssert t') -> + conv env t t' + (VEquivalent t u, VEquivalent t' u') -> + conv env t t' && conv env u u' + (VInject m k mt, VInject m' k' mt') -> + eqMapsBy (eqMaybeBy (conv env)) m m' && k == k' && eqMaybeBy (conv env) mt mt' + (VEmbed a, VEmbed a') -> + a == a' + (_, _) -> + False + where + fresh :: Text -> (Text, Val a) + fresh x = (x, VVar x (countEnvironment x env)) + {-# INLINE fresh #-} + + freshClosure :: Closure a -> (Text, Val a, Closure a) + freshClosure closure@(Closure x _ _) = (x, snd (fresh x), closure) + {-# INLINE freshClosure #-} + + convChunks :: VChunks a -> VChunks a -> Bool + convChunks (VChunks xys z) (VChunks xys' z') = + eqListBy (\(x, y) (x', y') -> x == x' && conv env y y') xys xys' && z == z' + {-# INLINE convChunks #-} + + convSkip :: Text -> Val a -> Val a -> Bool + convSkip x = conv (Skip env x) + {-# INLINE convSkip #-} + +judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool +judgmentallyEqual (Syntax.denote -> t) (Syntax.denote -> u) = + conv Empty (eval Empty t) (eval Empty u) +{-# INLINABLE judgmentallyEqual #-} + +data Names + = EmptyNames + | Bind !Names {-# UNPACK #-} !Text + deriving Show + +envNames :: Environment a -> Names +envNames Empty = EmptyNames +envNames (Skip env x ) = Bind (envNames env) x +envNames (Extend env x _) = Bind (envNames env) x + +countNames :: Text -> Names -> Int +countNames x = go 0 + where + go !acc EmptyNames = acc + go acc (Bind env x') = go (if x == x' then acc + 1 else acc) env + +-- | Quote a value into beta-normal form. +quote :: forall a. Eq a => Names -> Val a -> Expr Void a +quote !env !t0 = + case t0 of + VConst k -> + Const k + VVar !x !i -> + Var (V x (countNames x env - i - 1)) + VApp t u -> + quote env t `qApp` u + VLam a (freshClosure -> (x, v, t)) -> + Lam + mempty + (Syntax.makeFunctionBinding x (quote env a)) + (quoteBind x (instantiate t v)) + VHLam i t -> + case i of + Typed (fresh -> (x, v)) a -> + Lam mempty + (Syntax.makeFunctionBinding x (quote env a)) + (quoteBind x (t v)) + Prim -> + quote env (t VPrimVar) + NaturalSubtractZero -> + App NaturalSubtract (NaturalLit 0) + TextReplaceEmpty -> + App TextReplace (TextLit (Chunks [] "")) + TextReplaceEmptyArgument replacement -> + App (App TextReplace (TextLit (Chunks [] ""))) + (quote env replacement) + + VPi a (freshClosure -> (x, v, b)) -> + Pi mempty x (quote env a) (quoteBind x (instantiate b v)) + VHPi (fresh -> (x, v)) a b -> + Pi mempty x (quote env a) (quoteBind x (b v)) + VBool -> + Bool + VBoolLit b -> + BoolLit b + VBoolAnd t u -> + BoolAnd (quote env t) (quote env u) + VBoolOr t u -> + BoolOr (quote env t) (quote env u) + VBoolEQ t u -> + BoolEQ (quote env t) (quote env u) + VBoolNE t u -> + BoolNE (quote env t) (quote env u) + VBoolIf t u v -> + BoolIf (quote env t) (quote env u) (quote env v) + VBytes -> + Bytes + VBytesLit b -> + BytesLit b + VNatural -> + Natural + VNaturalLit n -> + NaturalLit n + VNaturalFold a t u v -> + NaturalFold `qApp` a `qApp` t `qApp` u `qApp` v + VNaturalBuild t -> + NaturalBuild `qApp` t + VNaturalIsZero t -> + NaturalIsZero `qApp` t + VNaturalEven t -> + NaturalEven `qApp` t + VNaturalOdd t -> + NaturalOdd `qApp` t + VNaturalToInteger t -> + NaturalToInteger `qApp` t + VNaturalShow t -> + NaturalShow `qApp` t + VNaturalPlus t u -> + NaturalPlus (quote env t) (quote env u) + VNaturalTimes t u -> + NaturalTimes (quote env t) (quote env u) + VNaturalSubtract x y -> + NaturalSubtract `qApp` x `qApp` y + VInteger -> + Integer + VIntegerLit n -> + IntegerLit n + VIntegerClamp t -> + IntegerClamp `qApp` t + VIntegerNegate t -> + IntegerNegate `qApp` t + VIntegerShow t -> + IntegerShow `qApp` t + VIntegerToDouble t -> + IntegerToDouble `qApp` t + VDouble -> + Double + VDoubleLit n -> + DoubleLit n + VDoubleShow t -> + DoubleShow `qApp` t + VText -> + Text + VTextLit (VChunks xys z) -> + TextLit (Chunks (fmap (fmap (quote env)) xys) z) + VTextAppend t u -> + TextAppend (quote env t) (quote env u) + VTextShow t -> + TextShow `qApp` t + VTextReplace a b c -> + TextReplace `qApp` a `qApp` b `qApp` c + VDate -> + Date + VDateLiteral d -> + DateLiteral d + VDateShow t -> + DateShow `qApp` t + VTime -> + Time + VTimeLiteral t p -> + TimeLiteral t p + VTimeShow t -> + TimeShow `qApp` t + VTimeZone -> + TimeZone + VTimeZoneLiteral z -> + TimeZoneLiteral z + VTimeZoneShow t -> + TimeZoneShow `qApp` t + VList t -> + List `qApp` t + VListLit ma ts -> + ListLit (fmap (quote env) ma) (fmap (quote env) ts) + VListAppend t u -> + ListAppend (quote env t) (quote env u) + VListBuild a t -> + ListBuild `qApp` a `qApp` t + VListFold a l t u v -> + ListFold `qApp` a `qApp` l `qApp` t `qApp` u `qApp` v + VListLength a t -> + ListLength `qApp` a `qApp` t + VListHead a t -> + ListHead `qApp` a `qApp` t + VListLast a t -> + ListLast `qApp` a `qApp` t + VListIndexed a t -> + ListIndexed `qApp` a `qApp` t + VListReverse a t -> + ListReverse `qApp` a `qApp` t + VOptional a -> + Optional `qApp` a + VSome t -> + Some (quote env t) + VNone t -> + None `qApp` t + VRecord m -> + Record (fmap quoteRecordField m) + VRecordLit m -> + RecordLit (fmap quoteRecordField m) + VUnion m -> + Union (fmap (fmap (quote env)) m) + VCombine mk t u -> + Combine mempty mk (quote env t) (quote env u) + VCombineTypes t u -> + CombineTypes mempty (quote env t) (quote env u) + VPrefer t u -> + Prefer mempty PreferFromSource (quote env t) (quote env u) + VMerge t u ma -> + Merge (quote env t) (quote env u) (fmap (quote env) ma) + VToMap t ma -> + ToMap (quote env t) (fmap (quote env) ma) + VShowConstructor t -> + ShowConstructor (quote env t) + VField t k -> + Field (quote env t) $ Syntax.makeFieldSelection k + VProject t p -> + Project (quote env t) (first Dhall.Set.toList (fmap (quote env) p)) + VAssert t -> + Assert (quote env t) + VEquivalent t u -> + Equivalent mempty (quote env t) (quote env u) + VWith e ks v -> + With (quote env e) ks (quote env v) + VInject m k Nothing -> + Field (Union (fmap (fmap (quote env)) m)) $ Syntax.makeFieldSelection k + VInject m k (Just t) -> + Field (Union (fmap (fmap (quote env)) m)) (Syntax.makeFieldSelection k) `qApp` t + VEmbed a -> + Embed a + VPrimVar -> + error errorMsg + where + fresh :: Text -> (Text, Val a) + fresh x = (x, VVar x (countNames x env)) + {-# INLINE fresh #-} + + freshClosure :: Closure a -> (Text, Val a, Closure a) + freshClosure closure@(Closure x _ _) = (x, snd (fresh x), closure) + {-# INLINE freshClosure #-} + + quoteBind :: Text -> Val a -> Expr Void a + quoteBind x = quote (Bind env x) + {-# INLINE quoteBind #-} + + qApp :: Expr Void a -> Val a -> Expr Void a + qApp t VPrimVar = t + qApp t u = App t (quote env u) + {-# INLINE qApp #-} + + quoteRecordField :: Val a -> RecordField Void a + quoteRecordField = Syntax.makeRecordField . quote env + {-# INLINE quoteRecordField #-} + +-- | Normalize an expression in an environment of values. Any variable pointing out of +-- the environment is treated as opaque free variable. +nf :: Eq a => Environment a -> Expr s a -> Expr t a +nf !env = Syntax.renote . quote (envNames env) . eval env . Syntax.denote + +normalize :: Eq a => Expr s a -> Expr t a +normalize = nf Empty +{-# INLINABLE normalize #-} + +alphaNormalize :: Expr s a -> Expr s a +alphaNormalize = goEnv EmptyNames + where + goVar :: Names -> Text -> Int -> Expr s a + goVar e topX topI = go 0 e topI + where + go !acc (Bind env x) !i + | x == topX = if i == 0 then Var (V "_" acc) else go (acc + 1) env (i - 1) + | otherwise = go (acc + 1) env i + go _ EmptyNames i = Var (V topX i) + + goEnv :: Names -> Expr s a -> Expr s a + goEnv !e0 t0 = + case t0 of + Const k -> + Const k + Var (V x i) -> + goVar e0 x i + Lam cs (FunctionBinding src0 x src1 src2 t) u -> + Lam cs (FunctionBinding src0 "_" src1 src2 (go t)) (goBind x u) + Pi cs x a b -> + Pi cs "_" (go a) (goBind x b) + App t u -> + App (go t) (go u) + Let (Binding src0 x src1 mA src2 a) b -> + Let (Binding src0 "_" src1 (fmap (fmap go) mA) src2 (go a)) (goBind x b) + Annot t u -> + Annot (go t) (go u) + Bool -> + Bool + BoolLit b -> + BoolLit b + BoolAnd t u -> + BoolAnd (go t) (go u) + BoolOr t u -> + BoolOr (go t) (go u) + BoolEQ t u -> + BoolEQ (go t) (go u) + BoolNE t u -> + BoolNE (go t) (go u) + BoolIf b t f -> + BoolIf (go b) (go t) (go f) + Bytes -> + Bytes + BytesLit b -> + BytesLit b + Natural -> + Natural + NaturalLit n -> + NaturalLit n + NaturalFold -> + NaturalFold + NaturalBuild -> + NaturalBuild + NaturalIsZero -> + NaturalIsZero + NaturalEven -> + NaturalEven + NaturalOdd -> + NaturalOdd + NaturalToInteger -> + NaturalToInteger + NaturalShow -> + NaturalShow + NaturalSubtract -> + NaturalSubtract + NaturalPlus t u -> + NaturalPlus (go t) (go u) + NaturalTimes t u -> + NaturalTimes (go t) (go u) + Integer -> + Integer + IntegerLit n -> + IntegerLit n + IntegerClamp -> + IntegerClamp + IntegerNegate -> + IntegerNegate + IntegerShow -> + IntegerShow + IntegerToDouble -> + IntegerToDouble + Double -> + Double + DoubleLit n -> + DoubleLit n + DoubleShow -> + DoubleShow + Text -> + Text + TextLit cs -> + TextLit (goChunks cs) + TextAppend t u -> + TextAppend (go t) (go u) + TextShow -> + TextShow + TextReplace -> + TextReplace + Date -> + Date + DateLiteral d -> + DateLiteral d + DateShow -> + DateShow + Time -> + Time + TimeLiteral t p -> + TimeLiteral t p + TimeShow -> + TimeShow + TimeZone -> + TimeZone + TimeZoneLiteral z -> + TimeZoneLiteral z + TimeZoneShow -> + TimeZoneShow + List -> + List + ListLit ma ts -> + ListLit (fmap go ma) (fmap go ts) + ListAppend t u -> + ListAppend (go t) (go u) + ListBuild -> + ListBuild + ListFold -> + ListFold + ListLength -> + ListLength + ListHead -> + ListHead + ListLast -> + ListLast + ListIndexed -> + ListIndexed + ListReverse -> + ListReverse + Optional -> + Optional + Some t -> + Some (go t) + None -> + None + Record kts -> + Record (goRecordField <$> kts) + RecordLit kts -> + RecordLit (goRecordField <$> kts) + Union kts -> + Union (fmap (fmap go) kts) + Combine cs m t u -> + Combine cs m (go t) (go u) + CombineTypes cs t u -> + CombineTypes cs (go t) (go u) + Prefer cs b t u -> + Prefer cs b (go t) (go u) + RecordCompletion t u -> + RecordCompletion (go t) (go u) + Merge x y ma -> + Merge (go x) (go y) (fmap go ma) + ToMap x ma -> + ToMap (go x) (fmap go ma) + ShowConstructor x -> + ShowConstructor (go x) + Field t k -> + Field (go t) k + Project t ks -> + Project (go t) (fmap go ks) + Assert t -> + Assert (go t) + Equivalent cs t u -> + Equivalent cs (go t) (go u) + With e k v -> + With (go e) k (go v) + Note s e -> + Note s (go e) + ImportAlt t u -> + ImportAlt (go t) (go u) + Embed a -> + Embed a + where + go = goEnv e0 + goBind x = goEnv (Bind e0 x) + goChunks (Chunks ts x) = Chunks (fmap (fmap go) ts) x + goRecordField (RecordField s0 e s1 s2) = RecordField s0 (go e) s1 s2 diff --git a/src/Dhall/Format.hs b/src/Dhall/Format.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Format.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | This module contains the implementation of the @dhall format@ subcommand + +module Dhall.Format + ( -- * Format + Format(..) + , format + ) where + +import Data.Foldable (for_) +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromMaybe) +import Dhall.Pretty (CharacterSet, annToAnsiStyle, detectCharacterSet) +import Dhall.Util + ( Censor + , CheckFailed (..) + , Header (..) + , Input (..) + , OutputMode (..) + , Transitivity (..) + , handleMultipleChecksFailed + ) + +import qualified Data.Text.IO +import qualified Dhall.Import +import qualified Dhall.Pretty +import qualified Dhall.Util +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Terminal as Pretty.Terminal +import qualified Prettyprinter.Render.Text as Pretty.Text +import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText +import qualified System.Console.ANSI +import qualified System.FilePath +import qualified System.IO + +-- | Arguments to the `format` subcommand +data Format = Format + { chosenCharacterSet :: Maybe CharacterSet + , censor :: Censor + , transitivity :: Transitivity + , inputs :: NonEmpty Input + , outputMode :: OutputMode + } + +-- | Implementation of the @dhall format@ subcommand +format :: Format -> IO () +format (Format { inputs = inputs0, transitivity = transitivity0, ..}) = + handleMultipleChecksFailed "format" "formatted" go inputs0 + where + go input = do + let directory = case input of + StandardInput -> + "." + InputFile file -> + System.FilePath.takeDirectory file + + let status = Dhall.Import.emptyStatus directory + + let layoutHeaderAndExpr (Header header, expr) = + let characterSet = fromMaybe (detectCharacterSet expr) chosenCharacterSet + in + Dhall.Pretty.layout + ( Pretty.pretty header + <> Dhall.Pretty.prettyCharacterSet characterSet expr + <> "\n") + + (inputName, originalText, transitivity) <- case input of + InputFile file -> do + text <- Data.Text.IO.readFile file + + return (file, text, transitivity0) + StandardInput -> do + text <- Data.Text.IO.getContents + + return ("(input)", text, NonTransitive) + + + headerAndExpr@(_, parsedExpression) <- Dhall.Util.getExpressionAndHeaderFromStdinText censor inputName originalText + + case transitivity of + Transitive -> + for_ parsedExpression $ \import_ -> do + maybeFilepath <- Dhall.Import.dependencyToFile status import_ + + for_ maybeFilepath $ \filepath -> + go (InputFile filepath) + + NonTransitive -> + return () + + let docStream = layoutHeaderAndExpr headerAndExpr + + let formattedText = Pretty.Text.renderStrict docStream + + case outputMode of + Write -> do + case input of + InputFile file -> + if originalText == formattedText + then return () + else AtomicWrite.LazyText.atomicWriteFile + file + (Pretty.Text.renderLazy docStream) + + StandardInput -> do + supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout + + Pretty.Terminal.renderIO + System.IO.stdout + (if supportsANSI + then (fmap annToAnsiStyle docStream) + else (Pretty.unAnnotateS docStream)) + + return (Right ()) + + Check -> + return $ + if originalText == formattedText + then Right () + else Left CheckFailed{..} diff --git a/src/Dhall/Freeze.hs b/src/Dhall/Freeze.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Freeze.hs @@ -0,0 +1,445 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | This module contains the implementation of the @dhall freeze@ subcommand + +module Dhall.Freeze + ( -- * Freeze + freeze + , freezeExpression + , freezeImport + , freezeRemoteImport + + -- * Freeze with custom evaluation settings + , freezeWithSettings + , freezeExpressionWithSettings + , freezeImportWithSettings + , freezeRemoteImportWithSettings + + -- * Types + , Scope(..) + , Intent(..) + + -- * Deprecated functions + , freezeWithManager + , freezeExpressionWithManager + , freezeImportWithManager + , freezeRemoteImportWithManager + ) where + +import Data.Foldable (for_) +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromMaybe) +import Dhall (EvaluateSettings) +import Dhall.Pretty (CharacterSet, detectCharacterSet) +import Dhall.Syntax + ( Expr (..) + , Import (..) + , ImportHashed (..) + , ImportType (..) + ) +import Dhall.Util + ( Censor + , CheckFailed (..) + , Header (..) + , Input (..) + , OutputMode (..) + , Transitivity (..) + , handleMultipleChecksFailed + ) +import Lens.Micro (set, transformMOf, transformOf) +import Lens.Micro.Extras (view) +import System.Console.ANSI (hSupportsANSI) + +import qualified Control.Exception as Exception +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Text.IO as Text.IO +import qualified Dhall +import qualified Dhall.Core as Core +import qualified Dhall.Import +import qualified Dhall.Pretty +import qualified Dhall.TypeCheck +import qualified Dhall.Util as Util +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Terminal as Pretty +import qualified Prettyprinter.Render.Text as Pretty.Text +import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText +import qualified System.FilePath +import qualified System.IO + +-- | Specifies which imports to freeze +data Scope + = OnlyRemoteImports + -- ^ Freeze only remote imports (i.e. URLs) + | AllImports + -- ^ Freeze all imports (including paths and environment variables) + +-- | Specifies why we are adding semantic integrity checks +data Intent + = Secure + -- ^ Protect imports with an integrity check without a fallback so that + -- import resolution fails if the import changes + | Cache + -- ^ Protect imports with an integrity check and also add a fallback import + -- import without an integrity check. This is useful if you only want to + -- cache imports when possible but still gracefully degrade to resolving + -- them if the semantic integrity check has changed. + +-- | Retrieve an `Import` and update the hash to match the latest contents +freezeImport + :: FilePath + -- ^ Current working directory + -> Import + -> IO Import +freezeImport = freezeImportWithSettings Dhall.defaultEvaluateSettings + +-- | See 'freezeImport'. +freezeImportWithManager + :: IO Dhall.Import.Manager + -> FilePath + -> Import + -> IO Import +freezeImportWithManager newManager = freezeImportWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings) +{-# DEPRECATED freezeImportWithManager "Use freezeImportWithSettings directly" #-} + +-- | Freeze an import only if the import is a `Remote` import +freezeRemoteImport + :: FilePath + -- ^ Current working directory + -> Import + -> IO Import +freezeRemoteImport = freezeRemoteImportWithSettings Dhall.defaultEvaluateSettings + +-- | See 'freezeRemoteImport'. +freezeRemoteImportWithManager + :: IO Dhall.Import.Manager + -> FilePath + -> Import + -> IO Import +freezeRemoteImportWithManager newManager = freezeRemoteImportWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings) +{-# DEPRECATED freezeRemoteImportWithManager "Use freezeRemoteImportWithSettings directly" #-} + +-- | Implementation of the @dhall freeze@ subcommand +freeze + :: OutputMode + -> Transitivity + -> NonEmpty Input + -> Scope + -> Intent + -> Maybe CharacterSet + -> Censor + -> IO () +freeze = freezeWithSettings Dhall.defaultEvaluateSettings + +-- | See 'freeze'. +freezeWithManager + :: IO Dhall.Import.Manager + -> OutputMode + -> Transitivity + -> NonEmpty Input + -> Scope + -> Intent + -> Maybe CharacterSet + -> Censor + -> IO () +freezeWithManager newManager = freezeWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings) +{-# DEPRECATED freezeWithManager "Use freezeWithSettings directly" #-} + +{-| Slightly more pure version of the `freeze` function + + This still requires `IO` to freeze the import, but now the input and output + expression are passed in explicitly +-} +freezeExpression + :: FilePath + -- ^ Starting directory + -> Scope + -> Intent + -> Expr s Import + -> IO (Expr s Import) +freezeExpression = freezeExpressionWithSettings Dhall.defaultEvaluateSettings + +-- | See 'freezeExpression'. +freezeExpressionWithManager + :: IO Dhall.Import.Manager + -> FilePath + -> Scope + -> Intent + -> Expr s Import + -> IO (Expr s Import) +freezeExpressionWithManager newManager = freezeExpressionWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings) +{-# DEPRECATED freezeExpressionWithManager "Use freezeExpressionWithSettings directly" #-} + +-------------------------------------------------------------------------------- +-- Versions that take EvaluateSettings +-------------------------------------------------------------------------------- + +-- | See 'freezeImport'. +freezeImportWithSettings + :: EvaluateSettings + -> FilePath + -> Import + -> IO Import +freezeImportWithSettings settings directory import_ = do + let unprotectedImport = + import_ + { importHashed = + (importHashed import_) + { hash = Nothing + } + } + + let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory + + expression <- State.evalStateT (Dhall.Import.loadWith (Embed unprotectedImport)) status + + case Dhall.TypeCheck.typeWith (view Dhall.startingContext settings) expression of + Left exception -> Exception.throwIO exception + Right _ -> return () + + let normalizedExpression = Core.alphaNormalize (Core.normalizeWith (view Dhall.normalizer settings) expression) + + -- make sure the frozen import is present in the semantic cache + Dhall.Import.writeExpressionToSemanticCache (Core.denote expression) + + let expressionHash = Dhall.Import.hashExpression normalizedExpression + + let newImportHashed = (importHashed import_) { hash = Just expressionHash } + + let newImport = import_ { importHashed = newImportHashed } + + return newImport + +-- | See 'freezeRemoteImport'. +freezeRemoteImportWithSettings + :: EvaluateSettings + -> FilePath + -> Import + -> IO Import +freezeRemoteImportWithSettings settings directory import_ = + case importType (importHashed import_) of + Remote {} -> freezeImportWithSettings settings directory import_ + _ -> return import_ + +-- | See 'freezeRemoteImport'. +freezeNonMissingImportWithSettings + :: EvaluateSettings + -> FilePath + -> Import + -> IO Import +freezeNonMissingImportWithSettings settings directory import_ = + case importType (importHashed import_) of + Missing -> return import_ + _ -> freezeImportWithSettings settings directory import_ + +-- | See 'freeze'. +freezeWithSettings + :: EvaluateSettings + -> OutputMode + -> Transitivity + -> NonEmpty Input + -> Scope + -> Intent + -> Maybe CharacterSet + -> Censor + -> IO () +freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenCharacterSet censor = + handleMultipleChecksFailed "freeze" "frozen" go inputs + where + go input = do + let directory = case input of + StandardInput -> + "." + InputFile file -> + System.FilePath.takeDirectory file + + let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory + + (inputName, originalText, transitivity) <- case input of + InputFile file -> do + text <- Text.IO.readFile file + + return (file, text, transitivity0) + + StandardInput -> do + text <- Text.IO.getContents + + return ("(input)", text, NonTransitive) + + (Header header, parsedExpression) <- Util.getExpressionAndHeaderFromStdinText censor inputName originalText + + let characterSet = fromMaybe (detectCharacterSet parsedExpression) chosenCharacterSet + + case transitivity of + Transitive -> + for_ parsedExpression $ \import_ -> do + maybeFilepath <- Dhall.Import.dependencyToFile status import_ + + for_ maybeFilepath $ \filepath -> + go (InputFile filepath) + + NonTransitive -> + return () + + frozenExpression <- freezeExpressionWithSettings settings directory scope intent parsedExpression + + let doc = Pretty.pretty header + <> Dhall.Pretty.prettyCharacterSet characterSet frozenExpression + <> "\n" + + let stream = Dhall.Pretty.layout doc + + let modifiedText = Pretty.Text.renderStrict stream + + case outputMode of + Write -> do + let unAnnotated = Pretty.unAnnotateS stream + + case input of + InputFile file -> + if originalText == modifiedText + then return () + else + AtomicWrite.LazyText.atomicWriteFile + file + (Pretty.Text.renderLazy unAnnotated) + + StandardInput -> do + supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout + if supportsANSI + then + Pretty.renderIO System.IO.stdout (Dhall.Pretty.annToAnsiStyle <$> stream) + else + Pretty.renderIO System.IO.stdout unAnnotated + + return (Right ()) + + Check -> + return $ + if originalText == modifiedText + then Right () + else Left CheckFailed{..} + +-- | See 'freezeExpression'. +freezeExpressionWithSettings + :: EvaluateSettings + -> FilePath + -> Scope + -> Intent + -> Expr s Import + -> IO (Expr s Import) +freezeExpressionWithSettings settings directory scope intent expression = do + let freezeScope = + case scope of + AllImports -> freezeNonMissingImportWithSettings + OnlyRemoteImports -> freezeRemoteImportWithSettings + + let freezeFunction = freezeScope settings directory + + let cache + -- This case is necessary because `transformOf` is a bottom-up + -- rewrite rule. Without this rule, if you were to transform a + -- file that already has a cached expression, like this: + -- + -- someImport sha256:… ? someImport + -- + -- ... then you would get: + -- + -- (someImport sha256:… ? someImport) + -- ? (someImport sha256:… ? someImport) + -- + -- ... and this rule fixes that by collapsing that back to: + -- + -- (someImport sha256:… ? someImport) + (ImportAlt + (Core.shallowDenote -> ImportAlt + (Core.shallowDenote -> Embed + Import{ importHashed = ImportHashed{ hash = Just _expectedHash } } + ) + (Core.shallowDenote -> Embed + Import{ importHashed = ImportHashed{ hash = Nothing } } + ) + ) + import_@(Core.shallowDenote -> ImportAlt + (Core.shallowDenote -> Embed + Import{ importHashed = ImportHashed{ hash = Just _actualHash } } + ) + (Core.shallowDenote -> Embed + Import{ importHashed = ImportHashed{ hash = Nothing } } + ) + ) + ) = + {- Here we could actually compare the `_expectedHash` and + `_actualHash` to see if they differ, but we choose not to do + so and instead automatically accept the `_actualHash`. This + is done for the same reason that the `freeze*` functions + ignore hash mismatches: the user intention when using `dhall + freeze` is to update the hash, which they expect to possibly + change. + -} + return import_ + cache + (Embed import_@(Import { importHashed = ImportHashed { hash = Nothing } })) = do + frozenImport <- freezeFunction import_ + + let frozenMissing = toMissing frozenImport + + {- The two imports can be the same if the import is local and + `freezeFunction` only freezes remote imports by default + -} + if frozenImport /= import_ + then return (ImportAlt (Embed frozenMissing) (Embed import_)) + else return (Embed import_) + cache + (Embed import_@(Import { importHashed = ImportHashed { hash = Just _ } })) = do + -- Regenerate the integrity check, just in case it's wrong + frozenImport <- freezeFunction import_ + + let frozenMissing = toMissing frozenImport + + -- `dhall freeze --cache` also works the other way around, adding an + -- unprotected fallback import to imports that are already + -- protected + let thawedImport = import_ + { importHashed = (importHashed import_) + { hash = Nothing + } + } + + return (ImportAlt (Embed frozenMissing) (Embed thawedImport)) + cache expression_ = + return expression_ + + let uncache + (ImportAlt + (Core.shallowDenote -> Embed + Import{ importHashed = ImportHashed { hash = Just expectedHash, importType = Missing } } + ) + (Core.shallowDenote -> Embed + import_@Import{ importHashed = ImportHashed{ hash = Nothing } } + ) + ) = Embed + (import_ + { importHashed = (importHashed import_) + { hash = Just expectedHash + } + } + ) + uncache expression_ = expression_ + + let simplify (ImportAlt (Core.shallowDenote -> Embed import1) (Core.shallowDenote -> Embed import2)) + | import1 == import2 = Embed import1 + simplify expression_ = expression_ + + transformOf Core.subExpressions simplify <$> case intent of + Secure -> + traverse freezeFunction (transformOf Core.subExpressions uncache expression) + Cache -> + transformMOf Core.subExpressions cache expression + +-- https://github.com/dhall-lang/dhall-haskell/issues/2347 +toMissing :: Import -> Import +toMissing import_ = + import_ { importHashed = (importHashed import_) { importType = Missing } } diff --git a/src/Dhall/Import.hs b/src/Dhall/Import.hs --- a/src/Dhall/Import.hs +++ b/src/Dhall/Import.hs @@ -1,873 +1,1401 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wall #-} - -{-| Dhall lets you import external expressions located either in local files or - hosted on network endpoints. - - To import a local file as an expression, just insert the path to the file, - prepending a @./@ if the path is relative to the current directory. For - example, if you create a file named @id@ with the following contents: - - > $ cat id - > λ(a : Type) → λ(x : a) → x - - Then you can use the file directly within a @dhall@ program just by - referencing the file's path: - - > $ dhall - > ./id Bool True - > - > Bool - > - > True - - Imported expressions may contain imports of their own, too, which will - continue to be resolved. However, Dhall will prevent cyclic imports. For - example, if you had these two files: - - > $ cat foo - > ./bar - - > $ cat bar - > ./foo - - ... Dhall would throw the following exception if you tried to import @foo@: - - > $ dhall - > ./foo - > ^D - > ↳ ./foo - > ↳ ./bar - > - > Cyclic import: ./foo - - You can also import expressions hosted on network endpoints. Just use the - URL - - > http://host[:port]/path - - The compiler expects the downloaded expressions to be in the same format - as local files, specifically UTF8-encoded source code text. - - For example, if our @id@ expression were hosted at @http://example.com/id@, - then we would embed the expression within our code using: - - > http://example.com/id - - You can also reuse directory names as expressions. If you provide a path - to a local or remote directory then the compiler will look for a file named - @\@@ within that directory and use that file to represent the directory. - - You can also import expressions stored within environment variables using - @env:NAME@, where @NAME@ is the name of the environment variable. For - example: - - > $ export FOO=1 - > $ export BAR='"Hi"' - > $ export BAZ='λ(x : Bool) → x == False' - > $ dhall <<< "{ foo = env:FOO , bar = env:BAR , baz = env:BAZ }" - > { bar : Text, baz : ∀(x : Bool) → Bool, foo : Integer } - > - > { bar = "Hi", baz = λ(x : Bool) → x == False, foo = 1 } - - If you wish to import the raw contents of a path as @Text@ then add - @as Text@ to the end of the import: - - > $ dhall <<< "http://example.com as Text" - > Text - > - > "\n\n\n Example Domain\n\n charset=\"utf-8\" />\n ; charset=utf-8\" />\n initial-scale=1\" />\n \n\n\n\n
\n

Example Domain h1>\n

This domain is established to be used for illustrative examples in d - > ocuments. You may use this\n domain in examples without prior coordination or - > asking for permission.

\n

e\">More information...

\n

\n\n\n" --} - -module Dhall.Import ( - -- * Import - exprFromPath - , load - , loadWith - , loadWithContext - , hashExpression - , hashExpressionToCode - , Status(..) - , emptyStatus - , Cycle(..) - , ReferentiallyOpaque(..) - , Imported(..) - , PrettyHttpException(..) - , MissingFile(..) - , MissingEnvironmentVariable(..) - ) where - -import Control.Applicative (empty) -import Control.Exception - (Exception, IOException, SomeException, onException, throwIO) -import Control.Monad (join) -import Control.Monad.Catch (throwM, MonadCatch(catch)) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.State.Strict (StateT) -import Crypto.Hash (SHA256) -import Data.ByteString.Lazy (ByteString) -import Data.CaseInsensitive (CI) -import Data.Map (Map) -import Data.Monoid ((<>)) -import Data.Text.Buildable (build) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Builder (Builder) -#if MIN_VERSION_base(4,8,0) -#else -import Data.Traversable (traverse) -#endif -import Data.Typeable (Typeable) -import System.FilePath (()) -import Dhall.Core - ( Expr(..) - , Chunks(..) - , HasHome(..) - , PathHashed(..) - , PathMode(..) - , PathType(..) - , Path(..) - ) -import Dhall.Parser (Parser(..), ParseError(..), Src(..)) -import Dhall.TypeCheck (X(..)) -import Lens.Family (LensLike') -import Lens.Family.State.Strict (zoom) -#if MIN_VERSION_http_client(0,5,0) -import Network.HTTP.Client - (HttpException(..), HttpExceptionContent(..), Manager) -#else -import Network.HTTP.Client (HttpException(..), Manager) -#endif -import Text.Trifecta (Result(..)) -import Text.Trifecta.Delta (Delta(..)) - -import qualified Control.Monad.Trans.State.Strict as State -import qualified Crypto.Hash -import qualified Data.ByteArray -import qualified Data.ByteString -import qualified Data.ByteString.Char8 -import qualified Data.ByteString.Lazy -import qualified Data.CaseInsensitive -import qualified Data.Foldable -import qualified Data.List as List -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.Map.Strict as Map -import qualified Data.Text.Encoding -import qualified Data.Text.IO -import qualified Data.Text.Lazy as Text -import qualified Data.Text.Lazy.Builder as Builder -import qualified Data.Text.Lazy.Encoding -import qualified Data.Text.Lazy.IO -import qualified Dhall.Core -import qualified Dhall.Parser -import qualified Dhall.Context -import qualified Dhall.TypeCheck -import qualified Network.HTTP.Client as HTTP -import qualified Network.HTTP.Client.TLS as HTTP -import qualified System.Environment -import qualified System.Directory -import qualified System.FilePath as FilePath -import qualified Text.Parser.Combinators -import qualified Text.Parser.Token -import qualified Text.Trifecta - -builderToString :: Builder -> String -builderToString = Text.unpack . Builder.toLazyText - --- | An import failed because of a cycle in the import graph -newtype Cycle = Cycle - { cyclicImport :: Path -- ^ The offending cyclic import - } - deriving (Typeable) - -instance Exception Cycle - -instance Show Cycle where - show (Cycle path) = "\nCyclic import: " ++ builderToString (build path) - -{-| Dhall tries to ensure that all expressions hosted on network endpoints are - weakly referentially transparent, meaning roughly that any two clients will - compile the exact same result given the same URL. - - To be precise, a strong interpretaton of referential transparency means that - if you compiled a URL you could replace the expression hosted at that URL - with the compiled result. Let's call this \"static linking\". Dhall (very - intentionally) does not satisfy this stronger interpretation of referential - transparency since \"statically linking\" an expression (i.e. permanently - resolving all imports) means that the expression will no longer update if - its dependencies change. - - In general, either interpretation of referential transparency is not - enforceable in a networked context since one can easily violate referential - transparency with a custom DNS, but Dhall can still try to guard against - common unintentional violations. To do this, Dhall enforces that a - non-local import may not reference a local import. - - Local imports are defined as: - - * A file - - * A URL with a host of @localhost@ or @127.0.0.1@ - - All other imports are defined to be non-local --} -newtype ReferentiallyOpaque = ReferentiallyOpaque - { opaqueImport :: Path -- ^ The offending opaque import - } deriving (Typeable) - -instance Exception ReferentiallyOpaque - -instance Show ReferentiallyOpaque where - show (ReferentiallyOpaque path) = - "\nReferentially opaque import: " ++ builderToString (build path) - --- | Extend another exception with the current import stack -data Imported e = Imported - { importStack :: [Path] -- ^ Imports resolved so far, in reverse order - , nested :: e -- ^ The nested exception - } deriving (Typeable) - -instance Exception e => Exception (Imported e) - -instance Show e => Show (Imported e) where - show (Imported paths e) = - (case paths of [] -> ""; _ -> "\n") - ++ unlines (map indent paths') - ++ show e - where - indent (n, path) = - take (2 * n) (repeat ' ') ++ "↳ " ++ builderToString (build path) - -- Canonicalize all paths - paths' = zip [0..] (drop 1 (reverse (canonicalizeAll paths))) - --- | Newtype used to wrap `HttpException`s with a prettier `Show` instance -newtype PrettyHttpException = PrettyHttpException HttpException - deriving (Typeable) - -instance Exception PrettyHttpException - -#if MIN_VERSION_http_client(0,5,0) -instance Show PrettyHttpException where - show (PrettyHttpException (InvalidUrlException _ r)) = - "\n" - <> "\ESC[1;31mError\ESC[0m: Invalid URL\n" - <> "\n" - <> "↳ " <> show r - show (PrettyHttpException (HttpExceptionRequest _ e)) = case e of - ConnectionFailure e' -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Wrong host\n" - <> "\n" - <> "↳ " <> show e' - InvalidDestinationHost host -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Invalid host name\n" - <> "\n" - <> "↳ " <> show host - ResponseTimeout -> - "\ESC[1;31mError\ESC[0m: The host took too long to respond\n" - e' -> "\n" <> show e' -#else -instance Show PrettyHttpException where - show (PrettyHttpException e) = case e of - FailedConnectionException2 _ _ _ e' -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Wrong host\n" - <> "\n" - <> "↳ " <> show e' - InvalidDestinationHost host -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Invalid host name\n" - <> "\n" - <> "↳ " <> show host - ResponseTimeout -> - "\ESC[1;31mError\ESC[0m: The host took too long to respond\n" - e' -> "\n" - <> show e' -#endif - --- | Exception thrown when an imported file is missing -data MissingFile = MissingFile FilePath - deriving (Typeable) - -instance Exception MissingFile - -instance Show MissingFile where - show (MissingFile path) = - "\n" - <> "\ESC[1;31mError\ESC[0m: Missing file " - <> path - <> "\n" - --- | Exception thrown when an environment variable is missing -newtype MissingEnvironmentVariable = MissingEnvironmentVariable { name :: Text } - deriving (Typeable) - -instance Exception MissingEnvironmentVariable - -instance Show MissingEnvironmentVariable where - show (MissingEnvironmentVariable {..}) = - "\n" - <> "\ESC[1;31mError\ESC[0m: Missing environment variable\n" - <> "\n" - <> "↳ " <> Text.unpack name - --- | State threaded throughout the import process -data Status = Status - { _stack :: [Path] - -- ^ Stack of `Path`s that we've imported along the way to get to the - -- current point - , _cache :: Map Path (Expr Src X) - -- ^ Cache of imported expressions in order to avoid importing the same - -- expression twice with different values - , _manager :: Maybe Manager - -- ^ Cache for the `Manager` so that we only acquire it once - } - --- | Default starting `Status` -emptyStatus :: Status -emptyStatus = Status [] Map.empty Nothing - -canonicalizeAll :: [Path] -> [Path] -canonicalizeAll = map canonicalizePath . List.tails - -stack :: Functor f => LensLike' f Status [Path] -stack k s = fmap (\x -> s { _stack = x }) (k (_stack s)) - -cache :: Functor f => LensLike' f Status (Map Path (Expr Src X)) -cache k s = fmap (\x -> s { _cache = x }) (k (_cache s)) - -manager :: Functor f => LensLike' f Status (Maybe Manager) -manager k s = fmap (\x -> s { _manager = x }) (k (_manager s)) - -needManager :: StateT Status IO Manager -needManager = do - x <- zoom manager State.get - case x of - Just m -> return m - Nothing -> do - let settings = HTTP.tlsManagerSettings -#if MIN_VERSION_http_client(0,5,0) - { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (30 * 1000 * 1000) } -- 30 seconds -#else - { HTTP.managerResponseTimeout = Just (30 * 1000 * 1000) } -- 30 seconds -#endif - m <- liftIO (HTTP.newManager settings) - zoom manager (State.put (Just m)) - return m - -{-| This function computes the current path by taking the last absolute path - (either an absolute `FilePath` or `URL`) and combining it with all following - relative paths - - For example, if the file `./foo/bar` imports `./baz`, that will resolve to - `./foo/baz`. Relative imports are relative to a file's parent directory. - This also works for URLs, too. - - This code is full of all sorts of edge cases so it wouldn't surprise me at - all if you find something broken in here. Most of the ugliness is due to: - - * Handling paths ending with @/\@@ by stripping the @/\@@ suffix if and only - if you navigate to any downstream relative paths - * Removing spurious @.@s and @..@s from the path - - Also, there are way too many `reverse`s in the URL-handling code For now I - don't mind, but if were to really do this correctly we'd store the URLs as - `Text` for O(1) access to the end of the string. The only reason we use - `String` at all is for consistency with the @http-client@ library. --} -canonicalize :: [PathType] -> PathType -canonicalize [] = File Homeless "." -canonicalize (File hasHome0 file0:paths0) = - if FilePath.isRelative file0 && hasHome0 == Homeless - then go file0 paths0 - else File hasHome0 (FilePath.normalise file0) - where - go currPath [] = File Homeless (FilePath.normalise currPath) - go currPath (Env _ :_ ) = File Homeless (FilePath.normalise currPath) - go currPath (URL url0 headers:rest ) = combine prefix suffix - where - headers' = fmap (onPathType (\h -> canonicalize (h:rest))) headers - - prefix = parentURL (removeAtFromURL url0) - - suffix = FilePath.normalise currPath - - -- `clean` will resolve internal @.@/@..@'s in @currPath@, but we still - -- need to manually handle @.@/@..@'s at the beginning of the path - combine url path = case List.stripPrefix "../" path of - Just path' -> combine url' path' - where - url' = parentURL (removeAtFromURL url) - Nothing -> case List.stripPrefix "./" path of - Just path' -> combine url path' - Nothing -> - -- This `last` is safe because the lexer constrains all - -- URLs to be non-empty. I couldn't find a simple and safe - -- equivalent in the `text` API - case Text.last url of - '/' -> URL (url <> path') headers' - _ -> URL (url <> "/" <> path') headers' - where - path' = Text.pack path - go currPath (File hasHome file:paths) = - if FilePath.isRelative file && hasHome == Homeless - then go file' paths - else File hasHome (FilePath.normalise file') - where - file' = FilePath.takeDirectory (removeAtFromFilename file) currPath -canonicalize (URL path headers:rest) = URL path headers' - where - headers' = fmap (onPathType (\h -> canonicalize (h:rest))) headers -canonicalize (Env env :_ ) = Env env - -onPathType :: (PathType -> PathType) -> PathHashed -> PathHashed -onPathType f (PathHashed a b) = PathHashed a (f b) - -canonicalizePath :: [Path] -> Path -canonicalizePath [] = - Path - { pathMode = Code - , pathHashed = PathHashed - { hash = Nothing - , pathType = canonicalize [] - } - } -canonicalizePath (path:paths) = - Path - { pathMode = pathMode path - , pathHashed = (pathHashed path) - { hash = hash (pathHashed path) - , pathType = - canonicalize (map (pathType . pathHashed) (path:paths)) - } - } - -parentURL :: Text -> Text -parentURL = Text.dropWhileEnd (/= '/') - -removeAtFromURL:: Text -> Text -removeAtFromURL url - | Text.isSuffixOf "/@" url = Text.dropEnd 2 url - | Text.isSuffixOf "/" url = Text.dropEnd 1 url - | otherwise = url - -removeAtFromFilename :: FilePath -> FilePath -removeAtFromFilename fp = - if FilePath.takeFileName fp == "@" - then FilePath.takeDirectory fp - else fp - -toHeaders - :: Expr s a - -> Maybe [(CI Data.ByteString.ByteString, Data.ByteString.ByteString)] -toHeaders (ListLit _ hs) = do - hs' <- mapM toHeader hs - return (Data.Foldable.toList hs') -toHeaders _ = do - empty - -toHeader - :: Expr s a - -> Maybe (CI Data.ByteString.ByteString, Data.ByteString.ByteString) -toHeader (RecordLit m) = do - TextLit (Chunks [] keyBuilder ) <- Data.HashMap.Strict.InsOrd.lookup "header" m - TextLit (Chunks [] valueBuilder) <- Data.HashMap.Strict.InsOrd.lookup "value" m - let keyText = Text.toStrict (Builder.toLazyText keyBuilder ) - let valueText = Text.toStrict (Builder.toLazyText valueBuilder) - let keyBytes = Data.Text.Encoding.encodeUtf8 keyText - let valueBytes = Data.Text.Encoding.encodeUtf8 valueText - return (Data.CaseInsensitive.mk keyBytes, valueBytes) -toHeader _ = do - empty - - -{-| This exception indicates that there was an internal error in Dhall's - import-related logic - the `expected` type then the `extract` function must succeed. If not, then - this exception is thrown - - This exception indicates that an invalid `Type` was provided to the `input` - function --} -data InternalError = InternalError deriving (Typeable) - -_ERROR :: String -_ERROR = "\ESC[1;31mError\ESC[0m" - -instance Show InternalError where - show InternalError = unlines - [ _ERROR <> ": Compiler bug " - , " " - , "Explanation: This error message means that there is a bug in the Dhall compiler." - , "You didn't do anything wrong, but if you would like to see this problem fixed " - , "then you should report the bug at: " - , " " - , "https://github.com/dhall-lang/dhall-haskell/issues " - , " " - , "Please include the following text in your bug report: " - , " " - , "``` " - , "Header extraction failed even though the header type-checked " - , "``` " - ] - -instance Exception InternalError - --- | Exception thrown when an integrity check fails -data HashMismatch = HashMismatch - { expectedHash :: Crypto.Hash.Digest SHA256 - , actualHash :: Crypto.Hash.Digest SHA256 - } deriving (Typeable) - -instance Exception HashMismatch - -instance Show HashMismatch where - show (HashMismatch {..}) = - "\n" - <> "\ESC[1;31mError\ESC[0m: Import integrity check failed\n" - <> "\n" - <> "Expected hash:\n" - <> "\n" - <> "↳ " <> show expectedHash <> "\n" - <> "\n" - <> "Actual hash:\n" - <> "\n" - <> "↳ " <> show actualHash <> "\n" - -parseFromFileEx - :: Text.Trifecta.Parser a - -> FilePath - -> IO (Text.Trifecta.Result a) -parseFromFileEx parser path = do - text <- Data.Text.Lazy.IO.readFile path - - let lazyBytes = Data.Text.Lazy.Encoding.encodeUtf8 text - - let strictBytes = Data.ByteString.Lazy.toStrict lazyBytes - - let delta = Directed bytesPath 0 0 0 0 - - return (Text.Trifecta.parseByteString parser delta strictBytes) - where - bytesPath = Data.ByteString.Char8.pack path - --- | Parse an expression from a `Path` containing a Dhall program -exprFromPath :: Path -> StateT Status IO (Expr Src Path) -exprFromPath (Path {..}) = case pathType of - File hasHome file -> liftIO (do - path <- case hasHome of - Home -> do - home <- System.Directory.getHomeDirectory - return (home file) - Homeless -> do - return file - - case pathMode of - Code -> do - exists <- System.Directory.doesFileExist path - if exists - then return () - else throwIO (MissingFile path) - - -- Unfortunately, GHC throws an `InappropriateType` exception - -- when trying to read a directory, but does not export the - -- exception, so I must resort to a more heavy-handed `catch` - let handler :: IOException -> IO (Result (Expr Src Path)) - handler e = do - -- If the fallback fails, reuse the original exception - -- to avoid user confusion - parseFromFileEx parser (path "@") - `onException` throwIO e - - x <- parseFromFileEx parser path `catch` handler - case x of - Failure errInfo -> do - throwIO (ParseError (Text.Trifecta._errDoc errInfo)) - Success expr -> do - return expr - RawText -> do - text <- Data.Text.IO.readFile path - return (TextLit (Chunks [] (build text))) ) - URL url headerPath -> do - m <- needManager - request <- liftIO (HTTP.parseUrlThrow (Text.unpack url)) - - let handler :: HTTP.HttpException -> IO (HTTP.Response ByteString) -#if MIN_VERSION_http_client(0,5,0) - handler err@(HttpExceptionRequest _ (StatusCodeException _ _)) = do -#else - handler err@(StatusCodeException _ _ _) = do -#endif - let request' = request { HTTP.path = HTTP.path request <> "/@" } - -- If the fallback fails, reuse the original exception to avoid - -- user confusion - HTTP.httpLbs request' m `onException` throwIO (PrettyHttpException err) - handler err = throwIO (PrettyHttpException err) - - requestWithHeaders <- case headerPath of - Nothing -> return request - Just path -> do - expr <- loadStaticIO Dhall.Context.empty (Path path Code) - let expected :: Expr Src X - expected = - App List - ( Record - ( Data.HashMap.Strict.InsOrd.fromList - [("header", Text), ("value", Text)] - ) - ) - let suffix = - ( Data.ByteString.Lazy.toStrict - . Data.Text.Lazy.Encoding.encodeUtf8 - . Builder.toLazyText - . build - ) expected - let annot = case expr of - Note (Src begin end bytes) _ -> - Note (Src begin end bytes') (Annot expr expected) - where - bytes' = bytes <> " : " <> suffix - _ -> - Annot expr expected - case Dhall.TypeCheck.typeOf annot of - Left err -> liftIO (throwIO err) - Right _ -> return () - let expr' = Dhall.Core.normalize expr - headers <- case toHeaders expr' of - Just headers -> do - return headers - Nothing -> do - liftIO (throwIO InternalError) - let requestWithHeaders = request - { HTTP.requestHeaders = headers - } - return requestWithHeaders - response <- liftIO (HTTP.httpLbs requestWithHeaders m `catch` handler) - - let bytes = HTTP.responseBody response - - text <- case Data.Text.Lazy.Encoding.decodeUtf8' bytes of - Left err -> liftIO (throwIO err) - Right text -> return text - - case pathMode of - Code -> do - let urlBytes = Data.Text.Lazy.Encoding.encodeUtf8 url - let delta = - Directed (Data.ByteString.Lazy.toStrict urlBytes) 0 0 0 0 - case Text.Trifecta.parseString parser delta (Text.unpack text) of - Failure err -> do - -- Also try the fallback in case of a parse error, since - -- the parse error might signify that this URL points to - -- a directory list - let err' = ParseError (Text.Trifecta._errDoc err) - - request' <- liftIO (HTTP.parseUrlThrow (Text.unpack url)) - - let request'' = - request' - { HTTP.path = HTTP.path request' <> "/@" } - response' <- liftIO (HTTP.httpLbs request'' m `onException` throwIO err' ) - - let bytes' = HTTP.responseBody response' - - text' <- case Data.Text.Lazy.Encoding.decodeUtf8' bytes' of - Left _ -> liftIO (throwIO err') - Right text' -> return text' - - case Text.Trifecta.parseString parser delta (Text.unpack text') of - Failure _ -> liftIO (throwIO err') - Success expr -> return expr - Success expr -> return expr - RawText -> do - return (TextLit (Chunks [] (build text))) - Env env -> liftIO (do - x <- System.Environment.lookupEnv (Text.unpack env) - case x of - Just str -> do - case pathMode of - Code -> do - let envBytes = Data.Text.Lazy.Encoding.encodeUtf8 env - let delta = - Directed (Data.ByteString.Lazy.toStrict envBytes) 0 0 0 0 - case Text.Trifecta.parseString parser delta str of - Failure errInfo -> do - throwIO (ParseError (Text.Trifecta._errDoc errInfo)) - Success expr -> do - return expr - RawText -> return (TextLit (Chunks [] (build str))) - Nothing -> throwIO (MissingEnvironmentVariable env) ) - where - PathHashed {..} = pathHashed - - parser = unParser (do - Text.Parser.Token.whiteSpace - r <- Dhall.Parser.expr - Text.Parser.Combinators.eof - return r ) - -{-| Load a `Path` as a \"dynamic\" expression (without resolving any imports) - - This also returns the true final path (i.e. explicit "/@" at the end for - directories) --} -loadDynamic - :: forall m . MonadCatch m - => (Path -> StateT Status m (Expr Src Path)) - -> Path - -> StateT Status m (Expr Src Path) -loadDynamic from_path p = do - paths <- zoom stack State.get - - let handler :: SomeException -> StateT Status m (Expr Src Path) - handler e = throwM (Imported (p:paths) e) - - from_path (canonicalizePath (p:paths)) `catch` handler - -loadStaticIO - :: Dhall.Context.Context (Expr Src X) - -> Path - -> StateT Status IO (Expr Src X) -loadStaticIO = loadStaticWith exprFromPath - --- | Resolve all imports within an expression using a custom typing context and Path --- resolving callback in arbitrary `MonadCatch` monad. -loadWith - :: MonadCatch m - => (Path -> StateT Status m (Expr Src Path)) - -> Dhall.Context.Context (Expr Src X) - -> Expr Src Path - -> m (Expr Src X) -loadWith from_path ctx = evalStatus (loadStaticWith from_path ctx) - --- | Resolve all imports within an expression using a custom typing context. --- --- @load = loadWithContext Dhall.Context.empty@ -loadWithContext - :: Dhall.Context.Context (Expr Src X) - -> Expr Src Path - -> IO (Expr Src X) -loadWithContext ctx = evalStatus (loadStaticIO ctx) - -loadStaticWith - :: MonadCatch m - => (Path -> StateT Status m (Expr Src Path)) - -> Dhall.Context.Context (Expr Src X) - -> Path - -> StateT Status m (Expr Src X) -loadStaticWith from_path ctx path = do - paths <- zoom stack State.get - - let local (Path (PathHashed _ (URL _ _ )) _) = False - local (Path (PathHashed _ (File _ _)) _) = True - local (Path (PathHashed _ (Env _ )) _) = True - - let parent = canonicalizePath paths - let here = canonicalizePath (path:paths) - - if local here && not (local parent) - then throwM (Imported paths (ReferentiallyOpaque path)) - else return () - - (expr, cached) <- if here `elem` canonicalizeAll paths - then throwM (Imported paths (Cycle path)) - else do - m <- zoom cache State.get - case Map.lookup here m of - Just expr -> return (expr, True) - Nothing -> do - expr' <- loadDynamic from_path path - expr'' <- case traverse (\_ -> Nothing) expr' of - -- No imports left - Just expr -> do - zoom cache (State.put $! Map.insert here expr m) - return expr - -- Some imports left, so recurse - Nothing -> do - let paths' = path:paths - zoom stack (State.put paths') - expr'' <- fmap join (traverse (loadStaticWith from_path ctx) - expr') - zoom stack (State.put paths) - return expr'' - return (expr'', False) - - -- Type-check expressions here for three separate reasons: - -- - -- * to verify that they are closed - -- * to catch type errors as early in the import process as possible - -- * to avoid normalizing ill-typed expressions that need to be hashed - -- - -- There is no need to check expressions that have been cached, since they - -- have already been checked - if cached - then return () - else case Dhall.TypeCheck.typeWith ctx expr of - Left err -> throwM (Imported (path:paths) err) - Right _ -> return () - - case hash (pathHashed path) of - Nothing -> do - return () - Just expectedHash -> do - let actualHash = hashExpression expr - if expectedHash == actualHash - then return () - else throwM (HashMismatch {..}) - - return expr - -evalStatus - :: (Traversable f, Monad m, Monad f) - => (a -> StateT Status m (f b)) -> f a -> m (f b) -evalStatus cb expr = State.evalStateT (fmap join (traverse cb expr)) emptyStatus - --- | Resolve all imports within an expression -load :: Expr Src Path -> IO (Expr Src X) -load = loadWithContext Dhall.Context.empty - --- | Hash a fully resolved expression -hashExpression :: Expr s X -> (Crypto.Hash.Digest SHA256) -hashExpression expr = Crypto.Hash.hashlazy actualBytes - where - text = Dhall.Core.pretty (Dhall.Core.normalize expr) - actualBytes = Data.Text.Lazy.Encoding.encodeUtf8 text - -{-| Convenience utility to hash a fully resolved expression and return the - base-16 encoded hash with the @sha256:@ prefix - - In other words, the output of this function can be pasted into Dhall - source code to add an integrity check to an import --} -hashExpressionToCode :: Expr s X -> Text -hashExpressionToCode expr = "sha256:" <> lazyText - where - bytes = hashExpression expr - - bytes16 = Data.ByteArray.convert bytes - - -- Notes that `decodeUtf8` is partial, but the base16-encoded bytestring - -- should always successfully decode - text = Data.Text.Encoding.decodeUtf8 bytes16 - - lazyText = Text.fromStrict text +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -Wall #-} + +{-| Dhall lets you import external expressions located either in local files or + hosted on network endpoints. + + To import a local file as an expression, just insert the path to the file, + prepending a @./@ if the path is relative to the current directory. For + example, if you create a file named @id@ with the following contents: + + > $ cat id + > λ(a : Type) → λ(x : a) → x + + Then you can use the file directly within a @dhall@ program just by + referencing the file's path: + + > $ dhall + > ./id Bool True + > + > Bool + > + > True + + Imported expressions may contain imports of their own, too, which will + continue to be resolved. However, Dhall will prevent cyclic imports. For + example, if you had these two files: + + > $ cat foo + > ./bar + + > $ cat bar + > ./foo + + ... Dhall would throw the following exception if you tried to import @foo@: + + > $ dhall + > ./foo + > ^D + > ↳ ./foo + > ↳ ./bar + > + > Cyclic import: ./foo + + You can also import expressions hosted on network endpoints. Just use the + URL + + > http://host[:port]/path + + The compiler expects the downloaded expressions to be in the same format + as local files, specifically UTF8-encoded source code text. + + For example, if our @id@ expression were hosted at @http://example.com/id@, + then we would embed the expression within our code using: + + > http://example.com/id + + You can also import expressions stored within environment variables using + @env:NAME@, where @NAME@ is the name of the environment variable. For + example: + + > $ export FOO=1 + > $ export BAR='"Hi"' + > $ export BAZ='λ(x : Bool) → x == False' + > $ dhall <<< "{ foo = env:FOO , bar = env:BAR , baz = env:BAZ }" + > { bar : Text, baz : ∀(x : Bool) → Bool, foo : Integer } + > + > { bar = "Hi", baz = λ(x : Bool) → x == False, foo = 1 } + + If you wish to import the raw contents of an impoert as @Text@ then add + @as Text@ to the end of the import: + + > $ dhall <<< "http://example.com as Text" + > Text + > + > "\n\n\n Example Domain\n\n charset=\"utf-8\" />\n ; charset=utf-8\" />\n initial-scale=1\" />\n \n\n\n\n
\n

Example Domain h1>\n

This domain is established to be used for illustrative examples in d + > ocuments. You may use this\n domain in examples without prior coordination or + > asking for permission.

\n

e\">More information...

\n

\n\n\n" +-} + +module Dhall.Import ( + -- * Import + load + , loadWithManager + , loadRelativeTo + , loadWithStatus + , loadWith + , localToPath + , hashExpression + , hashExpressionToCode + , writeExpressionToSemanticCache + , assertNoImports + , Manager + , defaultNewManager + , CacheWarning(..) + , Status(..) + , SemanticCacheMode(..) + , Chained + , chainedImport + , chainedFromLocalHere + , chainedChangeMode + , emptyStatus + , emptyStatusWithManager + , envOriginHeaders + , makeEmptyStatus + , remoteStatus + , remoteStatusWithManager + , fetchRemote + , stack + , cache + , Depends(..) + , graph + , remote + , toHeaders + , substitutions + , normalizer + , startingContext + , chainImport + , dependencyToFile + , ImportSemantics + , HTTPHeader + , Cycle(..) + , ReferentiallyOpaque(..) + , Imported(..) + , ImportResolutionDisabled(..) + , PrettyHttpException(..) + , MissingFile(..) + , MissingEnvironmentVariable(..) + , MissingImports(..) + , HashMismatch(..) + ) where + +import Control.Applicative (Alternative (..)) +import Control.Exception + ( Exception + , IOException + , SomeException + , toException + ) +import Control.Monad.Catch (MonadCatch (catch), handle, throwM) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Morph (hoist) +import Control.Monad.State.Strict (MonadState, StateT) +import Data.ByteString (ByteString) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Typeable (Typeable) +import Data.Void (Void, absurd) +import Dhall.TypeCheck (TypeError) +import Dhall.Util (printWarning) + +import Dhall.Syntax + ( Chunks (..) + , Directory (..) + , Expr (..) + , File (..) + , FilePrefix (..) + , Import (..) + , ImportHashed (..) + , ImportMode (..) + , ImportType (..) + , URL (..) + , bindingExprs + , functionBindingExprs + , recordFieldExprs + ) + +import System.FilePath (()) +import Text.Megaparsec (SourcePos (SourcePos), mkPos) + +#ifdef WITH_HTTP +import Dhall.Import.HTTP +#endif +import Dhall.Import.Headers + ( normalizeHeaders + , originHeadersTypeExpr + , toHeaders + , toOriginHeaders + ) +import Dhall.Import.Types + +import Dhall.Parser + ( ParseError (..) + , Parser (..) + , SourcedException (..) + , Src (..) + ) +import Lens.Micro.Mtl (zoom) + +import qualified Codec.CBOR.Write as Write +import qualified Codec.Serialise +import qualified Control.Exception as Exception +import qualified Control.Monad.State.Strict as State +import qualified Control.Monad.Trans.Maybe as Maybe +import qualified Data.ByteString +import qualified Data.ByteString.Lazy +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Maybe as Maybe +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding +import qualified Data.Text.IO +import qualified Dhall.Binary +import qualified Dhall.Core as Core +import qualified Dhall.Crypto +import qualified Dhall.Map +import qualified Dhall.Parser +import qualified Dhall.Pretty.Internal +import qualified Dhall.Substitution +import qualified Dhall.Syntax as Syntax +import qualified Dhall.TypeCheck +import qualified System.AtomicWrite.Writer.ByteString.Binary as AtomicWrite.Binary +import qualified System.Directory as Directory +import qualified System.Environment +import qualified System.FilePath as FilePath +import qualified System.Info +import qualified System.IO +import qualified Text.Megaparsec +import qualified Text.Parser.Combinators +import qualified Text.Parser.Token + +{- $setup + + >>> import Dhall.Syntax +-} + +-- | An import failed because of a cycle in the import graph +newtype Cycle = Cycle + { cyclicImport :: Import -- ^ The offending cyclic import + } + deriving (Typeable) + +instance Exception Cycle + +instance Show Cycle where + show (Cycle import_) = + "\nCyclic import: " ++ Dhall.Pretty.Internal.prettyToString import_ + +{-| Dhall tries to ensure that all expressions hosted on network endpoints are + weakly referentially transparent, meaning roughly that any two clients will + compile the exact same result given the same URL. + + To be precise, a strong interpretaton of referential transparency means that + if you compiled a URL you could replace the expression hosted at that URL + with the compiled result. Let's call this \"static linking\". Dhall (very + intentionally) does not satisfy this stronger interpretation of referential + transparency since \"statically linking\" an expression (i.e. permanently + resolving all imports) means that the expression will no longer update if + its dependencies change. + + In general, either interpretation of referential transparency is not + enforceable in a networked context since one can easily violate referential + transparency with a custom DNS, but Dhall can still try to guard against + common unintentional violations. To do this, Dhall enforces that a + non-local import may not reference a local import. + + Local imports are defined as: + + * A file + + * A URL with a host of @localhost@ or @127.0.0.1@ + + All other imports are defined to be non-local +-} +newtype ReferentiallyOpaque = ReferentiallyOpaque + { opaqueImport :: Import -- ^ The offending opaque import + } deriving (Typeable) + +instance Exception ReferentiallyOpaque + +instance Show ReferentiallyOpaque where + show (ReferentiallyOpaque import_) = + "\nLocal imports are not permitted from remote imports: " ++ Dhall.Pretty.Internal.prettyToString import_ + +-- | Extend another exception with the current import stack +data Imported e = Imported + { importStack :: NonEmpty Chained -- ^ Imports resolved so far, in reverse order + , nested :: e -- ^ The nested exception + } deriving (Typeable) + +instance Exception e => Exception (Imported e) + +instance Show e => Show (Imported e) where + show (Imported canonicalizedImports e) = + concat (zipWith indent [0..] toDisplay) + ++ "\n" + ++ show e + where + indent n import_ = + "\n" ++ replicate (2 * n) ' ' ++ "↳ " ++ Dhall.Pretty.Internal.prettyToString import_ + + canonical = NonEmpty.toList canonicalizedImports + + -- Tthe final (outermost) import is fake to establish the base + -- directory. Also, we need outermost-first. + toDisplay = drop 1 (reverse canonical) + +-- | Exception thrown when an imported file is missing +newtype MissingFile = MissingFile FilePath + deriving (Typeable) + +instance Exception MissingFile + +instance Show MissingFile where + show (MissingFile path) = + "\n" + <> "\ESC[1;31mError\ESC[0m: Missing file " + <> path + +-- | Exception thrown when an environment variable is missing +newtype MissingEnvironmentVariable = MissingEnvironmentVariable { name :: Text } + deriving (Typeable) + +instance Exception MissingEnvironmentVariable + +instance Show MissingEnvironmentVariable where + show MissingEnvironmentVariable{..} = + "\n" + <> "\ESC[1;31mError\ESC[0m: Missing environment variable\n" + <> "\n" + <> "↳ " <> Text.unpack name + +-- | List of Exceptions we encounter while resolving Import Alternatives +newtype MissingImports = MissingImports [SomeException] + +instance Exception MissingImports + +instance Show MissingImports where + show (MissingImports []) = + "\n" + <> "\ESC[1;31mError\ESC[0m: No valid imports" + show (MissingImports [e]) = show e + show (MissingImports es) = + "\n" + <> "\ESC[1;31mError\ESC[0m: Failed to resolve imports. Error list:" + <> "\n" + <> concatMap (\e -> "\n" <> show e <> "\n") es + +throwMissingImport :: (MonadCatch m, Exception e) => e -> m a +throwMissingImport e = throwM (MissingImports [toException e]) + +-- | Exception thrown when a HTTP url is imported but dhall was built without +-- the @with-http@ Cabal flag. +data CannotImportHTTPURL = + CannotImportHTTPURL + String + (Maybe [HTTPHeader]) + deriving (Typeable) + +instance Exception CannotImportHTTPURL + +instance Show CannotImportHTTPURL where + show (CannotImportHTTPURL url _mheaders) = + "\n" + <> "\ESC[1;31mError\ESC[0m: Cannot import HTTP URL.\n" + <> "\n" + <> "Dhall was compiled without the 'with-http' flag.\n" + <> "\n" + <> "The requested URL was: " + <> url + <> "\n" + +{-| +> canonicalize . canonicalize = canonicalize + +> canonicalize (a <> b) = canonicalize (canonicalize a <> canonicalize b) +-} +class Semigroup path => Canonicalize path where + canonicalize :: path -> path + +-- | +-- >>> canonicalize (Directory {components = ["..",".."]}) +-- Directory {components = ["..",".."]} +instance Canonicalize Directory where + canonicalize (Directory []) = Directory [] + + canonicalize (Directory ("." : components₀)) = + canonicalize (Directory components₀) + + canonicalize (Directory (".." : components₀)) = + case canonicalize (Directory components₀) of + Directory [] -> + Directory [ ".." ] + Directory (".." : components₁) -> + Directory (".." : ".." : components₁) + Directory (_ : components₁) -> + Directory components₁ + + canonicalize (Directory (component : components₀)) = + Directory (component : components₁) + where + Directory components₁ = canonicalize (Directory components₀) + +instance Canonicalize File where + canonicalize (File { directory, .. }) = + File { directory = canonicalize directory, .. } + +instance Canonicalize ImportType where + canonicalize (Local prefix file) = + Local prefix (canonicalize file) + + canonicalize (Remote (URL {..})) = + Remote (URL { path = canonicalize path, headers = fmap (fmap canonicalize) headers, ..}) + + canonicalize (Env name) = + Env name + + canonicalize Missing = + Missing + +instance Canonicalize ImportHashed where + canonicalize (ImportHashed hash importType) = + ImportHashed hash (canonicalize importType) + +instance Canonicalize Import where + canonicalize (Import importHashed importMode) = + Import (canonicalize importHashed) importMode + +-- | Exception thrown when an integrity check fails +data HashMismatch = HashMismatch + { expectedHash :: Dhall.Crypto.SHA256Digest + , actualHash :: Dhall.Crypto.SHA256Digest + } deriving (Typeable) + +instance Exception HashMismatch + +instance Show HashMismatch where + show HashMismatch{..} = + "\n" + <> "\ESC[1;31mError\ESC[0m: " <> makeHashMismatchMessage expectedHash actualHash + +makeHashMismatchMessage :: Dhall.Crypto.SHA256Digest -> Dhall.Crypto.SHA256Digest -> String +makeHashMismatchMessage expectedHash actualHash = + "Import integrity check failed\n" + <> "\n" + <> "Expected hash:\n" + <> "\n" + <> "↳ " <> show expectedHash <> "\n" + <> "\n" + <> "Actual hash:\n" + <> "\n" + <> "↳ " <> show actualHash <> "\n" + +-- | Construct the file path corresponding to a local import. If the import is +-- _relative_ then the resulting path is also relative. +localToPath :: MonadIO io => FilePrefix -> File -> io FilePath +localToPath prefix file_ = liftIO $ do + let File {..} = file_ + + let Directory {..} = directory + + prefixPath <- case prefix of + Home -> + Directory.getHomeDirectory + + Absolute -> + return "/" + + Parent -> + return ".." + + Here -> + return "." + + let cs = map Text.unpack (file : components) + + let cons component dir = dir component + + return (foldr cons prefixPath cs) + +-- | Given a `Local` import construct the corresponding unhashed `Chained` +-- import (interpreting relative path as relative to the current directory). +chainedFromLocalHere :: FilePrefix -> File -> ImportMode -> Chained +chainedFromLocalHere prefix file mode = Chained $ + Import (ImportHashed Nothing (Local prefix (canonicalize file))) mode + +-- | Adjust the import mode of a chained import +chainedChangeMode :: ImportMode -> Chained -> Chained +chainedChangeMode mode (Chained (Import importHashed _)) = + Chained (Import importHashed mode) + +-- | Chain imports, also typecheck and normalize headers if applicable. +chainImport :: Chained -> Import -> StateT Status IO Chained +chainImport (Chained parent) child@(Import importHashed@(ImportHashed _ (Remote url)) _) = do + url' <- normalizeHeadersIn url + let child' = child { importHashed = importHashed { importType = Remote url' } } + return (Chained (canonicalize (parent <> child'))) + +chainImport (Chained parent) child = + return (Chained (canonicalize (parent <> child))) + +-- | Load an import, resulting in a fully resolved, type-checked and normalised +-- expression. @loadImport@ handles the \"hot\" cache in @Status@ and defers +-- to @loadImportWithSemanticCache@ for imports that aren't in the @Status@ +-- cache already. +loadImport :: Chained -> StateT Status IO ImportSemantics +loadImport import_ = do + Status {..} <- State.get + + case Dhall.Map.lookup import_ _cache of + Just importSemantics -> return importSemantics + Nothing -> do + importSemantics <- loadImportWithSemanticCache import_ + zoom cache (State.modify (Dhall.Map.insert import_ importSemantics)) + return importSemantics + +-- | Load an import from the 'semantic cache'. Defers to +-- @loadImportWithSemisemanticCache@ for imports that aren't frozen (and +-- therefore not cached semantically), as well as those that aren't cached yet. +loadImportWithSemanticCache :: Chained -> StateT Status IO ImportSemantics +loadImportWithSemanticCache + import_@(Chained (Import (ImportHashed Nothing _) _)) = + loadImportWithSemisemanticCache import_ + +loadImportWithSemanticCache + import_@(Chained (Import _ Location)) = + loadImportWithSemisemanticCache import_ + +loadImportWithSemanticCache + import_@(Chained (Import (ImportHashed (Just semanticHash) _) _)) = do + Status { .. } <- State.get + mCached <- + case _semanticCacheMode of + UseSemanticCache -> + zoom cacheWarning (fetchFromSemanticCache semanticHash) + IgnoreSemanticCache -> + pure Nothing + + case mCached of + Just bytesStrict -> do + let actualHash = Dhall.Crypto.sha256Hash bytesStrict + + if semanticHash == actualHash + then do + let bytesLazy = Data.ByteString.Lazy.fromStrict bytesStrict + + importSemantics <- case Dhall.Binary.decodeExpression bytesLazy of + Left err -> throwMissingImport (Imported _stack err) + Right e -> return e + + return (ImportSemantics {..}) + else do + printWarning $ + makeHashMismatchMessage semanticHash actualHash + <> "\n" + <> "The interpreter will attempt to fix the cached import\n" + fetch + + + Nothing -> fetch + where + fetch = do + ImportSemantics{ importSemantics } <- loadImportWithSemisemanticCache import_ + + let bytes = encodeExpression (Core.alphaNormalize importSemantics) + + let actualHash = Dhall.Crypto.sha256Hash bytes + + let expectedHash = semanticHash + + if actualHash == expectedHash + then do + zoom cacheWarning (writeToSemanticCache semanticHash bytes) + + else do + Status{ _stack } <- State.get + + throwMissingImport (Imported _stack HashMismatch{..}) + + return ImportSemantics{..} + + + +-- Fetch encoded normal form from "semantic cache" +fetchFromSemanticCache + :: (MonadState CacheWarning m, MonadCatch m, MonadIO m) + => Dhall.Crypto.SHA256Digest + -> m (Maybe Data.ByteString.ByteString) +fetchFromSemanticCache expectedHash = Maybe.runMaybeT $ do + cacheFile <- getCacheFile "dhall" expectedHash + True <- liftIO (Directory.doesFileExist cacheFile) + liftIO (Data.ByteString.readFile cacheFile) + +-- | Ensure that the given expression is present in the semantic cache. The +-- given expression should be alpha-beta-normal. +writeExpressionToSemanticCache :: Expr Void Void -> IO () +writeExpressionToSemanticCache expression = + -- Defaulting to not displaying the warning is for backwards compatibility + -- with the old behavior + State.evalStateT (writeToSemanticCache hash bytes) CacheWarned + where + bytes = encodeExpression expression + + hash = Dhall.Crypto.sha256Hash bytes + +writeToSemanticCache + :: (MonadState CacheWarning m, MonadCatch m, MonadIO m) + => Dhall.Crypto.SHA256Digest + -> Data.ByteString.ByteString + -> m () +writeToSemanticCache hash bytes = do + _ <- Maybe.runMaybeT $ do + cacheFile <- getCacheFile "dhall" hash + liftIO (AtomicWrite.Binary.atomicWriteFile cacheFile bytes) + return () + +-- Check the "semi-semantic" disk cache, otherwise typecheck and normalise from +-- scratch. +loadImportWithSemisemanticCache + :: Chained -> StateT Status IO ImportSemantics +loadImportWithSemisemanticCache (Chained (Import (ImportHashed _ importType) Code)) = do + text <- fetchFresh importType + Status {..} <- State.get + + path <- case importType of + Local prefix file -> liftIO $ do + path <- localToPath prefix file + absolutePath <- Directory.makeAbsolute path + return absolutePath + Remote url -> do + let urlText = Core.pretty (url { headers = Nothing }) + return (Text.unpack urlText) + Env env -> return $ Text.unpack env + Missing -> throwM (MissingImports []) + + let parser = unParser $ do + Text.Parser.Token.whiteSpace + r <- Dhall.Parser.expr + Text.Parser.Combinators.eof + return r + + parsedImport <- case Text.Megaparsec.parse parser path text of + Left errInfo -> + throwMissingImport (Imported _stack (ParseError errInfo text)) + Right expr -> return expr + + resolvedExpr <- loadWith parsedImport -- we load imports recursively here + + -- Check the semi-semantic cache. See + -- https://github.com/dhall-lang/dhall-haskell/issues/1098 for the reasoning + -- behind semi-semantic caching. + let semisemanticHash = computeSemisemanticHash (Core.denote resolvedExpr) + + mCached <- zoom cacheWarning (fetchFromSemisemanticCache semisemanticHash) + + importSemantics <- case mCached of + Just bytesStrict -> do + let bytesLazy = Data.ByteString.Lazy.fromStrict bytesStrict + + importSemantics <- case Dhall.Binary.decodeExpression bytesLazy of + Left err -> throwMissingImport (Imported _stack err) + Right sem -> return sem + + return importSemantics + + Nothing -> do + let substitutedExpr = + Dhall.Substitution.substitute resolvedExpr _substitutions + + case Core.shallowDenote parsedImport of + -- If this import trivially wraps another import, we can skip + -- the type-checking and normalization step as the transitive + -- import was already type-checked and normalized + Embed _ -> + return (Core.denote substitutedExpr) + + _ -> do + case Dhall.TypeCheck.typeWith _startingContext substitutedExpr of + Left err -> throwMissingImport (Imported _stack err) + Right _ -> return () + + let betaNormal = + Core.normalizeWith _normalizer substitutedExpr + + let bytes = encodeExpression betaNormal + + zoom cacheWarning (writeToSemisemanticCache semisemanticHash bytes) + + return betaNormal + + return (ImportSemantics {..}) + +-- `as Text` and `as Bytes` imports aren't cached since they are well-typed and +-- normal by construction +loadImportWithSemisemanticCache (Chained (Import (ImportHashed _ importType) RawText)) = do + text <- fetchFresh importType + + -- importSemantics is alpha-beta-normal by construction! + let importSemantics = TextLit (Chunks [] text) + return (ImportSemantics {..}) +loadImportWithSemisemanticCache (Chained (Import (ImportHashed _ importType) RawBytes)) = do + bytes <- fetchBytes importType + + -- importSemantics is alpha-beta-normal by construction! + let importSemantics = BytesLit bytes + return (ImportSemantics {..}) + +-- `as Location` imports aren't cached since they are well-typed and normal by +-- construction +loadImportWithSemisemanticCache (Chained (Import (ImportHashed _ importType) Location)) = do + let locationType = Union $ Dhall.Map.fromList + [ ("Environment", Just Text) + , ("Remote", Just Text) + , ("Local", Just Text) + , ("Missing", Nothing) + ] + + -- importSemantics is alpha-beta-normal by construction! + let importSemantics = case importType of + Missing -> Field locationType $ Core.makeFieldSelection "Missing" + local@(Local _ _) -> + App (Field locationType $ Core.makeFieldSelection "Local") + (TextLit (Chunks [] (Core.pretty local))) + remote_@(Remote _) -> + App (Field locationType $ Core.makeFieldSelection "Remote") + (TextLit (Chunks [] (Core.pretty remote_))) + Env env -> + App (Field locationType $ Core.makeFieldSelection "Environment") + (TextLit (Chunks [] (Core.pretty env))) + + return (ImportSemantics {..}) + +-- The semi-semantic hash of an expression is computed from the fully resolved +-- AST (without normalising or type-checking it first). See +-- https://github.com/dhall-lang/dhall-haskell/issues/1098 for further +-- discussion. +computeSemisemanticHash :: Expr Void Void -> Dhall.Crypto.SHA256Digest +computeSemisemanticHash resolvedExpr = hashExpression resolvedExpr + +-- Fetch encoded normal form from "semi-semantic cache" +fetchFromSemisemanticCache + :: (MonadState CacheWarning m, MonadCatch m, MonadIO m) + => Dhall.Crypto.SHA256Digest + -> m (Maybe Data.ByteString.ByteString) +fetchFromSemisemanticCache semisemanticHash = Maybe.runMaybeT $ do + cacheFile <- getCacheFile "dhall-haskell" semisemanticHash + True <- liftIO (Directory.doesFileExist cacheFile) + liftIO (Data.ByteString.readFile cacheFile) + +writeToSemisemanticCache + :: (MonadState CacheWarning m, MonadCatch m, MonadIO m) + => Dhall.Crypto.SHA256Digest + -> Data.ByteString.ByteString + -> m () +writeToSemisemanticCache semisemanticHash bytes = do + _ <- Maybe.runMaybeT $ do + cacheFile <- getCacheFile "dhall-haskell" semisemanticHash + liftIO (AtomicWrite.Binary.atomicWriteFile cacheFile bytes) + return () + +-- | Fetch source code directly from disk/network +fetchFresh :: ImportType -> StateT Status IO Text +fetchFresh (Local prefix file) = do + Status { _stack } <- State.get + path <- liftIO $ localToPath prefix file + exists <- liftIO $ Directory.doesFileExist path + if exists + then liftIO $ Data.Text.IO.readFile path + else throwMissingImport (Imported _stack (MissingFile path)) + +fetchFresh (Remote url) = do + Status { _remote } <- State.get + _remote url + +fetchFresh (Env env) = do + Status { _stack } <- State.get + x <- liftIO $ System.Environment.lookupEnv (Text.unpack env) + case x of + Just string -> + return (Text.pack string) + Nothing -> + throwMissingImport (Imported _stack (MissingEnvironmentVariable env)) + +fetchFresh Missing = throwM (MissingImports []) + +-- | Like `fetchFresh`, except for `Dhall.Syntax.Expr.Bytes` +fetchBytes :: ImportType -> StateT Status IO ByteString +fetchBytes (Local prefix file) = do + Status { _stack } <- State.get + path <- liftIO $ localToPath prefix file + exists <- liftIO $ Directory.doesFileExist path + if exists + then liftIO $ Data.ByteString.readFile path + else throwMissingImport (Imported _stack (MissingFile path)) + +fetchBytes (Remote url) = do + Status { _remoteBytes } <- State.get + _remoteBytes url + +fetchBytes (Env env) = do + Status { _stack } <- State.get + x <- liftIO $ System.Environment.lookupEnv (Text.unpack env) + case x of + Just string -> + return (Encoding.encodeUtf8 (Text.pack string)) + Nothing -> + throwMissingImport (Imported _stack (MissingEnvironmentVariable env)) +fetchBytes Missing = throwM (MissingImports []) + +-- | Fetch the text contents of a URL +fetchRemote :: URL -> StateT Status IO Data.Text.Text +#ifndef WITH_HTTP +fetchRemote (url@URL { headers = maybeHeadersExpression }) = do + let maybeHeaders = fmap toHeaders maybeHeadersExpression + let urlString = Text.unpack (Core.pretty url) + Status { _stack } <- State.get + throwMissingImport (Imported _stack (CannotImportHTTPURL urlString maybeHeaders)) +#else +fetchRemote url = do + zoom remote (State.put fetchFromHTTP) + fetchFromHTTP url + where + fetchFromHTTP :: URL -> StateT Status IO Data.Text.Text + fetchFromHTTP (url'@URL { headers = maybeHeadersExpression }) = do + let maybeHeaders = fmap toHeaders maybeHeadersExpression + fetchFromHttpUrl url' maybeHeaders +#endif + +-- | Fetch the text contents of a URL +fetchRemoteBytes :: URL -> StateT Status IO Data.ByteString.ByteString +#ifndef WITH_HTTP +fetchRemoteBytes (url@URL { headers = maybeHeadersExpression }) = do + let maybeHeaders = fmap toHeaders maybeHeadersExpression + let urlString = Text.unpack (Core.pretty url) + Status { _stack } <- State.get + throwMissingImport (Imported _stack (CannotImportHTTPURL urlString maybeHeaders)) +#else +fetchRemoteBytes url = do + zoom remoteBytes (State.put fetchFromHTTP) + fetchFromHTTP url + where + fetchFromHTTP :: URL -> StateT Status IO Data.ByteString.ByteString + fetchFromHTTP (url'@URL { headers = maybeHeadersExpression }) = do + let maybeHeaders = fmap toHeaders maybeHeadersExpression + fetchFromHttpUrlBytes url' maybeHeaders +#endif + +getCacheFile + :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m) + => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath +getCacheFile cacheName hash = do + cacheDirectory <- getOrCreateCacheDirectory cacheName + + let cacheFile = cacheDirectory ("1220" <> show hash) + + return cacheFile + +getOrCreateCacheDirectory + :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m) + => FilePath -> m FilePath +getOrCreateCacheDirectory cacheName = do + let warn message = do + cacheWarningStatus <- State.get + + case cacheWarningStatus of + CacheWarned -> printWarning message + CacheNotWarned -> return () + + State.put CacheWarned + + empty + + let handler action dir (ioex :: IOException) = do + let ioExMsg = + "When trying to " <> action <> ":\n" + <> "\n" + <> "↳ " <> dir <> "\n" + <> "\n" + <> "... the following exception was thrown:\n" + <> "\n" + <> "↳ " <> show ioex <> "\n" + + warn ioExMsg + + let setPermissions dir = do + let private = transform Directory.emptyPermissions + where + transform = + Directory.setOwnerReadable True + . Directory.setOwnerWritable True + . Directory.setOwnerSearchable True + + catch + (liftIO (Directory.setPermissions dir private)) + (handler "correct the permissions for" dir) + + let assertPermissions dir = do + let accessible path = + Directory.readable path + && Directory.writable path + && Directory.searchable path + + permissions <- + catch (liftIO (Directory.getPermissions dir)) + (handler "get permissions of" dir) + + if accessible permissions + then + return () + else do + let render f = if f permissions then "✓" else "✗" + let message = + "The directory:\n" + <> "\n" + <> "↳ " <> dir <> "\n" + <> "\n" + <> "... does not give you permission to read, write, or search files.\n\n" + <> "\n" + <> "The directory's current permissions are:\n" + <> "\n" + <> "• " <> render Directory.readable <> " readable\n" + <> "• " <> render Directory.writable <> " writable\n" + <> "• " <> render Directory.searchable <> " searchable\n" + + warn message + + let existsDirectory dir = + catch (liftIO (Directory.doesDirectoryExist dir)) + (handler "check the existence of" dir) + + let existsFile path = + catch (liftIO (Directory.doesFileExist path)) + (handler "check the existence of" path) + + let createDirectory dir = + catch (liftIO (Directory.createDirectory dir)) + (handler "create" dir) + + let assertDirectory dir = do + existsDir <- existsDirectory dir + + if existsDir + then + assertPermissions dir + + else do + existsFile' <- existsFile dir + + if existsFile' + then do + let message = + "The given path:\n" + <> "\n" + <> "↳ " <> dir <> "\n" + <> "\n" + <> "... already exists but is not a directory.\n" + + warn message + + else do + assertDirectory (FilePath.takeDirectory dir) + + createDirectory dir + + setPermissions dir + + cacheBaseDirectory <- getCacheBaseDirectory + + let directory = cacheBaseDirectory cacheName + + let message = + "Could not get or create the default cache directory:\n" + <> "\n" + <> "↳ " <> directory <> "\n" + <> "\n" + <> "You can enable caching by creating it if needed and setting read,\n" + <> "write and search permissions on it or providing another cache base\n" + <> "directory by setting the $XDG_CACHE_HOME environment variable.\n" + <> "\n" + + assertDirectory directory <|> warn message + + return directory + +getCacheBaseDirectory + :: (MonadState CacheWarning m, Alternative m, MonadIO m) => m FilePath +getCacheBaseDirectory = alternative₀ <|> alternative₁ <|> alternative₂ + where + alternative₀ = do + maybeXDGCacheHome <- + liftIO (System.Environment.lookupEnv "XDG_CACHE_HOME") + + case maybeXDGCacheHome of + Just xdgCacheHome -> return xdgCacheHome + Nothing -> empty + + alternative₁ + | isWindows = do + maybeLocalAppDirectory <- + liftIO (System.Environment.lookupEnv "LOCALAPPDATA") + + case maybeLocalAppDirectory of + Just localAppDirectory -> return localAppDirectory + Nothing -> empty + + | otherwise = do + maybeHomeDirectory <- + liftIO (System.Environment.lookupEnv "HOME") + + case maybeHomeDirectory of + Just homeDirectory -> return (homeDirectory ".cache") + Nothing -> empty + + where isWindows = System.Info.os == "mingw32" + + alternative₂ = do + cacheWarningStatus <- State.get + + let message = + "\n" + <> "\ESC[1;33mWarning\ESC[0m: " + <> "Could not locate a cache base directory from the environment.\n" + <> "\n" + <> "You can provide a cache base directory by pointing the $XDG_CACHE_HOME\n" + <> "environment variable to a directory with read and write permissions.\n" + + case cacheWarningStatus of + CacheNotWarned -> + liftIO (System.IO.hPutStrLn System.IO.stderr message) + CacheWarned -> + return () + + State.put CacheWarned + + empty + +-- If the URL contains headers typecheck them and replace them with their normal +-- forms. +normalizeHeadersIn :: URL -> StateT Status IO URL +normalizeHeadersIn url@URL { headers = Just headersExpression } = do + Status { _stack } <- State.get + loadedExpr <- loadWith headersExpression + let handler (e :: SomeException) = throwMissingImport (Imported _stack e) + normalized <- liftIO $ handle handler (normalizeHeaders loadedExpr) + return url { headers = Just (fmap absurd normalized) } + +normalizeHeadersIn url = return url + +-- | Empty origin headers used for remote contexts +-- (and fallback when nothing is set in env or config file) +emptyOriginHeaders :: Expr Src Import +emptyOriginHeaders = ListLit (Just (fmap absurd originHeadersTypeExpr)) mempty + +-- | A fake Src to annotate headers expressions with. +-- We need to wrap headers expressions in a Note for nice error reporting, +-- and because ImportAlt handling only catches SourcedExceptions +headersSrc :: Src +headersSrc = Src { + srcStart = SourcePos { + sourceName = fakeSrcName, + sourceLine = mkPos 1, + sourceColumn = mkPos 1 + }, + srcEnd = SourcePos { + sourceName = fakeSrcName, + sourceLine = mkPos 1, + sourceColumn = mkPos (Text.length fakeSrcText) + }, + srcText = fakeSrcText + } + where + fakeSrcText = "«Origin Header Configuration»" + fakeSrcName = "[builtin]" + +-- | Load headers only from the environment (used in tests) +envOriginHeaders :: Expr Src Import +envOriginHeaders = Note headersSrc (Embed (Import (ImportHashed Nothing (Env "DHALL_HEADERS")) Code)) + +-- | Load headers in env, falling back to config file +defaultOriginHeaders :: IO (Expr Src Import) +#ifndef WITH_HTTP +defaultOriginHeaders = return emptyOriginHeaders +#else +defaultOriginHeaders = do + fromFile <- originHeadersFileExpr + return (Note headersSrc (ImportAlt envOriginHeaders (Note headersSrc fromFile))) +#endif + +-- | Given a headers expression, return an origin headers loader +originHeadersLoader :: IO (Expr Src Import) -> StateT Status IO OriginHeaders +originHeadersLoader headersExpr = do + + -- Load the headers using the parent stack, which should always be a local + -- import (we only load headers for the first remote import) + + status <- State.get + + let parentStack = fromMaybe abortEmptyStack (nonEmpty (NonEmpty.tail (_stack status))) + + let headerLoadStatus = status { _stack = parentStack } + + (headers, _) <- liftIO (State.runStateT doLoad headerLoadStatus) + + -- return cached headers next time + _ <- State.modify (\state -> state { _loadOriginHeaders = return headers }) + + return headers + where + abortEmptyStack = Core.internalError "Origin headers loaded with an empty stack" + + doLoad = do + partialExpr <- liftIO headersExpr + loaded <- loadWith (Note headersSrc (ImportAlt partialExpr emptyOriginHeaders)) + liftIO (toOriginHeaders loaded) + +-- | Default starting `Status`, importing relative to the given directory. +emptyStatus :: FilePath -> Status +emptyStatus = makeEmptyStatus defaultNewManager defaultOriginHeaders + +-- | See 'emptyStatus' +emptyStatusWithManager + :: IO Manager + -> FilePath + -> Status +emptyStatusWithManager newManager = makeEmptyStatus newManager defaultOriginHeaders + +-- | See 'emptyStatus'. +makeEmptyStatus + :: IO Manager + -> IO (Expr Src Import) + -> FilePath + -> Status +makeEmptyStatus newManager headersExpr rootDirectory = + emptyStatusWith newManager (originHeadersLoader headersExpr) fetchRemote fetchRemoteBytes rootImport + where + prefix = if FilePath.isRelative rootDirectory + then Here + else Absolute + + pathComponents = + fmap Text.pack (reverse (FilePath.splitDirectories rootDirectory)) + + directoryAsFile = File (Directory pathComponents) "." + + rootImport = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local prefix directoryAsFile + } + , importMode = Code + } + +{-| Default `Status` appropriate for a server interpreting Dhall code + + Using this `Status` ensures that interpreted Dhall code cannot access + server-local resources (like files or environment variables) +-} +remoteStatus + :: URL + -- ^ Public address of the server + -> Status +remoteStatus = remoteStatusWithManager defaultNewManager + +-- | See `remoteStatus` +remoteStatusWithManager :: IO Manager -> URL -> Status +remoteStatusWithManager newManager url = + emptyStatusWith newManager (originHeadersLoader (pure emptyOriginHeaders)) fetchRemote fetchRemoteBytes rootImport + where + rootImport = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Remote url + } + , importMode = Code + } + +{-| Generalized version of `load` + + You can configure the desired behavior through the initial `Status` that you + supply +-} +loadWith :: Expr Src Import -> StateT Status IO (Expr Src Void) +loadWith expr₀ = case expr₀ of + Embed import₀ -> do + Status {..} <- State.get + + let parent = NonEmpty.head _stack + + child <- chainImport parent import₀ + + let local (Chained (Import (ImportHashed _ (Remote {})) _)) = False + local (Chained (Import (ImportHashed _ (Local {})) _)) = True + local (Chained (Import (ImportHashed _ (Env {})) _)) = True + local (Chained (Import (ImportHashed _ (Missing {})) _)) = False + + let referentiallySane = not (local child) || local parent + + if importMode import₀ == Location || referentiallySane + then return () + else throwMissingImport (Imported _stack (ReferentiallyOpaque import₀)) + + let _stack' = NonEmpty.cons child _stack + + if child `elem` _stack + then throwMissingImport (Imported _stack (Cycle import₀)) + else return () + + zoom graph . State.modify $ + -- Add the edge `parent -> child` to the import graph + \edges -> Depends parent child : edges + + let stackWithChild = NonEmpty.cons child _stack + + zoom stack (State.put stackWithChild) + ImportSemantics {..} <- loadImport child + zoom stack (State.put _stack) + + return (Core.renote importSemantics) + + ImportAlt a b -> loadWith a `catch` handler₀ + where + is :: forall e . Exception e => SomeException -> Bool + is exception = Maybe.isJust (Exception.fromException @e exception) + + isNotResolutionError exception = + is @(Imported (TypeError Src Void)) exception + || is @(Imported Cycle ) exception + || is @(Imported HashMismatch ) exception + || is @(Imported ParseError ) exception + + handler₀ exception₀@(SourcedException (Src begin _ text₀) (MissingImports es₀)) + | any isNotResolutionError es₀ = + throwM exception₀ + | otherwise = do + loadWith b `catch` handler₁ + where + handler₁ exception₁@(SourcedException (Src _ end text₁) (MissingImports es₁)) + | any isNotResolutionError es₁ = + throwM exception₁ + | otherwise = + -- Fix the source span for the error message to encompass both + -- alternatives, since both are equally to blame for the + -- failure if neither succeeds. + throwM (SourcedException (Src begin end text₂) (MissingImports (es₀ ++ es₁))) + where + text₂ = text₀ <> " ? " <> text₁ + + Note a b -> do + let handler e = throwM (SourcedException a (e :: MissingImports)) + + (Note <$> pure a <*> loadWith b) `catch` handler + Let a b -> Let <$> bindingExprs loadWith a <*> loadWith b + Record m -> Record <$> traverse (recordFieldExprs loadWith) m + RecordLit m -> RecordLit <$> traverse (recordFieldExprs loadWith) m + Lam cs a b -> Lam cs <$> functionBindingExprs loadWith a <*> loadWith b + Field a b -> Field <$> loadWith a <*> pure b + expression -> Syntax.unsafeSubExpressions loadWith expression + +-- | Resolve all imports within an expression +load :: Expr Src Import -> IO (Expr Src Void) +load = loadWithManager defaultNewManager + +-- | See 'load'. +loadWithManager :: IO Manager -> Expr Src Import -> IO (Expr Src Void) +loadWithManager newManager = + loadWithStatus + (makeEmptyStatus newManager defaultOriginHeaders ".") + UseSemanticCache + +-- | Resolve all imports within an expression, importing relative to the given +-- directory. +loadRelativeTo :: FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void) +loadRelativeTo parentDirectory = loadWithStatus + (makeEmptyStatus defaultNewManager defaultOriginHeaders parentDirectory) + +-- | See 'loadRelativeTo'. +loadWithStatus + :: Status + -> SemanticCacheMode + -> Expr Src Import + -> IO (Expr Src Void) +loadWithStatus status semanticCacheMode expression = + State.evalStateT + (loadWith expression) + status { _semanticCacheMode = semanticCacheMode } + +encodeExpression :: Expr Void Void -> Data.ByteString.ByteString +encodeExpression expression = bytesStrict + where + intermediateExpression :: Expr Void Import + intermediateExpression = fmap absurd expression + + encoding = Codec.Serialise.encode intermediateExpression + + bytesStrict = Write.toStrictByteString encoding + +-- | Hash a fully resolved expression +hashExpression :: Expr Void Void -> Dhall.Crypto.SHA256Digest +hashExpression = Dhall.Crypto.sha256Hash . encodeExpression + +{-| Convenience utility to hash a fully resolved expression and return the + base-16 encoded hash with the @sha256:@ prefix + + In other words, the output of this function can be pasted into Dhall + source code to add an integrity check to an import +-} +hashExpressionToCode :: Expr Void Void -> Text +hashExpressionToCode expr = + "sha256:" <> Text.pack (show (hashExpression expr)) + +-- | A call to `assertNoImports` failed because there was at least one import +data ImportResolutionDisabled = ImportResolutionDisabled deriving (Exception) + +instance Show ImportResolutionDisabled where + show _ = "\nImport resolution is disabled" + +-- | Assert than an expression is import-free +assertNoImports :: MonadIO io => Expr Src Import -> io (Expr Src Void) +assertNoImports expression = + Core.throws (traverse (\_ -> Left ImportResolutionDisabled) expression) +{-# INLINABLE assertNoImports #-} + +{-| This function is used by the @--transitive@ option of the + @dhall {freeze,format,lint}@ subcommands to determine which dependencies + to descend into + +#ifndef mingw32_HOST_OS + >>> dependencyToFile (emptyStatus ".") Import{ importHashed = ImportHashed{ hash = Nothing, importType = Local Here (File (Directory []) "foo") }, importMode = Code } + Just "./foo" + + >>> dependencyToFile (emptyStatus "./foo") Import{ importHashed = ImportHashed{ hash = Nothing, importType = Local Here (File (Directory []) "bar") }, importMode = Code } + Just "./foo/bar" + + + >>> dependencyToFile (emptyStatus "./foo") Import{ importHashed = ImportHashed{ hash = Nothing, importType = Remote (URL HTTPS "example.com" (File (Directory []) "") Nothing Nothing) }, importMode = Code } + Nothing + + >>> dependencyToFile (emptyStatus ".") Import{ importHashed = ImportHashed{ hash = Nothing, importType = Env "foo" }, importMode = Code } + Nothing +#endif +-} +dependencyToFile :: Status -> Import -> IO (Maybe FilePath) +dependencyToFile status import_ = flip State.evalStateT status $ do + parent :| _ <- zoom stack State.get + + child <- fmap chainedImport (hoist liftIO (chainImport parent import_)) + + let ignore = return Nothing + + -- We only need to transitively modify code imports since other import + -- types are not interpreted and therefore don't need to be modified + case importMode child of + RawText -> + ignore + + RawBytes -> + ignore + + Location -> + ignore + + Code -> + case importType (importHashed child) of + Local filePrefix file -> do + let descend = liftIO $ do + path <- localToPath filePrefix file + + return (Just path) + + -- Only follow relative imports when modifying dependencies. + -- Carefully note that we check the file prefix of the + -- original import (before chaining), since the chained + -- import will inherit the file prefix of the parent import. + case importType (importHashed import_) of + Local Here _ -> descend + Local Parent _ -> descend + _ -> ignore + + -- Don't transitively modify any other type of import + Remote{} -> + ignore + + Missing -> + ignore + + Env{} -> + ignore diff --git a/src/Dhall/Import/Headers.hs b/src/Dhall/Import/Headers.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Import/Headers.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +module Dhall.Import.Headers + ( normalizeHeaders + , originHeadersTypeExpr + , toHeaders + , toOriginHeaders + ) where + +import Control.Applicative (Alternative (..), liftA2) +import Control.Exception (SomeException) +import Control.Monad.Catch (handle, throwM) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Core (Chunks (..), Expr (..)) +import Dhall.Import.Types (HTTPHeader, OriginHeaders) +import Dhall.Parser (Src (..)) + +import qualified Data.CaseInsensitive +import qualified Data.Foldable +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Text.Encoding +import qualified Dhall.Core as Core +import qualified Dhall.Map +import qualified Dhall.Pretty.Internal +import qualified Dhall.TypeCheck + +-- | Given a well-typed (of type `List { header : Text, value Text }` or +-- `List { mapKey : Text, mapValue Text }`) headers expressions in normal form +-- construct the corresponding binary http headers; otherwise return the empty +-- list. +toHeaders :: Expr s a -> [HTTPHeader] +toHeaders (ListLit _ hs) = Data.Foldable.toList (Data.Foldable.fold maybeHeaders) + where + maybeHeaders = mapM toHeader hs +toHeaders _ = [] + +toHeader :: Expr s a -> Maybe HTTPHeader +toHeader (RecordLit m) = do + (Core.recordFieldValue -> TextLit (Chunks [] keyText), Core.recordFieldValue -> TextLit (Chunks [] valueText)) + <- lookupHeader <|> lookupMapKey + let keyBytes = Data.Text.Encoding.encodeUtf8 keyText + let valueBytes = Data.Text.Encoding.encodeUtf8 valueText + return (Data.CaseInsensitive.mk keyBytes, valueBytes) + where + lookupHeader = liftA2 (,) (Dhall.Map.lookup "header" m) (Dhall.Map.lookup "value" m) + lookupMapKey = liftA2 (,) (Dhall.Map.lookup "mapKey" m) (Dhall.Map.lookup "mapValue" m) +toHeader _ = + empty + +-- | Normalize, typecheck and return OriginHeaders from a given expression. +toOriginHeaders :: Expr Src Void -> IO OriginHeaders +toOriginHeaders expr = fmap convert (normalizeOriginHeaders expr) + where + convert :: Expr s a -> OriginHeaders + convert (ListLit _ hs) = HashMap.fromList (originPairs hs) + convert _ = mempty + + originPairs hs = Data.Foldable.toList (Data.Foldable.fold (mapM toOriginPair hs)) + + toOriginPair :: Expr s a -> Maybe (Text, [HTTPHeader]) + toOriginPair (RecordLit m) = do + (Core.recordFieldValue -> TextLit (Chunks [] keyText), Core.recordFieldValue -> value) + <- lookupMapKey + return (keyText, toHeaders value) + where + lookupMapKey = liftA2 (,) (Dhall.Map.lookup "mapKey" m) (Dhall.Map.lookup "mapValue" m) + toOriginPair _ = Nothing + +makeHeadersTypeExpr :: Text -> Text -> Expr Src Void +makeHeadersTypeExpr keyKey valueKey = + App List + ( Record $ Core.makeRecordField <$> + Dhall.Map.fromList + [ (keyKey, Text) + , (valueKey, Text) + ] + ) + +headersTypeExpr :: Expr Src Void +headersTypeExpr = makeHeadersTypeExpr "mapKey" "mapValue" + +leagacyHeadersTypeExpr :: Expr Src Void +leagacyHeadersTypeExpr = makeHeadersTypeExpr "header" "value" + +originHeadersTypeExpr :: Expr Src Void +originHeadersTypeExpr = + App List + ( Record $ Core.makeRecordField <$> + Dhall.Map.fromList + [ ("mapKey", Text) + , ("mapValue", headersTypeExpr) + ] + ) + +typecheck :: Expr Src Void -> Expr Src Void -> IO (Expr Src Void) +typecheck expected expr = do + let suffix_ = Dhall.Pretty.Internal.prettyToStrictText expected + let annot = case expr of + Note (Src begin end bytes) _ -> + Note (Src begin end bytes') (Annot expr expected) + where + bytes' = bytes <> " : " <> suffix_ + _ -> + Annot expr expected + + _ <- case (Dhall.TypeCheck.typeOf annot) of + Left err -> throwM err + Right _ -> return () + + return (Core.normalize expr) + +normalizeHeaders :: Expr Src Void -> IO (Expr Src Void) +normalizeHeaders headersExpr = do + let handler₀ (e :: SomeException) = do + {- Try to typecheck using the preferred @mapKey@/@mapValue@ fields + and fall back to @header@/@value@ if that fails. However, if + @header@/@value@ still fails then re-throw the original exception + for @mapKey@ / @mapValue@. -} + let handler₁ (_ :: SomeException) = throwM e + handle handler₁ (typecheck leagacyHeadersTypeExpr headersExpr) + + handle handler₀ (typecheck headersTypeExpr headersExpr) + +normalizeOriginHeaders :: Expr Src Void -> IO (Expr Src Void) +normalizeOriginHeaders = typecheck originHeadersTypeExpr diff --git a/src/Dhall/Import/Types.hs b/src/Dhall/Import/Types.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Import/Types.hs @@ -0,0 +1,245 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-# OPTIONS_GHC -Wall #-} + +module Dhall.Import.Types where + +import Control.Exception (Exception) +import Control.Monad.Trans.State.Strict (StateT) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) +import Data.Dynamic +import Data.HashMap.Strict (HashMap) +import Data.List.NonEmpty (NonEmpty) +import Data.Void (Void) +import Dhall.Context (Context) +import Dhall.Core + ( Expr + , Import (..) + , ReifiedNormalizer (..) + , URL + ) +import Dhall.Map (Map) +import Dhall.Parser (Src) +import Lens.Micro (Lens', lens) +import Prettyprinter (Pretty (..)) + +#ifdef WITH_HTTP +import qualified Dhall.Import.Manager +#endif + +import qualified Data.Text +import qualified Dhall.Context +import qualified Dhall.Map as Map +import qualified Dhall.Substitution + +-- | A fully \"chained\" import, i.e. if it contains a relative path that path +-- is relative to the current directory. If it is a remote import with headers +-- those are well-typed (either of type `List { header : Text, value Text}` or +-- `List { mapKey : Text, mapValue Text})` and in normal form. These +-- invariants are preserved by the API exposed by @Dhall.Import@. +newtype Chained = Chained + { chainedImport :: Import + -- ^ The underlying import + } + deriving (Eq, Ord) + +instance Pretty Chained where + pretty (Chained import_) = pretty import_ + +-- | An import that has been fully interpeted +newtype ImportSemantics = ImportSemantics + { importSemantics :: Expr Void Void + -- ^ The fully resolved import, typechecked and beta-normal. + } + +-- | `parent` imports (i.e. depends on) `child` +data Depends = Depends { parent :: Chained, child :: Chained } + +{-| This enables or disables the semantic cache for imports protected by + integrity checks +-} +data SemanticCacheMode = IgnoreSemanticCache | UseSemanticCache deriving (Eq) + +-- | Shared state for HTTP requests +type Manager = +#ifdef WITH_HTTP + Dhall.Import.Manager.Manager +#else + () +#endif + +-- | The default HTTP 'Manager' +defaultNewManager :: IO Manager +defaultNewManager = +#ifdef WITH_HTTP + Dhall.Import.Manager.defaultNewManager +#else + pure () +#endif + +-- | HTTP headers +type HTTPHeader = (CI ByteString, ByteString) + +-- | A map of site origin -> HTTP headers +type OriginHeaders = HashMap Data.Text.Text [HTTPHeader] + +{-| Used internally to track whether or not we've already warned the user about + caching issues +-} +data CacheWarning = CacheNotWarned | CacheWarned + +-- | State threaded throughout the import process +data Status = Status + { _stack :: NonEmpty Chained + -- ^ Stack of `Import`s that we've imported along the way to get to the + -- current point + + , _graph :: [Depends] + -- ^ Graph of all the imports visited so far, represented by a list of + -- import dependencies. + + , _cache :: Map Chained ImportSemantics + -- ^ Cache of imported expressions with their node id in order to avoid + -- importing the same expression twice with different values + + , _newManager :: IO Manager + , _manager :: Maybe Manager + -- ^ Used to cache the `Dhall.Import.Manager.Manager` when making multiple + -- requests + + , _loadOriginHeaders :: StateT Status IO OriginHeaders + -- ^ Load the origin headers from environment or configuration file. + -- After loading once, further evaluations return the cached version. + + , _remote :: URL -> StateT Status IO Data.Text.Text + -- ^ The remote resolver, fetches the content at the given URL. + + , _remoteBytes :: URL -> StateT Status IO Data.ByteString.ByteString + -- ^ Like `_remote`, except for `Dhall.Syntax.Expr.Bytes` + + , _substitutions :: Dhall.Substitution.Substitutions Src Void + + , _normalizer :: Maybe (ReifiedNormalizer Void) + + , _startingContext :: Context (Expr Src Void) + + , _semanticCacheMode :: SemanticCacheMode + + , _cacheWarning :: CacheWarning + -- ^ Records whether or not we already warned the user about issues with + -- cache directory + } + +-- | Initial `Status`, parameterised over the HTTP 'Manager', +-- the origin headers and the remote resolver, +-- importing relative to the given root import. +emptyStatusWith + :: IO Manager + -> StateT Status IO OriginHeaders + -> (URL -> StateT Status IO Data.Text.Text) + -> (URL -> StateT Status IO Data.ByteString.ByteString) + -> Import + -> Status +emptyStatusWith _newManager _loadOriginHeaders _remote _remoteBytes rootImport = Status {..} + where + _stack = pure (Chained rootImport) + + _graph = [] + + _cache = Map.empty + + _manager = Nothing + + _substitutions = Dhall.Substitution.empty + + _normalizer = Nothing + + _startingContext = Dhall.Context.empty + + _semanticCacheMode = UseSemanticCache + + _cacheWarning = CacheNotWarned + +-- | Lens from a `Status` to its `_stack` field +stack :: Lens' Status (NonEmpty Chained) +stack = lens _stack (\s x -> s { _stack = x }) + +-- | Lens from a `Status` to its `_graph` field +graph :: Lens' Status [Depends] +graph = lens _graph (\s x -> s { _graph = x }) + +-- | Lens from a `Status` to its `_cache` field +cache :: Lens' Status (Map Chained ImportSemantics) +cache = lens _cache (\s x -> s { _cache = x }) + +-- | Lens from a `Status` to its `_remote` field +remote :: Lens' Status (URL -> StateT Status IO Data.Text.Text) +remote = lens _remote (\s x -> s { _remote = x }) + +-- | Lens from a `Status` to its `_remote` field +remoteBytes :: Lens' Status (URL -> StateT Status IO Data.ByteString.ByteString) +remoteBytes = lens _remoteBytes (\s x -> s { _remoteBytes = x }) + +-- | Lens from a `Status` to its `_substitutions` field +substitutions :: Lens' Status (Dhall.Substitution.Substitutions Src Void) +substitutions = lens _substitutions (\s x -> s { _substitutions = x }) + +-- | Lens from a `Status` to its `_normalizer` field +normalizer :: Lens' Status (Maybe (ReifiedNormalizer Void)) +normalizer = lens _normalizer (\s x -> s {_normalizer = x}) + +-- | Lens from a `Status` to its `_startingContext` field +startingContext :: Lens' Status (Context (Expr Src Void)) +startingContext = lens _startingContext (\s x -> s { _startingContext = x }) + +-- | Lens from a `Status` to its `_cacheWarning` field +cacheWarning :: Lens' Status CacheWarning +cacheWarning = lens _cacheWarning (\s x -> s { _cacheWarning = x }) + +{-| This exception indicates that there was an internal error in Dhall's + import-related logic + + This exception indicates that an invalid `Dhall.Syntax.Type` was provided to + the `Dhall.input` function +-} +data InternalError = InternalError deriving (Typeable) + + +instance Show InternalError where + show InternalError = unlines + [ _ERROR <> ": Compiler bug " + , " " + , "Explanation: This error message means that there is a bug in the Dhall compiler." + , "You didn't do anything wrong, but if you would like to see this problem fixed " + , "then you should report the bug at: " + , " " + , "https://github.com/dhall-lang/dhall-haskell/issues " + , " " + , "Please include the following text in your bug report: " + , " " + , "``` " + , "Header extraction failed even though the header type-checked " + , "``` " + ] + where + _ERROR :: String + _ERROR = "\ESC[1;31mError\ESC[0m" + +instance Exception InternalError + +-- | Wrapper around `Network.HTTP.Client.HttpException`s with a prettier `Show` +-- instance +-- +-- In order to keep the library API constant even when the @with-http@ Cabal +-- flag is disabled the pretty error message is pre-rendered and the real +-- 'Network.HTTP.Client.HttpException' is stored in a 'Dynamic' +data PrettyHttpException = PrettyHttpException String Dynamic + deriving (Typeable) + +instance Exception PrettyHttpException + +instance Show PrettyHttpException where + show (PrettyHttpException msg _) = msg diff --git a/src/Dhall/Lint.hs b/src/Dhall/Lint.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Lint.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | This module contains the implementation of the @dhall lint@ command + +module Dhall.Lint + ( -- * Lint + lint + , removeUnusedBindings + , fixAssert + , fixParentPath + , addPreludeExtensions + , removeLetInLet + , useToMap + ) where + +import Control.Applicative ((<|>)) + +import Dhall.Syntax + ( Binding (..) + , Chunks (..) + , Directory (..) + , Expr (..) + , File (..) + , FilePrefix (..) + , Import (..) + , ImportHashed (..) + , ImportType (..) + , URL (..) + , Var (..) + , subExpressions + ) + +import qualified Data.Foldable as Foldable +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Text as Text +import qualified Dhall.Core as Core +import qualified Dhall.Map +import qualified Lens.Micro as Lens + +{-| Automatically improve a Dhall expression + + Currently this: + + * removes unused @let@ bindings with 'removeUnusedBindings'. + * fixes @let a = x ≡ y@ to be @let a = assert : x ≡ y@ + * consolidates nested @let@ bindings to use a multiple-@let@ binding with 'removeLetInLet' + * fixes paths of the form @.\/..\/foo@ to @..\/foo@ +-} +lint :: Eq s => Expr s Import -> Expr s Import +lint = Lens.rewriteOf subExpressions rewrite + where + rewrite e = + fixAssert e + <|> removeUnusedBindings e + <|> fixParentPath e + <|> removeLetInLet e + <|> addPreludeExtensions e + +-- | Remove unused `Let` bindings. +removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a) +-- Don't remove assertions! +removeUnusedBindings (Let (Binding _ _ _ _ _ e) _) + | isOrContainsAssert e = Nothing +removeUnusedBindings (Let (Binding _ a _ _ _ _) d) + | not (V a 0 `Core.freeIn` d) = + Just (Core.shift (-1) (V a 0) d) +removeUnusedBindings _ = Nothing + +-- | Fix `Let` bindings that the user probably meant to be @assert@s +fixAssert :: Expr s a -> Maybe (Expr s a) +fixAssert (Let (Binding { value = v@(Core.shallowDenote -> Equivalent {}), ..}) body) = + Just (Let (Binding { value = Assert v, .. }) body) +fixAssert (Let binding body@(Core.shallowDenote -> Equivalent {})) = + Just (Let binding (Assert body)) +fixAssert _ = + Nothing + +-- | This transforms @.\/..\/foo@ into @..\/foo@ +fixParentPath :: Expr s Import -> Maybe (Expr s Import) +fixParentPath (Embed oldImport) = do + let Import{..} = oldImport + + let ImportHashed{..} = importHashed + + case importType of + Local Here File{ directory = Directory { components }, .. } + | Just nonEmpty <- NonEmpty.nonEmpty components + , NonEmpty.last nonEmpty == ".." -> do + let newDirectory = + Directory { components = NonEmpty.init nonEmpty } + + let newImportType = + Local Parent File{ directory = newDirectory, .. } + + let newImportHashed = + ImportHashed { importType = newImportType, .. } + + let newImport = Import { importHashed = newImportHashed, .. } + + Just (Embed newImport) + _ -> + Nothing +fixParentPath _ = Nothing + +{-| This transforms @https://prelude.dhall-lang.org/…/foo@ to + @https://prelude.dhall-lang.org/…/foo.dhall@ +-} +addPreludeExtensions :: Expr s Import -> Maybe (Expr s Import) +addPreludeExtensions (Embed oldImport) = do + let Import{ importHashed = oldImportHashed, .. } = oldImport + + let ImportHashed{ importType = oldImportType, .. } = oldImportHashed + + case oldImportType of + Remote URL{ path = oldPath, ..} + | authority == "prelude.dhall-lang.org" -> + case oldPath of + File{ file = oldFile, .. } + | not (Text.isSuffixOf ".dhall" oldFile) -> do + let newFile = oldFile <> ".dhall" + + let newPath = File{ file = newFile, .. } + + let newImportType = Remote URL{ path = newPath, .. } + + let newImportHashed = + ImportHashed{ importType = newImportType, .. } + + let newImport = + Import{ importHashed = newImportHashed, .. } + + return (Embed newImport) + _ -> + Nothing + _ -> do + Nothing +addPreludeExtensions _ = Nothing + +isOrContainsAssert :: Expr s a -> Bool +isOrContainsAssert (Assert _) = True +isOrContainsAssert e = Lens.anyOf subExpressions isOrContainsAssert e + +-- | The difference between +-- +-- > let x = 1 let y = 2 in x + y +-- +-- and +-- +-- > let x = 1 in let y = 2 in x + y +-- +-- is that in the second expression, the inner 'Let' is wrapped by a 'Note'. +-- +-- We remove such a 'Note' in order to consolidate nested let-blocks into a +-- single one. +removeLetInLet :: Expr s a -> Maybe (Expr s a) +removeLetInLet (Let binding (Note _ l@Let{})) = Just (Let binding l) +removeLetInLet _ = Nothing + +-- | This replaces a record of key-value pairs with the equivalent use of +-- @toMap@ +-- +-- This is currently not used by @dhall lint@ because this would sort @Map@ +-- keys, which is not necessarily a behavior-preserving change, but is still +-- made available as a convenient rewrite rule. For example, +-- @{json,yaml}-to-dhall@ use this rewrite to simplify their output. +useToMap :: Expr s a -> Maybe (Expr s a) +useToMap + (ListLit + t@(Just + (Core.shallowDenote -> App + (Core.shallowDenote -> List) + (Core.shallowDenote -> Record + (Dhall.Map.sort -> + [ ("mapKey", Core.shallowDenote . Core.recordFieldValue -> Text) + , ("mapValue", _) + ] + ) + ) + ) + ) + [] + ) = + Just (ToMap (RecordLit []) t) +useToMap (ListLit _ keyValues) + | not (null keyValues) + , Just keyValues' <- traverse convert keyValues = + Just + (ToMap + (RecordLit (Dhall.Map.fromList (Foldable.toList keyValues'))) + Nothing + ) + where + convert keyValue = + case Core.shallowDenote keyValue of + RecordLit + (Dhall.Map.sort -> + [ ("mapKey" , Core.shallowDenote . Core.recordFieldValue -> TextLit (Chunks [] key)) + , ("mapValue", value) + ] + ) -> + Just (key, value) + _ -> + Nothing +useToMap _ = + Nothing diff --git a/src/Dhall/Main.hs b/src/Dhall/Main.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Main.hs @@ -0,0 +1,1073 @@ +{-| This module contains the top-level entrypoint and options parsing for the + @dhall@ executable +-} + +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.Main + ( -- * Options + Options(..) + , Mode(..) + , ResolveMode(..) + , parseOptions + , parserInfoOptions + + -- * Execution + , Dhall.Main.command + , main + ) where + +import Control.Applicative (optional, (<|>)) +import Control.Exception (Handler (..), SomeException) +import Control.Monad (when) +import Data.Foldable (for_) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import Data.Maybe (fromMaybe) +import Data.Monoid (Endo (..)) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Freeze (Intent (..), Scope (..)) +import Dhall.Import + ( Depends (..) + , Imported (..) + , SemanticCacheMode (..) + , _semanticCacheMode + ) +import Dhall.Package (PackagingMode (..), writePackage) +import Dhall.Parser (Src) +import Dhall.Pretty + ( Ann + , CharacterSet (..) + , annToAnsiStyle + , detectCharacterSet + ) +import Dhall.Schemas (Schemas (..)) +import Dhall.TypeCheck (Censored (..), DetailedTypeError (..), TypeError) +import Dhall.Version (dhallVersionString) +import Lens.Micro (set) +import Options.Applicative (Parser, ParserInfo) +import Prettyprinter (Doc, Pretty) +import System.Exit (ExitCode, exitFailure) +import System.IO (Handle) +import Text.Dot ((.->.)) + +import Dhall.Core + ( Expr (Annot) + , Import (..) + , ImportHashed (..) + , ImportType (..) + , URL (..) + , pretty + ) +import Dhall.Util + ( Censor (..) + , CheckFailed (..) + , Header (..) + , Input (..) + , Output (..) + , OutputMode (..) + , Transitivity (..) + , handleMultipleChecksFailed + ) + +import qualified Codec.CBOR.JSON +import qualified Codec.CBOR.Read +import qualified Codec.CBOR.Write +import qualified Control.Exception +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Aeson +import qualified Data.Aeson.Encode.Pretty +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Lazy.Char8 +import qualified Data.Map +import qualified Data.Text +import qualified Data.Text.IO +import qualified Dhall +import qualified Dhall.Binary +import qualified Dhall.Core +import qualified Dhall.Diff +import qualified Dhall.DirectoryTree as DirectoryTree +import qualified Dhall.Format +import qualified Dhall.Freeze +import qualified Dhall.Import +import qualified Dhall.Import.Types +import qualified Dhall.Lint +import qualified Dhall.Map +import qualified Dhall.Package +import qualified Dhall.Pretty +import qualified Dhall.Repl +import qualified Dhall.Schemas +import qualified Dhall.Tags +import qualified Dhall.TypeCheck +import qualified Dhall.Util +import qualified GHC.IO.Encoding +import qualified Options.Applicative +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Terminal as Pretty +import qualified Prettyprinter.Render.Text as Pretty.Text +import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText +import qualified System.Console.ANSI +import qualified System.Exit as Exit +import qualified System.FilePath +import qualified System.IO +import qualified Text.Dot +import qualified Text.Pretty.Simple + +-- | Top-level program options +data Options = Options + { mode :: Mode + , explain :: Bool + , plain :: Bool + , chosenCharacterSet :: Maybe CharacterSet + , censor :: Censor + } + +-- | The subcommands for the @dhall@ executable +data Mode + = Default + { file :: Input + , output :: Output + , annotate :: Bool + , alpha :: Bool + , semanticCacheMode :: SemanticCacheMode + , version :: Bool + } + | Version + | Resolve + { file :: Input + , resolveMode :: Maybe ResolveMode + , semanticCacheMode :: SemanticCacheMode + } + | Type + { file :: Input + , quiet :: Bool + , semanticCacheMode :: SemanticCacheMode + } + | Normalize { file :: Input , alpha :: Bool } + | Repl + | Format { deprecatedInPlace :: Bool, transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } + | Freeze { deprecatedInPlace :: Bool, transitivity :: Transitivity, all_ :: Bool, cache :: Bool, outputMode :: OutputMode, inputs :: NonEmpty Input } + | Hash { file :: Input, cache :: Bool } + | Diff { expr1 :: Text, expr2 :: Text } + | Lint { deprecatedInPlace :: Bool, transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input } + | Tags + { input :: Input + , output :: Output + , suffixes :: Maybe [Text] + , followSymlinks :: Bool + } + | Encode { file :: Input, json :: Bool } + | Decode { file :: Input, json :: Bool, quiet :: Bool } + | Text { file :: Input, output :: Output } + | DirectoryTree { allowSeparators :: Bool, file :: Input, path :: FilePath } + | Schemas { file :: Input, outputMode :: OutputMode, schemas :: Text } + | SyntaxTree { file :: Input, noted :: Bool } + | Package + { packageOptions :: Endo Dhall.Package.Options + , packageFiles :: NonEmpty FilePath + } + +-- | This specifies how to resolve transitive dependencies +data ResolveMode + = Dot + -- ^ Generate a DOT file for @graphviz@ + | ListTransitiveDependencies + -- ^ List all transitive dependencies as text, one per line + | ListImmediateDependencies + -- ^ List immediate dependencies as text, one per line + +-- | Groups of subcommands +data Group + = Manipulate + | Generate + | Interpret + | Convert + | Miscellaneous + | Debugging + +groupDescription :: Group -> String +groupDescription group = case group of + Manipulate -> "Manipulate Dhall code" + Generate -> "Generate other formats from Dhall" + Interpret -> "Interpret Dhall" + Convert -> "Convert Dhall to and from its binary representation" + Miscellaneous -> "Miscellaneous" + Debugging -> "Debugging this interpreter" + +-- | `Parser` for the `Options` type +parseOptions :: Parser Options +parseOptions = + Options + <$> parseMode + <*> switch "explain" "Explain error messages in more detail" + <*> switch "plain" "Disable syntax highlighting" + <*> parseCharacterSet + <*> parseCensor + where + switch name description = + Options.Applicative.switch + ( Options.Applicative.long name + <> Options.Applicative.help description + ) + + parseCensor = fmap f (switch "censor" "Hide source code in error messages") + where + f True = Censor + f False = NoCensor + + parseCharacterSet = + Options.Applicative.flag' + (Just Unicode) + ( Options.Applicative.long "unicode" + <> Options.Applicative.help "Format code using only Unicode syntax" + ) + <|> Options.Applicative.flag' + (Just ASCII) + ( Options.Applicative.long "ascii" + <> Options.Applicative.help "Format code using only ASCII syntax" + ) + <|> pure Nothing + +subcommand :: Group -> String -> String -> Parser a -> Parser a +subcommand group name description parser = + Options.Applicative.hsubparser + ( Options.Applicative.command name parserInfo + <> Options.Applicative.metavar name + <> Options.Applicative.commandGroup (groupDescription group) + ) + where + parserInfo = + Options.Applicative.info parser + ( Options.Applicative.fullDesc + <> Options.Applicative.progDesc description + ) + +parseMode :: Parser Mode +parseMode = + subcommand + Manipulate + "format" + "Standard code formatter for the Dhall language" + (Format <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseCheck "formatted" <*> parseFiles) + <|> subcommand + Manipulate + "freeze" + "Add integrity checks to remote import statements of an expression" + (Freeze <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen" <*> parseFiles) + <|> subcommand + Manipulate + "lint" + "Improve Dhall code by using newer language features and removing dead code" + (Lint <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseCheck "linted" <*> parseFiles) + <|> subcommand + Manipulate + "rewrite-with-schemas" + "Simplify Dhall code using a schemas record" + (Dhall.Main.Schemas <$> parseInplaceNonTransitive <*> parseCheck "rewritten" <*> parseSchemasRecord) + <|> subcommand + Generate + "text" + "Render a Dhall expression that evaluates to a Text literal" + (Text <$> parseFile <*> parseOutput) + <|> subcommand + Generate + "to-directory-tree" + "Convert nested records of Text literals into a directory tree" + (DirectoryTree <$> parseDirectoryTreeAllowSeparators <*> parseFile <*> parseDirectoryTreeOutput) + <|> subcommand + Interpret + "resolve" + "Resolve an expression's imports" + (Resolve <$> parseFile <*> parseResolveMode <*> parseSemanticCacheMode) + <|> subcommand + Interpret + "type" + "Infer an expression's type" + (Type <$> parseFile <*> parseQuiet <*> parseSemanticCacheMode) + <|> subcommand + Interpret + "normalize" + "Normalize an expression" + (Normalize <$> parseFile <*> parseAlpha) + <|> subcommand + Convert + "encode" + "Encode a Dhall expression to binary" + (Encode <$> parseFile <*> parseJSONFlag) + <|> subcommand + Convert + "decode" + "Decode a Dhall expression from binary" + (Decode <$> parseFile <*> parseJSONFlag <*> parseQuiet) + <|> subcommand + Miscellaneous + "repl" + "Interpret expressions in a REPL" + (pure Repl) + <|> subcommand + Miscellaneous + "diff" + "Render the difference between the normal form of two expressions" + (Diff <$> argument "expr1" <*> argument "expr2") + <|> subcommand + Miscellaneous + "hash" + "Compute semantic hashes for Dhall expressions" + (Hash <$> parseFile <*> parseCache) + <|> subcommand + Miscellaneous + "package" + "Create a package.dhall referencing the provided paths" + (Package <$> parsePackageOptions <*> parsePackageFiles) + <|> subcommand + Miscellaneous + "tags" + "Generate etags file" + (Tags <$> parseInput <*> parseTagsOutput <*> parseSuffixes <*> parseFollowSymlinks) + <|> subcommand + Miscellaneous + "version" + "Display version" + (pure Version) + <|> subcommand + Debugging + "haskell-syntax-tree" + "Output the parsed syntax tree (for debugging)" + (SyntaxTree <$> parseFile <*> parseNoted) + <|> ( Default + <$> parseFile + <*> parseOutput + <*> parseAnnotate + <*> parseAlpha + <*> parseSemanticCacheMode + <*> parseVersion + ) + where + deprecatedInPlace = + Options.Applicative.switch + ( Options.Applicative.long "inplace" + <> Options.Applicative.internal -- completely hidden from help + ) + + argument = + fmap Data.Text.pack + . Options.Applicative.strArgument + . Options.Applicative.metavar + + parseFile = fmap f (optional p) + where + f Nothing = StandardInput + f (Just file) = InputFile file + + p = Options.Applicative.strOption + ( Options.Applicative.long "file" + <> Options.Applicative.help "Read expression from a file instead of standard input" + <> Options.Applicative.metavar "FILE" + <> Options.Applicative.action "file" + ) + + parseFiles = fmap f (Options.Applicative.many p) + where + -- Parse explicit stdin in the input filepaths + parseStdin inputs + | InputFile "-" `elem` inputs = StandardInput : filter (/= InputFile "-") inputs + | otherwise = inputs + + f = fromMaybe (pure StandardInput) . nonEmpty . parseStdin . fmap InputFile + + p = Options.Applicative.strArgument + ( Options.Applicative.help "Read expression from files instead of standard input" + <> Options.Applicative.metavar "FILES" + <> Options.Applicative.action "file" + ) + + parseOutput = fmap f (optional p) + where + f Nothing = StandardOutput + f (Just file) = OutputFile file + + p = Options.Applicative.strOption + ( Options.Applicative.long "output" + <> Options.Applicative.help "Write result to a file instead of standard output" + <> Options.Applicative.metavar "FILE" + <> Options.Applicative.action "file" + ) + + parseAlpha = + Options.Applicative.switch + ( Options.Applicative.long "alpha" + <> Options.Applicative.help "α-normalize expression" + ) + + parseAnnotate = + Options.Applicative.switch + ( Options.Applicative.long "annotate" + <> Options.Applicative.help "Add a type annotation to the output" + ) + + parseSemanticCacheMode = + Options.Applicative.flag + UseSemanticCache + IgnoreSemanticCache + ( Options.Applicative.long "no-cache" + <> Options.Applicative.help + "Handle protected imports as if the cache was empty" + ) + + parseVersion = + Options.Applicative.switch + ( Options.Applicative.long "version" + <> Options.Applicative.help "Display version" + ) + + parseResolveMode = + Options.Applicative.flag' (Just Dot) + ( Options.Applicative.long "dot" + <> Options.Applicative.help + "Output import dependency graph in dot format" + ) + <|> + Options.Applicative.flag' (Just ListImmediateDependencies) + ( Options.Applicative.long "immediate-dependencies" + <> Options.Applicative.help + "List immediate import dependencies" + ) + <|> + Options.Applicative.flag' (Just ListTransitiveDependencies) + ( Options.Applicative.long "transitive-dependencies" + <> Options.Applicative.help + "List transitive import dependencies in post-order" + ) + <|> pure Nothing + + parseQuiet = + Options.Applicative.switch + ( Options.Applicative.long "quiet" + <> Options.Applicative.help "Don't print the result" + ) + + parseInplace = + Options.Applicative.strOption + ( Options.Applicative.long "inplace" + <> Options.Applicative.help "Modify the specified file in-place" + <> Options.Applicative.metavar "FILE" + <> Options.Applicative.action "file" + ) + + parseTransitiveSwitch = Options.Applicative.flag NonTransitive Transitive + ( Options.Applicative.long "transitive" + <> Options.Applicative.help "Modify the input and its transitive relative imports in-place" + ) + + parseInplaceNonTransitive = + fmap InputFile parseInplace + <|> pure StandardInput + + parseInput = fmap f (optional p) + where + f Nothing = StandardInput + f (Just path) = InputFile path + + p = Options.Applicative.strOption + ( Options.Applicative.long "path" + <> Options.Applicative.help "Index all files in path recursively. Will get list of files from STDIN if omitted." + <> Options.Applicative.metavar "PATH" + <> Options.Applicative.action "file" + <> Options.Applicative.action "directory" + ) + + parseTagsOutput = fmap f (optional p) + where + f Nothing = OutputFile "tags" + f (Just file) = OutputFile file + + p = Options.Applicative.strOption + ( Options.Applicative.long "output" + <> Options.Applicative.help "The name of the file that the tags are written to. Defaults to \"tags\"" + <> Options.Applicative.metavar "FILENAME" + <> Options.Applicative.action "file" + ) + + parseSuffixes = fmap f (optional p) + where + f Nothing = Just [".dhall"] + f (Just "") = Nothing + f (Just line) = Just (Data.Text.splitOn " " line) + + p = Options.Applicative.strOption + ( Options.Applicative.long "suffixes" + <> Options.Applicative.help "Index only files with suffixes. \"\" to index all files." + <> Options.Applicative.metavar "SUFFIXES" + ) + + parseFollowSymlinks = + Options.Applicative.switch + ( Options.Applicative.long "follow-symlinks" + <> Options.Applicative.help "Follow symlinks when recursing directories" + ) + + parseJSONFlag = + Options.Applicative.switch + ( Options.Applicative.long "json" + <> Options.Applicative.help "Use JSON representation of CBOR" + ) + + parseAllFlag = + Options.Applicative.switch + ( Options.Applicative.long "all" + <> Options.Applicative.help "Add integrity checks to all imports (not just remote imports) except for missing imports" + ) + + parseCacheFlag = + Options.Applicative.switch + ( Options.Applicative.long "cache" + <> Options.Applicative.help "Add fallback unprotected imports when using integrity checks purely for caching purposes" + ) + + parseCheck processed = fmap adapt switch + where + adapt True = Check + adapt False = Write + + switch = + Options.Applicative.switch + ( Options.Applicative.long "check" + <> Options.Applicative.help ("Only check if the input is " <> processed) + ) + + parseSchemasRecord = + Options.Applicative.strOption + ( Options.Applicative.long "schemas" + <> Options.Applicative.help "A record of schemas" + <> Options.Applicative.metavar "EXPR" + ) + + parseDirectoryTreeAllowSeparators = + Options.Applicative.switch + ( Options.Applicative.long "allow-path-separators" + <> Options.Applicative.help "Whether to allow path separators in file names" + ) + + parseDirectoryTreeOutput = + Options.Applicative.strOption + ( Options.Applicative.long "output" + <> Options.Applicative.help "The destination path to create" + <> Options.Applicative.metavar "PATH" + <> Options.Applicative.action "directory" + ) + + parseNoted = + Options.Applicative.switch + ( Options.Applicative.long "noted" + <> Options.Applicative.help "Print `Note` constructors" + ) + + parseCache = + Options.Applicative.switch + ( Options.Applicative.long "cache" + <> Options.Applicative.help "Cache the hashed expression" + ) + + parsePackageOptions :: Parser (Endo Dhall.Package.Options) + parsePackageOptions = do + packageMode <- (optional . Options.Applicative.flag' RecursiveSubpackages) + ( Options.Applicative.short 'r' + <> Options.Applicative.long "recursive" + <> Options.Applicative.help "Create packages for all subdirectories first." + ) + + packageFileName <- (optional . Options.Applicative.strOption) + ( Options.Applicative.long "name" + <> Options.Applicative.help "The filename of the package" + <> Options.Applicative.metavar "NAME" + <> Options.Applicative.action "file" + ) + + pure $ + maybe mempty (Endo . set Dhall.Package.packagingMode) packageMode <> + maybe mempty (Endo . set Dhall.Package.packageFileName) packageFileName + + parsePackageFiles = (:|) <$> p <*> Options.Applicative.many p + where + p = Options.Applicative.strArgument + ( Options.Applicative.help "Paths that may either point to files or directories. If the latter is the case all *.dhall files in the directory will be included." + <> Options.Applicative.metavar "PATH" + <> Options.Applicative.action "file" + ) + +-- | `ParserInfo` for the `Options` type +parserInfoOptions :: ParserInfo Options +parserInfoOptions = + Options.Applicative.info + (Options.Applicative.helper <*> parseOptions) + ( Options.Applicative.progDesc "Interpreter for the Dhall language" + <> Options.Applicative.fullDesc + ) + +noHeaders :: Import -> Import +noHeaders + (Import { importHashed = ImportHashed { importType = Remote URL{ .. }, ..}, .. }) = + Import { importHashed = ImportHashed { importType = Remote URL{ headers = Nothing, .. }, .. }, .. } +noHeaders i = + i + +-- | Run the command specified by the `Options` type +command :: Options -> IO () +command (Options {..}) = do + GHC.IO.Encoding.setLocaleEncoding System.IO.utf8 + + let rootDirectory = \case + InputFile f -> System.FilePath.takeDirectory f + StandardInput -> "." + + let toStatus = Dhall.Import.emptyStatus . rootDirectory + + let getExpression = Dhall.Util.getExpression censor + + -- The characterSet detection used here only works on the source + -- expression, before any transformation is applied. This helper is there + -- make sure the detection is done on the correct expr. + let getExpressionAndCharacterSet file = do + expr <- getExpression file + + let characterSet = fromMaybe (detectCharacterSet expr) chosenCharacterSet + + return (expr, characterSet) + + let handle io = + Control.Exception.catches io + [ Handler handleTypeError + , Handler handleImported + , Handler handleExitCode + ] + where + handleAll e = do + let string = show (e :: SomeException) + + if not (null string) + then System.IO.hPutStrLn System.IO.stderr string + else return () + + System.Exit.exitFailure + + handleTypeError e = Control.Exception.handle handleAll $ do + let _ = e :: TypeError Src Void + System.IO.hPutStrLn System.IO.stderr "" + if explain + then + case censor of + Censor -> Control.Exception.throwIO (CensoredDetailed (DetailedTypeError e)) + NoCensor -> Control.Exception.throwIO (DetailedTypeError e) + + else do + Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" + case censor of + Censor -> Control.Exception.throwIO (Censored e) + NoCensor -> Control.Exception.throwIO e + + handleImported (Imported ps e) = Control.Exception.handle handleAll $ do + let _ = e :: TypeError Src Void + System.IO.hPutStrLn System.IO.stderr "" + if explain + then Control.Exception.throwIO (Imported ps (DetailedTypeError e)) + else do + Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" + Control.Exception.throwIO (Imported ps e) + + handleExitCode e = + Control.Exception.throwIO (e :: ExitCode) + + let renderDoc :: Handle -> Doc Ann -> IO () + renderDoc h doc = do + let stream = Dhall.Pretty.layout doc + + supportsANSI <- System.Console.ANSI.hSupportsANSI h + let ansiStream = + if supportsANSI && not plain + then fmap annToAnsiStyle stream + else Pretty.unAnnotateS stream + + Pretty.renderIO h ansiStream + Data.Text.IO.hPutStrLn h "" + + let render :: Pretty a => Handle -> CharacterSet -> Expr Src a -> IO () + render h characterSet expression = do + let doc = Dhall.Pretty.prettyCharacterSet characterSet expression + + renderDoc h doc + + let writeDocToFile :: FilePath -> Doc ann -> IO () + writeDocToFile file doc = do + let stream = Dhall.Pretty.layout (doc <> "\n") + + AtomicWrite.LazyText.atomicWriteFile file (Pretty.Text.renderLazy stream) + + handle $ case mode of + Version -> + putStrLn dhallVersionString + + Default {..} -> do + if version + then do + putStrLn dhallVersionString + Exit.exitSuccess + else return () + + (expression, characterSet) <- getExpressionAndCharacterSet file + + resolvedExpression <- + Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression + + inferredType <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + + let normalizedExpression = Dhall.Core.normalize resolvedExpression + + let alphaNormalizedExpression = + if alpha + then Dhall.Core.alphaNormalize normalizedExpression + else normalizedExpression + + let annotatedExpression = + if annotate + then Annot alphaNormalizedExpression inferredType + else alphaNormalizedExpression + + case output of + StandardOutput -> render System.IO.stdout characterSet annotatedExpression + + OutputFile file_ -> + writeDocToFile + file_ + (Dhall.Pretty.prettyCharacterSet characterSet annotatedExpression) + + Resolve { resolveMode = Just Dot, ..} -> do + expression <- getExpression file + + (Dhall.Import.Types.Status { _graph, _stack }) <- + State.execStateT (Dhall.Import.loadWith expression) (toStatus file) { _semanticCacheMode = semanticCacheMode } + + let (rootImport :| _) = _stack + imports = rootImport : map parent _graph ++ map child _graph + importIds = Data.Map.fromList (zip imports [Text.Dot.userNodeId i | i <- [0..]]) + + let dotNode (i, nodeId) = + Text.Dot.userNode + nodeId + [ ("label", Data.Text.unpack $ pretty (convert i)) + , ("shape", "box") + , ("style", "rounded") + ] + where + convert = noHeaders . Dhall.Import.chainedImport + + let dotEdge (Depends parent child) = + case (Data.Map.lookup parent importIds, Data.Map.lookup child importIds) of + (Just from, Just to) -> from .->. to + _ -> pure () + + let dot = do Text.Dot.attribute ("rankdir", "LR") + mapM_ dotNode (Data.Map.assocs importIds) + mapM_ dotEdge _graph + + putStr . ("strict " <>) . Text.Dot.showDot $ dot + + Resolve { resolveMode = Just ListImmediateDependencies, ..} -> do + expression <- getExpression file + + mapM_ (print . Pretty.pretty . noHeaders) expression + + Resolve { resolveMode = Just ListTransitiveDependencies, ..} -> do + expression <- getExpression file + + (Dhall.Import.Types.Status { _cache }) <- + State.execStateT (Dhall.Import.loadWith expression) (toStatus file) { _semanticCacheMode = semanticCacheMode } + + mapM_ print + . fmap ( Pretty.pretty + . noHeaders + . Dhall.Import.chainedImport + ) + . reverse + . Dhall.Map.keys + $ _cache + + Resolve { resolveMode = Nothing, ..} -> do + (expression, characterSet) <- getExpressionAndCharacterSet file + + resolvedExpression <- + Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression + + render System.IO.stdout characterSet resolvedExpression + + Normalize {..} -> do + (expression, characterSet) <- getExpressionAndCharacterSet file + + resolvedExpression <- Dhall.Import.assertNoImports expression + + _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + + let normalizedExpression = Dhall.Core.normalize resolvedExpression + + let alphaNormalizedExpression = + if alpha + then Dhall.Core.alphaNormalize normalizedExpression + else normalizedExpression + + render System.IO.stdout characterSet alphaNormalizedExpression + + Type {..} -> do + (expression, characterSet) <- getExpressionAndCharacterSet file + + resolvedExpression <- + Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression + + inferredType <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + + if quiet + then return () + else render System.IO.stdout characterSet inferredType + + Repl -> + Dhall.Repl.repl + (fromMaybe Unicode chosenCharacterSet) -- Default to Unicode if no characterSet specified + explain + + Diff {..} -> do + expression1 <- Dhall.inputExpr expr1 + + expression2 <- Dhall.inputExpr expr2 + + let diff = Dhall.Diff.diffNormalized expression1 expression2 + + renderDoc System.IO.stdout (Dhall.Diff.doc diff) + + if Dhall.Diff.same diff + then return () + else Exit.exitFailure + + Format {..} -> do + when deprecatedInPlace $ + System.IO.hPutStrLn System.IO.stderr "Warning: the flag \"--inplace\" is deprecated" + + Dhall.Format.format Dhall.Format.Format{..} + + Freeze {..} -> do + when deprecatedInPlace $ + System.IO.hPutStrLn System.IO.stderr "Warning: the flag \"--inplace\" is deprecated" + + let scope = if all_ then AllImports else OnlyRemoteImports + + let intent = if cache then Cache else Secure + + Dhall.Freeze.freeze outputMode transitivity inputs scope intent chosenCharacterSet censor + + Hash {..} -> do + expression <- getExpression file + + resolvedExpression <- + Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression + + _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + + let normalizedExpression = + Dhall.Core.alphaNormalize (Dhall.Core.normalize resolvedExpression) + + if cache + then Dhall.Import.writeExpressionToSemanticCache normalizedExpression + else return () + + Data.Text.IO.putStrLn (Dhall.Import.hashExpressionToCode normalizedExpression) + + Lint { transitivity = transitivity0, ..} -> do + when deprecatedInPlace $ + System.IO.hPutStrLn System.IO.stderr "Warning: the flag \"--inplace\" is deprecated" + + handleMultipleChecksFailed "lint" "linted" go inputs + where + go input = do + let directory = case input of + StandardInput -> "." + InputFile file -> System.FilePath.takeDirectory file + + let status = Dhall.Import.emptyStatus directory + + (inputName, originalText, transitivity) <- case input of + InputFile file -> do + text <- Data.Text.IO.readFile file + + return (file, text, transitivity0) + StandardInput -> do + text <- Data.Text.IO.getContents + + return ("(input)", text, NonTransitive) + + (Header header, parsedExpression) <- + Dhall.Util.getExpressionAndHeaderFromStdinText censor inputName originalText + + let characterSet = fromMaybe (detectCharacterSet parsedExpression) chosenCharacterSet + + case transitivity of + Transitive -> + for_ parsedExpression $ \import_ -> do + maybeFilepath <- Dhall.Import.dependencyToFile status import_ + + for_ maybeFilepath $ \filepath -> + go (InputFile filepath) + + NonTransitive -> + return () + + let lintedExpression = Dhall.Lint.lint parsedExpression + + let doc = Pretty.pretty header + <> Dhall.Pretty.prettyCharacterSet characterSet lintedExpression + + let stream = Dhall.Pretty.layout doc + + let modifiedText = Pretty.Text.renderStrict stream <> "\n" + + case outputMode of + Write -> do + case input of + InputFile file -> + if originalText == modifiedText + then return () + else writeDocToFile file doc + + StandardInput -> + renderDoc System.IO.stdout doc + + return (Right ()) + + Check -> + return $ + if originalText == modifiedText + then Right () + else Left CheckFailed{..} + + Encode {..} -> do + expression <- getExpression file + + let bytes = Dhall.Binary.encodeExpression (Dhall.Core.denote expression) + + if json + then do + let decoder = Codec.CBOR.JSON.decodeValue False + + (_, value) <- Dhall.Core.throws (Codec.CBOR.Read.deserialiseFromBytes decoder bytes) + + let jsonBytes = Data.Aeson.Encode.Pretty.encodePretty value + + Data.ByteString.Lazy.Char8.putStrLn jsonBytes + + else + Data.ByteString.Lazy.putStr bytes + + Decode {..} -> do + bytes <- + case file of + InputFile f -> Data.ByteString.Lazy.readFile f + StandardInput -> Data.ByteString.Lazy.getContents + + expression <- + if json + then do + value <- case Data.Aeson.eitherDecode' bytes of + Left string -> fail string + Right value -> return value + + let encoding = Codec.CBOR.JSON.encodeValue value + + let cborgBytes = Codec.CBOR.Write.toLazyByteString encoding + + Dhall.Core.throws (Dhall.Binary.decodeExpression cborgBytes) + else + Dhall.Core.throws (Dhall.Binary.decodeExpression bytes) + + + if quiet + then return () + else do + let doc = + Dhall.Pretty.prettyCharacterSet + (fromMaybe Unicode chosenCharacterSet) -- default to Unicode + (Dhall.Core.renote expression :: Expr Src Import) + + renderDoc System.IO.stdout doc + + Text {..} -> do + expression <- getExpression file + + resolvedExpression <- + Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression + + _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf (Annot resolvedExpression Dhall.Core.Text)) + + let normalizedExpression = Dhall.Core.normalize resolvedExpression + + case normalizedExpression of + Dhall.Core.TextLit (Dhall.Core.Chunks [] text) -> + let write = case output of + StandardOutput -> Data.Text.IO.putStr + OutputFile file_ -> Data.Text.IO.writeFile file_ + in write text + _ -> do + let invalidDecoderExpected :: Expr Void Void + invalidDecoderExpected = Dhall.Core.Text + + let invalidDecoderExpression :: Expr Void Void + invalidDecoderExpression = normalizedExpression + + Control.Exception.throwIO (Dhall.InvalidDecoder {..}) + + Tags {..} -> do + tags <- Dhall.Tags.generate input suffixes followSymlinks + + case output of + OutputFile file -> + System.IO.withFile file System.IO.WriteMode (`Data.Text.IO.hPutStr` tags) + + StandardOutput -> Data.Text.IO.putStrLn tags + + DirectoryTree {..} -> do + expression <- getExpression file + + resolvedExpression <- + Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression + + _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) + + let normalizedExpression = Dhall.Core.normalize resolvedExpression + + DirectoryTree.toDirectoryTree allowSeparators path normalizedExpression + + Dhall.Main.Schemas{..} -> + Dhall.Schemas.schemasCommand Dhall.Schemas.Schemas{ input = file, ..} + + SyntaxTree {..} -> do + expression <- getExpression file + + if noted then + Text.Pretty.Simple.pPrintNoColor expression + else + let denoted :: Expr Void Import + denoted = Dhall.Core.denote expression + in Text.Pretty.Simple.pPrintNoColor denoted + + Package {..} -> do + let options = appEndo + (maybe mempty (Endo . set Dhall.Package.characterSet) chosenCharacterSet + <> packageOptions + ) Dhall.Package.defaultOptions + writePackage options packageFiles + +-- | Entry point for the @dhall@ executable +main :: IO () +main = do + options <- Options.Applicative.execParser parserInfoOptions + + Dhall.Main.command options diff --git a/src/Dhall/Map.hs b/src/Dhall/Map.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Map.hs @@ -0,0 +1,742 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +-- | `Map` type used to represent records and unions + +module Dhall.Map + ( -- * Type + Map + + -- * Construction + , empty + , singleton + , fromList + , fromListWithKey + , fromMap + + -- * Constructing unordered 'Map's + , unorderedSingleton + , unorderedFromList + + -- * Sorting + , sort + , isSorted + + -- * Insertion + , insert + , insertWith + + -- * Deletion/Update + , delete + , filter + , partition + , restrictKeys + , withoutKeys + , mapMaybe + + -- * Query + , lookup + , member + , uncons + , size + + -- * Combine + , union + , unionWith + , outerJoin + , intersection + , intersectionWith + , difference + + -- * Traversals + , mapWithKey + , traverseWithKey + , unorderedTraverseWithKey + , unorderedTraverseWithKey_ + , foldMapWithKey + + -- * Conversions + , toList + , toAscList + , toMap + , keys + , keysSet + , elems + ) where + +import Control.Applicative ((<|>)) +import Control.DeepSeq (NFData) +import Data.Data (Data) +import GHC.Generics (Generic) +import Instances.TH.Lift () +import Language.Haskell.TH.Syntax (Lift) +import Prelude hiding (filter, lookup) + +import qualified Data.Foldable.WithIndex as Foldable.WithIndex +import qualified Data.Functor.WithIndex as Functor.WithIndex +import qualified Data.List +import qualified Data.Map.Strict +import qualified Data.Set +import qualified Data.Traversable.WithIndex as Traversable.WithIndex +import qualified GHC.Exts +import qualified Prelude + +{-| A `Map` that remembers the original ordering of keys + + This is primarily used so that formatting preserves field order + + This is done primarily to avoid a dependency on @insert-ordered-containers@ + and also to improve performance +-} +data Map k v = Map (Data.Map.Strict.Map k v) (Keys k) + deriving (Data, Generic, Lift, NFData) + +data Keys a + = Sorted + | Original [a] + deriving (Data, Generic, Lift, NFData) + +instance (Ord k, Eq v) => Eq (Map k v) where + m1 == m2 = + Data.Map.Strict.size (toMap m1) == Data.Map.Strict.size (toMap m2) + && toList m1 == toList m2 + {-# INLINABLE (==) #-} + +{-| +>>> fromList [("A",1),("B",2)] < fromList [("B",1),("A",0)] +True +-} +instance (Ord k, Ord v) => Ord (Map k v) where + compare m1 m2 = compare (toList m1) (toList m2) + {-# INLINABLE compare #-} + +instance Functor (Map k) where + fmap f (Map m ks) = Map (fmap f m) ks + {-# INLINABLE fmap #-} + +instance Ord k => Foldable (Map k) where + foldr f z (Map m Sorted) = foldr f z m + foldr f z m = foldr f z (elems m) + {-# INLINABLE foldr #-} + + length m = size m + {-# INLINABLE length #-} + + null (Map m _) = null m + {-# INLINABLE null #-} + +instance Ord k => Traversable (Map k) where + traverse f m = traverseWithKey (\_ v -> f v) m + {-# INLINABLE traverse #-} + +{-| +prop> \x y z -> x <> (y <> z) == (x <> y) <> (z :: Map Int Int) +-} +instance Ord k => Semigroup (Map k v) where + (<>) = union + {-# INLINABLE (<>) #-} + +{-| +prop> \x -> x <> mempty == (x :: Map Int Int) +prop> \x -> mempty <> x == (x :: Map Int Int) +-} +instance Ord k => Monoid (Map k v) where + mempty = Map Data.Map.Strict.empty (Original []) + {-# INLINABLE mempty #-} + +instance (Show k, Show v, Ord k) => Show (Map k v) where + showsPrec d m = + showParen (d > 10) (showString "fromList " . showsPrec 11 kvs) + where + kvs = toList m + +instance Ord k => GHC.Exts.IsList (Map k v) where + type Item (Map k v) = (k, v) + + fromList = Dhall.Map.fromList + + toList = Dhall.Map.toList + +instance Ord k => Foldable.WithIndex.FoldableWithIndex k (Map k) where + ifoldMap = foldMapWithKey + {-# INLINABLE ifoldMap #-} + +instance Functor.WithIndex.FunctorWithIndex k (Map k) where + imap = mapWithKey + {-# INLINABLE imap #-} + +instance Ord k => Traversable.WithIndex.TraversableWithIndex k (Map k) where + itraverse = traverseWithKey + {-# INLINABLE itraverse #-} + +-- | Create an empty `Map` +empty :: Ord k => Map k v +empty = mempty + +{-| Create a `Map` from a single key-value pair + +>>> singleton "A" 1 +fromList [("A",1)] +-} +singleton :: k -> v -> Map k v +singleton k v = Map m ks + where + m = Data.Map.Strict.singleton k v + + ks = Original [k] +{-# INLINABLE singleton #-} + +{-| Create a `Map` from a list of key-value pairs + +>>> fromList [("B",1),("A",2)] -- The map preserves order +fromList [("B",1),("A",2)] +>>> fromList [("A",1),("A",2)] -- For duplicates, later values take precedence +fromList [("A",2)] + +Note that this handling of duplicates means that 'fromList' is /not/ a monoid +homomorphism: + +>>> fromList [(1, True)] <> fromList [(1, False)] +fromList [(1,True)] +>>> fromList ([(1, True)] <> [(1, False)]) +fromList [(1,False)] + +-} +fromList :: Ord k => [(k, v)] -> Map k v +fromList kvs = Map m ks + where + m = Data.Map.Strict.fromList kvs + + ks = Original (nubOrd (map fst kvs)) +{-# INLINABLE fromList #-} + +{-| Create a `Map` from a list of key-value pairs with a combining function. + +>>> fromListWithKey (\k v1 v2 -> k ++ v1 ++ v2) [("B","v1"),("A","v2"),("B","v3")] +fromList [("B","Bv3v1"),("A","v2")] +-} +fromListWithKey :: Ord k => (k -> v -> v -> v) -> [(k, v)] -> Map k v +fromListWithKey f kvs = Map m ks + where + m = Data.Map.Strict.fromListWithKey f kvs + + ks = Original (nubOrd (map fst kvs)) +{-# INLINABLE fromListWithKey #-} + +-- | Create a `Map` from a @"Data.Map.Strict".`Data.Map.Strict.Map`@ +fromMap :: Data.Map.Strict.Map k v -> Map k v +fromMap m = Map m Sorted + +{-| Remove duplicates from a list + +>>> nubOrd [1,2,3] +[1,2,3] +>>> nubOrd [1,1,3] +[1,3] +-} +nubOrd :: Ord k => [k] -> [k] +nubOrd = go Data.Set.empty + where + go _ [] = [] + go set (k:ks) + | Data.Set.member k set = go set ks + | otherwise = k : go (Data.Set.insert k set) ks +{-# INLINABLE nubOrd #-} + +{-| Create a `Map` from a single key-value pair. + + Any further operations on this map will not retain the order of the keys. + +>>> unorderedSingleton "A" 1 +fromList [("A",1)] +-} +unorderedSingleton :: k -> v -> Map k v +unorderedSingleton k v = Map m Sorted + where + m = Data.Map.Strict.singleton k v +{-# INLINABLE unorderedSingleton #-} + +{-| Create a `Map` from a list of key-value pairs + + Any further operations on this map will not retain the order of the keys. + +>>> unorderedFromList [] +fromList [] +>>> unorderedFromList [("B",1),("A",2)] -- The map /doesn't/ preserve order +fromList [("A",2),("B",1)] +>>> unorderedFromList [("A",1),("A",2)] -- For duplicates, later values take precedence +fromList [("A",2)] +-} +unorderedFromList :: Ord k => [(k, v)] -> Map k v +unorderedFromList kvs = Map m Sorted + where + m = Data.Map.Strict.fromList kvs +{-# INLINABLE unorderedFromList #-} + +{-| Sort the keys of a `Map`, forgetting the original ordering + +> sort (sort x) = sort x + +>>> sort (fromList [("B",1),("A",2)]) +fromList [("A",2),("B",1)] +-} +sort :: Map k v -> Map k v +sort (Map m _) = Map m Sorted +{-# INLINABLE sort #-} + +{-| Check if the keys of a `Map` are already sorted + +> isSorted (sort m) = True + +>>> isSorted (fromList [("B",1),("A",2)]) -- Sortedness is based only on keys +False +>>> isSorted (fromList [("A",2),("B",1)]) +True +-} +isSorted :: Eq k => Map k v -> Bool +isSorted (Map _ Sorted) = True +isSorted (Map m (Original ks)) = Data.Map.Strict.keys m == ks -- Or shortcut to False here? +{-# INLINABLE isSorted #-} + +{-| Insert a key-value pair into a `Map`, overriding any previous value stored + underneath the same key, if present + +> insert = insertWith (\v _ -> v) + +>>> insert "C" 1 (fromList [("B",2),("A",3)]) -- Values are inserted on left +fromList [("C",1),("B",2),("A",3)] +>>> insert "C" 1 (fromList [("C",2),("A",3)]) -- New value takes precedence +fromList [("C",1),("A",3)] +-} +insert :: Ord k => k -> v -> Map k v -> Map k v +insert k v (Map m Sorted) = Map (Data.Map.Strict.insert k v m) Sorted +insert k v (Map m (Original ks)) = Map m' (Original ks') + where + (mayOldV, m') = Data.Map.Strict.insertLookupWithKey (\_k new _old -> new) k v m + + ks' | Just _ <- mayOldV = ks + | otherwise = k : ks +{-# INLINABLE insert #-} + +{-| Insert a key-value pair into a `Map`, using the supplied function to combine + the new value with any old value underneath the same key, if present + +>>> insertWith (+) "C" 1 (fromList [("B",2),("A",3)]) -- No collision +fromList [("C",1),("B",2),("A",3)] +>>> insertWith (+) "C" 1 (fromList [("C",2),("A",3)]) -- Collision +fromList [("C",3),("A",3)] +-} +insertWith :: Ord k => (v -> v -> v) -> k -> v -> Map k v -> Map k v +insertWith f k v (Map m Sorted) = Map (Data.Map.Strict.insertWith f k v m) Sorted +insertWith f k v (Map m (Original ks)) = Map m' (Original ks') + where + (mayOldV, m') = Data.Map.Strict.insertLookupWithKey (\_k new old -> f new old) k v m + + ks' | Just _ <- mayOldV = ks + | otherwise = k : ks +{-# INLINABLE insertWith #-} + +{-| Delete a key from a `Map` if present, otherwise return the original `Map` + +>>> delete "B" (fromList [("C",1),("B",2),("A",3)]) +fromList [("C",1),("A",3)] +>>> delete "D" (fromList [("C",1),("B",2),("A",3)]) +fromList [("C",1),("B",2),("A",3)] +-} +delete :: Ord k => k -> Map k v -> Map k v +delete k (Map m ks) = Map m' ks' + where + m' = Data.Map.Strict.delete k m + + ks' = case ks of + Sorted -> Sorted + Original ks'' -> Original (Data.List.delete k ks'') +{-# INLINABLE delete #-} + +{-| Keep all values that satisfy the given predicate + +>>> filter even (fromList [("C",3),("B",2),("A",1)]) +fromList [("B",2)] +>>> filter odd (fromList [("C",3),("B",2),("A",1)]) +fromList [("C",3),("A",1)] +-} +filter :: Ord k => (a -> Bool) -> Map k a -> Map k a +filter predicate (Map m ks) = Map m' ks' + where + m' = Data.Map.Strict.filter predicate m + + ks' = filterKeys (\k -> Data.Map.Strict.member k m') ks +{-# INLINABLE filter #-} + +{-| Split the map into values that do and don't satisfy the predicate + +>>> partition even (fromList [("C",3),("B",2),("A",1)]) +(fromList [("B",2)],fromList [("C",3),("A",1)]) +>>> partition odd (fromList [("C",3),("B",2),("A",1)]) +(fromList [("C",3),("A",1)],fromList [("B",2)]) +-} +partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a) +partition predicate (Map m ks) = (Map mpass kpass, Map mfail kfail) + where + (mpass, mfail) = Data.Map.Strict.partition predicate m + + (kpass, kfail) = partitionKeys (\k -> Data.Map.Strict.member k mpass) ks +{-# INLINABLE partition #-} + +{-| Restrict a 'Map' to only those keys found in a @"Data.Set".'Data.Set.Set'@. + +>>> restrictKeys (fromList [("A",1),("B",2)]) (Data.Set.fromList ["A"]) +fromList [("A",1)] +-} +restrictKeys :: Ord k => Map k a -> Data.Set.Set k -> Map k a +restrictKeys (Map m ks) s = Map m' ks' + where + m' = Data.Map.Strict.restrictKeys m s + + ks' = filterKeys (\k -> Data.Set.member k s) ks +{-# INLINABLE restrictKeys #-} + +{-| Remove all keys in a @"Data.Set".'Data.Set.Set'@ from a 'Map' + +>>> withoutKeys (fromList [("A",1),("B",2)]) (Data.Set.fromList ["A"]) +fromList [("B",2)] +-} +withoutKeys :: Ord k => Map k a -> Data.Set.Set k -> Map k a +withoutKeys (Map m ks) s = Map m' ks' + where + m' = Data.Map.Strict.withoutKeys m s + + ks' = filterKeys (\k -> Data.Set.notMember k s) ks +{-# INLINABLE withoutKeys #-} + +{-| Transform all values in a `Map` using the supplied function, deleting the + key if the function returns `Nothing` + +>>> mapMaybe Data.Maybe.listToMaybe (fromList [("C",[1]),("B",[]),("A",[3])]) +fromList [("C",1),("A",3)] +-} +mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b +mapMaybe f (Map m ks) = Map m' ks' + where + m' = Data.Map.Strict.mapMaybe f m + + ks' = filterKeys (\k -> Data.Map.Strict.member k m') ks +{-# INLINABLE mapMaybe #-} + +{-| Retrieve a key from a `Map` + +> lookup k mempty = empty +> +> lookup k (x <> y) = lookup k y <|> lookup k x + +>>> lookup "A" (fromList [("B",1),("A",2)]) +Just 2 +>>> lookup "C" (fromList [("B",1),("A",2)]) +Nothing +-} +lookup :: Ord k => k -> Map k v -> Maybe v +lookup k (Map m _) = Data.Map.Strict.lookup k m +{-# INLINABLE lookup #-} + +{-| Retrieve the first key, value of the 'Map', if present, + and also returning the rest of the 'Map'. + +> uncons mempty = empty +> +> uncons (singleton k v) = (k, v, mempty) + +>>> uncons (fromList [("C",1),("B",2),("A",3)]) +Just ("C",1,fromList [("B",2),("A",3)]) +>>> uncons (fromList []) +Nothing +-} +uncons :: Ord k => Map k v -> Maybe (k, v, Map k v) +uncons (Map _ (Original [])) = Nothing +uncons (Map m (Original (k:ks))) = + Just (k, m Data.Map.Strict.! k, Map (Data.Map.Strict.delete k m) (Original ks)) +uncons (Map m Sorted) + | Just ((k, v), m') <- Data.Map.Strict.minViewWithKey m = Just (k, v, Map m' Sorted) + | otherwise = Nothing +{-# INLINABLE uncons #-} + +{-| Check if a key belongs to a `Map` + +> member k mempty = False +> +> member k (x <> y) = member k x || member k y + +>>> member "A" (fromList [("B",1),("A",2)]) +True +>>> member "C" (fromList [("B",1),("A",2)]) +False +-} +member :: Ord k => k -> Map k v -> Bool +member k (Map m _) = Data.Map.Strict.member k m +{-# INLINABLE member #-} + +{-| +>>> size (fromList [("A",1)]) +1 +-} +size :: Map k v -> Int +size (Map m _) = Data.Map.Strict.size m +{-# INLINABLE size #-} + +{-| Combine two `Map`s, preferring keys from the first `Map` + +> union = unionWith (\v _ -> v) + +>>> union (fromList [("D",1),("C",2)]) (fromList [("B",3),("A",4)]) +fromList [("D",1),("C",2),("B",3),("A",4)] +>>> union (fromList [("D",1),("C",2)]) (fromList [("C",3),("A",4)]) +fromList [("D",1),("C",2),("A",4)] +-} +union :: Ord k => Map k v -> Map k v -> Map k v +union (Map mL ksL) (Map mR ksR) = Map m ks + where + m = Data.Map.Strict.union mL mR + + ks = case (ksL, ksR) of + (Original l, Original r) -> Original $ + l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k mL) r + _ -> Sorted +{-# INLINABLE union #-} + +{-| Combine two `Map`s using a combining function for colliding keys + +>>> unionWith (+) (fromList [("D",1),("C",2)]) (fromList [("B",3),("A",4)]) +fromList [("D",1),("C",2),("B",3),("A",4)] +>>> unionWith (+) (fromList [("D",1),("C",2)]) (fromList [("C",3),("A",4)]) +fromList [("D",1),("C",5),("A",4)] +-} +unionWith :: Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v +unionWith combine (Map mL ksL) (Map mR ksR) = Map m ks + where + m = Data.Map.Strict.unionWith combine mL mR + + ks = case (ksL, ksR) of + (Original l, Original r) -> Original $ + l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k mL) r + _ -> Sorted +{-# INLINABLE unionWith #-} + +{-| A generalised 'unionWith'. + +>>> outerJoin Left Left (\k a b -> Right (k, a, b)) (fromList [("A",1),("B",2)]) (singleton "A" 3) +fromList [("A",Right ("A",1,3)),("B",Left 2)] + +This function is much inspired by the "Data.Semialign.Semialign" class. +-} +outerJoin + :: Ord k + => (a -> c) + -> (b -> c) + -> (k -> a -> b -> c) + -> Map k a + -> Map k b + -> Map k c +outerJoin fa fb fab (Map ma ksA) (Map mb ksB) = Map m ks + where + m = Data.Map.Strict.mergeWithKey + (\k a b -> Just (fab k a b)) + (fmap fa) + (fmap fb) + ma + mb + + ks = case (ksA, ksB) of + (Original l, Original r) -> Original $ + l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k ma) r + _ -> Sorted +{-# INLINABLE outerJoin #-} + +{-| Combine two `Map` on their shared keys, keeping the value from the first + `Map` + +> intersection = intersectionWith (\v _ -> v) + +>>> intersection (fromList [("C",1),("B",2)]) (fromList [("B",3),("A",4)]) +fromList [("B",2)] +-} +intersection :: Ord k => Map k a -> Map k b -> Map k a +intersection (Map mL ksL) (Map mR _) = Map m ks + where + m = Data.Map.Strict.intersection mL mR + + -- Or forget order unless both maps are ordered?! + ks = filterKeys (\k -> Data.Map.Strict.member k m) ksL +{-# INLINABLE intersection #-} + +{-| Combine two `Map`s on their shared keys, using the supplied function to + combine values from the first and second `Map` + +>>> intersectionWith (+) (fromList [("C",1),("B",2)]) (fromList [("B",3),("A",4)]) +fromList [("B",5)] +-} +intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c +intersectionWith combine (Map mL ksL) (Map mR _) = Map m ks + where + m = Data.Map.Strict.intersectionWith combine mL mR + + -- Or forget order unless both maps are ordered?! + ks = filterKeys (\k -> Data.Map.Strict.member k m) ksL +{-# INLINABLE intersectionWith #-} + +{-| Compute the difference of two `Map`s by subtracting all keys from the + second `Map` from the first `Map` + +>>> difference (fromList [("C",1),("B",2)]) (fromList [("B",3),("A",4)]) +fromList [("C",1)] +-} +difference :: Ord k => Map k a -> Map k b -> Map k a +difference (Map mL ksL) (Map mR _) = Map m ks + where + m = Data.Map.Strict.difference mL mR + + ks = filterKeys (\k -> Data.Map.Strict.notMember k mR) ksL +{-# INLINABLE difference #-} + +{-| Fold all of the key-value pairs in a `Map`, in their original order + +>>> foldMapWithKey (,) (fromList [("B",[1]),("A",[2])]) +("BA",[1,2]) +-} +foldMapWithKey :: (Monoid m, Ord k) => (k -> a -> m) -> Map k a -> m +foldMapWithKey f (Map m Sorted) = Data.Map.Strict.foldMapWithKey f m +foldMapWithKey f m = foldMap (uncurry f) (toList m) +{-# INLINABLE foldMapWithKey #-} + +{-| Transform the values of a `Map` using their corresponding key + +> mapWithKey (pure id) = id +> +> mapWithKey (liftA2 (.) f g) = mapWithKey f . mapWithKey g + +> mapWithKey f mempty = mempty +> +> mapWithKey f (x <> y) = mapWithKey f x <> mapWithKey f y + +>>> mapWithKey (,) (fromList [("B",1),("A",2)]) +fromList [("B",("B",1)),("A",("A",2))] +-} +mapWithKey :: (k -> a -> b) -> Map k a -> Map k b +mapWithKey f (Map m ks) = Map m' ks + where + m' = Data.Map.Strict.mapWithKey f m +{-# INLINABLE mapWithKey #-} + +{-| Traverse all of the key-value pairs in a `Map`, in their original order + +>>> traverseWithKey (,) (fromList [("B",1),("A",2)]) +("BA",fromList [("B",1),("A",2)]) +-} +traverseWithKey + :: Ord k => Applicative f => (k -> a -> f b) -> Map k a -> f (Map k b) +traverseWithKey f (Map m Sorted) = + fmap (\m' -> Map m' Sorted) (Data.Map.Strict.traverseWithKey f m) +traverseWithKey f m@(Map _ ks) = + flip Map ks . Data.Map.Strict.fromList <$> traverse f' (toList m) + where + f' (k, a) = fmap ((,) k) (f k a) +{-# INLINABLE traverseWithKey #-} + +{-| Same as `traverseWithKey`, except that the order of effects is not + necessarily the same as the order of the keys +-} +unorderedTraverseWithKey + :: Ord k => Applicative f => (k -> a -> f b) -> Map k a -> f (Map k b) +unorderedTraverseWithKey f (Map m ks) = + fmap (\m' -> Map m' ks) (Data.Map.Strict.traverseWithKey f m) +{-# INLINABLE unorderedTraverseWithKey #-} + +{-| Traverse all of the key-value pairs in a 'Map', not preserving their + original order, where the result of the computation can be forgotten. + + Note that this is a strict traversal, fully traversing the map even + when the Applicative is lazy in the remaining elements. +-} +unorderedTraverseWithKey_ + :: Ord k => Applicative f => (k -> a -> f ()) -> Map k a -> f () +unorderedTraverseWithKey_ f (Map m _) = + Data.Map.Strict.foldlWithKey' (\acc k v -> acc *> f k v) (pure ()) m +{-# INLINABLE unorderedTraverseWithKey_ #-} + +{-| Convert a `Map` to a list of key-value pairs in the original order of keys + +>>> toList (fromList [("B",1),("A",2)]) +[("B",1),("A",2)] +-} +toList :: Ord k => Map k v -> [(k, v)] +toList (Map m Sorted) = Data.Map.Strict.toList m +toList (Map m (Original ks)) = fmap (\k -> (k, m Data.Map.Strict.! k)) ks +{-# INLINABLE toList #-} + +{-| Convert a `Map` to a list of key-value pairs in ascending order of keys +-} +toAscList :: Map k v -> [(k, v)] +toAscList (Map m _) = Data.Map.Strict.toAscList m +{-# INLINABLE toAscList #-} + +{-| Convert a @"Dhall.Map".`Map`@ to a @"Data.Map.Strict".`Data.Map.Strict.Map`@ + +>>> toMap (fromList [("B",1),("A",2)]) -- Order is lost upon conversion +fromList [("A",2),("B",1)] +-} +toMap :: Map k v -> Data.Map.Strict.Map k v +toMap (Map m _) = m +{-# INLINABLE toMap #-} + +{-| Return the keys from a `Map` in their original order + +>>> keys (fromList [("B",1),("A",2)]) +["B","A"] +-} +keys :: Map k v -> [k] +keys (Map m Sorted) = Data.Map.Strict.keys m +keys (Map _ (Original ks)) = ks +{-# INLINABLE keys #-} + +{-| Return the values from a `Map` in their original order. + +>>> elems (fromList [("B",1),("A",2)]) +[1,2] +-} +elems :: Ord k => Map k v -> [v] +elems (Map m Sorted) = Data.Map.Strict.elems m +elems (Map m (Original ks)) = fmap (\k -> m Data.Map.Strict.! k) ks +{-# INLINABLE elems #-} + +{-| Return the @"Data.Set".'Data.Set.Set'@ of the keys + +>>> keysSet (fromList [("B",1),("A",2)]) +fromList ["A","B"] +-} +keysSet :: Map k v -> Data.Set.Set k +keysSet (Map m _) = Data.Map.Strict.keysSet m +{-# INLINABLE keysSet #-} + +filterKeys :: (a -> Bool) -> Keys a -> Keys a +filterKeys _ Sorted = Sorted +filterKeys f (Original ks) = Original (Prelude.filter f ks) +{-# INLINABLE filterKeys #-} + +partitionKeys :: (a -> Bool) -> Keys a -> (Keys a, Keys a) +partitionKeys _ Sorted = (Sorted, Sorted) +partitionKeys f (Original ks) = + let (kpass, kfail) = Data.List.partition f ks + in (Original kpass, Original kfail) +{-# INLINABLE partitionKeys #-} + +{- $setup +>>> import Test.QuickCheck (Arbitrary(..), oneof) +>>> :{ + instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where + arbitrary = oneof [fromList <$> arbitrary, unorderedFromList <$> arbitrary] +:} +-} diff --git a/src/Dhall/Marshal/Decode.hs b/src/Dhall/Marshal/Decode.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Marshal/Decode.hs @@ -0,0 +1,1712 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} + +{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining + how to use the language, the compiler, and this library +-} + +module Dhall.Marshal.Decode + ( -- * General + Decoder (..) + , FromDhall(..) + , Interpret + , auto + + -- * Building decoders + -- ** Simple decoders + , bool + , unit + , void + -- ** Numbers + , natural + , word + , word8 + , word16 + , word32 + , word64 + , integer + , int + , int8 + , int16 + , int32 + , int64 + , scientific + , double + -- ** Bytes + , lazyBytes + , strictBytes + , shortBytes + -- ** Textual + , string + , lazyText + , strictText + , shortText + -- ** Time + , timeOfDay + , day + , timeZone + , localTime + , zonedTime + , utcTime + , dayOfWeek + -- ** Containers + , maybe + , pair + , sequence + , list + , vector + , setFromDistinctList + , setIgnoringDuplicates + , hashSetFromDistinctList + , hashSetIgnoringDuplicates + , Dhall.Marshal.Decode.map + , hashMap + , pairFromMapEntry + -- ** Functions + , function + , functionWith + -- ** Records + , RecordDecoder(..) + , record + , field + -- ** Unions + , UnionDecoder(..) + , union + , constructor + + -- * Generic decoding + , GenericFromDhall(..) + , GenericFromDhallUnion(..) + , genericAuto + , genericAutoWith + , genericAutoWithInputNormalizer + + -- * Decoding errors + , DhallErrors(..) + , showDhallErrors + , InvalidDecoder(..) + -- ** Extraction errors + , ExtractErrors + , ExtractError(..) + , Extractor + , typeError + , extractError + , MonadicExtractor + , toMonadic + , fromMonadic + -- ** Typing errors + , ExpectedTypeErrors + , ExpectedTypeError(..) + , Expector + + -- * Miscellaneous + , InputNormalizer(..) + , defaultInputNormalizer + , InterpretOptions(..) + , SingletonConstructors(..) + , defaultInterpretOptions + , Result + + -- * Re-exports + , Natural + , Seq + , Text + , Vector + , Generic + ) where + + +import Control.Applicative (empty, liftA2) +import Control.Exception (Exception) +import Control.Monad (guard) +import Control.Monad.Trans.State.Strict +import Data.Coerce (coerce) +import Data.Either.Validation + ( Validation (..) + , eitherToValidation + , validationToEither + ) +import Data.Functor.Contravariant + ( Equivalence (..) + , Op (..) + , Predicate (..) + ) +import Data.Functor.Identity (Identity (..)) +import Data.Hashable (Hashable) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Typeable (Proxy (..), Typeable) +import Dhall.Parser (Src (..)) +import Dhall.Syntax + ( Chunks (..) + , DhallDouble (..) + , Expr (..) + , FieldSelection (..) + , FunctionBinding (..) + , Var (..) + ) +import GHC.Generics +import Prelude hiding (maybe, sequence) +import Prettyprinter (Pretty) + +import qualified Control.Applicative +import qualified Data.ByteString +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import qualified Data.Foldable +import qualified Data.Functor.Compose +import qualified Data.Functor.Product +import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashSet +import qualified Data.List as List +import qualified Data.List.NonEmpty +import qualified Data.Map +import qualified Data.Maybe +import qualified Data.Scientific +import qualified Data.Sequence +import qualified Data.Set +import qualified Data.Text +import qualified Data.Text.Lazy +import qualified Data.Text.Short +import qualified Data.Time as Time +import qualified Data.Vector +import qualified Dhall.Core as Core +import qualified Dhall.Map +import qualified Dhall.Util + +import Dhall.Marshal.Encode +import Dhall.Marshal.Internal + +-- $setup +-- >>> import Dhall (input) + +{-| A @(Decoder a)@ represents a way to marshal a value of type @\'a\'@ from Dhall + into Haskell. + + You can produce `Decoder`s either explicitly: + +> example :: Decoder (Vector Text) +> example = vector text + + ... or implicitly using `auto`: + +> example :: Decoder (Vector Text) +> example = auto + + You can consume `Decoder`s using the `Dhall.input` function: + +> input :: Decoder a -> Text -> IO a +-} +data Decoder a = Decoder + { extract :: Expr Src Void -> Extractor Src Void a + -- ^ Extracts Haskell value from the Dhall expression + , expected :: Expector (Expr Src Void) + -- ^ Dhall type of the Haskell value + } + deriving (Functor) + +{-| Any value that implements `FromDhall` can be automatically decoded based on + the inferred return type of `Dhall.input`. + +>>> input auto "[1, 2, 3]" :: IO (Vector Natural) +[1,2,3] +>>> input auto "toMap { a = False, b = True }" :: IO (Map Text Bool) +fromList [("a",False),("b",True)] + + This class auto-generates a default implementation for types that + implement `Generic`. This does not auto-generate an instance for recursive + types. + + The default instance can be tweaked using 'genericAutoWith'/'genericAutoWithInputNormalizer' + and custom 'InterpretOptions', or using + [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) + and 'Dhall.Deriving.Codec' from "Dhall.Deriving". +-} +class FromDhall a where + autoWith :: InputNormalizer -> Decoder a + default autoWith + :: (Generic a, GenericFromDhall a (Rep a)) => InputNormalizer -> Decoder a + autoWith _ = genericAuto + +-- | A compatibility alias for `FromDhall`. +type Interpret = FromDhall +{-# DEPRECATED Interpret "Use FromDhall instead" #-} + +{-| Use the default input normalizer for interpreting an input. + +> auto = autoWith defaultInputNormalizer +-} +auto :: FromDhall a => Decoder a +auto = autoWith defaultInputNormalizer + + + +instance FromDhall Void where + autoWith _ = void + +instance FromDhall () where + autoWith _ = unit + +instance FromDhall Bool where + autoWith _ = bool + +instance FromDhall Natural where + autoWith _ = natural + +instance FromDhall Word where + autoWith _ = word + +instance FromDhall Word8 where + autoWith _ = word8 + +instance FromDhall Word16 where + autoWith _ = word16 + +instance FromDhall Word32 where + autoWith _ = word32 + +instance FromDhall Word64 where + autoWith _ = word64 + +instance FromDhall Integer where + autoWith _ = integer + +instance FromDhall Int where + autoWith _ = int + +instance FromDhall Int8 where + autoWith _ = int8 + +instance FromDhall Int16 where + autoWith _ = int16 + +instance FromDhall Int32 where + autoWith _ = int32 + +instance FromDhall Int64 where + autoWith _ = int64 + +instance FromDhall Scientific where + autoWith _ = scientific + +instance FromDhall Double where + autoWith _ = double + +instance FromDhall Data.ByteString.Short.ShortByteString where + autoWith _ = shortBytes + +instance FromDhall Data.ByteString.Lazy.ByteString where + autoWith _ = lazyBytes + +instance FromDhall Data.ByteString.ByteString where + autoWith _ = strictBytes + +instance {-# OVERLAPS #-} FromDhall [Char] where + autoWith _ = string + +instance FromDhall Data.Text.Short.ShortText where + autoWith _ = shortText + +instance FromDhall Data.Text.Lazy.Text where + autoWith _ = lazyText + +instance FromDhall Text where + autoWith _ = strictText + +instance FromDhall a => FromDhall (Identity a) where + autoWith opts = Identity <$> autoWith opts + +instance FromDhall a => FromDhall (Maybe a) where + autoWith opts = maybe (autoWith opts) + +instance FromDhall a => FromDhall (Seq a) where + autoWith opts = sequence (autoWith opts) + +instance FromDhall a => FromDhall [a] where + autoWith opts = list (autoWith opts) + +instance FromDhall a => FromDhall (Vector a) where + autoWith opts = vector (autoWith opts) + +instance FromDhall Time.TimeOfDay where + autoWith _ = timeOfDay + +instance FromDhall Time.Day where + autoWith _ = day + +instance FromDhall Time.TimeZone where + autoWith _ = timeZone + +instance FromDhall Time.LocalTime where + autoWith _ = localTime + +instance FromDhall Time.ZonedTime where + autoWith _ = zonedTime + +instance FromDhall Time.UTCTime where + autoWith _ = utcTime + +instance FromDhall Time.DayOfWeek where + autoWith _ = dayOfWeek + +{-| Note that this instance will throw errors in the presence of duplicates in + the list. To ignore duplicates, use `setIgnoringDuplicates`. +-} +instance (FromDhall a, Ord a, Show a) => FromDhall (Data.Set.Set a) where + autoWith opts = setFromDistinctList (autoWith opts) + +{-| Note that this instance will throw errors in the presence of duplicates in + the list. To ignore duplicates, use `hashSetIgnoringDuplicates`. +-} +instance (FromDhall a, Hashable a, Ord a, Show a) => FromDhall (Data.HashSet.HashSet a) where + autoWith inputNormalizer = hashSetFromDistinctList (autoWith inputNormalizer) + +instance (Ord k, FromDhall k, FromDhall v) => FromDhall (Map k v) where + autoWith inputNormalizer = Dhall.Marshal.Decode.map (autoWith inputNormalizer) (autoWith inputNormalizer) + +instance (Eq k, Hashable k, FromDhall k, FromDhall v) => FromDhall (HashMap k v) where + autoWith inputNormalizer = Dhall.Marshal.Decode.hashMap (autoWith inputNormalizer) (autoWith inputNormalizer) + +instance (ToDhall a, FromDhall b) => FromDhall (a -> b) where + autoWith inputNormalizer = + functionWith inputNormalizer (injectWith inputNormalizer) (autoWith inputNormalizer) + +instance (FromDhall a, FromDhall b) => FromDhall (a, b) + +instance FromDhall (f (Result f)) => FromDhall (Result f) where + autoWith inputNormalizer = Decoder {..} + where + extract (App _ expr) = + fmap Result (Dhall.Marshal.Decode.extract (autoWith inputNormalizer) expr) + extract expr = typeError expected expr + + expected = pure "result" + +deriving newtype instance (ToDhall x) => FromDhall (Predicate x) + +deriving newtype instance (ToDhall x) => FromDhall (Equivalence x) + +deriving newtype instance (FromDhall b, ToDhall x) => FromDhall (Op b x) + +-- | You can use this instance to marshal recursive types from Dhall to Haskell. +-- +-- Here is an example use of this instance: +-- +-- > {-# LANGUAGE DeriveAnyClass #-} +-- > {-# LANGUAGE DeriveFoldable #-} +-- > {-# LANGUAGE DeriveFunctor #-} +-- > {-# LANGUAGE DeriveTraversable #-} +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE KindSignatures #-} +-- > {-# LANGUAGE QuasiQuotes #-} +-- > {-# LANGUAGE StandaloneDeriving #-} +-- > {-# LANGUAGE TypeFamilies #-} +-- > {-# LANGUAGE TemplateHaskell #-} +-- > +-- > import Data.Fix (Fix(..)) +-- > import Data.Text (Text) +-- > import Dhall (FromDhall) +-- > import GHC.Generics (Generic) +-- > import Numeric.Natural (Natural) +-- > +-- > import qualified Data.Fix as Fix +-- > import qualified Data.Functor.Foldable as Foldable +-- > import qualified Data.Functor.Foldable.TH as TH +-- > import qualified Dhall +-- > import qualified NeatInterpolation +-- > +-- > data Expr +-- > = Lit Natural +-- > | Add Expr Expr +-- > | Mul Expr Expr +-- > deriving (Show) +-- > +-- > TH.makeBaseFunctor ''Expr +-- > +-- > deriving instance Generic (ExprF a) +-- > deriving instance FromDhall a => FromDhall (ExprF a) +-- > +-- > example :: Text +-- > example = [NeatInterpolation.text| +-- > \(Expr : Type) +-- > -> let ExprF = +-- > < LitF : +-- > Natural +-- > | AddF : +-- > { _1 : Expr, _2 : Expr } +-- > | MulF : +-- > { _1 : Expr, _2 : Expr } +-- > > +-- > +-- > in \(Fix : ExprF -> Expr) +-- > -> let Lit = \(x : Natural) -> Fix (ExprF.LitF x) +-- > +-- > let Add = +-- > \(x : Expr) +-- > -> \(y : Expr) +-- > -> Fix (ExprF.AddF { _1 = x, _2 = y }) +-- > +-- > let Mul = +-- > \(x : Expr) +-- > -> \(y : Expr) +-- > -> Fix (ExprF.MulF { _1 = x, _2 = y }) +-- > +-- > in Add (Mul (Lit 3) (Lit 7)) (Add (Lit 1) (Lit 2)) +-- > |] +-- > +-- > convert :: Fix ExprF -> Expr +-- > convert = Fix.foldFix Foldable.embed +-- > +-- > main :: IO () +-- > main = do +-- > x <- Dhall.input Dhall.auto example :: IO (Fix ExprF) +-- > +-- > print (convert x :: Expr) +instance (Functor f, FromDhall (f (Result f))) => FromDhall (Fix f) where + autoWith inputNormalizer = Decoder {..} + where + extract expr0 = extract0 expr0 + where + die = typeError expected expr0 + + extract0 (Lam _ (FunctionBinding { functionBindingVariable = x }) expr) = + extract1 (rename x "result" expr) + extract0 _ = die + + extract1 (Lam _ (FunctionBinding { functionBindingVariable = y }) expr) = + extract2 (rename y "Make" expr) + extract1 _ = die + + extract2 expr = fmap resultToFix (Dhall.Marshal.Decode.extract (autoWith inputNormalizer) expr) + + rename a b expr + | a /= b = Core.subst (V a 0) (Var (V b 0)) (Core.shift 1 (V b 0) expr) + | otherwise = expr + + expected = (\x -> Pi mempty "result" (Const Core.Type) (Pi mempty "Make" (Pi mempty "_" x "result") "result")) + <$> Dhall.Marshal.Decode.expected (autoWith inputNormalizer :: Decoder (f (Result f))) + +resultToFix :: Functor f => Result f -> Fix f +resultToFix (Result x) = Fix (fmap resultToFix x) + + + +{-| This is the underlying class that powers the `FromDhall` class's support + for automatically deriving a generic implementation. +-} +class GenericFromDhall t f where + genericAutoWithNormalizer :: Proxy t -> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a)) + +instance GenericFromDhall t f => GenericFromDhall t (M1 D d f) where + genericAutoWithNormalizer p inputNormalizer options = do + res <- genericAutoWithNormalizer p inputNormalizer options + pure (fmap M1 res) + +instance GenericFromDhall t V1 where + genericAutoWithNormalizer _ _ _ = pure Decoder {..} + where + extract expr = typeError expected expr + + expected = pure $ Union mempty + +instance GenericFromDhallUnion t (f :+: g) => GenericFromDhall t (f :+: g) where + genericAutoWithNormalizer p inputNormalizer options = + pure (union (genericUnionAutoWithNormalizer p inputNormalizer options)) + +instance GenericFromDhall t f => GenericFromDhall t (M1 C c f) where + genericAutoWithNormalizer p inputNormalizer options = do + res <- genericAutoWithNormalizer p inputNormalizer options + pure (fmap M1 res) + +instance GenericFromDhall t U1 where + genericAutoWithNormalizer _ _ _ = pure (Decoder {..}) + where + extract _ = pure U1 + + expected = pure expected' + + expected' = Record (Dhall.Map.fromList []) + +instance (GenericFromDhall t (f :*: g), GenericFromDhall t (h :*: i)) => GenericFromDhall t ((f :*: g) :*: (h :*: i)) where + genericAutoWithNormalizer p inputNormalizer options = do + Decoder extractL expectedL <- genericAutoWithNormalizer p inputNormalizer options + Decoder extractR expectedR <- genericAutoWithNormalizer p inputNormalizer options + + let ktsL = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" <$> expectedL + let ktsR = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" <$> expectedR + + let expected = Record <$> (Dhall.Map.union <$> ktsL <*> ktsR) + + let extract expression = + liftA2 (:*:) (extractL expression) (extractR expression) + + return (Decoder {..}) + +instance (GenericFromDhall t (f :*: g), Selector s, FromDhall a) => GenericFromDhall t ((f :*: g) :*: M1 S s (K1 i a)) where + genericAutoWithNormalizer p inputNormalizer options@InterpretOptions{..} = do + let nR :: M1 S s (K1 i a) r + nR = undefined + + nameR <- fmap fieldModifier (getSelName nR) + + Decoder extractL expectedL <- genericAutoWithNormalizer p inputNormalizer options + + let Decoder extractR expectedR = autoWith inputNormalizer + + let ktsL = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" <$> expectedL + + let expected = Record <$> (Dhall.Map.insert nameR . Core.makeRecordField <$> expectedR <*> ktsL) + + let extract expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> + case Core.recordFieldValue <$> Dhall.Map.lookup nameR kvs of + Just expressionR -> + liftA2 (:*:) + (extractL expression) + (fmap (M1 . K1) (extractR expressionR)) + _ -> die + _ -> die + + return (Decoder {..}) + +instance (Selector s, FromDhall a, GenericFromDhall t (f :*: g)) => GenericFromDhall t (M1 S s (K1 i a) :*: (f :*: g)) where + genericAutoWithNormalizer p inputNormalizer options@InterpretOptions{..} = do + let nL :: M1 S s (K1 i a) r + nL = undefined + + nameL <- fmap fieldModifier (getSelName nL) + + let Decoder extractL expectedL = autoWith inputNormalizer + + Decoder extractR expectedR <- genericAutoWithNormalizer p inputNormalizer options + + let ktsR = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" <$> expectedR + + let expected = Record <$> (Dhall.Map.insert nameL . Core.makeRecordField <$> expectedL <*> ktsR) + + let extract expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> + case Core.recordFieldValue <$> Dhall.Map.lookup nameL kvs of + Just expressionL -> + liftA2 (:*:) + (fmap (M1 . K1) (extractL expressionL)) + (extractR expression) + _ -> die + _ -> die + + return (Decoder {..}) + +instance {-# OVERLAPPING #-} GenericFromDhall a1 (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where + genericAutoWithNormalizer _ _ _ = pure $ Decoder + { extract = \_ -> Failure $ DhallErrors $ pure $ ExpectedTypeError RecursiveTypeError + , expected = Failure $ DhallErrors $ pure RecursiveTypeError + } + +instance {-# OVERLAPPING #-} GenericFromDhall a2 (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where + genericAutoWithNormalizer _ _ _ = pure $ Decoder + { extract = \_ -> Failure $ DhallErrors $ pure $ ExpectedTypeError RecursiveTypeError + , expected = Failure $ DhallErrors $ pure RecursiveTypeError + } + +instance {-# OVERLAPPABLE #-} (Selector s1, Selector s2, FromDhall a1, FromDhall a2) => GenericFromDhall t (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where + genericAutoWithNormalizer _ inputNormalizer InterpretOptions{..} = do + let nL :: M1 S s1 (K1 i1 a1) r + nL = undefined + + let nR :: M1 S s2 (K1 i2 a2) r + nR = undefined + + nameL <- fmap fieldModifier (getSelName nL) + nameR <- fmap fieldModifier (getSelName nR) + + let Decoder extractL expectedL = autoWith inputNormalizer + let Decoder extractR expectedR = autoWith inputNormalizer + + let expected = do + l <- Core.makeRecordField <$> expectedL + r <- Core.makeRecordField <$> expectedR + pure $ Record + (Dhall.Map.fromList + [ (nameL, l) + , (nameR, r) + ] + ) + + let extract expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> + case liftA2 (,) (Dhall.Map.lookup nameL kvs) (Dhall.Map.lookup nameR kvs) of + Just (expressionL, expressionR) -> + liftA2 (:*:) + (fmap (M1 . K1) (extractL $ Core.recordFieldValue expressionL)) + (fmap (M1 . K1) (extractR $ Core.recordFieldValue expressionR)) + Nothing -> die + _ -> die + + return (Decoder {..}) + +instance {-# OVERLAPPING #-} GenericFromDhall a (M1 S s (K1 i a)) where + genericAutoWithNormalizer _ _ _ = pure $ Decoder + { extract = \_ -> Failure $ DhallErrors $ pure $ ExpectedTypeError RecursiveTypeError + , expected = Failure $ DhallErrors $ pure RecursiveTypeError + } + +instance {-# OVERLAPPABLE #-} (Selector s, FromDhall a) => GenericFromDhall t (M1 S s (K1 i a)) where + genericAutoWithNormalizer _ inputNormalizer InterpretOptions{..} = do + let n :: M1 S s (K1 i a) r + n = undefined + + name <- fmap fieldModifier (getSelName n) + + let Decoder { extract = extract', expected = expected'} = autoWith inputNormalizer + + let expected = + case singletonConstructors of + Bare -> + expected' + Smart | selName n == "" -> + expected' + _ -> + Record . Dhall.Map.singleton name . Core.makeRecordField <$> expected' + + let extract0 expression = fmap (M1 . K1) (extract' expression) + + let extract1 expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> + case Core.recordFieldValue <$> Dhall.Map.lookup name kvs of + Just subExpression -> + fmap (M1 . K1) (extract' subExpression) + Nothing -> + die + _ -> die + + let extract = + case singletonConstructors of + Bare -> extract0 + Smart | selName n == "" -> extract0 + _ -> extract1 + + return (Decoder {..}) + +{-| `genericAuto` is the default implementation for `auto` if you derive + `FromDhall`. The difference is that you can use `genericAuto` without + having to explicitly provide a `FromDhall` instance for a type as long as + the type derives `Generic`. +-} +genericAuto :: (Generic a, GenericFromDhall a (Rep a)) => Decoder a +genericAuto = genericAutoWith defaultInterpretOptions + +{-| `genericAutoWith` is a configurable version of `genericAuto`. +-} +genericAutoWith :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> Decoder a +genericAutoWith options = genericAutoWithInputNormalizer options defaultInputNormalizer + +{-| `genericAutoWithInputNormalizer` is like `genericAutoWith`, but instead of + using the `defaultInputNormalizer` it expects an custom `InputNormalizer`. +-} +genericAutoWithInputNormalizer :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> InputNormalizer -> Decoder a +genericAutoWithInputNormalizer options inputNormalizer = withProxy (\p -> fmap to (evalState (genericAutoWithNormalizer p inputNormalizer options) 1)) + where + withProxy :: (Proxy a -> Decoder a) -> Decoder a + withProxy f = f Proxy + +extractUnionConstructor + :: Expr s a -> Maybe (Text, Expr s a, Dhall.Map.Map Text (Maybe (Expr s a))) +extractUnionConstructor (App (Field (Union kts) (Core.fieldSelectionLabel -> fld)) e) = + return (fld, e, Dhall.Map.delete fld kts) +extractUnionConstructor (Field (Union kts) (Core.fieldSelectionLabel -> fld)) = + return (fld, RecordLit mempty, Dhall.Map.delete fld kts) +extractUnionConstructor _ = + empty + +{-| This is the underlying class that powers the `FromDhall` class's support + for automatically deriving a generic implementation for a union type. +-} +class GenericFromDhallUnion t f where + genericUnionAutoWithNormalizer :: Proxy t -> InputNormalizer -> InterpretOptions -> UnionDecoder (f a) + +instance (GenericFromDhallUnion t f1, GenericFromDhallUnion t f2) => GenericFromDhallUnion t (f1 :+: f2) where + genericUnionAutoWithNormalizer p inputNormalizer options = + (<>) + (L1 <$> genericUnionAutoWithNormalizer p inputNormalizer options) + (R1 <$> genericUnionAutoWithNormalizer p inputNormalizer options) + +instance (Constructor c1, GenericFromDhall t f1) => GenericFromDhallUnion t (M1 C c1 f1) where + genericUnionAutoWithNormalizer p inputNormalizer options@(InterpretOptions {..}) = + constructor name (evalState (genericAutoWithNormalizer p inputNormalizer options) 1) + where + n :: M1 C c1 f1 a + n = undefined + + name = constructorModifier (Data.Text.pack (conName n)) + + + +{-| Decode a `Prelude.Bool`. + +>>> input bool "True" +True +-} +bool :: Decoder Bool +bool = Decoder {..} + where + extract (BoolLit b) = pure b + extract expr = typeError expected expr + + expected = pure Bool + +{-| Decode a `Prelude.Natural`. + +>>> input natural "42" +42 +-} +natural :: Decoder Natural +natural = Decoder {..} + where + extract (NaturalLit n) = pure n + extract expr = typeError expected expr + + expected = pure Natural + +{-| Decode an `Prelude.Integer`. + +>>> input integer "+42" +42 +-} +integer :: Decoder Integer +integer = Decoder {..} + where + extract (IntegerLit n) = pure n + extract expr = typeError expected expr + + expected = pure Integer + +wordHelper :: forall a . (Bounded a, Integral a) => Text -> Decoder a +wordHelper name = Decoder {..} + where + extract (NaturalLit n) + | toInteger n <= toInteger (maxBound @a) = + pure (fromIntegral n) + | otherwise = + extractError ("Decoded " <> name <> " is out of bounds: " <> Data.Text.pack (show n)) + extract expr = + typeError expected expr + + expected = pure Natural + +{-| Decode a `Word` from a Dhall @Natural@. + +>>> input word "42" +42 +-} +word :: Decoder Word +word = wordHelper "Word" + +{-| Decode a `Word8` from a Dhall @Natural@. + +>>> input word8 "42" +42 +-} +word8 :: Decoder Word8 +word8 = wordHelper "Word8" + +{-| Decode a `Word16` from a Dhall @Natural@. + +>>> input word16 "42" +42 +-} +word16 :: Decoder Word16 +word16 = wordHelper "Word16" + +{-| Decode a `Word32` from a Dhall @Natural@. + +>>> input word32 "42" +42 +-} +word32 :: Decoder Word32 +word32 = wordHelper "Word32" + +{-| Decode a `Word64` from a Dhall @Natural@. + +>>> input word64 "42" +42 +-} +word64 :: Decoder Word64 +word64 = wordHelper "Word64" + +intHelper :: forall a . (Bounded a, Integral a) => Text -> Decoder a +intHelper name = Decoder {..} + where + extract (IntegerLit n) + | toInteger (minBound @a) <= n && n <= toInteger (maxBound @a) = + pure (fromIntegral n) + | otherwise = + extractError ("Decoded " <> name <> " is out of bounds: " <> Data.Text.pack (show n)) + extract expr = + typeError expected expr + + expected = pure Integer + +{-| Decode an `Int` from a Dhall @Integer@. + +>>> input int "-42" +-42 +-} +int :: Decoder Int +int = intHelper "Int" + +{-| Decode an `Int8` from a Dhall @Integer@. + +>>> input int8 "-42" +-42 +-} +int8 :: Decoder Int8 +int8 = intHelper "Int8" + +{-| Decode an `Int16` from a Dhall @Integer@. + +>>> input int16 "-42" +-42 +-} +int16 :: Decoder Int16 +int16 = intHelper "Int16" + +{-| Decode an `Int32` from a Dhall @Integer@. + +>>> input int32 "-42" +-42 +-} +int32 :: Decoder Int32 +int32 = intHelper "Int32" + +{-| Decode an `Int64` from a Dhall @Integer@. + +>>> input int64 "-42" +-42 +-} +int64 :: Decoder Int64 +int64 = intHelper "Int64" + +{-| Decode a `Scientific`. + +>>> input scientific "1e100" +1.0e100 +-} +scientific :: Decoder Scientific +scientific = fmap Data.Scientific.fromFloatDigits double + +{-| Decode a `Prelude.Double`. + +>>> input double "42.0" +42.0 +-} +double :: Decoder Double +double = Decoder {..} + where + extract (DoubleLit (DhallDouble n)) = pure n + extract expr = typeError expected expr + + expected = pure Double + +{-| Decode a `Data.ByteString.Short.ShortByteString` + +>>> input shortBytes "0x\"00FF\"" +"\NUL\255" +-} +shortBytes :: Decoder Data.ByteString.Short.ShortByteString +shortBytes = fmap Data.ByteString.Short.toShort strictBytes + +{-| Decode a lazy `Data.ByteString.Lazy.ByteString`. + +>>> input lazyBytes "0x\"00FF\"" +"\NUL\255" +-} +lazyBytes :: Decoder Data.ByteString.Lazy.ByteString +lazyBytes = fmap Data.ByteString.Lazy.fromStrict strictBytes + +{-| Decode a strict `Data.ByteString.ByteString` + +>>> input strictBytes "0x\"00FF\"" +"\NUL\255" +-} +strictBytes :: Decoder Data.ByteString.ByteString +strictBytes = Decoder {..} + where + extract (BytesLit b) = pure b + extract expr = typeError expected expr + + expected = pure Bytes + +{-| Decode `Data.Text.Short.ShortText`. + +>>> input shortText "\"Test\"" +"Test" +-} +shortText :: Decoder Data.Text.Short.ShortText +shortText = fmap Data.Text.Short.fromText strictText + +{-| Decode lazy `Data.Text.Lazy.Text`. + +>>> input lazyText "\"Test\"" +"Test" +-} +lazyText :: Decoder Data.Text.Lazy.Text +lazyText = fmap Data.Text.Lazy.fromStrict strictText + +{-| Decode strict `Data.Text.Text`. + +>>> input strictText "\"Test\"" +"Test" +-} +strictText :: Decoder Text +strictText = Decoder {..} + where + extract (TextLit (Chunks [] t)) = pure t + extract expr = typeError expected expr + + expected = pure Text + +{-| Decode `Time.TimeOfDay` + +>>> input timeOfDay "00:00:00" +00:00:00 +-} +timeOfDay :: Decoder Time.TimeOfDay +timeOfDay = Decoder {..} + where + extract (TimeLiteral t _) = pure t + extract expr = typeError expected expr + + expected = pure Time + +{-| Decode `Time.Day` + +>>> input day "2000-01-01" +2000-01-01 +-} +day :: Decoder Time.Day +day = Decoder {..} + where + extract (DateLiteral d) = pure d + extract expr = typeError expected expr + + expected = pure Date + +{-| Decode `Time.TimeZone` + +>>> input timeZone "+00:00" ++0000 +-} +timeZone :: Decoder Time.TimeZone +timeZone = Decoder {..} + where + extract (TimeZoneLiteral z) = pure z + extract expr = typeError expected expr + + expected = pure TimeZone + +{-| Decode `Time.LocalTime` + +>>> input localTime "2020-01-01T12:34:56" +2020-01-01 12:34:56 +-} +localTime :: Decoder Time.LocalTime +localTime = record $ + Time.LocalTime + <$> field "date" day + <*> field "time" timeOfDay + +{-| Decode `Time.ZonedTime` + +>>> input zonedTime "2020-01-01T12:34:56+02:00" +2020-01-01 12:34:56 +0200 +-} +zonedTime :: Decoder Time.ZonedTime +zonedTime = record $ + adapt + <$> field "date" day + <*> field "time" timeOfDay + <*> field "timeZone" timeZone + where + adapt date time = Time.ZonedTime (Time.LocalTime date time) + +{-| Decode `Time.UTCTime` + +>>> input utcTime "2020-01-01T12:34:56+02:00" +2020-01-01 10:34:56 UTC +-} +utcTime :: Decoder Time.UTCTime +utcTime = Time.zonedTimeToUTC <$> zonedTime + +{-| Decode `Time.DayOfWeek` + +>>> input dayOfWeek "< Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday >.Monday" +Monday +-} +dayOfWeek :: Decoder Time.DayOfWeek +dayOfWeek = Decoder{..} + where + extract expr@(Field _ FieldSelection{ fieldSelectionLabel }) = + case fieldSelectionLabel of + "Sunday" -> pure Time.Sunday + "Monday" -> pure Time.Monday + "Tuesday" -> pure Time.Tuesday + "Wednesday" -> pure Time.Wednesday + "Thursday" -> pure Time.Thursday + "Friday" -> pure Time.Friday + "Saturday" -> pure Time.Saturday + _ -> typeError expected expr + extract expr = + typeError expected expr + + expected = + pure + (Union + (Dhall.Map.fromList + [ ("Sunday", Nothing) + , ("Monday", Nothing) + , ("Tuesday", Nothing) + , ("Wednesday", Nothing) + , ("Thursday", Nothing) + , ("Friday", Nothing) + , ("Saturday", Nothing) + ] + ) + ) + +{-| Decode a `Maybe`. + +>>> input (maybe natural) "Some 1" +Just 1 +-} +maybe :: Decoder a -> Decoder (Maybe a) +maybe (Decoder extractIn expectedIn) = Decoder extractOut expectedOut + where + extractOut (Some e ) = fmap Just (extractIn e) + extractOut (App None _) = pure Nothing + extractOut expr = typeError expectedOut expr + + expectedOut = App Optional <$> expectedIn + +{-| Decode a `Seq`. + +>>> input (sequence natural) "[1, 2, 3]" +fromList [1,2,3] +-} +sequence :: Decoder a -> Decoder (Seq a) +sequence (Decoder extractIn expectedIn) = Decoder extractOut expectedOut + where + extractOut (ListLit _ es) = traverse extractIn es + extractOut expr = typeError expectedOut expr + + expectedOut = App List <$> expectedIn + +{-| Decode a list. + +>>> input (list natural) "[1, 2, 3]" +[1,2,3] +-} +list :: Decoder a -> Decoder [a] +list = fmap Data.Foldable.toList . sequence + +{-| Decode a `Vector`. + +>>> input (vector natural) "[1, 2, 3]" +[1,2,3] +-} +vector :: Decoder a -> Decoder (Vector a) +vector = fmap Data.Vector.fromList . list + +{-| Decode a Dhall function into a Haskell function. + +>>> f <- input (function inject bool) "Natural/even" :: IO (Natural -> Bool) +>>> f 0 +True +>>> f 1 +False +-} +function + :: Encoder a + -> Decoder b + -> Decoder (a -> b) +function = functionWith defaultInputNormalizer + +{-| Decode a Dhall function into a Haskell function using the specified normalizer. + +>>> f <- input (functionWith defaultInputNormalizer inject bool) "Natural/even" :: IO (Natural -> Bool) +>>> f 0 +True +>>> f 1 +False +-} +functionWith + :: InputNormalizer + -> Encoder a + -> Decoder b + -> Decoder (a -> b) +functionWith inputNormalizer (Encoder {..}) (Decoder extractIn expectedIn) = + Decoder extractOut expectedOut + where + normalizer_ = Just (getInputNormalizer inputNormalizer) + + extractOut e = pure (\i -> case extractIn (Core.normalizeWith normalizer_ (App e (embed i))) of + Success o -> o + Failure _e -> error "FromDhall: You cannot decode a function if it does not have the correct type" ) + + expectedOut = Pi mempty "_" declared <$> expectedIn + +{-| Decode a `Data.Set.Set` from a `List`. + +>>> input (setIgnoringDuplicates natural) "[1, 2, 3]" +fromList [1,2,3] + +Duplicate elements are ignored. + +>>> input (setIgnoringDuplicates natural) "[1, 1, 3]" +fromList [1,3] + +-} +setIgnoringDuplicates :: (Ord a) => Decoder a -> Decoder (Data.Set.Set a) +setIgnoringDuplicates = fmap Data.Set.fromList . list + +{-| Decode a `Data.HashSet.HashSet` from a `List`. + +>>> input (hashSetIgnoringDuplicates natural) "[1, 2, 3]" +fromList [1,2,3] + +Duplicate elements are ignored. + +>>> input (hashSetIgnoringDuplicates natural) "[1, 1, 3]" +fromList [1,3] + +-} +hashSetIgnoringDuplicates :: (Hashable a, Ord a) + => Decoder a + -> Decoder (Data.HashSet.HashSet a) +hashSetIgnoringDuplicates = fmap Data.HashSet.fromList . list + +{-| Decode a `Data.Set.Set` from a `List` with distinct elements. + +>>> input (setFromDistinctList natural) "[1, 2, 3]" +fromList [1,2,3] + +An error is thrown if the list contains duplicates. + +> >>> input (setFromDistinctList natural) "[1, 1, 3]" +> *** Exception: Error: Failed extraction +> +> The expression type-checked successfully but the transformation to the target +> type failed with the following error: +> +> One duplicate element in the list: 1 +> + +> >>> input (setFromDistinctList natural) "[1, 1, 3, 3]" +> *** Exception: Error: Failed extraction +> +> The expression type-checked successfully but the transformation to the target +> type failed with the following error: +> +> 2 duplicates were found in the list, including 1 +> + +-} +setFromDistinctList :: (Ord a, Show a) => Decoder a -> Decoder (Data.Set.Set a) +setFromDistinctList = setHelper Data.Set.size Data.Set.fromList + +{-| Decode a `Data.HashSet.HashSet` from a `List` with distinct elements. + +>>> input (hashSetFromDistinctList natural) "[1, 2, 3]" +fromList [1,2,3] + +An error is thrown if the list contains duplicates. + +> >>> input (hashSetFromDistinctList natural) "[1, 1, 3]" +> *** Exception: Error: Failed extraction +> +> The expression type-checked successfully but the transformation to the target +> type failed with the following error: +> +> One duplicate element in the list: 1 +> + +> >>> input (hashSetFromDistinctList natural) "[1, 1, 3, 3]" +> *** Exception: Error: Failed extraction +> +> The expression type-checked successfully but the transformation to the target +> type failed with the following error: +> +> 2 duplicates were found in the list, including 1 +> + +-} +hashSetFromDistinctList :: (Hashable a, Ord a, Show a) + => Decoder a + -> Decoder (Data.HashSet.HashSet a) +hashSetFromDistinctList = setHelper Data.HashSet.size Data.HashSet.fromList + + +setHelper :: (Eq a, Foldable t, Show a) + => (t a -> Int) + -> ([a] -> t a) + -> Decoder a + -> Decoder (t a) +setHelper size toSet (Decoder extractIn expectedIn) = Decoder extractOut expectedOut + where + extractOut (ListLit _ es) = case traverse extractIn es of + Success vSeq + | sameSize -> Success vSet + | otherwise -> extractError err + where + vList = Data.Foldable.toList vSeq + vSet = toSet vList + sameSize = size vSet == Data.Sequence.length vSeq + duplicates = vList List.\\ Data.Foldable.toList vSet + err | length duplicates == 1 = + "One duplicate element in the list: " + <> (Data.Text.pack $ show $ head duplicates) + | otherwise = Data.Text.pack $ unwords + [ show $ length duplicates + , "duplicates were found in the list, including" + , show $ head duplicates + ] + Failure f -> Failure f + extractOut expr = typeError expectedOut expr + + expectedOut = App List <$> expectedIn + +{-| Decode a `Map` from a @toMap@ expression or generally a @Prelude.Map.Type@. + +>>> input (Dhall.map strictText bool) "toMap { a = True, b = False }" +fromList [("a",True),("b",False)] +>>> input (Dhall.map strictText bool) "[ { mapKey = \"foo\", mapValue = True } ]" +fromList [("foo",True)] + +If there are duplicate @mapKey@s, later @mapValue@s take precedence: + +>>> let expr = "[ { mapKey = 1, mapValue = True }, { mapKey = 1, mapValue = False } ]" +>>> input (Dhall.map natural bool) expr +fromList [(1,False)] + +-} +map :: Ord k => Decoder k -> Decoder v -> Decoder (Map k v) +map k v = fmap Data.Map.fromList (list (pairFromMapEntry k v)) + +{-| Decode a `HashMap` from a @toMap@ expression or generally a @Prelude.Map.Type@. + +>>> fmap (List.sort . HashMap.toList) (input (Dhall.hashMap strictText bool) "toMap { a = True, b = False }") +[("a",True),("b",False)] +>>> fmap (List.sort . HashMap.toList) (input (Dhall.hashMap strictText bool) "[ { mapKey = \"foo\", mapValue = True } ]") +[("foo",True)] + +If there are duplicate @mapKey@s, later @mapValue@s take precedence: + +>>> let expr = "[ { mapKey = 1, mapValue = True }, { mapKey = 1, mapValue = False } ]" +>>> input (Dhall.hashMap natural bool) expr +fromList [(1,False)] + +-} +hashMap :: (Eq k, Hashable k) => Decoder k -> Decoder v -> Decoder (HashMap k v) +hashMap k v = fmap HashMap.fromList (list (pairFromMapEntry k v)) + +{-| Decode a tuple from a @Prelude.Map.Entry@ record. + +>>> input (pairFromMapEntry strictText natural) "{ mapKey = \"foo\", mapValue = 3 }" +("foo",3) +-} +pairFromMapEntry :: Decoder k -> Decoder v -> Decoder (k, v) +pairFromMapEntry k v = Decoder extractOut expectedOut + where + extractOut (RecordLit kvs) + | Just key <- Core.recordFieldValue <$> Dhall.Map.lookup "mapKey" kvs + , Just value <- Core.recordFieldValue <$> Dhall.Map.lookup "mapValue" kvs + = liftA2 (,) (extract k key) (extract v value) + extractOut expr = typeError expectedOut expr + + expectedOut = do + k' <- Core.makeRecordField <$> expected k + v' <- Core.makeRecordField <$> expected v + pure $ Record $ Dhall.Map.fromList + [ ("mapKey", k') + , ("mapValue", v')] + +{-| Decode @()@ from an empty record. + +>>> input unit "{=}" -- GHC doesn't print the result if it is () + +-} +unit :: Decoder () +unit = Decoder {..} + where + extract (RecordLit fields) + | Data.Foldable.null fields = pure () + extract expr = typeError expected expr + + expected = pure $ Record mempty + +{-| Decode 'Void' from an empty union. + +Since @<>@ is uninhabited, @'Dhall.input' 'void'@ will always fail. +-} +void :: Decoder Void +void = union mempty + +{-| Decode a `String` + +>>> input string "\"ABC\"" +"ABC" + +-} +string :: Decoder String +string = Data.Text.Lazy.unpack <$> lazyText + +{-| Given a pair of `Decoder`s, decode a tuple-record into their pairing. + +>>> input (pair natural bool) "{ _1 = 42, _2 = False }" +(42,False) +-} +pair :: Decoder a -> Decoder b -> Decoder (a, b) +pair l r = Decoder extractOut expectedOut + where + extractOut expr@(RecordLit fields) = + (,) <$> Data.Maybe.maybe (typeError expectedOut expr) (extract l) + (Core.recordFieldValue <$> Dhall.Map.lookup "_1" fields) + <*> Data.Maybe.maybe (typeError expectedOut expr) (extract r) + (Core.recordFieldValue <$> Dhall.Map.lookup "_2" fields) + extractOut expr = typeError expectedOut expr + + expectedOut = do + l' <- Core.makeRecordField <$> expected l + r' <- Core.makeRecordField <$> expected r + pure $ Record $ Dhall.Map.fromList + [ ("_1", l') + , ("_2", r')] + + + +{-| The 'RecordDecoder' applicative functor allows you to build a 'Decoder' + from a Dhall record. + + For example, let's take the following Haskell data type: + +>>> :{ +data Project = Project + { projectName :: Text + , projectDescription :: Text + , projectStars :: Natural + } +:} + + And assume that we have the following Dhall record that we would like to + parse as a @Project@: + +> { name = +> "dhall-haskell" +> , description = +> "A configuration language guaranteed to terminate" +> , stars = +> 289 +> } + + Our decoder has type 'Decoder' @Project@, but we can't build that out of any + smaller decoders, as 'Decoder's cannot be combined (they are only 'Functor's). + However, we can use a 'RecordDecoder' to build a 'Decoder' for @Project@: + +>>> :{ +project :: Decoder Project +project = + record + ( Project <$> field "name" strictText + <*> field "description" strictText + <*> field "stars" natural + ) +:} +-} +newtype RecordDecoder a = + RecordDecoder + ( Data.Functor.Product.Product + ( Control.Applicative.Const + (Dhall.Map.Map Text (Expector (Expr Src Void))) + ) + ( Data.Functor.Compose.Compose ((->) (Expr Src Void)) (Extractor Src Void) + ) + a + ) + deriving (Functor, Applicative) + +-- | Run a 'RecordDecoder' to build a 'Decoder'. +record :: RecordDecoder a -> Dhall.Marshal.Decode.Decoder a +record + (RecordDecoder + (Data.Functor.Product.Pair + (Control.Applicative.Const fields) + (Data.Functor.Compose.Compose extract) + ) + ) = Decoder {..} + where + expected = Record <$> traverse (fmap Core.makeRecordField) fields + +-- | Parse a single field of a record. +field :: Text -> Decoder a -> RecordDecoder a +field key (Decoder {..}) = + RecordDecoder + ( Data.Functor.Product.Pair + ( Control.Applicative.Const + (Dhall.Map.singleton key expected) + ) + ( Data.Functor.Compose.Compose extractBody ) + ) + where + extractBody expr@(RecordLit fields) = case Core.recordFieldValue <$> Dhall.Map.lookup key fields of + Just v -> extract v + _ -> typeError expected expr + extractBody expr = typeError expected expr + + + +{-| The 'UnionDecoder' monoid allows you to build a 'Decoder' from a Dhall union. + + For example, let's take the following Haskell data type: + +>>> :{ +data Status = Queued Natural + | Result Text + | Errored Text +:} + + And assume that we have the following Dhall union that we would like to + parse as a @Status@: + +> < Result : Text +> | Queued : Natural +> | Errored : Text +> >.Result "Finish successfully" + + Our decoder has type 'Decoder' @Status@, but we can't build that out of any + smaller decoders, as 'Decoder's cannot be combined (they are only 'Functor's). + However, we can use a 'UnionDecoder' to build a 'Decoder' for @Status@: + +>>> :{ +status :: Decoder Status +status = union + ( ( Queued <$> constructor "Queued" natural ) + <> ( Result <$> constructor "Result" strictText ) + <> ( Errored <$> constructor "Errored" strictText ) + ) +:} + +-} +newtype UnionDecoder a = + UnionDecoder + ( Data.Functor.Compose.Compose (Dhall.Map.Map Text) Decoder a ) + deriving (Functor) + +instance Semigroup (UnionDecoder a) where + (<>) = coerce ((<>) :: Dhall.Map.Map Text (Decoder a) -> Dhall.Map.Map Text (Decoder a) -> Dhall.Map.Map Text (Decoder a)) + +instance Monoid (UnionDecoder a) where + mempty = coerce (mempty :: Dhall.Map.Map Text (Decoder a)) + +-- | Run a 'UnionDecoder' to build a 'Decoder'. +union :: UnionDecoder a -> Decoder a +union (UnionDecoder (Data.Functor.Compose.Compose mp)) = Decoder {..} + where + extract expr = case expected' of + Failure e -> Failure $ fmap ExpectedTypeError e + Success x -> extract' expr x + + extract' e0 mp' = Data.Maybe.maybe (typeError expected e0) (uncurry Dhall.Marshal.Decode.extract) $ do + (fld, e1, rest) <- extractUnionConstructor e0 + + t <- Dhall.Map.lookup fld mp + + guard $ + Core.Union rest `Core.judgmentallyEqual` Core.Union (Dhall.Map.delete fld mp') + + pure (t, e1) + + expected = Union <$> expected' + + expected' = traverse (fmap notEmptyRecord . Dhall.Marshal.Decode.expected) mp + +-- | Parse a single constructor of a union. +constructor :: Text -> Decoder a -> UnionDecoder a +constructor key valueDecoder = UnionDecoder + ( Data.Functor.Compose.Compose (Dhall.Map.singleton key valueDecoder) ) + + + +{-| A newtype suitable for collecting one or more errors. +-} +newtype DhallErrors e = DhallErrors + { getErrors :: NonEmpty e + } deriving (Eq, Functor, Semigroup) + +instance (Show (DhallErrors e), Typeable e) => Exception (DhallErrors e) + +{-| Render a given prefix and some errors to a string. +-} +showDhallErrors :: Show e => String -> DhallErrors e -> String +showDhallErrors _ (DhallErrors (e :| [])) = show e +showDhallErrors ctx (DhallErrors es) = prefix <> (unlines . Data.List.NonEmpty.toList . fmap show $ es) + where + prefix = + "Multiple errors were encountered" ++ ctx ++ ": \n\ + \ \n" + +{-| One or more errors returned from extracting a Dhall expression to a + Haskell expression. +-} +type ExtractErrors s a = DhallErrors (ExtractError s a) + +instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractErrors s a) where + show = showDhallErrors " during extraction" + +{-| Extraction of a value can fail for two reasons, either a type mismatch (which should not happen, + as expressions are type-checked against the expected type before being passed to @extract@), or + a term-level error, described with a freeform text value. +-} +data ExtractError s a = + TypeMismatch (InvalidDecoder s a) + | ExpectedTypeError ExpectedTypeError + | ExtractError Text + deriving (Eq) + +instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractError s a) where + show (TypeMismatch e) = show e + show (ExpectedTypeError e) = show e + show (ExtractError es) = unlines + [ _ERROR <> ": Failed extraction " + , " " + , "The expression type-checked successfully but the transformation to the target " + , "type failed with the following error: " + , " " + , Data.Text.unpack es + , " " + ] + +instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractError s a) + +{-| Useful synonym for the `Validation` type used when marshalling Dhall + expressions. +-} +type Extractor s a = Validation (ExtractErrors s a) + +{-| Generate a type error during extraction by specifying the expected type + and the actual type. + The expected type is not yet determined. +-} +typeError :: Expector (Expr s a) -> Expr s a -> Extractor s a b +typeError expected actual = Failure $ case expected of + Failure e -> fmap ExpectedTypeError e + Success expected' -> DhallErrors $ pure $ TypeMismatch $ InvalidDecoder expected' actual + +-- | Turn a `Data.Text.Text` message into an extraction failure. +extractError :: Text -> Extractor s a b +extractError = Failure . DhallErrors . pure . ExtractError + +{-| Useful synonym for the equivalent `Either` type used when marshalling Dhall + code. +-} +type MonadicExtractor s a = Either (ExtractErrors s a) + +-- | Switches from an @Applicative@ extraction result, able to accumulate errors, +-- to a @Monad@ extraction result, able to chain sequential operations. +toMonadic :: Extractor s a b -> MonadicExtractor s a b +toMonadic = validationToEither + +-- | Switches from a @Monad@ extraction result, able to chain sequential errors, +-- to an @Applicative@ extraction result, able to accumulate errors. +fromMonadic :: MonadicExtractor s a b -> Extractor s a b +fromMonadic = eitherToValidation + +{-| Every `Decoder` must obey the contract that if an expression's type matches + the `expected` type then the `extract` function must not fail with a type + error. However, decoding may still fail for other reasons (such as the + decoder for `Data.Map.Set`s rejecting a Dhall @List@ with duplicate + elements). + + This error type is used to indicate an internal error in the implementation + of a `Decoder` where the expected type matched the Dhall expression, but the + expression supplied to the extraction function did not match the expected + type. If this happens that means that the `Decoder` itself needs to be + fixed. +-} +data InvalidDecoder s a = InvalidDecoder + { invalidDecoderExpected :: Expr s a + , invalidDecoderExpression :: Expr s a + } + deriving (Eq, Typeable) + +instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecoder s a) + +instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where + show InvalidDecoder { .. } = unlines + [ _ERROR <> ": Invalid Dhall.Decoder " + , " " + , "Every Decoder must provide an extract function that does not fail with a type " + , "error if an expression matches the expected type. You provided a Decoder that " + , "disobeys this contract " + , " " + , "The Decoder provided has the expected dhall type: " + , " " + , show (Dhall.Util.insert invalidDecoderExpected) + , " " + , "and it threw a type error during extraction from the well-typed expression: " + , " " + , show (Dhall.Util.insert invalidDecoderExpression) + , " " + ] + +{-| Useful synonym for the `Validation` type used when marshalling Dhall + expressions. +-} +type Expector = Validation ExpectedTypeErrors + +{-| One or more errors returned when determining the Dhall type of a + Haskell expression. +-} +type ExpectedTypeErrors = DhallErrors ExpectedTypeError + +{-| Error type used when determining the Dhall type of a Haskell expression. +-} +data ExpectedTypeError = RecursiveTypeError + deriving (Eq, Show) + +instance Exception ExpectedTypeError + +instance Show ExpectedTypeErrors where + show = showDhallErrors " while determining the expected type" + +_ERROR :: String +_ERROR = "\ESC[1;31mError\ESC[0m" diff --git a/src/Dhall/Marshal/Encode.hs b/src/Dhall/Marshal/Encode.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Marshal/Encode.hs @@ -0,0 +1,1068 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining + how to use the language, the compiler, and this library +-} + +module Dhall.Marshal.Encode + ( -- * General + Encoder(..) + , ToDhall(..) + , Inject + , inject + + -- * Building encoders + + -- ** Records + , RecordEncoder(..) + , recordEncoder + , encodeField + , encodeFieldWith + -- ** Unions + , UnionEncoder(..) + , unionEncoder + , encodeConstructor + , encodeConstructorWith + , (>|<) + + -- * Generic encoding + , GenericToDhall(..) + , genericToDhall + , genericToDhallWith + , genericToDhallWithInputNormalizer + , InterpretOptions(..) + , SingletonConstructors(..) + , defaultInterpretOptions + + -- * Miscellaneous + , InputNormalizer(..) + , defaultInputNormalizer + , Result + , (>$<) + , (>*<) + + -- * Re-exports + , Natural + , Seq + , Text + , Vector + , Generic + ) where + +import Control.Monad.Trans.State.Strict +import Data.Functor.Contravariant (Contravariant (..), Op (..), (>$<)) +import Data.Functor.Contravariant.Divisible (Divisible (..), divided) +import Dhall.Parser (Src (..)) +import Dhall.Syntax + ( Chunks (..) + , DhallDouble (..) + , Expr (..) + ) +import GHC.Generics +import Prelude hiding (maybe, sequence) + +import qualified Control.Applicative +import qualified Data.ByteString +import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short +import qualified Data.Functor.Product +import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashSet +import qualified Data.Map +import qualified Data.Scientific +import qualified Data.Sequence +import qualified Data.Set +import qualified Data.Text +import qualified Data.Text.Lazy +import qualified Data.Text.Short +import qualified Data.Time as Time +import qualified Data.Vector +import qualified Data.Void +import qualified Dhall.Core as Core +import qualified Dhall.Map + +import Dhall.Marshal.Internal + +-- $setup +-- >>> :set -XRecordWildCards +-- >>> import Dhall.Pretty.Internal (prettyExpr) + +{-| An @(Encoder a)@ represents a way to marshal a value of type @\'a\'@ from + Haskell into Dhall. +-} +data Encoder a = Encoder + { embed :: a -> Expr Src Void + -- ^ Embeds a Haskell value as a Dhall expression + , declared :: Expr Src Void + -- ^ Dhall type of the Haskell value + } + +instance Contravariant Encoder where + contramap f (Encoder embed declared) = Encoder embed' declared + where + embed' x = embed (f x) + +{-| This class is used by `Dhall.Marshal.Decode.FromDhall` instance for functions: + +> instance (ToDhall a, FromDhall b) => FromDhall (a -> b) + + You can convert Dhall functions with "simple" inputs (i.e. instances of this + class) into Haskell functions. This works by: + + * Marshaling the input to the Haskell function into a Dhall expression (i.e. + @x :: Expr Src Void@) + * Applying the Dhall function (i.e. @f :: Expr Src Void@) to the Dhall input + (i.e. @App f x@) + * Normalizing the syntax tree (i.e. @normalize (App f x)@) + * Marshaling the resulting Dhall expression back into a Haskell value + + This class auto-generates a default implementation for types that + implement `Generic`. This does not auto-generate an instance for recursive + types. + + The default instance can be tweaked using 'genericToDhallWith'/'genericToDhallWithInputNormalizer' + and custom 'InterpretOptions', or using + [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) + and 'Dhall.Deriving.Codec' from "Dhall.Deriving". +-} +class ToDhall a where + injectWith :: InputNormalizer -> Encoder a + default injectWith + :: (Generic a, GenericToDhall (Rep a)) => InputNormalizer -> Encoder a + injectWith _ = genericToDhall + +-- | A compatibility alias for `ToDhall` +type Inject = ToDhall +{-# DEPRECATED Inject "Use ToDhall instead" #-} + +{-| Use the default input normalizer for injecting a value. + +> inject = injectWith defaultInputNormalizer +-} +inject :: ToDhall a => Encoder a +inject = injectWith defaultInputNormalizer + + + +instance ToDhall Void where + injectWith _ = Encoder {..} + where + embed = Data.Void.absurd + + declared = Union mempty + +instance ToDhall Bool where + injectWith _ = Encoder {..} + where + embed = BoolLit + + declared = Bool + +instance ToDhall Data.ByteString.Short.ShortByteString where + injectWith options = + contramap Data.ByteString.Short.fromShort (injectWith options) + +instance ToDhall Data.ByteString.Lazy.ByteString where + injectWith options = + contramap Data.ByteString.Lazy.toStrict (injectWith options) + +instance ToDhall Data.ByteString.ByteString where + injectWith _ = Encoder {..} + where + embed bytes = BytesLit bytes + + declared = Bytes + +instance ToDhall Data.Text.Short.ShortText where + injectWith _ = Encoder {..} + where + embed text = + TextLit (Chunks [] (Data.Text.Short.toText text)) + + declared = Text + +instance ToDhall Data.Text.Lazy.Text where + injectWith _ = Encoder {..} + where + embed text = + TextLit (Chunks [] (Data.Text.Lazy.toStrict text)) + + declared = Text + +instance ToDhall Text where + injectWith _ = Encoder {..} + where + embed text = TextLit (Chunks [] text) + + declared = Text + +instance {-# OVERLAPS #-} ToDhall String where + injectWith inputNormalizer = + contramap Data.Text.pack (injectWith inputNormalizer :: Encoder Text) + +instance ToDhall Natural where + injectWith _ = Encoder {..} + where + embed = NaturalLit + + declared = Natural + +instance ToDhall Integer where + injectWith _ = Encoder {..} + where + embed = IntegerLit + + declared = Integer + +instance ToDhall Int where + injectWith _ = Encoder {..} + where + embed = IntegerLit . toInteger + + declared = Integer + +instance ToDhall Int8 where + injectWith _ = Encoder {..} + where + embed = IntegerLit . toInteger + + declared = Integer + +instance ToDhall Int16 where + injectWith _ = Encoder {..} + where + embed = IntegerLit . toInteger + + declared = Integer + +instance ToDhall Int32 where + injectWith _ = Encoder {..} + where + embed = IntegerLit . toInteger + + declared = Integer + +instance ToDhall Int64 where + injectWith _ = Encoder {..} + where + embed = IntegerLit . toInteger + + declared = Integer + +{-| Encode a 'Word' to a Dhall @Natural@. + +>>> embed inject (12 :: Word) +NaturalLit 12 +-} +instance ToDhall Word where + injectWith _ = Encoder {..} + where + embed = NaturalLit . fromIntegral + + declared = Natural + +{-| Encode a 'Word8' to a Dhall @Natural@. + +>>> embed inject (12 :: Word8) +NaturalLit 12 +-} +instance ToDhall Word8 where + injectWith _ = Encoder {..} + where + embed = NaturalLit . fromIntegral + + declared = Natural + +{-| Encode a 'Word16' to a Dhall @Natural@. + +>>> embed inject (12 :: Word16) +NaturalLit 12 +-} +instance ToDhall Word16 where + injectWith _ = Encoder {..} + where + embed = NaturalLit . fromIntegral + + declared = Natural + +{-| Encode a 'Word32' to a Dhall @Natural@. + +>>> embed inject (12 :: Word32) +NaturalLit 12 +-} +instance ToDhall Word32 where + injectWith _ = Encoder {..} + where + embed = NaturalLit . fromIntegral + + declared = Natural + +{-| Encode a 'Word64' to a Dhall @Natural@. + +>>> embed inject (12 :: Word64) +NaturalLit 12 +-} +instance ToDhall Word64 where + injectWith _ = Encoder {..} + where + embed = NaturalLit . fromIntegral + + declared = Natural + +instance ToDhall Double where + injectWith _ = Encoder {..} + where + embed = DoubleLit . DhallDouble + + declared = Double + +instance ToDhall Scientific where + injectWith inputNormalizer = + contramap Data.Scientific.toRealFloat (injectWith inputNormalizer :: Encoder Double) + +instance ToDhall () where + injectWith _ = Encoder {..} + where + embed = const (RecordLit mempty) + + declared = Record mempty + +instance ToDhall a => ToDhall (Maybe a) where + injectWith inputNormalizer = Encoder embedOut declaredOut + where + embedOut (Just x ) = Some (embedIn x) + embedOut Nothing = App None declaredIn + + Encoder embedIn declaredIn = injectWith inputNormalizer + + declaredOut = App Optional declaredIn + +instance ToDhall a => ToDhall (Seq a) where + injectWith inputNormalizer = Encoder embedOut declaredOut + where + embedOut xs = ListLit listType (fmap embedIn xs) + where + listType + | null xs = Just (App List declaredIn) + | otherwise = Nothing + + declaredOut = App List declaredIn + + Encoder embedIn declaredIn = injectWith inputNormalizer + +instance ToDhall a => ToDhall [a] where + injectWith = fmap (contramap Data.Sequence.fromList) injectWith + +instance ToDhall a => ToDhall (Vector a) where + injectWith = fmap (contramap Data.Vector.toList) injectWith + +instance ToDhall Time.TimeOfDay where + injectWith _ = Encoder {..} + where + embed timeOfDay = TimeLiteral timeOfDay 12 + + declared = Time + +instance ToDhall Time.Day where + injectWith _ = Encoder {..} + where + embed = DateLiteral + + declared = Date + +instance ToDhall Time.TimeZone where + injectWith _ = Encoder {..} + where + embed = TimeZoneLiteral + + declared = TimeZone + +instance ToDhall Time.LocalTime where + injectWith _ = recordEncoder $ + adapt + >$< encodeField "date" + >*< encodeField "time" + where + adapt (Time.LocalTime date time) = (date, time) + +instance ToDhall Time.ZonedTime where + injectWith _ = recordEncoder $ + adapt + >$< encodeField "date" + >*< encodeField "time" + >*< encodeField "timeZone" + where + adapt (Time.ZonedTime (Time.LocalTime date time) timeZone) = (date, (time, timeZone)) + +instance ToDhall Time.UTCTime where + injectWith = contramap (Time.utcToZonedTime Time.utc) . injectWith + +instance ToDhall Time.DayOfWeek where + injectWith _ = Encoder{..} + where + embed Time.Sunday = + Field declared (Core.makeFieldSelection "Sunday") + embed Time.Monday = + Field declared (Core.makeFieldSelection "Monday" ) + embed Time.Tuesday = + Field declared (Core.makeFieldSelection "Tuesday") + embed Time.Wednesday = + Field declared (Core.makeFieldSelection "Wednesday") + embed Time.Thursday = + Field declared (Core.makeFieldSelection "Thursday") + embed Time.Friday = + Field declared (Core.makeFieldSelection "Friday") + embed Time.Saturday = + Field declared (Core.makeFieldSelection "Saturday") + + declared = + Union + (Dhall.Map.fromList + [ ("Sunday", Nothing) + , ("Monday", Nothing) + , ("Tuesday", Nothing) + , ("Wednesday", Nothing) + , ("Thursday", Nothing) + , ("Friday", Nothing) + , ("Saturday", Nothing) + ] + ) + +{-| Note that the output list will be sorted. + +>>> let x = Data.Set.fromList ["mom", "hi" :: Text] +>>> prettyExpr $ embed inject x +[ "hi", "mom" ] + +-} +instance ToDhall a => ToDhall (Data.Set.Set a) where + injectWith = fmap (contramap Data.Set.toAscList) injectWith + +-- | Note that the output list may not be sorted +instance ToDhall a => ToDhall (Data.HashSet.HashSet a) where + injectWith = fmap (contramap Data.HashSet.toList) injectWith + +instance (ToDhall a, ToDhall b) => ToDhall (a, b) + +{-| Embed a `Data.Map` as a @Prelude.Map.Type@. + +>>> prettyExpr $ embed inject (Data.Map.fromList [(1 :: Natural, True)]) +[ { mapKey = 1, mapValue = True } ] + +>>> prettyExpr $ embed inject (Data.Map.fromList [] :: Data.Map.Map Natural Bool) +[] : List { mapKey : Natural, mapValue : Bool } + +-} +instance (ToDhall k, ToDhall v) => ToDhall (Data.Map.Map k v) where + injectWith inputNormalizer = Encoder embedOut declaredOut + where + embedOut m = ListLit listType (mapEntries m) + where + listType + | Data.Map.null m = Just declaredOut + | otherwise = Nothing + + declaredOut = App List (Record $ Dhall.Map.fromList + [ ("mapKey", Core.makeRecordField declaredK) + , ("mapValue", Core.makeRecordField declaredV) + ]) + + mapEntries = Data.Sequence.fromList . fmap recordPair . Data.Map.toList + recordPair (k, v) = RecordLit $ Dhall.Map.fromList + [ ("mapKey", Core.makeRecordField $ embedK k) + , ("mapValue", Core.makeRecordField $ embedV v) + ] + + Encoder embedK declaredK = injectWith inputNormalizer + Encoder embedV declaredV = injectWith inputNormalizer + +{-| Embed a `Data.HashMap` as a @Prelude.Map.Type@. + +>>> prettyExpr $ embed inject (HashMap.fromList [(1 :: Natural, True)]) +[ { mapKey = 1, mapValue = True } ] + +>>> prettyExpr $ embed inject (HashMap.fromList [] :: HashMap Natural Bool) +[] : List { mapKey : Natural, mapValue : Bool } + +-} +instance (ToDhall k, ToDhall v) => ToDhall (HashMap k v) where + injectWith inputNormalizer = Encoder embedOut declaredOut + where + embedOut m = ListLit listType (mapEntries m) + where + listType + | HashMap.null m = Just declaredOut + | otherwise = Nothing + + declaredOut = App List (Record $ Dhall.Map.fromList + [ ("mapKey", Core.makeRecordField declaredK) + , ("mapValue", Core.makeRecordField declaredV) + ]) + + mapEntries = Data.Sequence.fromList . fmap recordPair . HashMap.toList + recordPair (k, v) = RecordLit $ Dhall.Map.fromList + [ ("mapKey", Core.makeRecordField $ embedK k) + , ("mapValue", Core.makeRecordField $ embedV v) + ] + + Encoder embedK declaredK = injectWith inputNormalizer + Encoder embedV declaredV = injectWith inputNormalizer + +instance ToDhall (f (Result f)) => ToDhall (Result f) where + injectWith inputNormalizer = Encoder {..} + where + embed = App "Make" . Dhall.Marshal.Encode.embed (injectWith inputNormalizer) . _unResult + declared = "result" + +instance forall f. (Functor f, ToDhall (f (Result f))) => ToDhall (Fix f) where + injectWith inputNormalizer = Encoder {..} + where + embed fixf = + Lam Nothing (Core.makeFunctionBinding "result" (Const Core.Type)) $ + Lam Nothing (Core.makeFunctionBinding "Make" makeType) $ + embed' . fixToResult $ fixf + + declared = Pi Nothing "result" (Const Core.Type) $ Pi Nothing "_" makeType "result" + + makeType = Pi Nothing "_" declared' "result" + Encoder embed' _ = injectWith @(Dhall.Marshal.Internal.Result f) inputNormalizer + Encoder _ declared' = injectWith @(f (Dhall.Marshal.Internal.Result f)) inputNormalizer + +fixToResult :: Functor f => Fix f -> Result f +fixToResult (Fix x) = Result (fmap fixToResult x) + + + +{-| This is the underlying class that powers the `Dhall.Marshal.Decode.FromDhall` class's support + for automatically deriving a generic implementation. +-} +class GenericToDhall f where + genericToDhallWithNormalizer :: InputNormalizer -> InterpretOptions -> State Int (Encoder (f a)) + +instance GenericToDhall f => GenericToDhall (M1 D d f) where + genericToDhallWithNormalizer inputNormalizer options = do + res <- genericToDhallWithNormalizer inputNormalizer options + pure (contramap unM1 res) + +instance GenericToDhall f => GenericToDhall (M1 C c f) where + genericToDhallWithNormalizer inputNormalizer options = do + res <- genericToDhallWithNormalizer inputNormalizer options + pure (contramap unM1 res) + +instance (Selector s, ToDhall a) => GenericToDhall (M1 S s (K1 i a)) where + genericToDhallWithNormalizer inputNormalizer InterpretOptions{..} = do + let Encoder { embed = embed', declared = declared' } = + injectWith inputNormalizer + + let n :: M1 S s (K1 i a) r + n = undefined + + name <- fieldModifier <$> getSelName n + + let embed0 (M1 (K1 x)) = embed' x + + let embed1 (M1 (K1 x)) = + RecordLit (Dhall.Map.singleton name (Core.makeRecordField $ embed' x)) + + let embed = + case singletonConstructors of + Bare -> embed0 + Smart | selName n == "" -> embed0 + _ -> embed1 + + let declared = + case singletonConstructors of + Bare -> + declared' + Smart | selName n == "" -> + declared' + _ -> + Record (Dhall.Map.singleton name $ Core.makeRecordField declared') + + return (Encoder {..}) + +instance (Constructor c1, Constructor c2, GenericToDhall f1, GenericToDhall f2) => GenericToDhall (M1 C c1 f1 :+: M1 C c2 f2) where + genericToDhallWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Encoder {..}) + where + embed (L1 (M1 l)) = + case notEmptyRecordLit (embedL l) of + Nothing -> + Field declared $ Core.makeFieldSelection keyL + Just valL -> + App (Field declared $ Core.makeFieldSelection keyL) valL + + embed (R1 (M1 r)) = + case notEmptyRecordLit (embedR r) of + Nothing -> + Field declared $ Core.makeFieldSelection keyR + Just valR -> + App (Field declared $ Core.makeFieldSelection keyR) valR + + declared = + Union + (Dhall.Map.fromList + [ (keyL, notEmptyRecord declaredL) + , (keyR, notEmptyRecord declaredR) + ] + ) + + nL :: M1 i c1 f1 a + nL = undefined + + nR :: M1 i c2 f2 a + nR = undefined + + keyL = constructorModifier (Data.Text.pack (conName nL)) + keyR = constructorModifier (Data.Text.pack (conName nR)) + + Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + +instance (Constructor c, GenericToDhall (f :+: g), GenericToDhall h) => GenericToDhall ((f :+: g) :+: M1 C c h) where + genericToDhallWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Encoder {..}) + where + embed (L1 l) = + case maybeValL of + Nothing -> Field declared $ Core.makeFieldSelection keyL + Just valL -> App (Field declared $ Core.makeFieldSelection keyL) valL + where + (keyL, maybeValL) = + unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedL l) + embed (R1 (M1 r)) = + case notEmptyRecordLit (embedR r) of + Nothing -> Field declared $ Core.makeFieldSelection keyR + Just valR -> App (Field declared $ Core.makeFieldSelection keyR) valR + + nR :: M1 i c h a + nR = undefined + + keyR = constructorModifier (Data.Text.pack (conName nR)) + + declared = Union (Dhall.Map.insert keyR (notEmptyRecord declaredR) ktsL) + + Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + + ktsL = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredL + +instance (Constructor c, GenericToDhall f, GenericToDhall (g :+: h)) => GenericToDhall (M1 C c f :+: (g :+: h)) where + genericToDhallWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Encoder {..}) + where + embed (L1 (M1 l)) = + case notEmptyRecordLit (embedL l) of + Nothing -> Field declared $ Core.makeFieldSelection keyL + Just valL -> App (Field declared $ Core.makeFieldSelection keyL) valL + embed (R1 r) = + case maybeValR of + Nothing -> Field declared $ Core.makeFieldSelection keyR + Just valR -> App (Field declared $ Core.makeFieldSelection keyR) valR + where + (keyR, maybeValR) = + unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedR r) + + nL :: M1 i c f a + nL = undefined + + keyL = constructorModifier (Data.Text.pack (conName nL)) + + declared = Union (Dhall.Map.insert keyL (notEmptyRecord declaredL) ktsR) + + Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + + ktsR = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredR + +instance (GenericToDhall (f :+: g), GenericToDhall (h :+: i)) => GenericToDhall ((f :+: g) :+: (h :+: i)) where + genericToDhallWithNormalizer inputNormalizer options = pure (Encoder {..}) + where + embed (L1 l) = + case maybeValL of + Nothing -> Field declared $ Core.makeFieldSelection keyL + Just valL -> App (Field declared $ Core.makeFieldSelection keyL) valL + where + (keyL, maybeValL) = + unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedL l) + embed (R1 r) = + case maybeValR of + Nothing -> Field declared $ Core.makeFieldSelection keyR + Just valR -> App (Field declared $ Core.makeFieldSelection keyR) valR + where + (keyR, maybeValR) = + unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedR r) + + declared = Union (Dhall.Map.union ktsL ktsR) + + Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 + + ktsL = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredL + ktsR = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredR + +instance (GenericToDhall (f :*: g), GenericToDhall (h :*: i)) => GenericToDhall ((f :*: g) :*: (h :*: i)) where + genericToDhallWithNormalizer inputNormalizer options = do + Encoder embedL declaredL <- genericToDhallWithNormalizer inputNormalizer options + Encoder embedR declaredR <- genericToDhallWithNormalizer inputNormalizer options + + let embed (l :*: r) = + RecordLit (Dhall.Map.union mapL mapR) + where + mapL = + unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedL l) + + mapR = + unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedR r) + + let declared = Record (Dhall.Map.union mapL mapR) + where + mapL = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredL + mapR = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredR + + pure (Encoder {..}) + +instance (GenericToDhall (f :*: g), Selector s, ToDhall a) => GenericToDhall ((f :*: g) :*: M1 S s (K1 i a)) where + genericToDhallWithNormalizer inputNormalizer options@InterpretOptions{..} = do + let nR :: M1 S s (K1 i a) r + nR = undefined + + nameR <- fmap fieldModifier (getSelName nR) + + Encoder embedL declaredL <- genericToDhallWithNormalizer inputNormalizer options + + let Encoder embedR declaredR = injectWith inputNormalizer + + let embed (l :*: M1 (K1 r)) = + RecordLit (Dhall.Map.insert nameR (Core.makeRecordField $ embedR r) mapL) + where + mapL = + unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedL l) + + let declared = Record (Dhall.Map.insert nameR (Core.makeRecordField declaredR) mapL) + where + mapL = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredL + + return (Encoder {..}) + +instance (Selector s, ToDhall a, GenericToDhall (f :*: g)) => GenericToDhall (M1 S s (K1 i a) :*: (f :*: g)) where + genericToDhallWithNormalizer inputNormalizer options@InterpretOptions{..} = do + let nL :: M1 S s (K1 i a) r + nL = undefined + + nameL <- fmap fieldModifier (getSelName nL) + + let Encoder embedL declaredL = injectWith inputNormalizer + + Encoder embedR declaredR <- genericToDhallWithNormalizer inputNormalizer options + + let embed (M1 (K1 l) :*: r) = + RecordLit (Dhall.Map.insert nameL (Core.makeRecordField $ embedL l) mapR) + where + mapR = + unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedR r) + + let declared = Record (Dhall.Map.insert nameL (Core.makeRecordField declaredL) mapR) + where + mapR = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredR + + return (Encoder {..}) + +instance (Selector s1, Selector s2, ToDhall a1, ToDhall a2) => GenericToDhall (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where + genericToDhallWithNormalizer inputNormalizer InterpretOptions{..} = do + let nL :: M1 S s1 (K1 i1 a1) r + nL = undefined + + let nR :: M1 S s2 (K1 i2 a2) r + nR = undefined + + nameL <- fmap fieldModifier (getSelName nL) + nameR <- fmap fieldModifier (getSelName nR) + + let Encoder embedL declaredL = injectWith inputNormalizer + let Encoder embedR declaredR = injectWith inputNormalizer + + let embed (M1 (K1 l) :*: M1 (K1 r)) = + RecordLit $ + Dhall.Map.fromList + [ (nameL, Core.makeRecordField $ embedL l) + , (nameR, Core.makeRecordField $ embedR r) ] + + + let declared = + Record $ Dhall.Map.fromList + [ (nameL, Core.makeRecordField declaredL) + , (nameR, Core.makeRecordField declaredR) ] + + + return (Encoder {..}) + +instance GenericToDhall U1 where + genericToDhallWithNormalizer _ _ = pure (Encoder {..}) + where + embed _ = RecordLit mempty + + declared = Record mempty + +{-| Use the default options for injecting a value, whose structure is +determined generically. + +This can be used when you want to use 'ToDhall' on types that you don't +want to define orphan instances for. +-} +genericToDhall + :: (Generic a, GenericToDhall (Rep a)) => Encoder a +genericToDhall + = genericToDhallWith defaultInterpretOptions + +{-| Use custom options for injecting a value, whose structure is +determined generically. + +This can be used when you want to use 'ToDhall' on types that you don't +want to define orphan instances for. +-} +genericToDhallWith + :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a +genericToDhallWith options = genericToDhallWithInputNormalizer options defaultInputNormalizer + +{-| `genericToDhallWithInputNormalizer` is like `genericToDhallWith`, but + instead of using the `defaultInputNormalizer` it expects an custom + `InputNormalizer`. +-} +genericToDhallWithInputNormalizer + :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> InputNormalizer -> Encoder a +genericToDhallWithInputNormalizer options inputNormalizer + = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer inputNormalizer options) 1) + + + +{-| The 'RecordEncoder' divisible (contravariant) functor allows you to build + an 'Encoder' for a Dhall record. + + For example, let's take the following Haskell data type: + +>>> :{ +data Project = Project + { projectName :: Text + , projectDescription :: Text + , projectStars :: Natural + } +:} + + And assume that we have the following Dhall record that we would like to + parse as a @Project@: + +> { name = +> "dhall-haskell" +> , description = +> "A configuration language guaranteed to terminate" +> , stars = +> 289 +> } + + Our encoder has type 'Encoder' @Project@, but we can't build that out of any + smaller encoders, as 'Encoder's cannot be combined (they are only 'Contravariant's). + However, we can use an 'RecordEncoder' to build an 'Encoder' for @Project@: + +>>> :{ +injectProject :: Encoder Project +injectProject = + recordEncoder + ( adapt >$< encodeFieldWith "name" inject + >*< encodeFieldWith "description" inject + >*< encodeFieldWith "stars" inject + ) + where + adapt (Project{..}) = (projectName, (projectDescription, projectStars)) +:} + + Or, since we are simply using the `ToDhall` instance to inject each field, we could write + +>>> :{ +injectProject :: Encoder Project +injectProject = + recordEncoder + ( adapt >$< encodeField "name" + >*< encodeField "description" + >*< encodeField "stars" + ) + where + adapt (Project{..}) = (projectName, (projectDescription, projectStars)) +:} + +-} +newtype RecordEncoder a + = RecordEncoder (Dhall.Map.Map Text (Encoder a)) + +instance Contravariant RecordEncoder where + contramap f (RecordEncoder encodeTypeRecord) = RecordEncoder $ contramap f <$> encodeTypeRecord + +instance Divisible RecordEncoder where + divide f (RecordEncoder bEncoderRecord) (RecordEncoder cEncoderRecord) = + RecordEncoder + $ Dhall.Map.union + ((contramap $ fst . f) <$> bEncoderRecord) + ((contramap $ snd . f) <$> cEncoderRecord) + conquer = RecordEncoder mempty + +-- | Convert a `RecordEncoder` into the equivalent `Encoder`. +recordEncoder :: RecordEncoder a -> Encoder a +recordEncoder (RecordEncoder encodeTypeRecord) = Encoder makeRecordLit recordType + where + recordType = Record $ (Core.makeRecordField . declared) <$> encodeTypeRecord + makeRecordLit x = RecordLit $ (Core.makeRecordField . ($ x) . embed) <$> encodeTypeRecord + +{-| Specify how to encode one field of a record using the default `ToDhall` + instance for that type. +-} +encodeField :: ToDhall a => Text -> RecordEncoder a +encodeField name = encodeFieldWith name inject + +{-| Specify how to encode one field of a record by supplying an explicit + `Encoder` for that field. +-} +encodeFieldWith :: Text -> Encoder a -> RecordEncoder a +encodeFieldWith name encodeType = RecordEncoder $ Dhall.Map.singleton name encodeType + + + +{-| 'UnionEncoder' allows you to build an 'Encoder' for a Dhall record. + + For example, let's take the following Haskell data type: + +>>> :{ +data Status = Queued Natural + | Result Text + | Errored Text +:} + + And assume that we have the following Dhall union that we would like to + parse as a @Status@: + +> < Result : Text +> | Queued : Natural +> | Errored : Text +> >.Result "Finish successfully" + + Our encoder has type 'Encoder' @Status@, but we can't build that out of any + smaller encoders, as 'Encoder's cannot be combined. + However, we can use an 'UnionEncoder' to build an 'Encoder' for @Status@: + +>>> :{ +injectStatus :: Encoder Status +injectStatus = adapt >$< unionEncoder + ( encodeConstructorWith "Queued" inject + >|< encodeConstructorWith "Result" inject + >|< encodeConstructorWith "Errored" inject + ) + where + adapt (Queued n) = Left n + adapt (Result t) = Right (Left t) + adapt (Errored e) = Right (Right e) +:} + + Or, since we are simply using the `ToDhall` instance to inject each branch, we could write + +>>> :{ +injectStatus :: Encoder Status +injectStatus = adapt >$< unionEncoder + ( encodeConstructor "Queued" + >|< encodeConstructor "Result" + >|< encodeConstructor "Errored" + ) + where + adapt (Queued n) = Left n + adapt (Result t) = Right (Left t) + adapt (Errored e) = Right (Right e) +:} + +-} +newtype UnionEncoder a = + UnionEncoder + ( Data.Functor.Product.Product + ( Control.Applicative.Const + ( Dhall.Map.Map + Text + ( Expr Src Void ) + ) + ) + ( Op (Text, Expr Src Void) ) + a + ) + deriving (Contravariant) + +-- | Convert a `UnionEncoder` into the equivalent `Encoder`. +unionEncoder :: UnionEncoder a -> Encoder a +unionEncoder ( UnionEncoder ( Data.Functor.Product.Pair ( Control.Applicative.Const fields ) ( Op embedF ) ) ) = + Encoder + { embed = \x -> + let (name, y) = embedF x + in case notEmptyRecordLit y of + Nothing -> Field (Union fields') $ Core.makeFieldSelection name + Just val -> App (Field (Union fields') $ Core.makeFieldSelection name) val + , declared = + Union fields' + } + where + fields' = fmap notEmptyRecord fields + +{-| Specify how to encode an alternative by using the default `ToDhall` instance + for that type. +-} +encodeConstructor + :: ToDhall a + => Text + -> UnionEncoder a +encodeConstructor name = encodeConstructorWith name inject + +{-| Specify how to encode an alternative by providing an explicit `Encoder` + for that alternative. +-} +encodeConstructorWith + :: Text + -> Encoder a + -> UnionEncoder a +encodeConstructorWith name encodeType = UnionEncoder $ + Data.Functor.Product.Pair + ( Control.Applicative.Const + ( Dhall.Map.singleton + name + ( declared encodeType ) + ) + ) + ( Op ( (name,) . embed encodeType ) + ) + +-- | Combines two 'UnionEncoder' values. See 'UnionEncoder' for usage +-- notes. +-- +-- Ideally, this matches 'Data.Functor.Contravariant.Divisible.chosen'; +-- however, this allows 'UnionEncoder' to not need a 'Divisible' instance +-- itself (since no instance is possible). +(>|<) :: UnionEncoder a -> UnionEncoder b -> UnionEncoder (Either a b) +UnionEncoder (Data.Functor.Product.Pair (Control.Applicative.Const mx) (Op fx)) + >|< UnionEncoder (Data.Functor.Product.Pair (Control.Applicative.Const my) (Op fy)) = + UnionEncoder + ( Data.Functor.Product.Pair + ( Control.Applicative.Const (mx <> my) ) + ( Op (either fx fy) ) + ) + +infixr 5 >|< + + + +-- | Infix 'divided' +(>*<) :: Divisible f => f a -> f b -> f (a, b) +(>*<) = divided + +infixr 5 >*< diff --git a/src/Dhall/Marshal/Internal.hs b/src/Dhall/Marshal/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Marshal/Internal.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining + how to use the language, the compiler, and this library +-} + +module Dhall.Marshal.Internal + ( InputNormalizer(..) + , defaultInputNormalizer + , InterpretOptions(..) + , SingletonConstructors(..) + , defaultInterpretOptions + + -- * Miscellaneous + , Result(..) + + -- * Helpers for the generic deriving machinery + , getSelName + , notEmptyRecord + , notEmptyRecordLit + , unsafeExpectRecord + , unsafeExpectRecordLit + , unsafeExpectUnion + , unsafeExpectUnionLit + + -- * Re-exports + , Fix(..) + , HashMap + , Int8 + , Int16 + , Int32 + , Int64 + , Map + , Natural + , Scientific + , Seq + , Text + , Vector + , Void + , Word8 + , Word16 + , Word32 + , Word64 + , Generic + ) where + +import Control.Monad.Trans.State.Strict +import Data.Fix (Fix (..)) +import Data.HashMap.Strict (HashMap) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Map (Map) +import Data.Scientific (Scientific) +import Data.Sequence (Seq) +import Data.Text (Text) +import Data.Vector (Vector) +import Data.Void (Void) +import Data.Word (Word16, Word32, Word64, Word8) +import Dhall.Parser (Src (..)) +import Dhall.Syntax (Expr (..), RecordField (..)) +import GHC.Generics +import Numeric.Natural (Natural) +import Prelude hiding (maybe, sequence) + +import qualified Data.Text +import qualified Dhall.Core as Core +import qualified Dhall.Map + +{-| This type is exactly the same as `Data.Fix.Fix` except with a different + `Dhall.Marshal.Decode.FromDhall` instance. This intermediate type + simplifies the implementation of the inner loop for the + `Dhall.Marshal.Decode.FromDhall` instance for `Fix`. +-} +newtype Result f = Result { _unResult :: f (Result f) } + +{-| Use these options to tweak how Dhall derives a generic implementation of + `Dhall.Marshal.Decode.FromDhall`. +-} +data InterpretOptions = InterpretOptions + { fieldModifier :: Text -> Text + -- ^ Function used to transform Haskell field names into their corresponding + -- Dhall field names + , constructorModifier :: Text -> Text + -- ^ Function used to transform Haskell constructor names into their + -- corresponding Dhall alternative names + , singletonConstructors :: SingletonConstructors + -- ^ Specify how to handle constructors with only one field. The default is + -- `Smart` + } + +{-| This is only used by the `Dhall.Marshal.Decode.FromDhall` instance for + functions in order to normalize the function input before marshaling the + input into a Dhall expression. +-} +newtype InputNormalizer = InputNormalizer + { getInputNormalizer :: Core.ReifiedNormalizer Void } + +-- | Default normalization-related settings (no custom normalization) +defaultInputNormalizer :: InputNormalizer +defaultInputNormalizer = InputNormalizer + { getInputNormalizer = Core.ReifiedNormalizer (const (pure Nothing)) } + +{-| This type specifies how to model a Haskell constructor with 1 field in + Dhall + + For example, consider the following Haskell datatype definition: + + > data Example = Foo { x :: Double } | Bar Double + + Depending on which option you pick, the corresponding Dhall type could be: + + > < Foo : Double | Bar : Double > -- Bare + + > < Foo : { x : Double } | Bar : { _1 : Double } > -- Wrapped + + > < Foo : { x : Double } | Bar : Double > -- Smart +-} +data SingletonConstructors + = Bare + -- ^ Never wrap the field in a record + | Wrapped + -- ^ Always wrap the field in a record + | Smart + -- ^ Only fields in a record if they are named + +{-| Default interpret options for generics-based instances, + which you can tweak or override, like this: + +> genericAutoWith +> (defaultInterpretOptions { fieldModifier = Data.Text.Lazy.dropWhile (== '_') }) +-} +defaultInterpretOptions :: InterpretOptions +defaultInterpretOptions = InterpretOptions + { fieldModifier = + id + , constructorModifier = + id + , singletonConstructors = + Smart + } + +unsafeExpectUnion + :: Text -> Expr Src Void -> Dhall.Map.Map Text (Maybe (Expr Src Void)) +unsafeExpectUnion _ (Union kts) = + kts +unsafeExpectUnion name expression = + Core.internalError + (name <> ": Unexpected constructor: " <> Core.pretty expression) + +unsafeExpectRecord + :: Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void) +unsafeExpectRecord _ (Record kts) = + kts +unsafeExpectRecord name expression = + Core.internalError + (name <> ": Unexpected constructor: " <> Core.pretty expression) + +unsafeExpectUnionLit + :: Text + -> Expr Src Void + -> (Text, Maybe (Expr Src Void)) +unsafeExpectUnionLit _ (Field (Union _) (Core.fieldSelectionLabel -> k)) = + (k, Nothing) +unsafeExpectUnionLit _ (App (Field (Union _) (Core.fieldSelectionLabel -> k)) v) = + (k, Just v) +unsafeExpectUnionLit name expression = + Core.internalError + (name <> ": Unexpected constructor: " <> Core.pretty expression) + +unsafeExpectRecordLit + :: Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void) +unsafeExpectRecordLit _ (RecordLit kvs) = + kvs +unsafeExpectRecordLit name expression = + Core.internalError + (name <> ": Unexpected constructor: " <> Core.pretty expression) + +notEmptyRecordLit :: Expr s a -> Maybe (Expr s a) +notEmptyRecordLit e = case e of + RecordLit m | null m -> Nothing + _ -> Just e + +notEmptyRecord :: Expr s a -> Maybe (Expr s a) +notEmptyRecord e = case e of + Record m | null m -> Nothing + _ -> Just e + +getSelName :: Selector s => M1 i s f a -> State Int Text +getSelName n = case selName n of + "" -> do i <- get + put (i + 1) + pure (Data.Text.pack ("_" ++ show i)) + nn -> pure (Data.Text.pack nn) diff --git a/src/Dhall/Normalize.hs b/src/Dhall/Normalize.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Normalize.hs @@ -0,0 +1,1037 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} + +module Dhall.Normalize ( + alphaNormalize + , normalize + , normalizeWith + , normalizeWithM + , Normalizer + , NormalizerM + , ReifiedNormalizer (..) + , judgmentallyEqual + , subst + , Syntax.shift + , isNormalized + , isNormalizedWith + , freeIn + ) where + +import Control.Applicative (empty) +import Data.Foldable +import Data.Functor.Identity (Identity (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Sequence (ViewL (..), ViewR (..)) +import Data.Traversable +import Instances.TH.Lift () +import Prelude hiding (succ) + +import Dhall.Syntax + ( Binding (Binding) + , Chunks (..) + , DhallDouble (..) + , Expr (..) + , FieldSelection (..) + , FunctionBinding (..) + , PreferAnnotation (..) + , RecordField (..) + , Var (..) + , WithComponent (..) + ) + +import qualified Data.Sequence +import qualified Data.Set +import qualified Data.Text as Text +import qualified Dhall.Eval as Eval +import qualified Dhall.Map +import qualified Dhall.Syntax as Syntax +import qualified Lens.Micro as Lens + +{-| Returns `True` if two expressions are α-equivalent and β-equivalent and + `False` otherwise + + `judgmentallyEqual` can fail with an `error` if you compare ill-typed + expressions +-} +judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool +judgmentallyEqual = Eval.judgmentallyEqual +{-# INLINE judgmentallyEqual #-} + +{-| Substitute all occurrences of a variable with an expression + +> subst x C B ~ B[x := C] +-} +subst :: Var -> Expr s a -> Expr s a -> Expr s a +subst _ _ (Const a) = Const a +subst (V x n) e (Lam cs (FunctionBinding src0 y src1 src2 _A) b) = + Lam cs (FunctionBinding src0 y src1 src2 _A') b' + where + _A' = subst (V x n ) e _A + b' = subst (V x n') (Syntax.shift 1 (V y 0) e) b + n' = if x == y then n + 1 else n +subst (V x n) e (Pi cs y _A _B) = Pi cs y _A' _B' + where + _A' = subst (V x n ) e _A + _B' = subst (V x n') (Syntax.shift 1 (V y 0) e) _B + n' = if x == y then n + 1 else n +subst v e (Var v') = if v == v' then e else Var v' +subst (V x n) e (Let (Binding src0 f src1 mt src2 r) b) = + Let (Binding src0 f src1 mt' src2 r') b' + where + b' = subst (V x n') (Syntax.shift 1 (V f 0) e) b + where + n' = if x == f then n + 1 else n + + mt' = fmap (fmap (subst (V x n) e)) mt + r' = subst (V x n) e r +subst x e expression = Lens.over Syntax.subExpressions (subst x e) expression + +{-| This function is used to determine whether folds like @Natural/fold@ or + @List/fold@ should be lazy or strict in their accumulator based on the type + of the accumulator + + If this function returns `True`, then they will be strict in their + accumulator since we can guarantee an upper bound on the amount of work to + normalize the accumulator on each step of the loop. If this function + returns `False` then they will be lazy in their accumulator and only + normalize the final result at the end of the fold +-} +boundedType :: Expr s a -> Bool +boundedType Bool = True +boundedType Natural = True +boundedType Integer = True +boundedType Double = True +boundedType Text = True +boundedType (App List _) = False +boundedType (App Optional t) = boundedType t +boundedType (Record kvs) = all (boundedType . recordFieldValue) kvs +boundedType (Union kvs) = all (all boundedType) kvs +boundedType _ = False + +{-| α-normalize an expression by renaming all bound variables to @\"_\"@ and + using De Bruijn indices to distinguish them + +>>> mfb = Syntax.makeFunctionBinding +>>> alphaNormalize (Lam mempty (mfb "a" (Const Type)) (Lam mempty (mfb "b" (Const Type)) (Lam mempty (mfb "x" "a") (Lam mempty (mfb "y" "b") "x")))) +Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Var (V "_" 1))))) + + α-normalization does not affect free variables: + +>>> alphaNormalize "x" +Var (V "x" 0) + +-} +alphaNormalize :: Expr s a -> Expr s a +alphaNormalize = Eval.alphaNormalize +{-# INLINE alphaNormalize #-} + +{-| Reduce an expression to its normal form, performing beta reduction + + `normalize` does not type-check the expression. You may want to type-check + expressions before normalizing them since normalization can convert an + ill-typed expression into a well-typed expression. + + `normalize` can also fail with `error` if you normalize an ill-typed + expression +-} +normalize :: Eq a => Expr s a -> Expr t a +normalize = Eval.normalize +{-# INLINE normalize #-} + +{-| Reduce an expression to its normal form, performing beta reduction and applying + any custom definitions. + + `normalizeWith` is designed to be used with function `Dhall.TypeCheck.typeWith`. The `Dhall.TypeCheck.typeWith` + function allows typing of Dhall functions in a custom typing context whereas + `normalizeWith` allows evaluating Dhall expressions in a custom context. + + To be more precise `normalizeWith` applies the given normalizer when it finds an + application term that it cannot reduce by other means. + + Note that the context used in normalization will determine the properties of normalization. + That is, if the functions in custom context are not total then the Dhall language, evaluated + with those functions is not total either. + + `normalizeWith` can fail with an `error` if you normalize an ill-typed + expression +-} +normalizeWith :: Eq a => Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a +normalizeWith (Just ctx) t = runIdentity (normalizeWithM (getReifiedNormalizer ctx) t) +normalizeWith _ t = Eval.normalize t +{-# INLINABLE normalizeWith #-} + +{-| This function generalizes `normalizeWith` by allowing the custom normalizer + to use an arbitrary `Monad` + + `normalizeWithM` can fail with an `error` if you normalize an ill-typed + expression +-} +normalizeWithM + :: (Monad m, Eq a) => NormalizerM m a -> Expr s a -> m (Expr t a) +normalizeWithM ctx e0 = loop (Syntax.denote e0) + where + loop e = ctx e >>= \case + Just e' -> loop e' + Nothing -> case e of + Const k -> pure (Const k) + Var v -> pure (Var v) + Lam cs (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A }) b -> + Lam cs <$> (Syntax.makeFunctionBinding x <$> _A') <*> b' + where + _A' = loop _A + b' = loop b + Pi cs x _A _B -> Pi cs x <$> _A' <*> _B' + where + _A' = loop _A + _B' = loop _B + App f a -> do + f' <- loop f + a' <- loop a + case f' of + Lam _ (FunctionBinding _ x _ _ _A) b₀ -> do + + let a₂ = Syntax.shift 1 (V x 0) a' + let b₁ = subst (V x 0) a₂ b₀ + let b₂ = Syntax.shift (-1) (V x 0) b₁ + + loop b₂ + _ -> + case App f' a' of + App (App (App (App NaturalFold (NaturalLit n0)) t) succ') zero -> do + t' <- loop t + if boundedType t' then strict else lazy + where + -- Use an `Integer` for the loop, due to the following + -- issue: + -- + -- https://github.com/ghcjs/ghcjs/issues/782 + strict = strictLoop (fromIntegral n0 :: Integer) + lazy = loop ( lazyLoop (fromIntegral n0 :: Integer)) + + strictLoop !n = do + z <- loop zero + strictLoopShortcut n z + + strictLoopShortcut 0 !previous = pure previous + strictLoopShortcut !n !previous = do + current <- loop (App succ' previous) + if judgmentallyEqual previous current + then pure previous + else strictLoopShortcut (n - 1) current + + lazyLoop 0 = zero + lazyLoop !n = App succ' (lazyLoop (n - 1)) + App NaturalBuild g -> loop (App (App (App g Natural) succ) zero) + where + succ = Lam mempty (Syntax.makeFunctionBinding "n" Natural) (NaturalPlus "n" (NaturalLit 1)) + + zero = NaturalLit 0 + App NaturalIsZero (NaturalLit n) -> pure (BoolLit (n == 0)) + App NaturalEven (NaturalLit n) -> pure (BoolLit (even n)) + App NaturalOdd (NaturalLit n) -> pure (BoolLit (odd n)) + App NaturalToInteger (NaturalLit n) -> pure (IntegerLit (toInteger n)) + App NaturalShow (NaturalLit n) -> + pure (TextLit (Chunks [] (Text.pack (show n)))) + App (App NaturalSubtract (NaturalLit x)) (NaturalLit y) + -- Use an `Integer` for the subtraction, due to the + -- following issue: + -- + -- https://github.com/ghcjs/ghcjs/issues/782 + | y >= x -> + pure (NaturalLit (fromIntegral (subtract (fromIntegral x :: Integer) (fromIntegral y :: Integer)))) + | otherwise -> + pure (NaturalLit 0) + App (App NaturalSubtract (NaturalLit 0)) y -> pure y + App (App NaturalSubtract _) (NaturalLit 0) -> pure (NaturalLit 0) + App (App NaturalSubtract x) y | Eval.judgmentallyEqual x y -> pure (NaturalLit 0) + App IntegerClamp (IntegerLit n) + | 0 <= n -> pure (NaturalLit (fromInteger n)) + | otherwise -> pure (NaturalLit 0) + App IntegerNegate (IntegerLit n) -> + pure (IntegerLit (negate n)) + App IntegerShow (IntegerLit n) + | 0 <= n -> pure (TextLit (Chunks [] ("+" <> Text.pack (show n)))) + | otherwise -> pure (TextLit (Chunks [] (Text.pack (show n)))) + -- `(read . show)` is used instead of `fromInteger` because `read` uses + -- the correct rounding rule. + -- See https://gitlab.haskell.org/ghc/ghc/issues/17231. + App IntegerToDouble (IntegerLit n) -> pure (DoubleLit ((DhallDouble . read . show) n)) + App DoubleShow (DoubleLit (DhallDouble n)) -> + pure (TextLit (Chunks [] (Text.pack (show n)))) + App (App ListBuild _A₀) g -> loop (App (App (App g list) cons) nil) + where + _A₁ = Syntax.shift 1 "a" _A₀ + + list = App List _A₀ + + cons = + Lam mempty (Syntax.makeFunctionBinding "a" _A₀) + (Lam mempty + (Syntax.makeFunctionBinding "as" (App List _A₁)) + (ListAppend (ListLit Nothing (pure "a")) "as") + ) + + nil = ListLit (Just (App List _A₀)) empty + App (App (App (App (App ListFold _) (ListLit _ xs)) t) cons) nil -> do + t' <- loop t + if boundedType t' then strict else lazy + where + strict = foldr strictCons strictNil xs + lazy = loop (foldr lazyCons lazyNil xs) + + strictNil = loop nil + lazyNil = nil + + strictCons y ys = + App (App cons y) <$> ys >>= loop + lazyCons y ys = App (App cons y) ys + App (App ListLength _) (ListLit _ ys) -> + pure (NaturalLit (fromIntegral (Data.Sequence.length ys))) + App (App ListHead t) (ListLit _ ys) -> loop o + where + o = case Data.Sequence.viewl ys of + y :< _ -> Some y + _ -> App None t + App (App ListLast t) (ListLit _ ys) -> loop o + where + o = case Data.Sequence.viewr ys of + _ :> y -> Some y + _ -> App None t + App (App ListIndexed _A₀) (ListLit _ as₀) -> loop (ListLit t as₁) + where + as₁ = Data.Sequence.mapWithIndex adapt as₀ + + _A₂ = Record (Dhall.Map.fromList kts) + where + kts = [ ("index", Syntax.makeRecordField Natural) + , ("value", Syntax.makeRecordField _A₀) + ] + + t | null as₀ = Just (App List _A₂) + | otherwise = Nothing + + adapt n a_ = + RecordLit (Dhall.Map.fromList kvs) + where + kvs = [ ("index", Syntax.makeRecordField $ NaturalLit (fromIntegral n)) + , ("value", Syntax.makeRecordField a_) + ] + App (App ListReverse _) (ListLit t xs) -> + loop (ListLit t (Data.Sequence.reverse xs)) + App TextShow (TextLit (Chunks [] oldText)) -> + loop (TextLit (Chunks [] newText)) + where + newText = Eval.textShow oldText + App + (App (App TextReplace (TextLit (Chunks [] ""))) _) + haystack -> + return haystack + App (App + (App TextReplace (TextLit (Chunks [] needleText))) + (TextLit (Chunks [] replacementText)) + ) + (TextLit (Chunks xys z)) -> do + let xys' = do + (x, y) <- xys + + let x' = Text.replace needleText replacementText x + return (x', y) + + let z' = Text.replace needleText replacementText z + + return (TextLit (Chunks xys' z')) + App (App + (App TextReplace (TextLit (Chunks [] needleText))) + replacement + ) + (TextLit (Chunks [] lastText)) -> do + let (prefix, suffix) = + Text.breakOn needleText lastText + + if Text.null suffix + then return (TextLit (Chunks [] lastText)) + else do + let remainder = + Text.drop + (Text.length needleText) + suffix + + loop (TextAppend (TextLit (Chunks [(prefix, replacement)] "")) (App (App (App TextReplace (TextLit (Chunks [] needleText))) replacement) (TextLit (Chunks [] remainder)))) + App (App + (App TextReplace (TextLit (Chunks [] needleText))) + replacement + ) + (TextLit + (Chunks + ((firstText, firstInterpolation) : chunks) + lastText + ) + ) -> do + let (prefix, suffix) = + Text.breakOn needleText firstText + + if Text.null suffix + then do + loop (TextAppend (TextLit (Chunks [(firstText, firstInterpolation)] "")) (App (App (App TextReplace (TextLit (Chunks [] needleText))) replacement) (TextLit (Chunks chunks lastText)))) + else do + let remainder = + Text.drop + (Text.length needleText) + suffix + + loop (TextAppend (TextLit (Chunks [(prefix, replacement)] "")) (App (App (App TextReplace (TextLit (Chunks [] needleText))) replacement) (TextLit (Chunks ((remainder, firstInterpolation) : chunks) lastText)))) + App DateShow (DateLiteral date) -> + loop (TextLit (Chunks [] text)) + where + text = Eval.dateShow date + App TimeShow (TimeLiteral time precision) -> + loop (TextLit (Chunks [] text)) + where + text = Eval.timeShow time precision + App TimeZoneShow (TimeZoneLiteral timezone) -> + loop (TextLit (Chunks [] text)) + where + text = Eval.timezoneShow timezone + _ -> do + res2 <- ctx (App f' a') + case res2 of + Nothing -> pure (App f' a') + Just app' -> loop app' + Let (Binding _ f _ _ _ r) b -> loop b'' + where + r' = Syntax.shift 1 (V f 0) r + b' = subst (V f 0) r' b + b'' = Syntax.shift (-1) (V f 0) b' + Annot x _ -> loop x + Bool -> pure Bool + BoolLit b -> pure (BoolLit b) + BoolAnd x y -> decide <$> loop x <*> loop y + where + decide (BoolLit True ) r = r + decide (BoolLit False) _ = BoolLit False + decide l (BoolLit True ) = l + decide _ (BoolLit False) = BoolLit False + decide l r + | Eval.judgmentallyEqual l r = l + | otherwise = BoolAnd l r + BoolOr x y -> decide <$> loop x <*> loop y + where + decide (BoolLit False) r = r + decide (BoolLit True ) _ = BoolLit True + decide l (BoolLit False) = l + decide _ (BoolLit True ) = BoolLit True + decide l r + | Eval.judgmentallyEqual l r = l + | otherwise = BoolOr l r + BoolEQ x y -> decide <$> loop x <*> loop y + where + decide (BoolLit True ) r = r + decide l (BoolLit True ) = l + decide l r + | Eval.judgmentallyEqual l r = BoolLit True + | otherwise = BoolEQ l r + BoolNE x y -> decide <$> loop x <*> loop y + where + decide (BoolLit False) r = r + decide l (BoolLit False) = l + decide l r + | Eval.judgmentallyEqual l r = BoolLit False + | otherwise = BoolNE l r + BoolIf bool true false -> decide <$> loop bool <*> loop true <*> loop false + where + decide (BoolLit True ) l _ = l + decide (BoolLit False) _ r = r + decide b (BoolLit True) (BoolLit False) = b + decide b l r + | Eval.judgmentallyEqual l r = l + | otherwise = BoolIf b l r + Bytes -> pure Bytes + BytesLit b -> pure (BytesLit b) + Natural -> pure Natural + NaturalLit n -> pure (NaturalLit n) + NaturalFold -> pure NaturalFold + NaturalBuild -> pure NaturalBuild + NaturalIsZero -> pure NaturalIsZero + NaturalEven -> pure NaturalEven + NaturalOdd -> pure NaturalOdd + NaturalToInteger -> pure NaturalToInteger + NaturalShow -> pure NaturalShow + NaturalSubtract -> pure NaturalSubtract + NaturalPlus x y -> decide <$> loop x <*> loop y + where + decide (NaturalLit 0) r = r + decide l (NaturalLit 0) = l + decide (NaturalLit m) (NaturalLit n) = NaturalLit (m + n) + decide l r = NaturalPlus l r + NaturalTimes x y -> decide <$> loop x <*> loop y + where + decide (NaturalLit 1) r = r + decide l (NaturalLit 1) = l + decide (NaturalLit 0) _ = NaturalLit 0 + decide _ (NaturalLit 0) = NaturalLit 0 + decide (NaturalLit m) (NaturalLit n) = NaturalLit (m * n) + decide l r = NaturalTimes l r + Integer -> pure Integer + IntegerLit n -> pure (IntegerLit n) + IntegerClamp -> pure IntegerClamp + IntegerNegate -> pure IntegerNegate + IntegerShow -> pure IntegerShow + IntegerToDouble -> pure IntegerToDouble + Double -> pure Double + DoubleLit n -> pure (DoubleLit n) + DoubleShow -> pure DoubleShow + Text -> pure Text + TextLit (Chunks xys z) -> do + chunks' <- mconcat <$> chunks + case chunks' of + Chunks [("", x)] "" -> pure x + c -> pure (TextLit c) + where + chunks = + ((++ [Chunks [] z]) . concat) <$> traverse process xys + + process (x, y) = do + y' <- loop y + case y' of + TextLit c -> pure [Chunks [] x, c] + _ -> pure [Chunks [(x, y')] mempty] + TextAppend x y -> loop (TextLit (Chunks [("", x), ("", y)] "")) + TextReplace -> pure TextReplace + TextShow -> pure TextShow + Date -> pure Date + DateLiteral d -> pure (DateLiteral d) + DateShow -> pure DateShow + Time -> pure Time + TimeLiteral t p -> pure (TimeLiteral t p) + TimeShow -> pure TimeShow + TimeZone -> pure TimeZone + TimeZoneLiteral z -> pure (TimeZoneLiteral z) + TimeZoneShow -> pure TimeZoneShow + List -> pure List + ListLit t es + | Data.Sequence.null es -> ListLit <$> t' <*> pure Data.Sequence.empty + | otherwise -> ListLit Nothing <$> es' + where + t' = traverse loop t + es' = traverse loop es + ListAppend x y -> decide <$> loop x <*> loop y + where + decide (ListLit _ m) r | Data.Sequence.null m = r + decide l (ListLit _ n) | Data.Sequence.null n = l + decide (ListLit t m) (ListLit _ n) = ListLit t (m <> n) + decide l r = ListAppend l r + ListBuild -> pure ListBuild + ListFold -> pure ListFold + ListLength -> pure ListLength + ListHead -> pure ListHead + ListLast -> pure ListLast + ListIndexed -> pure ListIndexed + ListReverse -> pure ListReverse + Optional -> pure Optional + Some a -> Some <$> a' + where + a' = loop a + None -> pure None + Record kts -> Record . Dhall.Map.sort <$> kts' + where + f (RecordField s0 expr s1 s2) = (\expr' -> RecordField s0 expr' s1 s2) <$> loop expr + kts' = traverse f kts + RecordLit kvs -> RecordLit . Dhall.Map.sort <$> kvs' + where + f (RecordField s0 expr s1 s2) = (\expr' -> RecordField s0 expr' s1 s2) <$> loop expr + kvs' = traverse f kvs + Union kts -> Union . Dhall.Map.sort <$> kts' + where + kts' = traverse (traverse loop) kts + Combine cs mk x y -> decide <$> loop x <*> loop y + where + decide (RecordLit m) r | Data.Foldable.null m = + r + decide l (RecordLit n) | Data.Foldable.null n = + l + decide (RecordLit m) (RecordLit n) = + RecordLit (Dhall.Map.unionWith f m n) + where + f (RecordField _ expr _ _) (RecordField _ expr' _ _) = + Syntax.makeRecordField $ decide expr expr' + decide l r = + Combine cs mk l r + CombineTypes cs x y -> decide <$> loop x <*> loop y + where + decide (Record m) r | Data.Foldable.null m = + r + decide l (Record n) | Data.Foldable.null n = + l + decide (Record m) (Record n) = + Record (Dhall.Map.unionWith f m n) + where + f (RecordField _ expr _ _) (RecordField _ expr' _ _) = + Syntax.makeRecordField $ decide expr expr' + decide l r = + CombineTypes cs l r + Prefer cs _ x y -> decide <$> loop x <*> loop y + where + decide (RecordLit m) r | Data.Foldable.null m = + r + decide l (RecordLit n) | Data.Foldable.null n = + l + decide (RecordLit m) (RecordLit n) = + RecordLit (Dhall.Map.union n m) + decide l r | Eval.judgmentallyEqual l r = + l + decide l r = + Prefer cs PreferFromSource l r + RecordCompletion x y -> + loop (Annot (Prefer mempty PreferFromCompletion (Field x def) y) (Field x typ)) + where + def = Syntax.makeFieldSelection "default" + typ = Syntax.makeFieldSelection "Type" + Merge x y t -> do + x' <- loop x + y' <- loop y + case x' of + RecordLit kvsX -> + case y' of + Field (Union ktsY) (Syntax.fieldSelectionLabel -> kY) -> + case Dhall.Map.lookup kY ktsY of + Just Nothing -> + case recordFieldValue <$> Dhall.Map.lookup kY kvsX of + Just vX -> return vX + Nothing -> Merge x' y' <$> t' + _ -> + Merge x' y' <$> t' + App (Field (Union ktsY) (Syntax.fieldSelectionLabel -> kY)) vY -> + case Dhall.Map.lookup kY ktsY of + Just (Just _) -> + case recordFieldValue <$> Dhall.Map.lookup kY kvsX of + Just vX -> loop (App vX vY) + Nothing -> Merge x' y' <$> t' + _ -> + Merge x' y' <$> t' + Some a -> + case recordFieldValue <$> Dhall.Map.lookup "Some" kvsX of + Just vX -> loop (App vX a) + Nothing -> Merge x' y' <$> t' + App None _ -> + case recordFieldValue <$> Dhall.Map.lookup "None" kvsX of + Just vX -> return vX + Nothing -> Merge x' y' <$> t' + _ -> Merge x' y' <$> t' + _ -> Merge x' y' <$> t' + where + t' = traverse loop t + ToMap x t -> do + x' <- loop x + t' <- traverse loop t + case x' of + RecordLit kvsX -> do + let entry (key, value) = + RecordLit + (Dhall.Map.fromList + [ ("mapKey" , Syntax.makeRecordField $ TextLit (Chunks [] key)) + , ("mapValue", Syntax.makeRecordField value ) + ] + ) + + let keyValues = Data.Sequence.fromList (map entry (Dhall.Map.toList $ recordFieldValue <$> kvsX)) + + let listType = case t' of + Just _ | null keyValues -> + t' + _ -> + Nothing + + return (ListLit listType keyValues) + _ -> + return (ToMap x' t') + ShowConstructor x -> do + x' <- loop x + return $ case x' of + Field (Union ktsY) (Syntax.fieldSelectionLabel -> kY) -> + case Dhall.Map.lookup kY ktsY of + Just Nothing -> TextLit (Chunks [] kY) + _ -> ShowConstructor x' + App (Field (Union ktsY) (Syntax.fieldSelectionLabel -> kY)) _ -> + case Dhall.Map.lookup kY ktsY of + Just (Just _) -> TextLit (Chunks [] kY) + _ -> ShowConstructor x' + Some _ -> + TextLit (Chunks [] "Some") + App None _ -> + TextLit (Chunks [] "None") + _ -> ShowConstructor x' + Field r k@FieldSelection{fieldSelectionLabel = x} -> do + let singletonRecordLit v = RecordLit (Dhall.Map.singleton x v) + + r' <- loop r + case r' of + RecordLit kvs -> + case Dhall.Map.lookup x kvs of + Just v -> pure $ recordFieldValue v + Nothing -> Field <$> (RecordLit <$> traverse (Syntax.recordFieldExprs loop) kvs) <*> pure k + Project r_ _ -> loop (Field r_ k) + Prefer cs _ (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of + Just v -> pure (Field (Prefer cs PreferFromSource (singletonRecordLit v) r_) k) + Nothing -> loop (Field r_ k) + Prefer _ _ l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of + Just v -> pure $ recordFieldValue v + Nothing -> loop (Field l k) + Combine cs m (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of + Just v -> pure (Field (Combine cs m (singletonRecordLit v) r_) k) + Nothing -> loop (Field r_ k) + Combine cs m l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of + Just v -> pure (Field (Combine cs m l (singletonRecordLit v)) k) + Nothing -> loop (Field l k) + _ -> pure (Field r' k) + Project x (Left fields)-> do + x' <- loop x + let fieldsSet = Data.Set.fromList fields + case x' of + RecordLit kvs -> + pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet)) + Project y _ -> + loop (Project y (Left fields)) + Prefer cs _ l (RecordLit rKvs) -> do + let rKs = Dhall.Map.keysSet rKvs + let l' = Project l (Left (Data.Set.toList (Data.Set.difference fieldsSet rKs))) + let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet) + loop (Prefer cs PreferFromSource l' r') + _ | null fields -> pure (RecordLit mempty) + | otherwise -> pure (Project x' (Left (Data.Set.toList (Data.Set.fromList fields)))) + Project r (Right e1) -> do + e2 <- loop e1 + + case e2 of + Record kts -> + loop (Project r (Left (Data.Set.toList (Dhall.Map.keysSet kts)))) + _ -> do + r' <- loop r + pure (Project r' (Right e2)) + Assert t -> do + t' <- loop t + + pure (Assert t') + Equivalent cs l r -> do + l' <- loop l + r' <- loop r + + pure (Equivalent cs l' r') + With r ks v -> do + r' <- loop r + v' <- loop v + + case r' of + RecordLit kvs -> + case ks of + WithLabel k :| [] -> + return (RecordLit (Dhall.Map.insert k (Syntax.makeRecordField v') kvs)) + WithLabel k₀ :| k₁ : ks' -> do + let e₁ = + case Dhall.Map.lookup k₀ kvs of + Nothing -> RecordLit mempty + Just val -> Syntax.recordFieldValue val + + e₂ <- loop (With e₁ (k₁ :| ks') v') + + return (RecordLit (Dhall.Map.insert k₀ (Syntax.makeRecordField e₂) kvs)) + WithQuestion :| _ -> do + return (With r' ks v') + Some t -> + case ks of + WithQuestion :| [] -> do + return (Some v') + WithQuestion :| k : ks' -> do + w <- loop (With t (k :| ks') v) + return (Some w) + WithLabel _ :| _ -> + return (With r' ks v') + App None _T -> + case ks of + WithQuestion :| _ -> + return (App None _T) + WithLabel _ :| _ -> + return (With r' ks v') + _ -> + return (With r' ks v') + Note _ e' -> loop e' + ImportAlt l _r -> loop l + Embed a -> pure (Embed a) + +-- | Use this to wrap you embedded functions (see `normalizeWith`) to make them +-- polymorphic enough to be used. +type NormalizerM m a = forall s. Expr s a -> m (Maybe (Expr s a)) + +-- | An variation on `NormalizerM` for pure normalizers +type Normalizer a = NormalizerM Identity a + +-- | A reified 'Normalizer', which can be stored in structures without +-- running into impredicative polymorphism. +newtype ReifiedNormalizer a = ReifiedNormalizer + { getReifiedNormalizer :: Normalizer a } + +-- | Check if an expression is in a normal form given a context of evaluation. +-- Unlike `isNormalized`, this will fully normalize and traverse through the expression. +-- +-- It is much more efficient to use `isNormalized`. +-- +-- `isNormalizedWith` can fail with an `error` if you check an ill-typed +-- expression +isNormalizedWith :: (Eq s, Eq a) => Normalizer a -> Expr s a -> Bool +isNormalizedWith ctx e = e == normalizeWith (Just (ReifiedNormalizer ctx)) e + +-- | Quickly check if an expression is in normal form +-- +-- Given a well-typed expression @e@, @'isNormalized' e@ is equivalent to +-- @e == 'normalize' e@. +-- +-- Given an ill-typed expression, 'isNormalized' may fail with an error, or +-- evaluate to either False or True! +isNormalized :: Eq a => Expr s a -> Bool +isNormalized e0 = loop (Syntax.denote e0) + where + loop e = case e of + Const _ -> True + Var _ -> True + Lam _ (FunctionBinding Nothing _ Nothing Nothing a) b -> loop a && loop b + Lam _ _ _ -> False + Pi _ _ a b -> loop a && loop b + App f a -> loop f && loop a && case App f a of + App (Lam _ _ _) _ -> False + App (App (App (App NaturalFold (NaturalLit _)) _) _) _ -> False + App NaturalBuild _ -> False + App NaturalIsZero (NaturalLit _) -> False + App NaturalEven (NaturalLit _) -> False + App NaturalOdd (NaturalLit _) -> False + App NaturalShow (NaturalLit _) -> False + App DateShow (DateLiteral _) -> False + App TimeShow (TimeLiteral _ _) -> False + App TimeZoneShow (TimeZoneLiteral _) -> False + App (App NaturalSubtract (NaturalLit _)) (NaturalLit _) -> False + App (App NaturalSubtract (NaturalLit 0)) _ -> False + App (App NaturalSubtract _) (NaturalLit 0) -> False + App (App NaturalSubtract x) y -> not (Eval.judgmentallyEqual x y) + App NaturalToInteger (NaturalLit _) -> False + App IntegerNegate (IntegerLit _) -> False + App IntegerClamp (IntegerLit _) -> False + App IntegerShow (IntegerLit _) -> False + App IntegerToDouble (IntegerLit _) -> False + App DoubleShow (DoubleLit _) -> False + App (App ListBuild _) _ -> False + App (App (App (App (App (App ListFold _) (ListLit _ _)) _) _) _) _ -> False + App (App ListLength _) (ListLit _ _) -> False + App (App ListHead _) (ListLit _ _) -> False + App (App ListLast _) (ListLit _ _) -> False + App (App ListIndexed _) (ListLit _ _) -> False + App (App ListReverse _) (ListLit _ _) -> False + App TextShow (TextLit (Chunks [] _)) -> + False + App (App (App TextReplace (TextLit (Chunks [] ""))) _) _ -> + False + App (App (App TextReplace (TextLit (Chunks [] _))) _) (TextLit _) -> + False + _ -> True + Let _ _ -> False + Annot _ _ -> False + Bool -> True + BoolLit _ -> True + BoolAnd x y -> loop x && loop y && decide x y + where + decide (BoolLit _) _ = False + decide _ (BoolLit _) = False + decide l r = not (Eval.judgmentallyEqual l r) + BoolOr x y -> loop x && loop y && decide x y + where + decide (BoolLit _) _ = False + decide _ (BoolLit _) = False + decide l r = not (Eval.judgmentallyEqual l r) + BoolEQ x y -> loop x && loop y && decide x y + where + decide (BoolLit True) _ = False + decide _ (BoolLit True) = False + decide l r = not (Eval.judgmentallyEqual l r) + BoolNE x y -> loop x && loop y && decide x y + where + decide (BoolLit False) _ = False + decide _ (BoolLit False ) = False + decide l r = not (Eval.judgmentallyEqual l r) + BoolIf x y z -> + loop x && loop y && loop z && decide x y z + where + decide (BoolLit _) _ _ = False + decide _ (BoolLit True) (BoolLit False) = False + decide _ l r = not (Eval.judgmentallyEqual l r) + Bytes -> True + BytesLit _ -> True + Natural -> True + NaturalLit _ -> True + NaturalFold -> True + NaturalBuild -> True + NaturalIsZero -> True + NaturalEven -> True + NaturalOdd -> True + NaturalShow -> True + NaturalSubtract -> True + NaturalToInteger -> True + NaturalPlus x y -> loop x && loop y && decide x y + where + decide (NaturalLit 0) _ = False + decide _ (NaturalLit 0) = False + decide (NaturalLit _) (NaturalLit _) = False + decide _ _ = True + NaturalTimes x y -> loop x && loop y && decide x y + where + decide (NaturalLit 0) _ = False + decide _ (NaturalLit 0) = False + decide (NaturalLit 1) _ = False + decide _ (NaturalLit 1) = False + decide (NaturalLit _) (NaturalLit _) = False + decide _ _ = True + Integer -> True + IntegerLit _ -> True + IntegerClamp -> True + IntegerNegate -> True + IntegerShow -> True + IntegerToDouble -> True + Double -> True + DoubleLit _ -> True + DoubleShow -> True + Text -> True + TextLit (Chunks [("", _)] "") -> False + TextLit (Chunks xys _) -> all (all check) xys + where + check y = loop y && case y of + TextLit _ -> False + _ -> True + TextAppend _ _ -> False + TextReplace -> True + TextShow -> True + Date -> True + DateLiteral _ -> True + DateShow -> True + Time -> True + TimeLiteral _ _ -> True + TimeShow -> True + TimeZone -> True + TimeZoneLiteral _ -> True + TimeZoneShow -> True + List -> True + ListLit t es -> all loop t && all loop es + ListAppend x y -> loop x && loop y && decide x y + where + decide (ListLit _ m) _ | Data.Sequence.null m = False + decide _ (ListLit _ n) | Data.Sequence.null n = False + decide (ListLit _ _) (ListLit _ _) = False + decide _ _ = True + ListBuild -> True + ListFold -> True + ListLength -> True + ListHead -> True + ListLast -> True + ListIndexed -> True + ListReverse -> True + Optional -> True + Some a -> loop a + None -> True + Record kts -> Dhall.Map.isSorted kts && all decide kts + where + decide (RecordField Nothing exp' Nothing Nothing) = loop exp' + decide _ = False + RecordLit kvs -> Dhall.Map.isSorted kvs && all decide kvs + where + decide (RecordField Nothing exp' Nothing Nothing) = loop exp' + decide _ = False + Union kts -> Dhall.Map.isSorted kts && all (all loop) kts + Combine _ _ x y -> loop x && loop y && decide x y + where + decide (RecordLit m) _ | Data.Foldable.null m = False + decide _ (RecordLit n) | Data.Foldable.null n = False + decide (RecordLit _) (RecordLit _) = False + decide _ _ = True + CombineTypes _ x y -> loop x && loop y && decide x y + where + decide (Record m) _ | Data.Foldable.null m = False + decide _ (Record n) | Data.Foldable.null n = False + decide (Record _) (Record _) = False + decide _ _ = True + Prefer _ _ x y -> loop x && loop y && decide x y + where + decide (RecordLit m) _ | Data.Foldable.null m = False + decide _ (RecordLit n) | Data.Foldable.null n = False + decide (RecordLit _) (RecordLit _) = False + decide l r = not (Eval.judgmentallyEqual l r) + RecordCompletion _ _ -> False + Merge x y t -> loop x && loop y && all loop t && case x of + RecordLit _ -> case y of + Field (Union _) _ -> False + App (Field (Union _) _) _ -> False + Some _ -> False + App None _ -> False + _ -> True + _ -> True + ToMap x t -> case x of + RecordLit _ -> False + _ -> loop x && all loop t + ShowConstructor x -> loop x && case x of + Field (Union kts) (Syntax.fieldSelectionLabel -> k) -> + case Dhall.Map.lookup k kts of + Just Nothing -> False + _ -> True + App (Field (Union kts) (Syntax.fieldSelectionLabel -> k)) _ -> + case Dhall.Map.lookup k kts of + Just (Just _) -> False + _ -> True + Some _ -> False + App None _ -> False + _ -> True + Field r (FieldSelection Nothing k Nothing) -> case r of + RecordLit _ -> False + Project _ _ -> False + Prefer _ _ (RecordLit m) _ -> Dhall.Map.keys m == [k] && loop r + Prefer _ _ _ (RecordLit _) -> False + Combine _ _ (RecordLit m) _ -> Dhall.Map.keys m == [k] && loop r + Combine _ _ _ (RecordLit m) -> Dhall.Map.keys m == [k] && loop r + _ -> loop r + Field _ _ -> False + Project r p -> loop r && + case p of + Left s -> case r of + RecordLit _ -> False + Project _ _ -> False + Prefer _ _ _ (RecordLit _) -> False + _ -> not (null s) && Data.Set.toList (Data.Set.fromList s) == s + Right e' -> case e' of + Record _ -> False + _ -> loop e' + Assert t -> loop t + Equivalent _ l r -> loop l && loop r + With{} -> False + Note _ e' -> loop e' + ImportAlt _ _ -> False + Embed _ -> True + +{-| Detect if the given variable is free within the given expression + +>>> "x" `freeIn` "x" +True +>>> "x" `freeIn` "y" +False +>>> "x" `freeIn` Lam mempty (Syntax.makeFunctionBinding "x" (Const Type)) "x" +False +-} +freeIn :: Eq a => Var -> Expr s a -> Bool +variable@(V var i) `freeIn` expression = + subst variable (Var (V var (i + 1))) strippedExpression + /= strippedExpression + where + denote' :: Expr t b -> Expr () b + denote' = Syntax.denote + + strippedExpression = denote' expression +{-# INLINABLE freeIn #-} + +{- $setup +>>> import Dhall.Syntax (Const(..)) +-} diff --git a/src/Dhall/Optics.hs b/src/Dhall/Optics.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Optics.hs @@ -0,0 +1,85 @@ +{-| This module contains some useful utilities copy-and-pasted from the @lens@ + library to avoid a dependency which are used internally and also re-exported + for convenience +-} + +{-# LANGUAGE RankNTypes #-} + +module Dhall.Optics {-# DEPRECATED "Use the definitions from Lens.Micro of the microlens package directly." #-} + ( Optic + , Optic' + -- * Utilities + , anyOf + , rewriteOf + , transformOf + , rewriteMOf + , transformMOf + , mapMOf + , cosmosOf + , to + , foldOf + ) where + +import Control.Applicative (Const (..), WrappedMonad (..)) +import Data.Monoid (Any (..)) +import Lens.Micro (ASetter, LensLike, Traversal, SimpleGetter) +import Lens.Micro.Internal ((#.)) + +import qualified Lens.Micro + +-- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.Getting`@ +type Getting r s a = (a -> Const r a) -> s -> Const r s + +-- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic`@ +type Optic p f s t a b = p a (f b) -> p s (f t) + +-- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic'`@ +type Optic' p f s a = Optic p f s s a a + +-- | Identical to @"Control.Lens".`Control.Lens.anyOf`@ +anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool +anyOf = Lens.Micro.anyOf +{-# INLINE anyOf #-} + +-- | Identical to @"Control.Lens".`Control.Lens.rewriteOf`@ +rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b +rewriteOf = Lens.Micro.rewriteOf +{-# INLINE rewriteOf #-} + +-- | Identical to @"Control.Lens".`Control.Lens.transformOf`@ +transformOf :: ASetter a b a b -> (b -> b) -> a -> b +transformOf = Lens.Micro.transformOf +{-# INLINE transformOf #-} + +-- | Identical to @"Control.Lens".`Control.Lens.rewriteMOf`@ +rewriteMOf + :: Monad m + => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b +rewriteMOf = Lens.Micro.rewriteMOf +{-# INLINE rewriteMOf #-} + +-- | Identical to @"Control.Lens".`Control.Lens.transformMOf`@ +transformMOf + :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b +transformMOf = Lens.Micro.transformMOf +{-# INLINE transformMOf #-} + +-- | Identical to @"Control.Lens".`Control.Lens.mapMOf`@ +mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t +mapMOf = Lens.Micro.mapMOf +{-# INLINE mapMOf #-} + +-- | Identical to @"Control.Lens.Plated".`Control.Lens.Plated.cosmosOf`@ +cosmosOf :: Traversal s t s t -> Traversal s t s b +cosmosOf = Lens.Micro.cosmosOf +{-# INLINE cosmosOf #-} + +-- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.to`@ +to :: (s -> a) -> SimpleGetter s a +to = Lens.Micro.to +{-# INLINE to #-} + +-- | Identical to @"Control.Lens.Fold".`Control.Lens.Fold.foldOf`@ +foldOf :: Getting a s a -> s -> a +foldOf l = getConst #. l Const +{-# INLINE foldOf #-} diff --git a/src/Dhall/Package.hs b/src/Dhall/Package.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Package.hs @@ -0,0 +1,297 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Create a package.dhall from files and directory contents. + +module Dhall.Package + ( Options + , defaultOptions + , characterSet + , packageFileName + , packagingMode + , PackagingMode(..) + , writePackage + , getPackagePathAndContent + , PackageError(..) + ) where + +import Control.Exception (Exception, throwIO) +import Control.Monad +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Traversable (for) +import Dhall.Core + ( Directory (..) + , Expr (..) + , File (..) + , FilePrefix (..) + , Import (..) + , ImportHashed (..) + , ImportMode (..) + , ImportType (..) + , RecordField (..) + , makeRecordField + ) +import Dhall.Map (Map) +import qualified Dhall.Map as Map +import Dhall.Pretty (CharacterSet (..)) +import qualified Dhall.Pretty +import Dhall.Util (_ERROR, renderExpression) +import Lens.Micro (Lens', lens) +import System.Directory +import System.FilePath + +-- | Options for package creation. +data Options = Options + { optionsCharacterSet :: CharacterSet + , optionsPackageFileName :: String + , optionsPackagingMode :: PackagingMode + } + +-- | The default options used for packaging. +-- +-- The default values for the different settings are: +-- +-- * The character set used is the one given by 'Dhall.Pretty.defaultCharacterSet'. +-- * The package file name is @package.dhall@. +-- * The packaging mode is 'OnlyThisPackage'. +defaultOptions :: Options +defaultOptions = Options + { optionsCharacterSet = Dhall.Pretty.defaultCharacterSet + , optionsPackageFileName = "package.dhall" + , optionsPackagingMode = OnlyThisPackage + } + +-- | Access the character set used to render the package content. +characterSet :: Lens' Options CharacterSet +characterSet = lens optionsCharacterSet (\s x -> s { optionsCharacterSet = x }) + +-- | Access the file name used for the package file. +packageFileName :: Lens' Options String +packageFileName = + lens optionsPackageFileName (\s x -> s { optionsPackageFileName = x }) + +-- | Access the packaging mode. +-- See the documentation of 'getPackagePathAndContent'. +packagingMode :: Lens' Options PackagingMode +packagingMode = + lens optionsPackagingMode (\s x -> s { optionsPackagingMode = x }) + +-- | Whether to recursively create a package for each subdirectory or not. +-- See the documentation of 'getPackagePathAndContent'. +data PackagingMode + = OnlyThisPackage + | RecursiveSubpackages + +-- | Create a package.dhall from files and directory contents. +-- For a description of how the package file is constructed see +-- 'getPackagePathAndContent'. +writePackage :: Options -> NonEmpty FilePath -> IO () +writePackage options inputs = do + (outputPath, expr) <- getPackagePathAndContent options inputs + renderExpression (optionsCharacterSet options) True (Just outputPath) expr + +-- | Get the path and the Dhall expression for a package file. +-- +-- The location of the resulting package file is determined by the first path of the second argument: +-- +-- * If it is a directory, it is also the output directory and the package +-- file will be placed there. +-- +-- * If it is a file, then the directory that file resides in is the output +-- directory and the package file will be placed there. +-- +-- All inputs provided as the second argument must be either in the output +-- directory or below it. They are processed depending on whether +-- the path points to a directory or a file: +-- +-- * If the path points to a directory, all files with a @.dhall@ extensions +-- in that directory are included in the package. +-- +-- If you passed `Recurse` to the this function, then in addition to these +-- files all subdirectories are traversed and a sub-package created for each +-- one. That sub-package will be included in the package too. +-- +-- * If the path points to a regular file, it is included in the package +-- unless it is the path of the package file itself. +-- +getPackagePathAndContent + :: Options + -> NonEmpty FilePath + -> IO (FilePath, Expr s Import) +getPackagePathAndContent options (path :| paths) = do + outputDir <- do + isDirectory <- doesDirectoryExist path + return $ if isDirectory then path else takeDirectory path + outputDir' <- addTrailingPathSeparator <$> makeAbsolute (normalise outputDir) + + -- Check if the supplied @dir@ argument points to a filesystem entry below + -- the output directory and return the path relative to the output directory. + let checkOutputDir dir = do + absoluteDir <- addTrailingPathSeparator <$> makeAbsolute (normalise dir) + let relativeDir = makeRelative outputDir' absoluteDir + unless (isRelative relativeDir) $ + throwIO $ AmbiguousOutputDirectory outputDir dir + return relativeDir + + resultMap <- go Map.empty checkOutputDir (path:paths) + return (outputDir outputFn, RecordLit $ Map.sort resultMap) + where + go + :: Map Text (RecordField s Import) + -> (FilePath -> IO FilePath) + -> [FilePath] + -> IO (Map Text (RecordField s Import)) + go !acc _checkOutputDir [] = return acc + go !acc checkOutputDir (p:ps) = do + isDirectory <- doesDirectoryExist p + isFile <- doesFileExist p + if | isDirectory -> do + void $ checkOutputDir p + entries <- listDirectory p + (dhallFiles, subdirectories) <- foldMap + ( \entry -> do + let entry' = p entry + isDirectoryEntry <- doesDirectoryExist entry' + return $ if isDirectoryEntry + then (mempty, [entry']) + else if hasDhallExtension entry + then ([entry'], mempty) + else mempty + ) entries + subpackages <- case optionsPackagingMode options of + RecursiveSubpackages -> + for subdirectories $ \subdirectory -> do + writePackage options (subdirectory :| []) + return (subdirectory outputFn) + OnlyThisPackage -> return [] + go acc checkOutputDir (dhallFiles <> subpackages <> ps) + | isFile -> do + dir <- checkOutputDir $ takeDirectory p + + let p' = normalise $ dir takeFileName p + + let resultMap = if p' == outputFn + then Map.empty + else filepathToMap outputFn p' + + acc' <- mergeMaps acc resultMap + go acc' checkOutputDir ps + | otherwise -> throwIO $ InvalidPath p + + hasDhallExtension :: FilePath -> Bool + hasDhallExtension entry = takeExtension entry == ".dhall" + + outputFn :: String + outputFn = optionsPackageFileName options + +-- | Construct a nested 'Map' from a 'FilePath'. +-- For example, the filepath @some/file/path.dhall@ will result in something +-- similar to the following: +-- +-- fromList +-- [ ("some", fromList +-- [ ("file", fromList +-- [ ("path", ./some/file/path.dhall) +-- ]) +-- ]) +-- ]) +-- +-- ... where ./some/file/path.dhall is a Dhall import. If the last component +-- equals the value passed in the @outputFn@ argument we produce a slightly +-- different result. Consider for example the Dhall Prelude: We have some +-- sub-packages there like @List/package.dhall@. If we want to construct the +-- top-level @package.dhall@ we want an entry like +-- +-- > List = ./List/package.dhall +-- +-- in there and not: +-- +-- > List = { package = ./List/package.dhall } +-- +filepathToMap :: FilePath -> FilePath -> Map Text (RecordField s Import) +filepathToMap outputFn = go [] . splitDirectories + where + go acc [] = go acc ["."] + go !acc [x] = + let import_ = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here File + { directory = Directory acc + , file = Text.pack x + } + } + , importMode = Code + } + in Map.singleton (Text.pack $ dropExtension x) $ makeRecordField $ Embed import_ + go !acc [x, y] | y == outputFn = + let import_ = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here File + { directory = Directory (Text.pack x : acc) + , file = Text.pack y + } + } + , importMode = Code + } + in Map.singleton (Text.pack x) $ makeRecordField $ Embed import_ + go !acc (x:xs) = Map.singleton (Text.pack x) $ makeRecordField $ RecordLit $ go (Text.pack x : acc) xs + +-- | Merge two 'Map's constructed with 'filepathToMap'. +-- It will throw an error if the arguments are not compatible with each other, e.g. +-- we cannot merge the following two maps: +-- +-- > fromList [ ("file", ./file.dhall) ] +-- > fromList [ ("file", fromList [("nested", ./file/nested.dhall)]) ] +-- +mergeMaps :: Map Text (RecordField s Import) -> Map Text (RecordField s Import) -> IO (Map Text (RecordField s Import)) +mergeMaps x y = do + let x' = fmap (:| []) x + y' = fmap (:| []) y + z = Map.unionWith (<>) x' y' + for z $ \case + v@RecordField{recordFieldValue = Embed{}} :| [] -> return v + vs | Just rs <- traverse extractRecordLit vs -> makeRecordField . RecordLit . Map.sort <$> foldM mergeMaps Map.empty rs + | otherwise -> throwIO $ IncompatiblePaths $ foldMap extractEmbeds vs + where + extractEmbeds :: RecordField s Import -> [Import] + extractEmbeds RecordField{recordFieldValue = Embed import_} = [import_] + extractEmbeds RecordField{recordFieldValue = RecordLit xs} = foldMap extractEmbeds xs + extractEmbeds _ = mempty + + extractRecordLit :: RecordField s Import -> Maybe (Map Text (RecordField s Import)) + extractRecordLit RecordField{recordFieldValue = RecordLit xs} = Just xs + extractRecordLit _ = Nothing + +-- | Exception thrown when creating a package file. +data PackageError + = AmbiguousOutputDirectory FilePath FilePath + | IncompatiblePaths [Import] + | InvalidPath FilePath + +instance Exception PackageError + +instance Show PackageError where + show (AmbiguousOutputDirectory dir1 dir2) = + _ERROR <> ": ❰dhall package❱ failed because the inputs make it impossible to\n\ + \determine the output directory of the package file. You asked to include files\n\ + \from the following directories in the package:\n\ + \\n" <> dir1 <> + "\n" <> dir2 <> + "\n\n\ + \Although those paths might point to the same location they are not lexically the\n\ + \same." + + show (IncompatiblePaths imports) = + _ERROR <> ": ❰dhall package❱ failed because some inputs are not compatible with\n\ + \each other:\n\ + \\n" <> unlines (map (show . Dhall.Pretty.prettyExpr . Embed) imports) + + show (InvalidPath fp) = + _ERROR <> ": ❰dhall package❱ failed because the input does not exist or is\n\ + \neither a directory nor a regular file:\n\ + \\n" <> fp diff --git a/src/Dhall/Parser.hs b/src/Dhall/Parser.hs --- a/src/Dhall/Parser.hs +++ b/src/Dhall/Parser.hs @@ -1,1579 +1,132 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - --- | This module contains Dhall's parsing logic - -module Dhall.Parser ( - -- * Utilities - exprFromText - , exprAndHeaderFromText - - -- * Parsers - , expr, exprA - - -- * Types - , Src(..) - , ParseError(..) - , Parser(..) - ) where - -import Control.Applicative (Alternative(..), liftA2, optional) -import Control.Exception (Exception) -import Control.Monad (MonadPlus) -import Data.ByteString (ByteString) -import Data.Functor (void) -import Data.HashMap.Strict.InsOrd (InsOrdHashMap) -import Data.Monoid ((<>)) -import Data.Sequence (ViewL(..)) -import Data.Scientific (Scientific) -import Data.String (IsString(..)) -import Data.Text.Buildable (Buildable(..)) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Builder (Builder) -import Data.Typeable (Typeable) -import Dhall.Core -import Numeric.Natural (Natural) -import Prelude hiding (const, pi) -import Text.PrettyPrint.ANSI.Leijen (Doc) -import Text.Parser.Combinators (choice, try, ()) -import Text.Parser.Token (TokenParsing(..)) -import Text.Trifecta - (CharParsing, DeltaParsing, MarkParsing, Parsing, Result(..)) -import Text.Trifecta.Delta (Delta) - -import qualified Control.Monad -import qualified Crypto.Hash -import qualified Data.ByteString.Lazy -import qualified Data.Char -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.HashSet -import qualified Data.List -import qualified Data.Sequence -import qualified Data.Text -import qualified Data.Text.Encoding -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Builder -import qualified Data.Text.Lazy.Encoding -import qualified Text.Parser.Char -import qualified Text.Parser.Combinators -import qualified Text.Parser.Token -import qualified Text.Parser.Token.Style -import qualified Text.PrettyPrint.ANSI.Leijen -import qualified Text.Trifecta - --- | Source code extract -data Src = Src Delta Delta ByteString deriving (Eq, Show) - -instance Buildable Src where - build (Src begin _ bytes) = - build text <> "\n" - <> "\n" - <> build (show (Text.PrettyPrint.ANSI.Leijen.pretty begin)) - <> "\n" - where - bytes' = Data.ByteString.Lazy.fromStrict bytes - - text = Data.Text.Lazy.strip (Data.Text.Lazy.Encoding.decodeUtf8 bytes') - -{-| A `Parser` that is almost identical to - @"Text.Trifecta".`Text.Trifecta.Parser`@ except treating Haskell-style - comments as whitespace --} -newtype Parser a = Parser { unParser :: Text.Trifecta.Parser a } - deriving - ( Functor - , Applicative - , Monad - , Alternative - , MonadPlus - , Parsing - , CharParsing - , DeltaParsing - , MarkParsing Delta - ) - -instance Monoid a => Monoid (Parser a) where - mempty = pure mempty - -#if MIN_VERSION_base(4,11,0) -instance Semigroup a => Semigroup (Parser a) where - (<>) = liftA2 (<>) -#else - mappend = liftA2 mappend -#endif - -instance IsString a => IsString (Parser a) where - fromString x = fmap fromString (Text.Parser.Char.string x) - -instance TokenParsing Parser where - someSpace = - Text.Parser.Token.Style.buildSomeSpaceParser - (Parser someSpace) - Text.Parser.Token.Style.haskellCommentStyle - - nesting (Parser m) = Parser (nesting m) - - semi = Parser semi - - highlight h (Parser m) = Parser (highlight h m) - -noted :: Parser (Expr Src a) -> Parser (Expr Src a) -noted parser = do - before <- Text.Trifecta.position - (e, bytes) <- Text.Trifecta.slicedWith (,) parser - after <- Text.Trifecta.position - return (Note (Src before after bytes) e) - -count :: Monoid a => Int -> Parser a -> Parser a -count n parser = mconcat (replicate n parser) - -range :: Monoid a => Int -> Int -> Parser a -> Parser a -range minimumBound maximumMatches parser = - count minimumBound parser <> loop maximumMatches - where - loop 0 = mempty - loop n = (parser <> loop (n - 1)) <|> mempty - -option :: (Alternative f, Monoid a) => f a -> f a -option p = p <|> pure mempty - -star :: (Alternative f, Monoid a) => f a -> f a -star p = plus p <|> pure mempty - -plus :: (Alternative f, Monoid a) => f a -> f a -plus p = mappend <$> p <*> star p - -satisfy :: (Char -> Bool) -> Parser Builder -satisfy predicate = - fmap Data.Text.Lazy.Builder.singleton (Text.Parser.Char.satisfy predicate) - -blockComment :: Parser () -blockComment = do - _ <- Text.Parser.Char.text "{-" - blockCommentContinue - -blockCommentChunk :: Parser () -blockCommentChunk = - choice - [ blockComment -- Nested block comment - , character - , endOfLine - ] - where - character = void (Text.Parser.Char.satisfy predicate) - where - predicate c = '\x20' <= c && c <= '\x10FFFF' || c == '\n' || c == '\t' - - endOfLine = void (Text.Parser.Char.text "\r\n") - -blockCommentContinue :: Parser () -blockCommentContinue = endOfComment <|> continue - where - endOfComment = void (Text.Parser.Char.text "-}") - - continue = do - blockCommentChunk - blockCommentContinue - -lineComment :: Parser () -lineComment = do - _ <- Text.Parser.Char.text "--" - Text.Parser.Combinators.skipMany notEndOfLine - endOfLine - return () - where - endOfLine = - void (Text.Parser.Char.char '\n' ) - <|> void (Text.Parser.Char.text "\r\n") - - notEndOfLine = void (Text.Parser.Char.satisfy predicate) - where - predicate c = ('\x20' <= c && c <= '\x10FFFF') || c == '\t' - - -whitespaceChunk :: Parser () -whitespaceChunk = - choice - [ void (Text.Parser.Char.satisfy predicate) - , void (Text.Parser.Char.text "\r\n") - , lineComment - , blockComment - ] "whitespace" - where - predicate c = c == ' ' || c == '\t' || c == '\n' - -whitespace :: Parser () -whitespace = Text.Parser.Combinators.skipMany whitespaceChunk - -alpha :: Char -> Bool -alpha c = ('\x41' <= c && c <= '\x5A') || ('\x61' <= c && c <= '\x7A') - -digit :: Char -> Bool -digit c = '\x30' <= c && c <= '\x39' - -hexdig :: Char -> Bool -hexdig c = - ('0' <= c && c <= '9') - || ('A' <= c && c <= 'F') - || ('a' <= c && c <= 'f') - -hexNumber :: Parser Int -hexNumber = choice [ hexDigit, hexUpper, hexLower ] - where - hexDigit = do - c <- Text.Parser.Char.satisfy predicate - return (Data.Char.ord c - Data.Char.ord '0') - where - predicate c = '0' <= c && c <= '9' - - hexUpper = do - c <- Text.Parser.Char.satisfy predicate - return (10 + Data.Char.ord c - Data.Char.ord 'A') - where - predicate c = 'A' <= c && c <= 'F' - - hexLower = do - c <- Text.Parser.Char.satisfy predicate - return (10 + Data.Char.ord c - Data.Char.ord 'a') - where - predicate c = 'a' <= c && c <= 'f' - -simpleLabel :: Parser Text -simpleLabel = try (do - c <- Text.Parser.Char.satisfy headCharacter - cs <- many (Text.Parser.Char.satisfy tailCharacter) - let string = c:cs - let text = Data.Text.Lazy.pack string - Control.Monad.guard (not (Data.HashSet.member text reservedIdentifiers)) - return text ) - where - headCharacter c = alpha c || c == '_' - - tailCharacter c = alpha c || digit c || c == '_' || c == '-' || c == '/' - -backtickLabel :: Parser Text -backtickLabel = do - _ <- Text.Parser.Char.char '`' - t <- some (Text.Parser.Char.satisfy predicate) - _ <- Text.Parser.Char.char '`' - return (Data.Text.Lazy.pack t) - where - predicate c = alpha c || digit c || elem c ("-/_:." :: String) - -label :: Parser Text -label = (do - t <- backtickLabel <|> simpleLabel - whitespace - return t ) "label" - -doubleQuotedChunk :: Parser a -> Parser (Chunks Src a) -doubleQuotedChunk embedded = - choice - [ interpolation - , unescapedCharacter - , escapedCharacter - ] - where - interpolation = do - _ <- Text.Parser.Char.text "${" - e <- expression embedded - _ <- Text.Parser.Char.char '}' - return (Chunks [(mempty, e)] mempty) - - unescapedCharacter = do - c <- Text.Parser.Char.satisfy predicate - return (Chunks [] (Data.Text.Lazy.Builder.singleton c)) - where - predicate c = - ('\x20' <= c && c <= '\x21' ) - || ('\x23' <= c && c <= '\x5B' ) - || ('\x5D' <= c && c <= '\x10FFFF') - - escapedCharacter = do - _ <- Text.Parser.Char.char '\\' - c <- choice - [ quotationMark - , dollarSign - , backSlash - , forwardSlash - , backSpace - , formFeed - , lineFeed - , carriageReturn - , tab - , unicode - ] - return (Chunks [] (Data.Text.Lazy.Builder.singleton c)) - where - quotationMark = Text.Parser.Char.char '"' - - dollarSign = Text.Parser.Char.char '$' - - backSlash = Text.Parser.Char.char '\\' - - forwardSlash = Text.Parser.Char.char '/' - - backSpace = do _ <- Text.Parser.Char.char 'b'; return '\b' - - formFeed = do _ <- Text.Parser.Char.char 'f'; return '\f' - - lineFeed = do _ <- Text.Parser.Char.char 'n'; return '\n' - - carriageReturn = do _ <- Text.Parser.Char.char 'r'; return '\r' - - tab = do _ <- Text.Parser.Char.char 't'; return '\t' - - unicode = do - _ <- Text.Parser.Char.char 'u'; - n0 <- hexNumber - n1 <- hexNumber - n2 <- hexNumber - n3 <- hexNumber - let n = ((n0 * 16 + n1) * 16 + n2) * 16 + n3 - return (Data.Char.chr n) - -doubleQuotedLiteral :: Parser a -> Parser (Chunks Src a) -doubleQuotedLiteral embedded = do - _ <- Text.Parser.Char.char '"' - chunks <- many (doubleQuotedChunk embedded) - _ <- Text.Parser.Char.char '"' - return (mconcat chunks) - --- | Similar to `Dhall.Core.buildChunks` except that this doesn't bother to --- render interpolated expressions to avoid a `Buildable a` constraint. The --- interpolated contents are not necessary for computing how much to dedent a --- multi-line string --- --- This also doesn't include the surrounding quotes since they would interfere --- with the whitespace detection -buildChunks :: Chunks s a -> Builder -buildChunks (Chunks a b) = foldMap buildChunk a <> escapeText b - where - buildChunk (c, _) = escapeText c <> "${x}" - -dedent :: Chunks Src a -> Chunks Src a -dedent chunks0 = process chunks0 - where - builder0 = buildChunks chunks0 - - text0 = Data.Text.Lazy.Builder.toLazyText builder0 - - lines0 = Data.Text.Lazy.lines text0 - - isEmpty = Data.Text.Lazy.all Data.Char.isSpace - - nonEmptyLines = filter (not . isEmpty) lines0 - - indentLength line = - Data.Text.Lazy.length (Data.Text.Lazy.takeWhile Data.Char.isSpace line) - - shortestIndent = case nonEmptyLines of - [] -> 0 - _ -> minimum (map indentLength nonEmptyLines) - - -- The purpose of this complicated `trimBegin`/`trimContinue` is to ensure - -- that we strip leading whitespace without stripping whitespace after - -- variable interpolation - - -- This is the trim function we use up until the first variable - -- interpolation, dedenting all lines - trimBegin = - build - . Data.Text.Lazy.intercalate "\n" - . map (Data.Text.Lazy.drop shortestIndent) - . Data.Text.Lazy.splitOn "\n" - . Data.Text.Lazy.Builder.toLazyText - - -- This is the trim function we use after each variable interpolation - -- where we indent each line except the first line (since it's not a true - -- beginning of a line) - trimContinue builder = build (Data.Text.Lazy.intercalate "\n" lines_) - where - text = Data.Text.Lazy.Builder.toLazyText builder - - lines_ = case Data.Text.Lazy.splitOn "\n" text of - [] -> [] - l:ls -> l:map (Data.Text.Lazy.drop shortestIndent) ls - - -- This is the loop that drives whether or not to use `trimBegin` or - -- `trimContinue`. We call this function with `trimBegin`, but after the - -- first interpolation we switch permanently to `trimContinue` - process (Chunks ((x0, y0):xys) z) = - Chunks ((trimBegin x0, y0):xys') (trimContinue z) - where - xys' = [ (trimContinue x, y) | (x, y) <- xys ] - process (Chunks [] z) = - Chunks [] (trimBegin z) - -singleQuoteContinue :: Parser a -> Parser (Chunks Src a) -singleQuoteContinue embedded = - choice - [ escapeSingleQuotes - , interpolation - , escapeInterpolation - , endLiteral - , unescapedCharacter - , tab - , endOfLine - ] - where - escapeSingleQuotes = do - _ <- "'''" :: Parser Builder - b <- singleQuoteContinue embedded - return ("''" <> b) - - interpolation = do - _ <- Text.Parser.Char.text "${" - a <- expression embedded - _ <- Text.Parser.Char.char '}' - b <- singleQuoteContinue embedded - return (Chunks [(mempty, a)] mempty <> b) - - escapeInterpolation = do - _ <- Text.Parser.Char.text "''${" - b <- singleQuoteContinue embedded - return ("${" <> b) - - endLiteral = do - _ <- Text.Parser.Char.text "''" - return mempty - - unescapedCharacter = do - a <- satisfy predicate - b <- singleQuoteContinue embedded - return (Chunks [] a <> b) - where - predicate c = '\x20' <= c && c <= '\x10FFFF' - - endOfLine = do - a <- "\n" <|> "\r\n" - b <- singleQuoteContinue embedded - return (Chunks [] a <> b) - - tab = do - _ <- Text.Parser.Char.char '\t' - b <- singleQuoteContinue embedded - return ("\t" <> b) - -singleQuoteLiteral :: Parser a -> Parser (Chunks Src a) -singleQuoteLiteral embedded = do - _ <- Text.Parser.Char.text "''" - - -- This is technically not in the grammar, but it's still equivalent to the - -- original grammar and an easy way to discard the first character if it's - -- a newline - _ <- optional endOfLine - - a <- singleQuoteContinue embedded - - return (dedent a) - where - endOfLine = - void (Text.Parser.Char.char '\n' ) - <|> void (Text.Parser.Char.text "\r\n") - -textLiteral :: Parser a -> Parser (Expr Src a) -textLiteral embedded = (do - literal <- doubleQuotedLiteral embedded <|> singleQuoteLiteral embedded - whitespace - return (TextLit literal) ) "text literal" - -reserved :: Data.Text.Text -> Parser () -reserved x = do _ <- Text.Parser.Char.text x; whitespace - -_if :: Parser () -_if = reserved "if" - -_then :: Parser () -_then = reserved "then" - -_else :: Parser () -_else = reserved "else" - -_let :: Parser () -_let = reserved "let" - -_in :: Parser () -_in = reserved "in" - -_as :: Parser () -_as = reserved "as" - -_using :: Parser () -_using = reserved "using" - -_merge :: Parser () -_merge = reserved "merge" - -_constructors :: Parser () -_constructors = reserved "constructors" - -_NaturalFold :: Parser () -_NaturalFold = reserved "Natural/fold" - -_NaturalBuild :: Parser () -_NaturalBuild = reserved "Natural/build" - -_NaturalIsZero :: Parser () -_NaturalIsZero = reserved "Natural/isZero" - -_NaturalEven :: Parser () -_NaturalEven = reserved "Natural/even" - -_NaturalOdd :: Parser () -_NaturalOdd = reserved "Natural/odd" - -_NaturalToInteger :: Parser () -_NaturalToInteger = reserved "Natural/toInteger" - -_NaturalShow :: Parser () -_NaturalShow = reserved "Natural/show" - -_IntegerShow :: Parser () -_IntegerShow = reserved "Integer/show" - -_DoubleShow :: Parser () -_DoubleShow = reserved "Double/show" - -_ListBuild :: Parser () -_ListBuild = reserved "List/build" - -_ListFold :: Parser () -_ListFold = reserved "List/fold" - -_ListLength :: Parser () -_ListLength = reserved "List/length" - -_ListHead :: Parser () -_ListHead = reserved "List/head" - -_ListLast :: Parser () -_ListLast = reserved "List/last" - -_ListIndexed :: Parser () -_ListIndexed = reserved "List/indexed" - -_ListReverse :: Parser () -_ListReverse = reserved "List/reverse" - -_OptionalFold :: Parser () -_OptionalFold = reserved "Optional/fold" - -_OptionalBuild :: Parser () -_OptionalBuild = reserved "Optional/build" - -_Bool :: Parser () -_Bool = reserved "Bool" - -_Optional :: Parser () -_Optional = reserved "Optional" - -_Natural :: Parser () -_Natural = reserved "Natural" - -_Integer :: Parser () -_Integer = reserved "Integer" - -_Double :: Parser () -_Double = reserved "Double" - -_Text :: Parser () -_Text = reserved "Text" - -_List :: Parser () -_List = reserved "List" - -_True :: Parser () -_True = reserved "True" - -_False :: Parser () -_False = reserved "False" - -_Type :: Parser () -_Type = reserved "Type" - -_Kind :: Parser () -_Kind = reserved "Kind" - -_equal :: Parser () -_equal = reserved "=" - -_or :: Parser () -_or = reserved "||" - -_plus :: Parser () -_plus = reserved "+" - -_textAppend :: Parser () -_textAppend = reserved "++" - -_listAppend :: Parser () -_listAppend = reserved "#" - -_and :: Parser () -_and = reserved "&&" - -_times :: Parser () -_times = reserved "*" - -_doubleEqual :: Parser () -_doubleEqual = reserved "==" - -_notEqual :: Parser () -_notEqual = reserved "!=" - -_dot :: Parser () -_dot = reserved "." - -_openBrace :: Parser () -_openBrace = reserved "{" - -_closeBrace :: Parser () -_closeBrace = reserved "}" - -_openBracket :: Parser () -_openBracket = reserved "[" - -_closeBracket :: Parser () -_closeBracket = reserved "]" - -_openAngle :: Parser () -_openAngle = reserved "<" - -_closeAngle :: Parser () -_closeAngle = reserved ">" - -_bar :: Parser () -_bar = reserved "|" - -_comma :: Parser () -_comma = reserved "," - -_openParens :: Parser () -_openParens = reserved "(" - -_closeParens :: Parser () -_closeParens = reserved ")" - -_colon :: Parser () -_colon = reserved ":" - -_at :: Parser () -_at = reserved "@" - -_combine :: Parser () -_combine = do - void (Text.Parser.Char.char '∧' "\"∧\"") <|> void (Text.Parser.Char.text "/\\") - whitespace - -_prefer :: Parser () -_prefer = do - void (Text.Parser.Char.char '⫽' "\"⫽\"") <|> void (Text.Parser.Char.text "//") - whitespace - -_lambda :: Parser () -_lambda = do - _ <- Text.Parser.Char.satisfy predicate - whitespace - where - predicate 'λ' = True - predicate '\\' = True - predicate _ = False - -_forall :: Parser () -_forall = do - void (Text.Parser.Char.char '∀' "\"∀\"") <|> void (Text.Parser.Char.text "forall") - whitespace - -_arrow :: Parser () -_arrow = do - void (Text.Parser.Char.char '→' "\"→\"") <|> void (Text.Parser.Char.text "->") - whitespace - -doubleLiteral :: Parser Scientific -doubleLiteral = (do - sign <- fmap (\_ -> negate) (Text.Parser.Char.char '-') - <|> pure id - a <- Text.Parser.Token.scientific - return (sign a) ) "double literal" - -integerLiteral :: Parser Integer -integerLiteral = Text.Parser.Token.integer "integer literal" - -naturalLiteral :: Parser Natural -naturalLiteral = (do - _ <- Text.Parser.Char.char '+' - a <- Text.Parser.Token.natural - return (fromIntegral a) ) "natural literal" - -identifier :: Parser Var -identifier = do - x <- label - - let indexed = do - _ <- Text.Parser.Char.char '@' - Text.Parser.Token.natural - - n <- indexed <|> pure 0 - return (V x n) - -headPathCharacter :: Char -> Bool -headPathCharacter c = - ('\x21' <= c && c <= '\x27') - || ('\x2A' <= c && c <= '\x2B') - || ('\x2D' <= c && c <= '\x2E') - || ('\x30' <= c && c <= '\x3B') - || c == '\x3D' - || ('\x3F' <= c && c <= '\x5A') - || ('\x5E' <= c && c <= '\x7A') - || c == '\x7C' - || c == '\x7E' - -pathCharacter :: Char -> Bool -pathCharacter c = - headPathCharacter c - || c == '\\' - || c == '/' - -fileRaw :: Parser PathType -fileRaw = - choice - [ try absolutePath - , relativePath - , parentPath - , homePath - ] - where - absolutePath = do - _ <- Text.Parser.Char.char '/' - a <- Text.Parser.Char.satisfy headPathCharacter - bs <- many (Text.Parser.Char.satisfy pathCharacter) - let filepath = '/':a:bs - return (File Homeless filepath) - - relativePath = do - _ <- Text.Parser.Char.text "./" - as <- many (Text.Parser.Char.satisfy pathCharacter) - let filepath = "./" <> as - return (File Homeless filepath) - - parentPath = do - _ <- Text.Parser.Char.text "../" - as <- many (Text.Parser.Char.satisfy pathCharacter) - let filepath = "../" <> as - return (File Homeless filepath) - - homePath = do - _ <- Text.Parser.Char.text "~/" - as <- many (Text.Parser.Char.satisfy pathCharacter) - return (File Home as) - -file :: Parser PathType -file = do - a <- fileRaw - whitespace - return a - -scheme :: Parser Builder -scheme = "http" <> option "s" - -httpRaw :: Parser Builder -httpRaw = - scheme - <> "://" - <> authority - <> pathAbempty - <> option ("?" <> query) - <> option ("#" <> fragment) - -authority :: Parser Builder -authority = option (try (userinfo <> "@")) <> host <> option (":" <> port) - -userinfo :: Parser Builder -userinfo = star (satisfy predicate <|> pctEncoded) - where - predicate c = unreserved c || subDelims c || c == ':' - -host :: Parser Builder -host = choice [ ipLiteral, ipV4Address, regName ] - -port :: Parser Builder -port = star (satisfy digit) - -ipLiteral :: Parser Builder -ipLiteral = "[" <> (ipV6Address <|> ipVFuture) <> "]" - -ipVFuture :: Parser Builder -ipVFuture = "v" <> plus (satisfy hexdig) <> "." <> plus (satisfy predicate) - where - predicate c = unreserved c || subDelims c || c == ':' - -ipV6Address :: Parser Builder -ipV6Address = - choice - [ try alternative0 - , try alternative1 - , try alternative2 - , try alternative3 - , try alternative4 - , try alternative5 - , try alternative6 - , try alternative7 - , alternative8 - ] - where - alternative0 = count 6 (h16 <> ":") <> ls32 - - alternative1 = "::" <> count 5 (h16 <> ":") <> ls32 - - alternative2 = option h16 <> "::" <> count 4 (h16 <> ":") <> ls32 - - alternative3 = - option (range 0 1 (h16 <> ":") <> h16) - <> "::" - <> count 3 (h16 <> ":") - <> ls32 - - alternative4 = - option (range 0 2 (h16 <> ":") <> h16) - <> "::" - <> count 2 (h16 <> ":") - <> ls32 - - alternative5 = - option (range 0 3 (h16 <> ":") <> h16) <> "::" <> h16 <> ":" <> ls32 - - alternative6 = - option (range 0 4 (h16 <> ":") <> h16) <> "::" <> ls32 - - alternative7 = - option (range 0 5 (h16 <> ":") <> h16) <> "::" <> h16 - - alternative8 = - option (range 0 6 (h16 <> ":") <> h16) <> "::" - -h16 :: Parser Builder -h16 = range 1 3 (satisfy hexdig) - -ls32 :: Parser Builder -ls32 = (h16 <> ":" <> h16) <|> ipV4Address - -ipV4Address :: Parser Builder -ipV4Address = decOctet <> "." <> decOctet <> "." <> decOctet <> "." <> decOctet - -decOctet :: Parser Builder -decOctet = - choice - [ try alternative4 - , try alternative3 - , try alternative2 - , try alternative1 - , alternative0 - ] - where - alternative0 = satisfy digit - - alternative1 = satisfy predicate <> satisfy digit - where - predicate c = '\x31' <= c && c <= '\x39' - - alternative2 = "1" <> count 2 (satisfy digit) - - alternative3 = "2" <> satisfy predicate <> satisfy digit - where - predicate c = '\x30' <= c && c <= '\x34' - - alternative4 = "25" <> satisfy predicate - where - predicate c = '\x30' <= c && c <= '\x35' - -regName :: Parser Builder -regName = star (satisfy predicate <|> pctEncoded) - where - predicate c = unreserved c || subDelims c - -pathAbempty :: Parser Builder -pathAbempty = star ("/" <> segment) - -segment :: Parser Builder -segment = star pchar - -pchar :: Parser Builder -pchar = satisfy predicate <|> pctEncoded - where - predicate c = unreserved c || subDelims c || c == ':' || c == '@' - -query :: Parser Builder -query = star (pchar <|> satisfy predicate) - where - predicate c = c == '/' || c == '?' - -fragment :: Parser Builder -fragment = star (pchar <|> satisfy predicate) - where - predicate c = c == '/' || c == '?' - -pctEncoded :: Parser Builder -pctEncoded = "%" <> count 2 (satisfy hexdig) - -unreserved :: Char -> Bool -unreserved c = - alpha c || digit c || c == '-' || c == '.' || c == '_' || c == '~' - -subDelims :: Char -> Bool -subDelims c = c `elem` ("!$&'()*+,;=" :: String) - -http :: Parser PathType -http = do - a <- httpRaw - whitespace - b <- optional (do - _using - pathHashed_ ) - return (URL (Data.Text.Lazy.Builder.toLazyText a) b) - -env :: Parser PathType -env = do - _ <- Text.Parser.Char.text "env:" - a <- (alternative0 <|> alternative1) - whitespace - return (Env a) - where - alternative0 = do - a <- bashEnvironmentVariable - return (Data.Text.Lazy.Builder.toLazyText a) - - alternative1 = do - _ <- Text.Parser.Char.char '"' - a <- posixEnvironmentVariable - _ <- Text.Parser.Char.char '"' - return (Data.Text.Lazy.Builder.toLazyText a) - -bashEnvironmentVariable :: Parser Builder -bashEnvironmentVariable = satisfy predicate0 <> star (satisfy predicate1) - where - predicate0 c = alpha c || c == '_' - - predicate1 c = alpha c || digit c || c == '_' - -posixEnvironmentVariable :: Parser Builder -posixEnvironmentVariable = plus posixEnvironmentVariableCharacter - -posixEnvironmentVariableCharacter :: Parser Builder -posixEnvironmentVariableCharacter = - ("\\" <> satisfy predicate0) <|> satisfy predicate1 - where - predicate0 c = c `elem` ("\"\\abfnrtv" :: String) - - predicate1 c = - ('\x20' <= c && c <= '\x21') - || ('\x23' <= c && c <= '\x3C') - || ('\x3E' <= c && c <= '\x5B') - || ('\x5D' <= c && c <= '\x7E') - -expression :: Parser a -> Parser (Expr Src a) -expression embedded = - ( noted - ( choice - [ alternative0 - , alternative1 - , alternative2 - , alternative3 - , alternative4 - ] - ) - <|> alternative5 - ) "expression" - where - alternative0 = do - _lambda - _openParens - a <- label - _colon - b <- expression embedded - _closeParens - _arrow - c <- expression embedded - return (Lam a b c) - - alternative1 = do - _if - a <- expression embedded - _then - b <- expression embedded - _else - c <- expression embedded - return (BoolIf a b c) - - alternative2 = do - _let - a <- label - b <- optional (do - _colon - expression embedded ) - _equal - c <- expression embedded - _in - d <- expression embedded - return (Let a b c d) - - alternative3 = do - _forall - _openParens - a <- label - _colon - b <- expression embedded - _closeParens - _arrow - c <- expression embedded - return (Pi a b c) - - alternative4 = do - a <- try (do a <- operatorExpression embedded; _arrow; return a) - b <- expression embedded - return (Pi "_" a b) - - alternative5 = annotatedExpression embedded - -annotatedExpression :: Parser a -> Parser (Expr Src a) -annotatedExpression embedded = - noted - ( choice - [ alternative0 - , try alternative1 - , alternative2 - ] - ) - where - alternative0 = do - _merge - a <- selectorExpression embedded - b <- selectorExpression embedded - c <- optional (do - _colon - applicationExpression embedded ) - return (Merge a b c) - - alternative1 = (do - _openBracket - (emptyCollection embedded <|> nonEmptyOptional embedded) ) - "list literal" - - alternative2 = do - a <- operatorExpression embedded - b <- optional (do _colon; expression embedded) - case b of - Nothing -> return a - Just c -> return (Annot a c) - -emptyCollection :: Parser a -> Parser (Expr Src a) -emptyCollection embedded = do - _closeBracket - _colon - a <- alternative0 <|> alternative1 - b <- selectorExpression embedded - return (a b) - where - alternative0 = do - _List - return (\a -> ListLit (Just a) empty) - - alternative1 = do - _Optional - return (\a -> OptionalLit a empty) - -nonEmptyOptional :: Parser a -> Parser (Expr Src a) -nonEmptyOptional embedded = do - a <- expression embedded - _closeBracket - _colon - _Optional - b <- selectorExpression embedded - return (OptionalLit b (pure a)) - -operatorExpression :: Parser a -> Parser (Expr Src a) -operatorExpression = orExpression - -makeOperatorExpression - :: (Parser a -> Parser (Expr Src a)) - -> Parser () - -> (Expr Src a -> Expr Src a -> Expr Src a) - -> Parser a - -> Parser (Expr Src a) -makeOperatorExpression subExpression operatorParser operator embedded = - noted (do - a <- subExpression embedded - b <- many (do operatorParser; subExpression embedded) - return (foldr1 operator (a:b)) ) - -orExpression :: Parser a -> Parser (Expr Src a) -orExpression = - makeOperatorExpression plusExpression _or BoolOr - -plusExpression :: Parser a -> Parser (Expr Src a) -plusExpression = - makeOperatorExpression textAppendExpression _plus NaturalPlus - -textAppendExpression :: Parser a -> Parser (Expr Src a) -textAppendExpression = - makeOperatorExpression listAppendExpression _textAppend TextAppend - -listAppendExpression :: Parser a -> Parser (Expr Src a) -listAppendExpression = - makeOperatorExpression andExpression _listAppend ListAppend - -andExpression :: Parser a -> Parser (Expr Src a) -andExpression = - makeOperatorExpression combineExpression _and BoolAnd - -combineExpression :: Parser a -> Parser (Expr Src a) -combineExpression = - makeOperatorExpression preferExpression _combine Combine - -preferExpression :: Parser a -> Parser (Expr Src a) -preferExpression = - makeOperatorExpression timesExpression _prefer Prefer - -timesExpression :: Parser a -> Parser (Expr Src a) -timesExpression = - makeOperatorExpression equalExpression _times NaturalTimes - -equalExpression :: Parser a -> Parser (Expr Src a) -equalExpression = - makeOperatorExpression notEqualExpression _doubleEqual BoolEQ - -notEqualExpression :: Parser a -> Parser (Expr Src a) -notEqualExpression = - makeOperatorExpression applicationExpression _notEqual BoolNE - -applicationExpression :: Parser a -> Parser (Expr Src a) -applicationExpression embedded = do - f <- (do _constructors; return Constructors) <|> return id - a <- noted (selectorExpression embedded) - b <- many (noted (selectorExpression embedded)) - return (foldl app (f a) b) - where - app nL@(Note (Src before _ bytesL) _) nR@(Note (Src _ after bytesR) _) = - Note (Src before after (bytesL <> bytesR)) (App nL nR) - app nL nR = - App nL nR - -selectorExpression :: Parser a -> Parser (Expr Src a) -selectorExpression embedded = noted (do - a <- primitiveExpression embedded - b <- many (try (do _dot; label)) - return (foldl Field a b) ) - -primitiveExpression :: Parser a -> Parser (Expr Src a) -primitiveExpression embedded = - noted - ( choice - [ alternative00 - , alternative01 - , alternative02 - , alternative03 - , alternative04 - , alternative05 - , alternative06 - , alternative07 - , alternative37 - - , choice - [ alternative08 - , alternative09 - , alternative10 - , alternative11 - , alternative12 - , alternative13 - , alternative14 - , alternative15 - , alternative16 - , alternative17 - , alternative18 - , alternative19 - , alternative20 - , alternative21 - , alternative22 - , alternative23 - , alternative24 - , alternative25 - , alternative26 - , alternative27 - , alternative28 - , alternative29 - , alternative30 - , alternative31 - , alternative32 - , alternative33 - , alternative34 - , alternative35 - , alternative36 - ] "built-in expression" - ] - ) - <|> alternative38 - where - alternative00 = do - a <- try doubleLiteral - return (DoubleLit a) - - alternative01 = do - a <- try naturalLiteral - return (NaturalLit a) - - alternative02 = do - a <- try integerLiteral - return (IntegerLit a) - - alternative03 = textLiteral embedded - - alternative04 = (do - _openBrace - a <- recordTypeOrLiteral embedded - _closeBrace - return a ) "record type or literal" - - alternative05 = (do - _openAngle - a <- unionTypeOrLiteral embedded - _closeAngle - return a ) "union type or literal" - - alternative06 = nonEmptyListLiteral embedded - - alternative07 = do - a <- embedded - return (Embed a) - - alternative08 = do - _NaturalFold - return NaturalFold - - alternative09 = do - _NaturalBuild - return NaturalBuild - - alternative10 = do - _NaturalIsZero - return NaturalIsZero - - alternative11 = do - _NaturalEven - return NaturalEven - - alternative12 = do - _NaturalOdd - return NaturalOdd - - alternative13 = do - _NaturalToInteger - return NaturalToInteger - - alternative14 = do - _NaturalShow - return NaturalShow - - alternative15 = do - _IntegerShow - return IntegerShow - - alternative16 = do - _DoubleShow - return DoubleShow - - alternative17 = do - _ListBuild - return ListBuild - - alternative18 = do - _ListFold - return ListFold - - alternative19 = do - _ListLength - return ListLength - - alternative20 = do - _ListHead - return ListHead - - alternative21 = do - _ListLast - return ListLast - - alternative22 = do - _ListIndexed - return ListIndexed - - alternative23 = do - _ListReverse - return ListReverse - - alternative24 = do - _OptionalFold - return OptionalFold - - alternative25 = do - _OptionalBuild - return OptionalBuild - - alternative26 = do - _Bool - return Bool - - alternative27 = do - _Optional - return Optional - - alternative28 = do - _Natural - return Natural - - alternative29 = do - _Integer - return Integer - - alternative30 = do - _Double - return Double - - alternative31 = do - _Text - return Text - - alternative32 = do - _List - return List - - alternative33 = do - _True - return (BoolLit True) - - alternative34 = do - _False - return (BoolLit False) - - alternative35 = do - _Type - return (Const Type) - - alternative36 = do - _Kind - return (Const Kind) - - alternative37 = do - a <- identifier - return (Var a) - - alternative38 = do - _openParens - a <- expression embedded - _closeParens - return a - -recordTypeOrLiteral :: Parser a -> Parser (Expr Src a) -recordTypeOrLiteral embedded = - choice - [ alternative0 - , alternative1 - , alternative2 - ] - where - alternative0 = do - _equal - return (RecordLit Data.HashMap.Strict.InsOrd.empty) - - alternative1 = nonEmptyRecordTypeOrLiteral embedded - - alternative2 = return (Record Data.HashMap.Strict.InsOrd.empty) - -nonEmptyRecordTypeOrLiteral :: Parser a -> Parser (Expr Src a) -nonEmptyRecordTypeOrLiteral embedded = do - a <- label - - let nonEmptyRecordType = do - _colon - b <- expression embedded - e <- many (do - _comma - c <- label - _colon - d <- expression embedded - return (c, d) ) - return (Record (Data.HashMap.Strict.InsOrd.fromList ((a, b):e))) - - let nonEmptyRecordLiteral = do - _equal - b <- expression embedded - e <- many (do - _comma - c <- label - _equal - d <- expression embedded - return (c, d) ) - return (RecordLit (Data.HashMap.Strict.InsOrd.fromList ((a, b):e))) - - nonEmptyRecordType <|> nonEmptyRecordLiteral - -unionTypeOrLiteral :: Parser a -> Parser (Expr Src a) -unionTypeOrLiteral embedded = - nonEmptyUnionTypeOrLiteral embedded - <|> return (Union Data.HashMap.Strict.InsOrd.empty) - -nonEmptyUnionTypeOrLiteral :: Parser a -> Parser (Expr Src a) -nonEmptyUnionTypeOrLiteral embedded = do - (f, kvs) <- loop - m <- toMap kvs - return (f m) - where - loop = do - a <- label - - let alternative0 = do - _equal - b <- expression embedded - kvs <- many (do - _bar - c <- label - _colon - d <- expression embedded - return (c, d) ) - return (UnionLit a b, kvs) - - let alternative1 = do - _colon - b <- expression embedded - - let alternative2 = do - _bar - (f, kvs) <- loop - return (f, (a, b):kvs) - - let alternative3 = return (Union, [(a, b)]) - - alternative2 <|> alternative3 - - alternative0 <|> alternative1 - -nonEmptyListLiteral :: Parser a -> Parser (Expr Src a) -nonEmptyListLiteral embedded = (do - _openBracket - a <- expression embedded - b <- many (do _comma; expression embedded) - _closeBracket - return (ListLit Nothing (Data.Sequence.fromList (a:b))) ) "list literal" - -completeExpression :: Parser a -> Parser (Expr Src a) -completeExpression embedded = do - whitespace - expression embedded - -toMap :: [(Text, a)] -> Parser (InsOrdHashMap Text a) -toMap kvs = do - let adapt (k, v) = (k, pure v) - let m = fromListWith (<|>) (fmap adapt kvs) - let action k vs = case Data.Sequence.viewl vs of - EmptyL -> empty - v :< vs' -> - if null vs' - then pure v - else - Text.Parser.Combinators.unexpected - ("duplicate field: " ++ Data.Text.Lazy.unpack k) - Data.HashMap.Strict.InsOrd.traverseWithKey action m - where - fromListWith combine = Data.List.foldl' snoc nil - where - nil = Data.HashMap.Strict.InsOrd.empty - - snoc m (k, v) = Data.HashMap.Strict.InsOrd.insertWith combine k v m - --- | Parser for a top-level Dhall expression -expr :: Parser (Expr Src Path) -expr = exprA import_ - --- | Parser for a top-level Dhall expression. The expression is parameterized --- over any parseable type, allowing the language to be extended as needed. -exprA :: Parser a -> Parser (Expr Src a) -exprA = completeExpression - -pathType_ :: Parser PathType -pathType_ = choice [ file, http, env ] - -pathHashed_ :: Parser PathHashed -pathHashed_ = do - pathType <- pathType_ - hash <- optional pathHash_ - return (PathHashed {..}) - where - pathHash_ = do - _ <- Text.Parser.Char.text "sha256:" - builder <- count 64 (satisfy hexdig "hex digit") - whitespace - let lazyText = Data.Text.Lazy.Builder.toLazyText builder - let lazyBytes = Data.Text.Lazy.Encoding.encodeUtf8 lazyText - case Crypto.Hash.digestFromByteString (Data.ByteString.Lazy.toStrict lazyBytes) of - Nothing -> fail "Invalid sha256 hash" - Just h -> pure h - -import_ :: Parser Path -import_ = (do - pathHashed <- pathHashed_ - pathMode <- alternative <|> pure Code - return (Path {..}) ) "import" - where - alternative = do - _as - _Text - return RawText - --- | A parsing error -newtype ParseError = ParseError Doc deriving (Typeable) - -instance Show ParseError where - show (ParseError doc) = - "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> show doc - -instance Exception ParseError - --- | Parse an expression from `Text` containing a Dhall program -exprFromText :: Delta -> Text -> Either ParseError (Expr Src Path) -exprFromText delta text = fmap snd (exprAndHeaderFromText delta text) - -{-| Like `exprFromText` but also returns the leading comments and whitespace - (i.e. header) up to the last newline before the code begins - - In other words, if you have a Dhall file of the form: - -> -- Comment 1 -> {- Comment -} 2 - - Then this will preserve @Comment 1@, but not @Comment 2@ - - This is used by @dhall-format@ to preserve leading comments and whitespace --} -exprAndHeaderFromText - :: Delta - -> Text - -> Either ParseError (Text, Expr Src Path) -exprAndHeaderFromText delta text = case result of - Failure errInfo -> Left (ParseError (Text.Trifecta._errDoc errInfo)) - Success (bytes, r) -> case Data.Text.Encoding.decodeUtf8' bytes of - Left errInfo -> Left (ParseError (fromString (show errInfo))) - Right txt -> do - let stripped = Data.Text.dropWhileEnd (/= '\n') txt - let lazyText = Data.Text.Lazy.fromStrict stripped - Right (lazyText, r) - where - string = Data.Text.Lazy.unpack text - - parser = unParser (do - bytes <- Text.Trifecta.slicedWith (\_ x -> x) whitespace - r <- expr - Text.Parser.Combinators.eof - return (bytes, r) ) - - result = Text.Trifecta.parseString parser delta string +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | This module contains Dhall's parsing logic + +module Dhall.Parser ( + -- * Utilities + exprFromText + , exprAndHeaderFromText + , censor + , createHeader + + -- * Parsers + , expr, exprA + + -- * Types + , Header(..) + , Src(..) + , SourcedException(..) + , ParseError(..) + , Parser(..) + ) where + +import Control.Applicative (many) +import Control.Exception (Exception) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Src (Src (..)) +import Dhall.Syntax +import Text.Megaparsec (ParseErrorBundle (..), PosState (..)) + +import qualified Data.Text as Text +import qualified Dhall.Core as Core +import qualified Text.Megaparsec + +import Dhall.Parser.Combinators +import Dhall.Parser.Expression +import Dhall.Parser.Token hiding (text) + +-- | Parser for a top-level Dhall expression +expr :: Parser (Expr Src Import) +expr = exprA (Text.Megaparsec.try import_) + +-- | Parser for a top-level Dhall expression. The expression is parameterized +-- over any parseable type, allowing the language to be extended as needed. +exprA :: Parser a -> Parser (Expr Src a) +exprA = completeExpression +{-# DEPRECATED exprA "Support for parsing custom imports will be dropped in a future release" #-} + +-- | A parsing error +data ParseError = ParseError { + unwrap :: Text.Megaparsec.ParseErrorBundle Text Void + , input :: Text + } + +{-| Replace the source code with spaces when rendering error messages + + This utility is used to implement the @--censor@ flag +-} +censor :: ParseError -> ParseError +censor parseError = + parseError + { unwrap = + (unwrap parseError) + { bundlePosState = + (bundlePosState (unwrap parseError)) + { pstateInput = + Core.censorText + (pstateInput (bundlePosState (unwrap parseError))) + } + } + } + +instance Show ParseError where + show (ParseError {..}) = + "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.errorBundlePretty unwrap + +instance Exception ParseError + +-- | Parse an expression from `Text.Text` containing a Dhall program +exprFromText + :: String -- ^ User-friendly name describing the input expression, + -- used in parsing error messages + -> Text -- ^ Input expression to parse + -> Either ParseError (Expr Src Import) +exprFromText delta text = fmap snd (exprAndHeaderFromText delta text) + +-- | A header corresponds to the leading comment at the top of a Dhall file. +-- +-- The header includes comment characters but is stripped of leading spaces and +-- trailing newlines +newtype Header = Header Text deriving Show + +-- | Create a header with stripped leading spaces and trailing newlines +createHeader :: Text -> Header +createHeader text = Header (prefix <> newSuffix) + where + isWhitespace c = c == ' ' || c == '\n' || c == '\r' || c == '\t' + + prefix = Text.dropAround isWhitespace text + + newSuffix + | Text.null prefix = "" + | otherwise = "\n" + +-- | Like `exprFromText` but also returns the leading comments and whitespace +-- (i.e. header) up to the last newline before the code begins +-- +-- In other words, if you have a Dhall file of the form: +-- +-- > -- Comment 1 +-- > {- Comment -} 2 +-- +-- Then this will preserve @Comment 1@, but not @Comment 2@ +-- +-- This is used by @dhall-format@ to preserve leading comments and whitespace +exprAndHeaderFromText + :: String -- ^ User-friendly name describing the input expression, + -- used in parsing error messages + -> Text -- ^ Input expression to parse + -> Either ParseError (Header, Expr Src Import) +exprAndHeaderFromText delta text = case result of + Left errInfo -> Left (ParseError { unwrap = errInfo, input = text }) + Right (txt, r) -> Right (createHeader txt, r) + where + parser = do + (bytes, _) <- Text.Megaparsec.match (many shebang *> whitespace) + r <- expr + Text.Megaparsec.eof + return (bytes, r) + + result = Text.Megaparsec.parse (unParser parser) delta text diff --git a/src/Dhall/Parser/Combinators.hs b/src/Dhall/Parser/Combinators.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Parser/Combinators.hs @@ -0,0 +1,292 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| This module contains Dhall's parser combinators +-} + +module Dhall.Parser.Combinators + ( Parser(..) + , SourcedException(..) + , laxSrcEq + , count + , range + , option + , star + , plus + , satisfy + , Dhall.Parser.Combinators.takeWhile + , takeWhile1 + , toMap + , toMapWith + , base + ) where + + +import Control.Applicative (Alternative (..), liftA2) +import Control.Exception (Exception) +import Control.Monad (MonadPlus (..)) +import Data.String (IsString (..)) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Map (Map) +import Dhall.Src (Src (..)) +import Prettyprinter (Pretty (..)) +import Text.Parser.Combinators (try, ()) +import Text.Parser.Token (TokenParsing (..)) + +import qualified Control.Monad.Fail +import qualified Data.Char as Char +import qualified Data.Text +import qualified Dhall.Map +import qualified Dhall.Pretty +import qualified Prettyprinter.Render.String as Pretty +import qualified Text.Megaparsec +import qualified Text.Megaparsec.Char +import qualified Text.Parser.Char +import qualified Text.Parser.Combinators +import qualified Text.Parser.Token.Style + +-- | An exception annotated with a `Src` span +data SourcedException e = SourcedException Src e + +instance Exception e => Exception (SourcedException e) + +instance Show e => Show (SourcedException e) where + show (SourcedException source exception) = + show exception + <> "\n" + <> "\n" + <> Pretty.renderString + (Dhall.Pretty.layout (pretty source)) + +-- | Doesn't force the 'Data.Text.Text' part +laxSrcEq :: Src -> Src -> Bool +laxSrcEq (Src p q _) (Src p' q' _) = eq p p' && eq q q' + where + -- Don't compare filename (which is FilePath = String) + eq :: Text.Megaparsec.SourcePos -> Text.Megaparsec.SourcePos -> Bool + eq (Text.Megaparsec.SourcePos _ a b) (Text.Megaparsec.SourcePos _ a' b') = + a == a' && b == b' +{-# INLINE laxSrcEq #-} + +{-| A `Parser` that is almost identical to + @"Text.Megaparsec".`Text.Megaparsec.Parsec`@ except treating Haskell-style + comments as whitespace +-} +newtype Parser a = Parser { unParser :: Text.Megaparsec.Parsec Void Text a } + +instance Functor Parser where + fmap f (Parser x) = Parser (fmap f x) + {-# INLINE fmap #-} + + f <$ Parser x = Parser (f <$ x) + {-# INLINE (<$) #-} + +instance Applicative Parser where + pure = Parser . pure + {-# INLINE pure #-} + + Parser f <*> Parser x = Parser (f <*> x) + {-# INLINE (<*>) #-} + + Parser a <* Parser b = Parser (a <* b) + {-# INLINE (<*) #-} + + Parser a *> Parser b = Parser (a *> b) + {-# INLINE (*>) #-} + +instance Monad Parser where + return = pure + {-# INLINE return #-} + + (>>) = (*>) + {-# INLINE (>>) #-} + + Parser n >>= k = Parser (n >>= unParser . k) + {-# INLINE (>>=) #-} + +#if !(MIN_VERSION_base(4,13,0)) + fail = Control.Monad.Fail.fail + {-# INLINE fail #-} +#endif + +instance Control.Monad.Fail.MonadFail Parser where + fail = Parser . Control.Monad.Fail.fail + {-# INLINE fail #-} + +instance Alternative Parser where + empty = Parser empty + -- {-# INLINE empty #-} + + Parser a <|> Parser b = Parser (a <|> b) + -- {-# INLINE (<|>) #-} + + some (Parser a) = Parser (some a) + -- {-# INLINE some #-} + + many (Parser a) = Parser (many a) + -- {-# INLINE many #-} + +instance MonadPlus Parser where + mzero = empty + -- {-# INLINE mzero #-} + + mplus = (<|>) + -- {-# INLINE mplus #-} + +instance Text.Megaparsec.MonadParsec Void Text Parser where + parseError e = Parser (Text.Megaparsec.parseError e) + + label l (Parser p) = Parser (Text.Megaparsec.label l p) + + hidden (Parser p) = Parser (Text.Megaparsec.hidden p) + + try (Parser p) = Parser (Text.Megaparsec.try p) + + lookAhead (Parser p) = Parser (Text.Megaparsec.lookAhead p) + + notFollowedBy (Parser p) = Parser (Text.Megaparsec.notFollowedBy p) + + withRecovery e (Parser p) = Parser (Text.Megaparsec.withRecovery (unParser . e) p) + + observing (Parser p) = Parser (Text.Megaparsec.observing p) + + eof = Parser Text.Megaparsec.eof + + token f e = Parser (Text.Megaparsec.token f e) + + tokens f ts = Parser (Text.Megaparsec.tokens f ts) + + takeWhileP s f = Parser (Text.Megaparsec.takeWhileP s f) + + takeWhile1P s f = Parser (Text.Megaparsec.takeWhile1P s f) + + takeP s n = Parser (Text.Megaparsec.takeP s n) + + getParserState = Parser Text.Megaparsec.getParserState + {-# INLINE getParserState #-} + + updateParserState f = Parser (Text.Megaparsec.updateParserState f) + +#if MIN_VERSION_megaparsec(9,4,0) + mkParsec f = Parser (Text.Megaparsec.mkParsec f) +#endif + +instance Semigroup a => Semigroup (Parser a) where + (<>) = liftA2 (<>) + +instance (Semigroup a, Monoid a) => Monoid (Parser a) where + mempty = pure mempty + +instance IsString a => IsString (Parser a) where + fromString x = fromString x <$ Text.Megaparsec.Char.string (fromString x) + +instance Text.Parser.Combinators.Parsing Parser where + try = Text.Megaparsec.try + + () = (Text.Megaparsec.) + + skipMany = Text.Megaparsec.skipMany + + skipSome = Text.Megaparsec.skipSome + + unexpected = fail + + eof = Parser Text.Megaparsec.eof + + notFollowedBy = Text.Megaparsec.notFollowedBy + +instance Text.Parser.Char.CharParsing Parser where + satisfy = Parser . Text.Megaparsec.satisfy + + char = Text.Megaparsec.Char.char + + notChar = Text.Megaparsec.Char.char + + anyChar = Text.Megaparsec.anySingle + + string = fmap Data.Text.unpack . Text.Megaparsec.Char.string . fromString + + text = Text.Megaparsec.Char.string + +instance TokenParsing Parser where + someSpace = + Text.Parser.Token.Style.buildSomeSpaceParser + (Parser (Text.Megaparsec.skipSome (Text.Megaparsec.satisfy Char.isSpace))) + Text.Parser.Token.Style.haskellCommentStyle + + highlight _ = id + + semi = token (Text.Megaparsec.Char.char ';' ";") + +-- | @count n p@ parses @n@ occurrences of @p@ +count :: (Semigroup a, Monoid a) => Int -> Parser a -> Parser a +count n parser = mconcat (replicate n parser) + +-- | @range lo hi p@ parses @n@ ocurrences of @p@ where @lo <= n <= hi@ +range :: (Semigroup a, Monoid a) => Int -> Int -> Parser a -> Parser a +range minimumBound maximumMatches parser = + count minimumBound parser <> loop maximumMatches + where + loop 0 = mempty + loop n = (parser <> loop (n - 1)) <|> mempty + +-- | @option p@ tries to apply parser @p@ returning @mempty@ if parsing failed +option :: (Alternative f, Monoid a) => f a -> f a +option p = p <|> pure mempty + +-- | @star p@ tries to apply a parser @0@ or more times +star :: (Alternative f, Monoid a) => f a -> f a +star p = plus p <|> pure mempty + +-- | @plus p@ tries to apply a parser @1@ or more times +plus :: (Alternative f, Monoid a) => f a -> f a +plus p = mappend <$> p <*> star p + +-- | @satisfy p@ creates a parser that consumes and return the next character +-- if it satisfies the predicate @p@ +satisfy :: (Char -> Bool) -> Parser Text +satisfy = fmap Data.Text.singleton . Text.Parser.Char.satisfy + +-- | @takeWhile p@ creates a parser that accepts the longest sequence of characters +-- that match the given predicate possibly returning an empty sequence +takeWhile :: (Char -> Bool) -> Parser Text +takeWhile predicate = Parser (Text.Megaparsec.takeWhileP Nothing predicate) + +-- | @takeWhile1 p@ creates a parser that accepts the longest sequence of characters +-- that match the given predicate. It fails when no character was consumed +takeWhile1 :: (Char -> Bool) -> Parser Text +takeWhile1 predicate = Parser (Text.Megaparsec.takeWhile1P Nothing predicate) + +-- | Creates a map with the given key-value pairs, failing if there was a +-- duplicate key. +toMap :: [(Text, a)] -> Parser (Map Text a) +toMap kvs = Dhall.Map.unorderedTraverseWithKey (\_k v -> v) m + where + m = Dhall.Map.fromListWithKey err (map (\(k, v) -> (k, pure v)) kvs) + + err k _v1 _v2 = Text.Parser.Combinators.unexpected + ("duplicate field: " ++ Data.Text.unpack k) + +-- | Creates a 'Map Text a' using the provided combining function and the +-- key-value pairs +toMapWith + :: (Text -> Parser a -> Parser a -> Parser a) + -> [(Text, a)] + -> Parser (Map Text a) +toMapWith combine kvs = sequence m + where + m = Dhall.Map.fromListWithKey combine (map (\(k, v) -> (k, pure v)) kvs) + +-- | Convert a list of digits to the equivalent number +base :: Num n => [Char] -> n -> n +digits `base` b = foldl snoc 0 (map (fromIntegral . digitToNumber) digits) + where + snoc result number = result * b + number + + digitToNumber c + | '0' <= c && c <= '9' = 0x0 + Char.ord c - Char.ord '0' + | 'A' <= c && c <= 'F' = 0xA + Char.ord c - Char.ord 'A' + | 'a' <= c && c <= 'f' = 0xa + Char.ord c - Char.ord 'a' + | otherwise = error "Invalid hexadecimal digit" diff --git a/src/Dhall/Parser/Expression.hs b/src/Dhall/Parser/Expression.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Parser/Expression.hs @@ -0,0 +1,1279 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Parsing Dhall expressions. +module Dhall.Parser.Expression where + +import Control.Applicative (Alternative (..), liftA2, optional) +import Data.Foldable (foldl') +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text (Text) +import Dhall.Src (Src (..)) +import Dhall.Syntax +import Text.Parser.Combinators (choice, try, ()) + +import qualified Control.Monad +import qualified Control.Monad.Combinators as Combinators +import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.Char as Char +import qualified Data.List +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Sequence +import qualified Data.Text +import qualified Data.Text.Encoding +import qualified Data.Time as Time +import qualified Dhall.Crypto +import qualified Text.Megaparsec + +import Dhall.Parser.Combinators +import Dhall.Parser.Token + +-- | Get the current source offset (in tokens) +getOffset :: Text.Megaparsec.MonadParsec e s m => m Int +getOffset = Text.Megaparsec.stateOffset <$> Text.Megaparsec.getParserState +{-# INLINE getOffset #-} + +-- | Set the current source offset +setOffset :: Text.Megaparsec.MonadParsec e s m => Int -> m () +setOffset o = Text.Megaparsec.updateParserState $ \state -> + state + { Text.Megaparsec.stateOffset = o } +{-# INLINE setOffset #-} + +{-| Wrap a `Parser` to still match the same text but return only the `Src` + span +-} +src :: Parser a -> Parser Src +src parser = do + before <- Text.Megaparsec.getSourcePos + (tokens, _) <- Text.Megaparsec.match parser + after <- Text.Megaparsec.getSourcePos + return (Src before after tokens) + +-- | Same as `src`, except also return the parsed value +srcAnd :: Parser a -> Parser (Src, a) +srcAnd parser = do + before <- Text.Megaparsec.getSourcePos + (tokens, x) <- Text.Megaparsec.match parser + after <- Text.Megaparsec.getSourcePos + return (Src before after tokens, x) + +{-| Wrap a `Parser` to still match the same text, but to wrap the resulting + `Expr` in a `Note` constructor containing the `Src` span +-} +noted :: Parser (Expr Src a) -> Parser (Expr Src a) +noted parser = do + before <- Text.Megaparsec.getSourcePos + (tokens, e) <- Text.Megaparsec.match parser + after <- Text.Megaparsec.getSourcePos + let src₀ = Src before after tokens + case e of + Note src₁ _ | laxSrcEq src₀ src₁ -> return e + _ -> return (Note src₀ e) + +{-| Parse a complete expression (with leading and trailing whitespace) + + This corresponds to the @complete-expression@ rule from the official + grammar +-} +completeExpression :: Parser a -> Parser (Expr Src a) +completeExpression embedded = completeExpression_ + where + Parsers {..} = parsers embedded + +{-| Parse an \"import expression\" + + This is not the same thing as @`fmap` `Embed`@. This parses any + expression of the same or higher precedence as an import expression (such + as a selector expression). For example, this parses @(1)@ + + This corresponds to the @import-expression@ rule from the official grammar +-} +importExpression :: Parser a -> Parser (Expr Src a) +importExpression embedded = importExpression_ + where + Parsers {..} = parsers embedded + +{-| For efficiency (and simplicity) we only expose two parsers from the + result of the `parsers` function, since these are the only parsers needed + outside of this module +-} +data Parsers a = Parsers + { completeExpression_ :: Parser (Expr Src a) + , importExpression_ :: Parser (Expr Src a) + , letBinding :: Parser (Binding Src a) + } + +{-| Parse a numeric `TimeZone` + + This corresponds to the @time-numoffset@ rule from the official grammar +-} +timeNumOffset :: Parser (Expr s a) +timeNumOffset = do + s <- signPrefix + + hour <- timeHour + + _ <- text ":" + + minute <- timeMinute + + let minutes = s (hour * 60 + minute) + + return (TimeZoneLiteral (Time.TimeZone minutes Prelude.False "")) + +{-| Parse a numeric `TimeZone` or a @Z@ + + This corresponds to the @time-offset@ rule from the official grammar +-} +timeOffset :: Parser (Expr s a) +timeOffset = + (do _ <- text "Z" + + return (TimeZoneLiteral (Time.TimeZone 0 Prelude.False "")) + ) + <|> timeNumOffset + +{-| Parse a `Time` + + This corresponds to the @partial-time@ rule from the official grammar +-} +partialTime :: Parser (Expr s a) +partialTime = do + hour <- timeHour + + _ <- text ":" + + minute <- timeMinute + + _ <- text ":" + + second <- timeSecond + + (fraction, precision) <- timeSecFrac <|> pure (0, 0) + + let time = Time.TimeOfDay hour minute (second + fraction) + + return (TimeLiteral time precision) + +{-| Parse a `Date` + + This corresponds to the @full-date@ rule from the official grammar +-} +fullDate :: Parser (Expr s a) +fullDate = do + year <- dateFullYear + + _ <- text "-" + + month <- dateMonth + + _ <- text "-" + + day <- dateMday + + case Time.fromGregorianValid year month day of + Nothing -> fail "Invalid calendar day" + Just d -> return (DateLiteral d) + +{-| Parse a `Date`, `Time`, `TimeZone` or any valid permutation of them as a + record + + This corresponds to the @temporal-literal@ rule from the official grammar +-} +temporalLiteral :: Parser (Expr s a) +temporalLiteral = + try (do + date <- fullDate + + _ <- text "T" <|> text "t" + + time <- partialTime + + timeZone <- timeOffset + + return + (RecordLit + [ ("date" , makeRecordField date) + , ("time" , makeRecordField time) + , ("timeZone", makeRecordField timeZone) + ] + ) + ) + <|> try (do + date <- fullDate + + _ <- text "T" <|> text "t" + + time <- partialTime + + return + (RecordLit + [ ("date", makeRecordField date) + , ("time", makeRecordField time) + ] + ) + ) + <|> try (do + time <- partialTime + + timeZone <- timeOffset + + return + (RecordLit + [ ("time" , makeRecordField time) + , ("timeZone", makeRecordField timeZone) + ] + ) + ) + <|> try fullDate + <|> try partialTime + <|> try timeNumOffset + +-- | Parse a \"shebang\" line (i.e. an initial line beginning with @#!@) +shebang :: Parser () +shebang = do + _ <- text "#!" + + let predicate c = ('\x20' <= c && c <= '\x10FFFF') || c == '\t' + + _ <- Dhall.Parser.Combinators.takeWhile predicate + + _ <- endOfLine + + return () + +-- | Given a parser for imports, +parsers :: forall a. Parser a -> Parsers a +parsers embedded = Parsers{..} + where + completeExpression_ = + whitespace + *> expression + <* whitespace + <* optional lineCommentPrefix + + letBinding = do + src0 <- try (_let *> src nonemptyWhitespace) + + c <- label + + src1 <- src whitespace + + d <- optional (do + _colon + + src2 <- src nonemptyWhitespace + + e <- expression + + whitespace + + return (Just src2, e) ) + + _equal + + src3 <- src whitespace + + f <- expression + + whitespace + + return (Binding (Just src0) c (Just src1) d (Just src3) f) + + expression = + noted + ( choice + [ alternative0 + , alternative1 + , alternative2 + , alternative3 + , alternative4 + , alternative5 + ] + ) "expression" + where + alternative0 = do + cs <- _lambda + whitespace + _openParens + src0 <- src whitespace + a <- label + src1 <- src whitespace + _colon + src2 <- src nonemptyWhitespace + b <- expression + whitespace + _closeParens + whitespace + cs' <- _arrow + whitespace + c <- expression + return (Lam (Just (cs <> cs')) (FunctionBinding (Just src0) a (Just src1) (Just src2) b) c) + + alternative1 = do + try (_if *> nonemptyWhitespace) + a <- expression + whitespace + try (_then *> nonemptyWhitespace) + b <- expression + whitespace + try (_else *> nonemptyWhitespace) + c <- expression + return (BoolIf a b c) + + alternative2 = do + as <- NonEmpty.some1 letBinding + + try (_in *> nonemptyWhitespace) + + b <- expression + + -- 'Note's in let-in-let: + -- + -- Subsequent @let@s that are not separated by an @in@ only get a + -- single surrounding 'Note'. For example: + -- + -- let x = a + -- let y = b + -- in let z = c + -- in x + -- + -- is parsed as + -- + -- (Note … + -- (Let x … + -- (Let y … + -- (Note … + -- (Let z … + return (Dhall.Syntax.wrapInLets as b) + + alternative3 = do + cs <- try (_forall <* whitespace <* _openParens) + whitespace + a <- label + whitespace + _colon + nonemptyWhitespace + b <- expression + whitespace + _closeParens + whitespace + cs' <- _arrow + whitespace + c <- expression + return (Pi (Just (cs <> cs')) a b c) + + alternative4 = do + try (_assert *> whitespace *> _colon) + nonemptyWhitespace + a <- expression + return (Assert a) + + alternative5 = do + (a0Info, a0) <- applicationExpressionWithInfo + + let (parseFirstOperatorExpression, parseOperatorExpression) = + operatorExpression (pure a0) + + let alternative5A = do + case a0Info of + ImportExpr -> return () + _ -> empty + + bs <- some (do + try (nonemptyWhitespace *> _with *> nonemptyWhitespace) + + let withComponent = + fmap WithLabel anyLabelOrSome + <|> fmap (\_ -> WithQuestion) (text "?") + + keys <- Combinators.NonEmpty.sepBy1 withComponent (try (whitespace *> _dot) *> whitespace) + + whitespace + + _equal + + whitespace + + value <- parseOperatorExpression + + return (\e -> With e keys value) ) + + return (foldl (\e f -> f e) a0 bs) + + let alternative5B = do + a <- parseFirstOperatorExpression + + whitespace + + let alternative5B0 = do + cs <- _arrow + whitespace + b <- expression + whitespace + return (Pi (Just cs) "_" a b) + + let alternative5B1 = do + _colon + nonemptyWhitespace + case (shallowDenote a, a0Info) of + (ListLit Nothing [], _) -> do + b <- expression + + return (ListLit (Just b) []) + (Merge c d Nothing, NakedMergeOrSomeOrToMap) -> do + b <- expression + + return (Merge c d (Just b)) + (ToMap c Nothing, NakedMergeOrSomeOrToMap) -> do + b <- expression + + return (ToMap c (Just b)) + _ -> do + b <- expression + + return (Annot a b) + + let alternative5B2 = + case shallowDenote a of + ListLit Nothing [] -> + fail "Empty list literal without annotation" + _ -> pure a + + alternative5B0 <|> alternative5B1 <|> alternative5B2 + + alternative5A <|> alternative5B + + -- The firstApplicationExpression argument is necessary in order to + -- left-factor the parsers for function types and @with@ expressions to + -- minimize backtracking + -- + -- For a longer explanation, see: + -- + -- https://github.com/dhall-lang/dhall-haskell/pull/1770#discussion_r419022486 + operatorExpression firstApplicationExpression = + foldr cons nil operatorParsers + where + cons operatorParser (p0, p) = + ( makeOperatorExpression p0 operatorParser p + , makeOperatorExpression p operatorParser p + ) + + nil = (firstApplicationExpression, applicationExpression) + + makeOperatorExpression firstSubExpression operatorParser subExpression = do + a <- firstSubExpression + + bs <- Text.Megaparsec.many $ do + (Src _ _ textOp, op0) <- srcAnd (try (whitespace *> operatorParser)) + + r0 <- subExpression + + let l@(Note (Src startL _ textL) _) `op` r@(Note (Src _ endR textR) _) = + Note (Src startL endR (textL <> textOp <> textR)) (l `op0` r) + -- We shouldn't hit this branch if things are working, but + -- that is not enforced in the types + l `op` r = + l `op0` r + + return (`op` r0) + + return (foldl' (\x f -> f x) a bs) + + operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)] + operatorParsers = + [ Equivalent . Just <$> _equivalent <* whitespace + , ImportAlt <$ _importAlt <* nonemptyWhitespace + , BoolOr <$ _or <* whitespace + , NaturalPlus <$ _plus <* nonemptyWhitespace + , TextAppend <$ _textAppend <* whitespace + , ListAppend <$ _listAppend <* whitespace + , BoolAnd <$ _and <* whitespace + , (\cs -> Combine (Just cs) Nothing) <$> _combine <* whitespace + , (\cs -> Prefer (Just cs) PreferFromSource) <$> _prefer <* whitespace + , CombineTypes . Just <$> _combineTypes <* whitespace + , NaturalTimes <$ _times <* whitespace + -- Make sure that `==` is not actually the prefix of `===` + , BoolEQ <$ try (_doubleEqual <* Text.Megaparsec.notFollowedBy (char '=')) <* whitespace + , BoolNE <$ _notEqual <* whitespace + ] + + applicationExpression = snd <$> applicationExpressionWithInfo + + applicationExpressionWithInfo :: Parser (ApplicationExprInfo, Expr Src a) + applicationExpressionWithInfo = do + let alternative0 = do + try (_merge *> nonemptyWhitespace) + + a <- importExpression_ <* nonemptyWhitespace + + return (\b -> Merge a b Nothing, Just "second argument to ❰merge❱") + + let alternative1 = do + try (_Some *> nonemptyWhitespace) + + return (Some, Just "argument to ❰Some❱") + + let alternative2 = do + try (_toMap *> nonemptyWhitespace) + + return (\a -> ToMap a Nothing, Just "argument to ❰toMap❱") + + let alternative3 = do + try (_showConstructor *> nonemptyWhitespace) + + return (\a -> ShowConstructor a, Just "argument to ❰showConstructor❱") + + let alternative4 = + return (id, Nothing) + + (f, maybeMessage) <- alternative0 <|> alternative1 <|> alternative2 <|> alternative3 <|> alternative4 + + let adapt parser = + case maybeMessage of + Nothing -> parser + Just message -> parser message + + a <- adapt (noted importExpression_) + + bs <- Text.Megaparsec.many . try $ do + (sep, _) <- Text.Megaparsec.match nonemptyWhitespace + b <- importExpression_ + return (sep, b) + + let c = foldl' app (f a) bs + + let info = + case (maybeMessage, bs) of + (Just _ , []) -> NakedMergeOrSomeOrToMap + (Nothing, []) -> ImportExpr + _ -> ApplicationExpr + + return (info, c) + where + app a (sep, b) + | Note (Src left _ bytesL) _ <- a + , Note (Src _ right bytesR) _ <- b + = Note (Src left right (bytesL <> sep <> bytesR)) (App a b) + app a (_, b) = + App a b + + importExpression_ = noted (choice [ alternative0, alternative1 ]) + where + alternative0 = do + a <- embedded + return (Embed a) + + alternative1 = completionExpression + + completionExpression = noted (do + a <- selectorExpression + + mb <- optional (do + try (whitespace *> _doubleColon) + + whitespace + + selectorExpression ) + + case mb of + Nothing -> return a + Just b -> return (RecordCompletion a b) ) + + selectorExpression = noted (do + a <- primitiveExpression + + let recordType = _openParens *> whitespace *> expression <* whitespace <* _closeParens + + let field x e = Field e x + let projectBySet xs e = Project e (Left xs) + let projectByExpression xs e = Project e (Right xs) + + let alternatives = do + src0 <- src whitespace + + let fieldSelection = do + l <- anyLabel + + pos <- Text.Megaparsec.getSourcePos + + -- FIXME: Suffix whitespace can't be parsed given our limitation + -- about whitespace treatment, but for @dhall-docs@ this + -- is enough + let src1 = Src pos pos "" + + return (FieldSelection (Just src0) l (Just src1)) + + let result = + fmap field fieldSelection + <|> fmap projectBySet labels + <|> fmap projectByExpression recordType + + result + + b <- Text.Megaparsec.many (try (whitespace *> _dot *> alternatives)) + + return (foldl' (\e k -> k e) a b) ) + + primitiveExpression = + noted + ( choice + [ bytesLiteral + , temporalLiteral + , alternative00 + , alternative01 + , alternative02 + , textLiteral + , alternative04 + , unionType + , listLiteral + , alternative37 + , alternative09 + , builtin + ] + ) + <|> alternative38 + where + alternative00 = do + n <- getOffset + a <- try doubleLiteral + b <- if isInfinite a + then setOffset n *> fail "double out of bounds" + else return a + return (DoubleLit (DhallDouble b)) + + alternative01 = do + a <- try naturalLiteral + return (NaturalLit a) + + alternative02 = do + a <- try integerLiteral + return (IntegerLit a) + + alternative04 = (do + _openBrace + + src0 <- src whitespace + mComma <- optional _comma + + -- `src1` corresponds to the prefix whitespace of the first key-value + -- pair. This is done to avoid using `try` to recover the consumed + -- whitespace when the comma is not consumed + src1 <- case mComma of + Nothing -> return src0 + Just _ -> src whitespace + + a <- recordTypeOrLiteral src1 + + _closeBrace + + return a ) "literal" + + alternative09 = do + a <- try doubleInfinity + return (DoubleLit (DhallDouble a)) + + builtin = do + let predicate c = + c == 'N' + || c == 'I' + || c == 'D' + || c == 'L' + || c == 'O' + || c == 'B' + || c == 'S' + || c == 'T' + || c == 'F' + || c == 'K' + + let nan = DhallDouble (0.0/0.0) + + c <- Text.Megaparsec.lookAhead (Text.Megaparsec.satisfy predicate) + + case c of + 'N' -> + choice + [ NaturalFold <$ _NaturalFold + , NaturalBuild <$ _NaturalBuild + , NaturalIsZero <$ _NaturalIsZero + , NaturalEven <$ _NaturalEven + , NaturalOdd <$ _NaturalOdd + , NaturalSubtract <$ _NaturalSubtract + , NaturalToInteger <$ _NaturalToInteger + , NaturalShow <$ _NaturalShow + , Natural <$ _Natural + , None <$ _None + , DoubleLit nan <$ _NaN + ] + 'I' -> + choice + [ IntegerClamp <$ _IntegerClamp + , IntegerNegate <$ _IntegerNegate + , IntegerShow <$ _IntegerShow + , IntegerToDouble <$ _IntegerToDouble + , Integer <$ _Integer + ] + + 'D' -> + choice + [ DateShow <$ _DateShow + , Date <$ _Date + , DoubleShow <$ _DoubleShow + , Double <$ _Double + ] + 'L' -> + choice + [ ListBuild <$ _ListBuild + , ListFold <$ _ListFold + , ListLength <$ _ListLength + , ListHead <$ _ListHead + , ListLast <$ _ListLast + , ListIndexed <$ _ListIndexed + , ListReverse <$ _ListReverse + , List <$ _List + ] + 'O' -> Optional <$ _Optional + 'B' -> + choice + [ Bool <$ _Bool + , Bytes <$ _Bytes + ] + 'S' -> Const Sort <$ _Sort + 'T' -> + choice + [ TextReplace <$ _TextReplace + , TextShow <$ _TextShow + , Text <$ _Text + , TimeZoneShow <$ _TimeZoneShow + , TimeZone <$ _TimeZone + , TimeShow <$ _TimeShow + , Time <$ _Time + , BoolLit True <$ _True + , Const Type <$ _Type + ] + 'F' -> BoolLit False <$ _False + 'K' -> Const Kind <$ _Kind + _ -> empty + + alternative37 = do + a <- identifier + return (Var a) + + alternative38 = do + _openParens + whitespace + a <- expression + whitespace + _closeParens + return a + + doubleQuotedChunk = + choice + [ interpolation + , unescapedCharacterFast + , unescapedCharacterSlow + , escapedCharacter + ] + where + interpolation = do + _ <- text "${" + e <- completeExpression_ + _ <- char '}' + return (Chunks [(mempty, e)] mempty) + + unescapedCharacterFast = do + t <- Text.Megaparsec.takeWhile1P Nothing predicate + return (Chunks [] t) + where + predicate c = + ( ('\x20' <= c && c <= '\x21' ) + || ('\x23' <= c && c <= '\x5B' ) + || ('\x5D' <= c && c <= '\x10FFFF') + ) && c /= '$' + + unescapedCharacterSlow = do + _ <- char '$' + return (Chunks [] "$") + + escapedCharacter = do + _ <- char '\\' + c <- choice + [ quotationMark + , dollarSign + , backSlash + , forwardSlash + , backSpace + , formFeed + , lineFeed + , carriageReturn + , tab + , unicode + ] + return (Chunks [] (Data.Text.singleton c)) + where + quotationMark = char '"' + + dollarSign = char '$' + + backSlash = char '\\' + + forwardSlash = char '/' + + backSpace = do _ <- char 'b'; return '\b' + + formFeed = do _ <- char 'f'; return '\f' + + lineFeed = do _ <- char 'n'; return '\n' + + carriageReturn = do _ <- char 'r'; return '\r' + + tab = do _ <- char 't'; return '\t' + + unicode = do + _ <- char 'u'; + + let toNumber = Data.List.foldl' (\x y -> x * 16 + y) 0 + + let fourCharacterEscapeSequence = do + ns <- Control.Monad.replicateM 4 hexNumber + + let number = toNumber ns + + Control.Monad.guard (validCodepoint number) + <|> fail "Invalid Unicode code point" + + return number + + let bracedEscapeSequence = do + _ <- char '{' + ns <- some hexNumber + + let number = toNumber ns + + Control.Monad.guard (number <= 0x10FFFD && validCodepoint number) + <|> fail "Invalid Unicode code point" + + _ <- char '}' + + return number + + n <- bracedEscapeSequence <|> fourCharacterEscapeSequence + + return (Char.chr n) + + doubleQuotedLiteral = do + _ <- char '"' + chunks <- Text.Megaparsec.many doubleQuotedChunk + _ <- char '"' + return (mconcat chunks) + + singleQuoteContinue = + choice + [ escapeSingleQuotes + , interpolation + , escapeInterpolation + , endLiteral + , unescapedCharacterFast + , unescapedCharacterSlow + , tab + , endOfLine_ + ] + where + escapeSingleQuotes = do + _ <- "'''" :: Parser Text + b <- singleQuoteContinue + return ("''" <> b) + + interpolation = do + _ <- text "${" + a <- completeExpression_ + _ <- char '}' + b <- singleQuoteContinue + return (Chunks [(mempty, a)] mempty <> b) + + escapeInterpolation = do + _ <- text "''${" + b <- singleQuoteContinue + return ("${" <> b) + + endLiteral = do + _ <- text "''" + return mempty + + unescapedCharacterFast = do + a <- Text.Megaparsec.takeWhile1P Nothing predicate + b <- singleQuoteContinue + return (Chunks [] a <> b) + where + predicate c = + ('\x20' <= c && c <= '\x10FFFF') && c /= '$' && c /= '\'' + + unescapedCharacterSlow = do + a <- satisfy predicate + b <- singleQuoteContinue + return (Chunks [] a <> b) + where + predicate c = c == '$' || c == '\'' + + endOfLine_ = do + a <- "\n" <|> "\r\n" + b <- singleQuoteContinue + return (Chunks [] a <> b) + + tab = do + _ <- char '\t' "tab" + b <- singleQuoteContinue + return ("\t" <> b) + + singleQuoteLiteral = do + _ <- text "''" + + _ <- endOfLine + + a <- singleQuoteContinue + + return (Dhall.Syntax.toDoubleQuoted a) + + textLiteral = (do + literal <- doubleQuotedLiteral <|> singleQuoteLiteral + return (TextLit literal) ) "literal" + + bytesLiteral = (do + _ <- text "0x\"" + + let byte = do + nibble0 <- Text.Megaparsec.satisfy hexdig + nibble1 <- Text.Megaparsec.satisfy hexdig + return ([nibble0, nibble1] `base` 16) + + bytes <- Text.Megaparsec.many byte + + _ <- char '"' + + return (BytesLit (ByteString.pack bytes)) ) "literal" + + recordTypeOrLiteral firstSrc0 = + choice + [ emptyRecordLiteral + , nonEmptyRecordTypeOrLiteral firstSrc0 + , emptyRecordType + ] + + emptyRecordLiteral = do + _equal + + _ <- optional (try (whitespace *> _comma)) + + whitespace + return (RecordLit mempty) + + emptyRecordType = return (Record mempty) + + nonEmptyRecordTypeOrLiteral firstSrc0 = do + let nonEmptyRecordType = do + (firstKeySrc1, a) <- try $ do + a <- anyLabelOrSome + s <- src whitespace + _colon + return (s, a) + + firstKeySrc2 <- src nonemptyWhitespace + + b <- expression + + e <- Text.Megaparsec.many $ do + (src0', c) <- try $ do + _comma + src0' <- src whitespace + c <- anyLabelOrSome + return (src0', c) + + src1 <- src whitespace + + _colon + + src2 <- src nonemptyWhitespace + + d <- expression + + whitespace + + return (c, RecordField (Just src0') d (Just src1) (Just src2)) + + _ <- optional (whitespace *> _comma) + whitespace + + m <- toMap ((a, RecordField (Just firstSrc0) b (Just firstKeySrc1) (Just firstKeySrc2)) : e) + + return (Record m) + + let keysValue maybeSrc = do + firstSrc0' <- case maybeSrc of + Just src0 -> return src0 + Nothing -> src whitespace + firstLabel <- anyLabelOrSome + firstSrc1 <- src whitespace + + let parseLabelWithWhsp = try $ do + _dot + src0 <- src whitespace + l <- anyLabelOrSome + src1 <- src whitespace + return (src0, l, src1) + + restKeys <- Combinators.many parseLabelWithWhsp + let keys = (firstSrc0', firstLabel, firstSrc1) :| restKeys + + let normalRecordEntry = do + try _equal + + lastSrc2 <- src whitespace + + value <- expression + + let cons (s0, key, s1) (key', values) = + (key, RecordField (Just s0) (RecordLit [ (key', values) ]) (Just s1) Nothing) + + let (lastSrc0, lastLabel, lastSrc1) = NonEmpty.last keys + let nil = (lastLabel, RecordField (Just lastSrc0) value (Just lastSrc1) (Just lastSrc2)) + + return (foldr cons nil (NonEmpty.init keys)) + + let punnedEntry = + case keys of + (s0, x, s1) :| [] -> return (x, RecordField (Just s0) (Var (V x 0)) (Just s1) Nothing) + _ -> empty + + (normalRecordEntry <|> punnedEntry) <* whitespace + + let nonEmptyRecordLiteral = do + a <- keysValue (Just firstSrc0) + + as <- many (try (_comma *> keysValue Nothing)) + + _ <- optional (whitespace *> _comma) + + whitespace + + let combine k = liftA2 $ \rf rf' -> makeRecordField $ Combine mempty (Just k) + (recordFieldValue rf') + (recordFieldValue rf) + + m <- toMapWith combine (a : as) + + return (RecordLit m) + + nonEmptyRecordType <|> nonEmptyRecordLiteral + + unionType = (do + _openAngle + + whitespace + + let unionTypeEntry = do + a <- anyLabelOrSome + + whitespace + + b <- optional (_colon *> nonemptyWhitespace *> expression <* whitespace) + + return (a, b) + + let nonEmptyUnionType = do + kv <- try (optional (_bar *> whitespace) *> unionTypeEntry) + + kvs <- many (try (_bar *> whitespace *> unionTypeEntry)) + + m <- toMap (kv : kvs) + + _ <- optional (_bar *> whitespace) + + _closeAngle + + return (Union m) + + let emptyUnionType = do + try (optional (_bar *> whitespace) *> _closeAngle) + + return (Union mempty) + + nonEmptyUnionType <|> emptyUnionType ) "literal" + + listLiteral = (do + _openBracket + + whitespace + + let nonEmptyListLiteral = do + a <- try (optional (_comma *> whitespace) *> expression) + + whitespace + + as <- many (try (_comma *> whitespace *> expression) <* whitespace) + + _ <- optional (_comma *> whitespace) + + _closeBracket + + return (ListLit Nothing (Data.Sequence.fromList (a : as))) + + let emptyListLiteral = do + try (optional (_comma *> whitespace) *> _closeBracket) + + return (ListLit Nothing mempty) + + nonEmptyListLiteral <|> emptyListLiteral) "literal" + +{-| Parse an environment variable import + + This corresponds to the @env@ rule from the official grammar +-} +env :: Parser ImportType +env = do + _ <- text "env:" + a <- (alternative0 <|> alternative1) + return (Env a) + where + alternative0 = bashEnvironmentVariable + + alternative1 = do + _ <- char '"' + a <- posixEnvironmentVariable + _ <- char '"' + return a + +-- | Parse a local import without trailing whitespace +localOnly :: Parser ImportType +localOnly = + choice + [ parentPath + , herePath + , homePath + , try absolutePath + ] + where + parentPath = do + _ <- ".." :: Parser Text + file <- file_ FileComponent + + return (Local Parent file) + + herePath = do + _ <- "." :: Parser Text + file <- file_ FileComponent + + return (Local Here file) + + homePath = do + _ <- "~" :: Parser Text + file <- file_ FileComponent + + return (Local Home file) + + absolutePath = do + file <- file_ FileComponent + + return (Local Absolute file) + +{-| Parse a local import + + This corresponds to the @local@ rule from the official grammar +-} +local :: Parser ImportType +local = do + a <- localOnly + return a + +{-| Parse an HTTP(S) import + + This corresponds to the @http@ rule from the official grammar +-} +http :: Parser ImportType +http = do + url <- httpRaw + headers <- optional (do + try (whitespace *> _using *> nonemptyWhitespace) + importExpression import_ ) + return (Remote (url { headers })) + +{-| Parse a `Missing` import + + This corresponds to the @missing@ rule from the official grammar +-} +missing :: Parser ImportType +missing = do + _missing + return Missing + +{-| Parse an `ImportType` + + This corresponds to the @import-type@ rule from the official grammar +-} +importType_ :: Parser ImportType +importType_ = do + let predicate c = + c == '~' || c == '.' || c == '/' || c == 'h' || c == 'e' || c == 'm' + + _ <- Text.Megaparsec.lookAhead (Text.Megaparsec.satisfy predicate) + + choice [ local, http, env, missing ] + +{-| Parse a `Dhall.Crypto.SHA256Digest` + + This corresponds to the @hash@ rule from the official grammar +-} +importHash_ :: Parser Dhall.Crypto.SHA256Digest +importHash_ = do + _ <- text "sha256:" + t <- count 64 (satisfy hexdig "hex digit") + let strictBytes16 = Data.Text.Encoding.encodeUtf8 t + strictBytes <- case Base16.decode strictBytes16 of + Left string -> fail string + Right strictBytes -> return strictBytes + case Dhall.Crypto.sha256DigestFromByteString strictBytes of + Nothing -> fail "Invalid sha256 hash" + Just h -> pure h + +{-| Parse an `ImportHashed` + + This corresponds to the @import-hashed@ rule from the official grammar +-} +importHashed_ :: Parser ImportHashed +importHashed_ = do + importType <- importType_ + hash <- optional (try (nonemptyWhitespace *> importHash_)) + return (ImportHashed {..}) + +{-| Parse an `Import` + + This corresponds to the @import@ rule from the official grammar +-} +import_ :: Parser Import +import_ = (do + importHashed <- importHashed_ + importMode <- alternative <|> pure Code + return (Import {..}) ) "import" + where + alternative = do + try (whitespace *> _as *> nonemptyWhitespace) + + (_Text >> pure RawText) + <|> (_Location >> pure Location) + <|> (_Bytes >> pure RawBytes) + +-- | 'ApplicationExprInfo' distinguishes certain subtypes of application +-- expressions. +data ApplicationExprInfo + = NakedMergeOrSomeOrToMap + -- ^ @merge x y@, @Some x@ or @toMap x@, unparenthesized. + | ImportExpr + -- ^ An import expression. + | ApplicationExpr + -- ^ Any other application expression. diff --git a/src/Dhall/Parser/Token.hs b/src/Dhall/Parser/Token.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Parser/Token.hs @@ -0,0 +1,1438 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Parse Dhall tokens. Even though we don't have a tokenizer per-se this +--- module is useful for keeping some small parsing utilities. +module Dhall.Parser.Token ( + endOfLine, + validCodepoint, + whitespace, + lineComment, + lineCommentPrefix, + blockComment, + nonemptyWhitespace, + bashEnvironmentVariable, + posixEnvironmentVariable, + ComponentType(..), + text, + char, + file_, + label, + anyLabelOrSome, + anyLabel, + labels, + httpRaw, + hexdig, + identifier, + hexNumber, + signPrefix, + doubleLiteral, + doubleInfinity, + naturalLiteral, + integerLiteral, + dateFullYear, + dateMonth, + dateMday, + timeHour, + timeMinute, + timeSecond, + timeSecFrac, + _Optional, + _if, + _then, + _else, + _let, + _in, + _as, + _using, + _merge, + _toMap, + _showConstructor, + _assert, + _Some, + _None, + _NaturalFold, + _NaturalBuild, + _NaturalIsZero, + _NaturalEven, + _NaturalOdd, + _NaturalToInteger, + _NaturalShow, + _NaturalSubtract, + _IntegerClamp, + _IntegerNegate, + _IntegerShow, + _IntegerToDouble, + _DoubleShow, + _ListBuild, + _ListFold, + _ListLength, + _ListHead, + _ListLast, + _ListIndexed, + _ListReverse, + _Bool, + _Bytes, + _Natural, + _Integer, + _Double, + _Text, + _TextReplace, + _TextShow, + _Date, + _DateShow, + _Time, + _TimeShow, + _TimeZone, + _TimeZoneShow, + _List, + _True, + _False, + _NaN, + _Type, + _Kind, + _Sort, + _Location, + _equal, + _or, + _plus, + _textAppend, + _listAppend, + _and, + _times, + _doubleEqual, + _notEqual, + _dot, + _openBrace, + _closeBrace, + _openBracket, + _closeBracket, + _openAngle, + _closeAngle, + _bar, + _comma, + _openParens, + _closeParens, + _colon, + _at, + _equivalent, + _missing, + _importAlt, + _combine, + _combineTypes, + _prefer, + _lambda, + _forall, + _arrow, + _doubleColon, + _with, + ) where + +import Dhall.Parser.Combinators + +import Control.Applicative (Alternative (..), optional) +import Data.Bits ((.&.)) +import Data.Fixed (Pico) +import Data.Functor (void, ($>)) +import Data.Ratio ((%)) +import Data.Text (Text) +import Dhall.Syntax +import Text.Parser.Combinators (choice, try, ()) + +import qualified Control.Monad as Monad +import qualified Data.Char as Char +import qualified Data.Foldable +import qualified Data.HashSet +import qualified Data.List as List +import qualified Data.List.NonEmpty +import qualified Data.Scientific as Scientific +import qualified Data.Text +import qualified Text.Megaparsec +import qualified Text.Megaparsec.Char.Lexer +import qualified Text.Parser.Char +import qualified Text.Parser.Combinators +import qualified Text.Parser.Token + +import Numeric.Natural (Natural) + +-- | Match an end-of-line character sequence +endOfLine :: Parser Text +endOfLine = + ( Text.Parser.Char.text "\n" + <|> Text.Parser.Char.text "\r\n" + ) "newline" + +-- | Returns `True` if the given `Int` is a valid Unicode codepoint +validCodepoint :: Int -> Bool +validCodepoint c = + not (category == Char.Surrogate + || c .&. 0xFFFE == 0xFFFE + || c .&. 0xFFFF == 0xFFFF) + where + category = Char.generalCategory (Char.chr c) + +{-| Parse 0 or more whitespace characters (including comments) + + This corresponds to the @whsp@ rule in the official grammar +-} +whitespace :: Parser () +whitespace = Text.Parser.Combinators.skipMany whitespaceChunk + +{-| Parse 1 or more whitespace characters (including comments) + + This corresponds to the @whsp1@ rule in the official grammar +-} +nonemptyWhitespace :: Parser () +nonemptyWhitespace = Text.Parser.Combinators.skipSome whitespaceChunk + +alpha :: Char -> Bool +alpha c = ('\x41' <= c && c <= '\x5A') || ('\x61' <= c && c <= '\x7A') + +digit :: Char -> Bool +digit c = '\x30' <= c && c <= '\x39' + +alphaNum :: Char -> Bool +alphaNum c = alpha c || digit c + +{-| Parse a hex digit (uppercase or lowercase) + + This corresponds to the @HEXDIG@ rule in the official grammar +-} +hexdig :: Char -> Bool +hexdig c = + ('0' <= c && c <= '9') + || ('A' <= c && c <= 'F') + || ('a' <= c && c <= 'f') + +-- | Parse a leading @+@ or @-@ sign +signPrefix :: Num a => Parser (a -> a) +signPrefix = (do + let positive = fmap (\_ -> id ) (char '+') + let negative = fmap (\_ -> negate) (char '-') + positive <|> negative ) "sign" + +{-| Parse a `Dhall.Syntax.Double` literal + + This corresponds to the @double-literal@ rule from the official grammar +-} +doubleLiteral :: Parser Double +doubleLiteral = (do + -- We don't use `Text.Parser.Token.double` since that consumes trailing + -- whitespace and there is no whitespace-free alternative. See: + -- + -- https://github.com/dhall-lang/dhall-haskell/pull/1646 + -- https://github.com/dhall-lang/dhall-haskell/pull/1647 + -- + -- We also don't use `Text.Megaparsec.Char.Lexer.float` because that + -- transitively depends on `Data.Char.toTitle` which is broken on older + -- versions of GHCJS that we still support. See: + -- + -- https://github.com/dhall-lang/dhall-haskell/pull/1681 + -- https://github.com/ghcjs/ghcjs-base/issues/62 + -- + -- Also, hand-writing the parser code for `Double` literals helps to better + -- ensure that we follow the standard exactly as written. + sign <- signPrefix <|> pure id + + x <- Text.Parser.Token.decimal + + let alternative0 = do + y <- fraction + + e <- exponent' <|> pure 1 + + return ((fromInteger x + y) * e) + + let alternative1 = do + expo <- exponent' + + return (fromInteger x * expo) + + n <- alternative0 <|> alternative1 + + return (sign (Scientific.toRealFloat n)) ) "literal" + where + fraction = do + _ <- Text.Parser.Char.char '.' + + digits <- some Text.Parser.Char.digit + + let snoc y d = + y + Scientific.scientific (fromIntegral (Char.digitToInt d)) (Scientific.base10Exponent y - 1) + + return (List.foldl' snoc 0 digits) + + exponent' = do + _ <- Text.Parser.Char.oneOf "eE" + + sign <- signPrefix <|> pure id + + x <- Text.Parser.Token.decimal + + return (Scientific.scientific 1 (fromInteger (sign x))) + +{-| Parse a signed @Infinity@ + + This corresponds to the @minus-infinity-literal@ and @plus-infinity-literal@ + rules from the official grammar +-} +doubleInfinity :: Parser Double +doubleInfinity = (do + let negative = fmap (\_ -> negate) (char '-') + sign <- negative <|> pure id + a <- text "Infinity" >> return (1.0/0.0) + return (sign a) ) "literal" + +{-| Parse an `Dhall.Syntax.Integer` literal + + This corresponds to the @integer-literal@ rule from the official grammar +-} +integerLiteral :: Parser Integer +integerLiteral = (do + sign <- signPrefix + a <- naturalLiteral + return (sign (fromIntegral a)) ) "literal" + +{-| Parse a `Dhall.Syntax.Natural` literal + + This corresponds to the @natural-literal@ rule from the official grammar +-} +naturalLiteral :: Parser Natural +naturalLiteral = (do + a <- binary + <|> hexadecimal + <|> decimal + <|> (char '0' $> 0) + return a ) "literal" + where + binary = try (char '0' >> char 'b' >> Text.Megaparsec.Char.Lexer.binary) + hexadecimal = try (char '0' >> char 'x' >> Text.Megaparsec.Char.Lexer.hexadecimal) + decimal = do + n <- headDigit + ns <- many tailDigit + return (mkNum (n:ns)) + where + headDigit = decimalDigit nonZeroDigit "non-zero digit" + where + nonZeroDigit c = '1' <= c && c <= '9' + + tailDigit = decimalDigit digit "digit" + + decimalDigit predicate = do + c <- Text.Parser.Char.satisfy predicate + return (fromIntegral (Char.ord c - Char.ord '0')) + + mkNum = Data.Foldable.foldl' step 0 + where + step acc x = acc * 10 + x + +{-| Parse a 4-digit year + + This corresponds to the @date-fullyear@ rule from the official grammar +-} +dateFullYear :: Parser Integer +dateFullYear = do + digits <- Monad.replicateM 4 (Text.Parser.Char.satisfy digit) + + return (digits `base` 10) + +{-| Parse a 2-digit month + + This corresponds to the @date-month@ rule from the official grammar +-} +dateMonth :: Parser Int +dateMonth = do + digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit) + + let month = digits `base` 10 + + if 1 <= month && month <= 12 + then return month + else fail "Invalid month" + +{-| Parse a 2-digit day of the month + + This corresponds to the @date-mday@ rule from the official grammar +-} +dateMday :: Parser Int +dateMday = do + digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit) + + let day = digits `base` 10 + + if 1 <= day && day <= 31 + then return day + else fail "Invalid day" + +{-| Parse a 2-digit hour + + This corresponds to the @time-hour@ rule from the official grammar +-} +timeHour :: Parser Int +timeHour = do + digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit) + + let hour = digits `base` 10 + + if 0 <= hour && hour < 24 + then return hour + else fail "Invalid hour" + +{-| Parse a 2-digit minute + + This corresponds to the @time-minute@ rule from the official grammar +-} +timeMinute :: Parser Int +timeMinute = do + digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit) + + let minute = digits `base` 10 + + if 0 <= minute && minute < 60 + then return minute + else fail "Invalid minute" + +{-| Parse a 2-digit second + + This corresponds to the @time-second@ rule from the official grammar +-} +timeSecond :: Parser Pico +timeSecond = do + digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit) + + let second = digits `base` 10 + + if 0 <= second && second < 60 + then return second + else fail "Invalid second" + +{-| Parse the fractional component of a second + + This corresponds to the @time-secfrac@ rule from the official grammar +-} +timeSecFrac :: Parser (Pico, Word) +timeSecFrac = do + _ <- Text.Parser.Char.text "." + + digits <- some (Text.Parser.Char.satisfy digit) + + let precision = fromIntegral (length digits) + + return (fromRational ((digits `base` 10) % (10 ^ precision)), precision) + +{-| Parse an identifier (i.e. a variable or built-in) + + Variables can have an optional index to disambiguate shadowed variables + + This corresponds to the @identifier@ rule from the official grammar +-} +identifier :: Parser Var +identifier = do + x <- label + + let indexed = try $ do + whitespace + _at + whitespace + n <- naturalLiteral + return (fromIntegral n) + + n <- indexed <|> pure 0 + return (V x n) + +whitespaceChunk :: Parser () +whitespaceChunk = + choice + [ void (Dhall.Parser.Combinators.takeWhile1 predicate) + , void (Text.Parser.Char.text "\r\n" "newline") + , void lineComment + , void blockComment + ] "whitespace" + where + predicate c = c == ' ' || c == '\t' || c == '\n' + +-- | Parse a hexademical number and convert to the corresponding `Int` +hexNumber :: Parser Int +hexNumber = choice [ hexDigit, hexUpper, hexLower ] + where + hexDigit = do + c <- Text.Parser.Char.satisfy predicate + return (Char.ord c - Char.ord '0') + where + predicate c = '0' <= c && c <= '9' + + hexUpper = do + c <- Text.Parser.Char.satisfy predicate + return (10 + Char.ord c - Char.ord 'A') + where + predicate c = 'A' <= c && c <= 'F' + + hexLower = do + c <- Text.Parser.Char.satisfy predicate + return (10 + Char.ord c - Char.ord 'a') + where + predicate c = 'a' <= c && c <= 'f' + +-- | Same as `lineComment` except that this doesn't parse the end-of-line +-- character +lineCommentPrefix :: Parser Text +lineCommentPrefix = do + _ <- text "--" + + let predicate c = ('\x20' <= c && c <= '\x10FFFF') || c == '\t' + + commentText <- Dhall.Parser.Combinators.takeWhile predicate + + return ("--" <> commentText) + +-- | Parse a Dhall's single-line comment, starting from `--` and until the +-- last character of the line /before/ the end-of-line character +lineComment :: Parser Text +lineComment = try (lineCommentPrefix <* endOfLine) + +-- | Parsed text doesn't include opening braces +blockComment :: Parser Text +blockComment = do + _ <- text "{-" + c <- blockCommentContinue + pure ("{-" <> c <> "-}") + +blockCommentChunk :: Parser Text +blockCommentChunk = + choice + [ blockComment -- Nested block comment + , characters + , character + , endOfLine + ] + where + characters = (Dhall.Parser.Combinators.takeWhile1 predicate) + where + predicate c = + '\x20' <= c && c <= '\x10FFFF' && c /= '-' && c /= '{' + || c == '\n' + || c == '\t' + + character = (Dhall.Parser.Combinators.satisfy predicate) + where + predicate c = '\x20' <= c && c <= '\x10FFFF' || c == '\n' || c == '\t' + +blockCommentContinue :: Parser Text +blockCommentContinue = endOfComment <|> continue + where + endOfComment = void (text "-}") *> pure "" + + continue = do + c <- blockCommentChunk + c' <- blockCommentContinue + pure (c <> c') + +simpleLabel :: Bool -> Parser Text +simpleLabel allowReserved = try $ do + c <- Text.Parser.Char.satisfy headCharacter + rest <- Dhall.Parser.Combinators.takeWhile tailCharacter + let t = Data.Text.cons c rest + let isNotAKeyword = not $ t `Data.HashSet.member` reservedKeywords + let isNotAReservedIdentifier = not $ t `Data.HashSet.member` reservedIdentifiers + Monad.guard (isNotAKeyword && (allowReserved || isNotAReservedIdentifier)) + return t + +headCharacter :: Char -> Bool +headCharacter c = alpha c || c == '_' + +tailCharacter :: Char -> Bool +tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/' + +backtickLabel :: Parser Text +backtickLabel = do + _ <- char '`' + t <- Dhall.Parser.Combinators.takeWhile predicate + _ <- char '`' + return t + where + predicate c = + '\x20' <= c && c <= '\x5F' + || '\x61' <= c && c <= '\x7E' + +{-| Parse a braced sequence of comma-separated labels + + For example, this is used to parse the record projection syntax + + This corresponds to the @labels@ rule in the official grammar +-} +labels :: Parser [Text] +labels = do + _openBrace + + whitespace + + nonEmptyLabels <|> emptyLabels + where + emptyLabels = do + try (optional (_comma *> whitespace) *> _closeBrace) + + pure [] + + nonEmptyLabels = do + x <- try (optional (_comma *> whitespace) *> anyLabelOrSome) + + whitespace + + xs <- many (try (_comma *> whitespace *> anyLabelOrSome) <* whitespace) + + _ <- optional (_comma *> whitespace) + + _closeBrace + + return (x : xs) + +{-| Parse a label (e.g. a variable\/field\/alternative name) + + Rejects labels that match built-in names (e.g. @Natural/even@) + + This corresponds to the @nonreserved-label@ rule in the official grammar +-} +label :: Parser Text +label = backtickLabel <|> simpleLabel False "label" + +{-| Same as `label` except that built-in names are allowed + + This corresponds to the @any-label@ rule in the official grammar +-} +anyLabel :: Parser Text +anyLabel = (do + t <- backtickLabel <|> simpleLabel True + return t ) "any label" + +{-| Same as `anyLabel` except that `Some` is allowed + + This corresponds to the @any-label-or-some@ rule in the official grammar +-} + +anyLabelOrSome :: Parser Text +anyLabelOrSome = try anyLabel <|> ("Some" <$ _Some) + +{-| Parse a valid Bash environment variable name + + This corresponds to the @bash-environment-variable@ rule in the official + grammar +-} +bashEnvironmentVariable :: Parser Text +bashEnvironmentVariable = satisfy predicate0 <> star (satisfy predicate1) + where + predicate0 c = alpha c || c == '_' + + predicate1 c = alphaNum c || c == '_' + +{-| Parse a valid POSIX environment variable name, which permits a wider range + of characters than a Bash environment variable name + + This corresponds to the @posix-environment-variable@ rule in the official + grammar +-} +posixEnvironmentVariable :: Parser Text +posixEnvironmentVariable = plus posixEnvironmentVariableCharacter + +posixEnvironmentVariableCharacter :: Parser Text +posixEnvironmentVariableCharacter = + escapeCharacter <|> satisfy predicate1 + where + escapeCharacter = do + _ <- char '\\' + + c <- Text.Parser.Char.satisfy (`elem` ("\"\\abfnrtv" :: String)) + + case c of + '"' -> return "\"" + '\\' -> return "\\" + 'a' -> return "\a" + 'b' -> return "\b" + 'f' -> return "\f" + 'n' -> return "\n" + 'r' -> return "\r" + 't' -> return "\t" + 'v' -> return "\v" + _ -> empty + + predicate1 c = + ('\x20' <= c && c <= '\x21') + || ('\x23' <= c && c <= '\x3C') + || ('\x3E' <= c && c <= '\x5B') + || ('\x5D' <= c && c <= '\x7E') + +quotedPathCharacter :: Char -> Bool +quotedPathCharacter c = + ('\x20' <= c && c <= '\x21') + || ('\x23' <= c && c <= '\x2E') + || ('\x30' <= c && c <= '\x10FFFF') + +{-| The @pathComponent@ function uses this type to distinguish whether to parse + a URL path component or a file path component +-} +data ComponentType = URLComponent | FileComponent + +-- | Parse a path component +pathComponent :: ComponentType -> Parser Text +pathComponent componentType = do + _ <- "/" :: Parser Text + + let pathData = + case componentType of + FileComponent -> + Text.Megaparsec.takeWhile1P Nothing Dhall.Syntax.pathCharacter + URLComponent -> + star pchar + + let quotedPathData = do + _ <- char '"' + t <- Text.Megaparsec.takeWhile1P Nothing quotedPathCharacter + _ <- char '"' + return t + + case componentType of + FileComponent -> quotedPathData <|> pathData + URLComponent -> pathData + +-- | Parse a `File` +file_ :: ComponentType -> Parser File +file_ componentType = do + let emptyPath = + case componentType of + URLComponent -> pure (pure "") + FileComponent -> empty + + path <- Data.List.NonEmpty.some1 (pathComponent componentType) <|> emptyPath + + let directory = Directory (reverse (Data.List.NonEmpty.init path)) + let file = Data.List.NonEmpty.last path + + return (File {..}) + +scheme_ :: Parser Scheme +scheme_ = + ("http" :: Parser Text) + *> ((("s" :: Parser Text) *> pure HTTPS) <|> pure HTTP) + <* ("://" :: Parser Text) + +{-| Parse an HTTP(S) URL without trailing whitespace + + This corresponds to the @http-raw@ rule in the official grammar +-} +httpRaw :: Parser URL +httpRaw = do + scheme <- scheme_ + authority <- authority_ + path <- file_ URLComponent + query <- optional (("?" :: Parser Text) *> query_) + + let headers = Nothing + + return (URL {..}) + +authority_ :: Parser Text +authority_ = option (try (userinfo <> "@")) <> host <> option (":" <> port) + +userinfo :: Parser Text +userinfo = star (satisfy predicate <|> pctEncoded) + where + predicate c = unreserved c || subDelims c || c == ':' + +host :: Parser Text +host = choice [ ipLiteral, try ipV4Address, domain ] + +port :: Parser Text +port = star (satisfy digit) + +ipLiteral :: Parser Text +ipLiteral = "[" <> (ipV6Address <|> ipVFuture) <> "]" + +ipVFuture :: Parser Text +ipVFuture = "v" <> plus (satisfy hexdig) <> "." <> plus (satisfy predicate) + where + predicate c = unreserved c || subDelims c || c == ':' + +ipV6Address :: Parser Text +ipV6Address = + choice + [ try alternative0 + , try alternative1 + , try alternative2 + , try alternative3 + , try alternative4 + , try alternative5 + , try alternative6 + , try alternative7 + , alternative8 + ] + where + alternative0 = count 6 (h16 <> ":") <> ls32 + + alternative1 = "::" <> count 5 (h16 <> ":") <> ls32 + + alternative2 = option h16 <> "::" <> count 4 (h16 <> ":") <> ls32 + + alternative3 = + option (h16 <> range 0 1 (try (":" <> h16))) + <> "::" + <> count 3 (h16 <> ":") + <> ls32 + + alternative4 = + option (h16 <> range 0 2 (try (":" <> h16))) + <> "::" + <> count 2 (h16 <> ":") + <> ls32 + + alternative5 = + option (h16 <> range 0 3 (try (":" <> h16))) + <> "::" + <> h16 + <> ":" + <> ls32 + + alternative6 = + option (h16 <> range 0 4 (try (":" <> h16))) <> "::" <> ls32 + + alternative7 = + option (h16 <> range 0 5 (try (":" <> h16))) <> "::" <> h16 + + alternative8 = + option (h16 <> range 0 6 (try (":" <> h16))) <> "::" + +h16 :: Parser Text +h16 = range 1 3 (satisfy hexdig) + +ls32 :: Parser Text +ls32 = try (h16 <> ":" <> h16) <|> ipV4Address + +ipV4Address :: Parser Text +ipV4Address = decOctet <> "." <> decOctet <> "." <> decOctet <> "." <> decOctet + +decOctet :: Parser Text +decOctet = + choice + [ try alternative4 + , try alternative3 + , try alternative2 + , try alternative1 + , alternative0 + ] + where + alternative0 = satisfy digit + + alternative1 = satisfy predicate <> satisfy digit + where + predicate c = '\x31' <= c && c <= '\x39' + + alternative2 = "1" <> count 2 (satisfy digit) + + alternative3 = "2" <> satisfy predicate <> satisfy digit + where + predicate c = '\x30' <= c && c <= '\x34' + + alternative4 = "25" <> satisfy predicate + where + predicate c = '\x30' <= c && c <= '\x35' + +domain :: Parser Text +domain = domainLabel <> star ("." <> domainLabel ) <> option "." + +domainLabel :: Parser Text +domainLabel = plus alphaNum_ <> star (plus "-" <> plus alphaNum_) + where + alphaNum_ = satisfy alphaNum + +pchar :: Parser Text +pchar = satisfy predicate <|> pctEncoded + where + predicate c = unreserved c || subDelims c || c == ':' || c == '@' + +query_ :: Parser Text +query_ = star (pchar <|> satisfy predicate) + where + predicate c = c == '/' || c == '?' + +pctEncoded :: Parser Text +pctEncoded = "%" <> count 2 (satisfy hexdig) + +subDelims :: Char -> Bool +subDelims c = c `elem` ("!$&'*+;=" :: String) + +unreserved :: Char -> Bool +unreserved c = + alphaNum c || c == '-' || c == '.' || c == '_' || c == '~' + +{-| A variation on `Text.Parser.Char.text` that doesn't quote the expected + in error messages +-} +text :: Data.Text.Text -> Parser Text +text t = Text.Parser.Char.text t Data.Text.unpack t +{-# INLINE text #-} + +{-| A variation on `Text.Parser.Char.char` that doesn't quote the expected + token in error messages +-} +char :: Char -> Parser Char +char c = Text.Parser.Char.char c [ c ] +{-# INLINE char #-} + +reserved :: Data.Text.Text -> Parser () +reserved x = void (text x) + +reservedChar :: Char -> Parser () +reservedChar c = void (char c) + +builtin :: Data.Text.Text -> Parser () +builtin x = reserved x "built-in" +{-# INLINE builtin #-} + +operator :: Data.Text.Text -> Parser () +operator x = reserved x "operator" +{-# INLINE operator #-} + +operatorChar :: Char -> Parser () +operatorChar x = reservedChar x "operator" +{-# INLINE operatorChar #-} + +keyword :: Data.Text.Text -> Parser () +keyword x = try (void (text x)) "keyword" + +{-| Parse the @if@ keyword + + This corresponds to the @if@ rule from the official grammar +-} +_if :: Parser () +_if = keyword "if" + +{-| Parse the @then@ keyword + + This corresponds to the @then@ rule from the official grammar +-} +_then :: Parser () +_then = keyword "then" + +{-| Parse the @else@ keyword + + This corresponds to the @else@ rule from the official grammar +-} +_else :: Parser () +_else = keyword "else" + +{-| Parse the @let@ keyword + + This corresponds to the @let@ rule from the official grammar +-} +_let :: Parser () +_let = keyword "let" + +{-| Parse the @in@ keyword + + This corresponds to the @in@ rule from the official grammar +-} +_in :: Parser () +_in = keyword "in" + +{-| Parse the @as@ keyword + + This corresponds to the @as@ rule from the official grammar +-} +_as :: Parser () +_as = keyword "as" + +{-| Parse the @using@ keyword + + This corresponds to the @using@ rule from the official grammar +-} +_using :: Parser () +_using = keyword "using" + +{-| Parse the @merge@ keyword + + This corresponds to the @merge@ rule from the official grammar +-} +_merge :: Parser () +_merge = keyword "merge" + +{-| Parse the @toMap@ keyword + + This corresponds to the @toMap@ rule from the official grammar +-} +_toMap :: Parser () +_toMap = keyword "toMap" + +{-| Parse the @showConstructor@ keyword + + This corresponds to the @showConstructor@ rule from the official grammar +-} +_showConstructor :: Parser () +_showConstructor = keyword "showConstructor" + +{-| Parse the @assert@ keyword + + This corresponds to the @assert@ rule from the official grammar +-} +_assert :: Parser () +_assert = keyword "assert" + +-- | Parse the @with@ keyword +_with :: Parser () +_with = keyword "with" + +{-| Parse the @Some@ built-in + + This corresponds to the @Some@ rule from the official grammar +-} +_Some :: Parser () +_Some = keyword "Some" + +{-| Parse the @None@ built-in + + This corresponds to the @None@ rule from the official grammar +-} +_None :: Parser () +_None = builtin "None" + +{-| Parse the @Natural/fold@ built-in + + This corresponds to the @Natural-fold@ rule from the official grammar +-} +_NaturalFold :: Parser () +_NaturalFold = builtin "Natural/fold" + +{-| Parse the @Natural/build@ built-in + + This corresponds to the @Natural-build@ rule from the official grammar +-} +_NaturalBuild :: Parser () +_NaturalBuild = builtin "Natural/build" + +{-| Parse the @Natural/isZero@ built-in + + This corresponds to the @Natural-isZero@ rule from the official grammar +-} +_NaturalIsZero :: Parser () +_NaturalIsZero = builtin "Natural/isZero" + +{-| Parse the @Natural/even@ built-in + + This corresponds to the @Natural-even@ rule from the official grammar +-} +_NaturalEven :: Parser () +_NaturalEven = builtin "Natural/even" + +{-| Parse the @Natural/odd@ built-in + + This corresponds to the @Natural-odd@ rule from the official grammar +-} +_NaturalOdd :: Parser () +_NaturalOdd = builtin "Natural/odd" + +{-| Parse the @Natural/toInteger@ built-in + + This corresponds to the @Natural-toInteger@ rule from the official grammar +-} +_NaturalToInteger :: Parser () +_NaturalToInteger = builtin "Natural/toInteger" + +{-| Parse the @Natural/show@ built-in + + This corresponds to the @Natural-show@ rule from the official grammar +-} +_NaturalShow :: Parser () +_NaturalShow = builtin "Natural/show" + +{-| Parse the @Natural/subtract@ built-in + + This corresponds to the @Natural-subtract@ rule from the official grammar +-} +_NaturalSubtract :: Parser () +_NaturalSubtract = builtin "Natural/subtract" + +{-| Parse the @Integer/clamp@ built-in + + This corresponds to the @Integer-clamp@ rule from the official grammar +-} +_IntegerClamp :: Parser () +_IntegerClamp = builtin "Integer/clamp" + +{-| Parse the @Integer/negate@ built-in + + This corresponds to the @Integer-negate@ rule from the official grammar +-} +_IntegerNegate :: Parser () +_IntegerNegate = builtin "Integer/negate" + +{-| Parse the @Integer/show@ built-in + + This corresponds to the @Integer-show@ rule from the official grammar +-} +_IntegerShow :: Parser () +_IntegerShow = builtin "Integer/show" + +{-| Parse the @Integer/toDouble@ built-in + + This corresponds to the @Integer-toDouble@ rule from the official grammar +-} +_IntegerToDouble :: Parser () +_IntegerToDouble = builtin "Integer/toDouble" + +{-| Parse the @Double/show@ built-in + + This corresponds to the @Double-show@ rule from the official grammar +-} +_DoubleShow :: Parser () +_DoubleShow = builtin "Double/show" + +{-| Parse the @List/build@ built-in + + This corresponds to the @List-build@ rule from the official grammar +-} +_ListBuild :: Parser () +_ListBuild = builtin "List/build" + +{-| Parse the @List/fold@ built-in + + This corresponds to the @List-fold@ rule from the official grammar +-} +_ListFold :: Parser () +_ListFold = builtin "List/fold" + +{-| Parse the @List/length@ built-in + + This corresponds to the @List-length@ rule from the official grammar +-} +_ListLength :: Parser () +_ListLength = builtin "List/length" + +{-| Parse the @List/head@ built-in + + This corresponds to the @List-head@ rule from the official grammar +-} +_ListHead :: Parser () +_ListHead = builtin "List/head" + +{-| Parse the @List/last@ built-in + + This corresponds to the @List-last@ rule from the official grammar +-} +_ListLast :: Parser () +_ListLast = builtin "List/last" + +{-| Parse the @List/indexed@ built-in + + This corresponds to the @List-indexed@ rule from the official grammar +-} +_ListIndexed :: Parser () +_ListIndexed = builtin "List/indexed" + +{-| Parse the @List/reverse@ built-in + + This corresponds to the @List-reverse@ rule from the official grammar +-} +_ListReverse :: Parser () +_ListReverse = builtin "List/reverse" + +{-| Parse the @Bool@ built-in + + This corresponds to the @Bool@ rule from the official grammar +-} +_Bool :: Parser () +_Bool = builtin "Bool" + +{-| Parse the @Bytes@ built-in + + This corresponds to the @Bytes@ rule from the official grammar +-} +_Bytes :: Parser () +_Bytes = builtin "Bytes" + +{-| Parse the @Optional@ built-in + + This corresponds to the @Optional@ rule from the official grammar +-} +_Optional :: Parser () +_Optional = builtin "Optional" + +{-| Parse the @Natural@ built-in + + This corresponds to the @Natural@ rule from the official grammar +-} +_Natural :: Parser () +_Natural = builtin "Natural" + +{-| Parse the @Integer@ built-in + + This corresponds to the @Integer@ rule from the official grammar +-} +_Integer :: Parser () +_Integer = builtin "Integer" + +{-| Parse the @Double@ built-in + + This corresponds to the @Double@ rule from the official grammar +-} +_Double :: Parser () +_Double = builtin "Double" + +{-| Parse the @Text@ built-in + + This corresponds to the @Text@ rule from the official grammar +-} +_Text :: Parser () +_Text = builtin "Text" + +{-| Parse the @Text/replace@ built-in + + This corresponds to the @Text-replace@ rule from the official grammar +-} +_TextReplace :: Parser () +_TextReplace = builtin "Text/replace" + +{-| Parse the @Text/show@ built-in + + This corresponds to the @Text-show@ rule from the official grammar +-} +_TextShow :: Parser () +_TextShow = builtin "Text/show" + +{-| Parse the @Date@ bult-in + + This corresponds to the @Date@ rule from the official grammar +-} +_Date :: Parser () +_Date = builtin "Date" + +{-| Parse the @Date/show@ built-in + + This corresponds to the @Date-show@ rule from the official grammar +-} +_DateShow :: Parser () +_DateShow = builtin "Date/show" + +{-| Parse the @Time@ bult-in + + This corresponds to the @Time@ rule from the official grammar +-} +_Time :: Parser () +_Time = builtin "Time" + +{-| Parse the @Time/show@ built-in + + This corresponds to the @Time-show@ rule from the official grammar +-} +_TimeShow :: Parser () +_TimeShow = builtin "Time/show" + +{-| Parse the @TimeZone@ bult-in + + This corresponds to the @TimeZone@ rule from the official grammar +-} +_TimeZone :: Parser () +_TimeZone = builtin "TimeZone" + +{-| Parse the @TimeZone/show@ built-in + + This corresponds to the @TimeZone-show@ rule from the official grammar +-} +_TimeZoneShow :: Parser () +_TimeZoneShow = builtin "TimeZone/show" + +{-| Parse the @List@ built-in + + This corresponds to the @List@ rule from the official grammar +-} +_List :: Parser () +_List = builtin "List" + +{-| Parse the @True@ built-in + + This corresponds to the @True@ rule from the official grammar +-} +_True :: Parser () +_True = builtin "True" + +{-| Parse the @False@ built-in + + This corresponds to the @False@ rule from the official grammar +-} +_False :: Parser () +_False = builtin "False" + +{-| Parse a @NaN@ literal + + This corresponds to the @NaN@ rule from the official grammar +-} +_NaN :: Parser () +_NaN = builtin "NaN" + +{-| Parse the @Type@ built-in + + This corresponds to the @Type@ rule from the official grammar +-} +_Type :: Parser () +_Type = builtin "Type" + +{-| Parse the @Kind@ built-in + + This corresponds to the @Kind@ rule from the official grammar +-} +_Kind :: Parser () +_Kind = builtin "Kind" + +{-| Parse the @Sort@ built-in + + This corresponds to the @Sort@ rule from the official grammar +-} +_Sort :: Parser () +_Sort = builtin "Sort" + +{-| Parse the @Location@ keyword + + This corresponds to the @Location@ rule from the official grammar +-} +_Location :: Parser () +_Location = builtin "Location" + +-- | Parse the @=@ symbol +_equal :: Parser () +_equal = reservedChar '=' + +-- | Parse the @||@ symbol +_or :: Parser () +_or = operator "||" + +-- | Parse the @+@ symbol +_plus :: Parser () +_plus = operatorChar '+' + +-- | Parse the @++@ symbol +_textAppend :: Parser () +_textAppend = operator "++" + +-- | Parse the @#@ symbol +_listAppend :: Parser () +_listAppend = operatorChar '#' + +-- | Parse the @&&@ symbol +_and :: Parser () +_and = operator "&&" + +-- | Parse the @*@ symbol +_times :: Parser () +_times = operatorChar '*' + +-- | Parse the @==@ symbol +_doubleEqual :: Parser () +_doubleEqual = operator "==" + +-- | Parse the @!=@ symbol +_notEqual :: Parser () +_notEqual = operator "!=" + +-- | Parse the @.@ symbol +_dot :: Parser () +_dot = operatorChar '.' + +-- | Parse the @{@ symbol +_openBrace :: Parser () +_openBrace = reservedChar '{' + +-- | Parse the @}@ symbol +_closeBrace :: Parser () +_closeBrace = reservedChar '}' + +-- | Parse the @[@] symbol +_openBracket :: Parser () +_openBracket = reservedChar '[' + +-- | Parse the @]@ symbol +_closeBracket :: Parser () +_closeBracket = reservedChar ']' + +-- | Parse the @<@ symbol +_openAngle :: Parser () +_openAngle = reservedChar '<' + +-- | Parse the @>@ symbol +_closeAngle :: Parser () +_closeAngle = reservedChar '>' + +-- | Parse the @|@ symbol +_bar :: Parser () +_bar = reservedChar '|' + +-- | Parse the @,@ symbol +_comma :: Parser () +_comma = reservedChar ',' "\',\'" + +-- | Parse the @(@ symbol +_openParens :: Parser () +_openParens = reservedChar '(' + +-- | Parse the @)@ symbol +_closeParens :: Parser () +_closeParens = reservedChar ')' + +-- | Parse the @:@ symbol +_colon :: Parser () +_colon = reservedChar ':' + +-- | Parse the @\@@ symbol +_at :: Parser () +_at = reservedChar '@' "\"@\"" + +-- | Parse the equivalence symbol (@===@ or @≡@) +_equivalent :: Parser CharacterSet +_equivalent = + (Unicode <$ char '≡' "\"≡\"") + <|> (ASCII <$ text "===" "===") + +-- | Parse the @missing@ keyword +_missing :: Parser () +_missing = + keyword "missing" + *> Text.Megaparsec.notFollowedBy (Text.Parser.Char.satisfy tailCharacter) + +-- | Parse the @?@ symbol +_importAlt :: Parser () +_importAlt = operatorChar '?' + +-- | Parse the record combine operator (@/\\@ or @∧@) +_combine :: Parser CharacterSet +_combine = + (Unicode <$ char '∧' "\"∧\"") + <|> (ASCII <$ text "/\\" "/\\") + +-- | Parse the record type combine operator (@//\\\\@ or @⩓@) +_combineTypes :: Parser CharacterSet +_combineTypes = + (Unicode <$ char '⩓' "\"⩓\"") + <|> (ASCII <$ text "//\\\\" "//\\\\") + +-- | Parse the record \"prefer\" operator (@//@ or @⫽@) +_prefer :: Parser CharacterSet +_prefer = + (Unicode <$ char '⫽' "\"⫽\"") + <|> (ASCII <$ text "//" "//") + +-- | Parse a lambda (@\\@ or @λ@) +_lambda :: Parser CharacterSet +_lambda = + (Unicode <$ char 'λ' "\"λ\"") + <|> (ASCII <$ char '\\' "\\") + +-- | Parse a forall (@forall@ or @∀@) +_forall :: Parser CharacterSet +_forall = + (Unicode <$ char '∀' "\"∀\"") + <|> (ASCII <$ text "forall" "forall") + +-- | Parse a right arrow (@->@ or @→@) +_arrow :: Parser CharacterSet +_arrow = + (Unicode <$ char '→' "\"→\"") + <|> (ASCII <$ text "->" "->") + +-- | Parse a double colon (@::@) +_doubleColon :: Parser () +_doubleColon = operator "::" diff --git a/src/Dhall/Pretty.hs b/src/Dhall/Pretty.hs --- a/src/Dhall/Pretty.hs +++ b/src/Dhall/Pretty.hs @@ -1,6 +1,25 @@ {-| This module contains logic for pretty-printing expressions, including support for syntax highlighting -} -module Dhall.Pretty ( Ann(..), annToAnsiStyle, prettyExpr ) where +module Dhall.Pretty + ( -- * Pretty + Ann(..) + , annToAnsiStyle + , prettyExpr + + , CharacterSet(..) + , defaultCharacterSet + , detectCharacterSet + , prettyCharacterSet + + , Dhall.Pretty.Internal.layout + , Dhall.Pretty.Internal.layoutOpts + + , escapeEnvironmentVariable + , UnescapedLabel(..) + , escapeLabel + + , temporalToText + ) where import Dhall.Pretty.Internal diff --git a/src/Dhall/Pretty/Internal.hs b/src/Dhall/Pretty/Internal.hs --- a/src/Dhall/Pretty/Internal.hs +++ b/src/Dhall/Pretty/Internal.hs @@ -1,1152 +1,1991 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wall #-} - -{-| This module provides internal pretty-printing utilities which are used by - other modules but are not part of the public facing API --} - -module Dhall.Pretty.Internal ( - Ann(..) - , annToAnsiStyle - , prettyExpr - , buildConst - , buildVar - , buildExpr - , buildNatural - , buildNumber - , buildScientific - , pretty - , escapeText - ) where - -import {-# SOURCE #-} Dhall.Core - -#if MIN_VERSION_base(4,8,0) -#else -import Control.Applicative (Applicative(..), (<$>)) -#endif -import Data.Foldable -import Data.HashMap.Strict.InsOrd (InsOrdHashMap) -import Data.Monoid ((<>)) -import Data.Scientific (Scientific) -import Data.Text.Buildable (Buildable(..)) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Builder (Builder) -import Data.Text.Prettyprint.Doc (Doc, Pretty, space) -import Numeric.Natural (Natural) -import Prelude hiding (succ) -import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal - -import qualified Data.Char -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.HashSet -import qualified Data.List -import qualified Data.Text.Lazy as Text -import qualified Data.Text.Lazy.Builder as Builder -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty - -{-| Annotation type used to tag elements in a pretty-printed document for - syntax highlighting purposes --} -data Ann - = Keyword -- ^ Used for syntactic keywords - | Syntax -- ^ Syntax punctuation such as commas, parenthesis, and braces - | Label -- ^ Record labels - | Literal -- ^ Literals such as integers and strings - | Builtin -- ^ Builtin types and values - | Operator -- ^ Operators - -{-| Convert annotations to their corresponding color for syntax highlighting - purposes --} -annToAnsiStyle :: Ann -> Terminal.AnsiStyle -annToAnsiStyle Keyword = Terminal.bold <> Terminal.colorDull Terminal.Green -annToAnsiStyle Syntax = Terminal.bold <> Terminal.colorDull Terminal.Green -annToAnsiStyle Label = mempty -annToAnsiStyle Literal = Terminal.colorDull Terminal.Magenta -annToAnsiStyle Builtin = Terminal.underlined -annToAnsiStyle Operator = Terminal.bold <> Terminal.colorDull Terminal.Green - --- | Pretty print an expression -prettyExpr :: Pretty a => Expr s a -> Doc Ann -prettyExpr = prettyExprA - -{-| Internal utility for pretty-printing, used when generating element lists - to supply to `enclose` or `enclose'`. This utility indicates that the - compact represent is the same as the multi-line representation for each - element --} -duplicate :: a -> (a, a) -duplicate x = (x, x) - --- Annotation helpers -keyword, syntax, label, literal, builtin, operator :: Doc Ann -> Doc Ann -keyword = Pretty.annotate Keyword -syntax = Pretty.annotate Syntax -label = Pretty.annotate Label -literal = Pretty.annotate Literal -builtin = Pretty.annotate Builtin -operator = Pretty.annotate Operator - -comma, lbracket, rbracket, langle, rangle, lbrace, rbrace, lparen, rparen, pipe, rarrow, backtick, dollar, colon, lambda, forall, equals, dot :: Doc Ann -comma = syntax Pretty.comma -lbracket = syntax Pretty.lbracket -rbracket = syntax Pretty.rbracket -langle = syntax Pretty.langle -rangle = syntax Pretty.rangle -lbrace = syntax Pretty.lbrace -rbrace = syntax Pretty.rbrace -lparen = syntax Pretty.lparen -rparen = syntax Pretty.rparen -pipe = syntax Pretty.pipe -rarrow = syntax "→" -backtick = syntax "`" -dollar = syntax "$" -colon = syntax ":" -lambda = syntax "λ" -forall = syntax "∀" -equals = syntax "=" -dot = syntax "." - --- | Pretty-print a list -list :: [Doc Ann] -> Doc Ann -list [] = lbracket <> rbracket -list docs = - enclose - (lbracket <> space) - (lbracket <> space) - (comma <> space) - (comma <> space) - (space <> rbracket) - rbracket - (fmap duplicate docs) - --- | Pretty-print union types and literals -angles :: [(Doc Ann, Doc Ann)] -> Doc Ann -angles [] = langle <> rangle -angles docs = - enclose - (langle <> space) - (langle <> space) - (space <> pipe <> space) - (pipe <> space) - (space <> rangle) - rangle - docs - --- | Pretty-print record types and literals -braces :: [(Doc Ann, Doc Ann)] -> Doc Ann -braces [] = lbrace <> rbrace -braces docs = - enclose - (lbrace <> space) - (lbrace <> space) - (comma <> space) - (comma <> space) - (space <> rbrace) - rbrace - docs - --- | Pretty-print anonymous functions and function types -arrows :: [(Doc Ann, Doc Ann)] -> Doc Ann -arrows = - enclose' - "" - " " - (" " <> rarrow <> " ") - (rarrow <> space) - -{-| Format an expression that holds a variable number of elements, such as a - list, record, or union --} -enclose - :: Doc ann - -- ^ Beginning document for compact representation - -> Doc ann - -- ^ Beginning document for multi-line representation - -> Doc ann - -- ^ Separator for compact representation - -> Doc ann - -- ^ Separator for multi-line representation - -> Doc ann - -- ^ Ending document for compact representation - -> Doc ann - -- ^ Ending document for multi-line representation - -> [(Doc ann, Doc ann)] - -- ^ Elements to format, each of which is a pair: @(compact, multi-line)@ - -> Doc ann -enclose beginShort _ _ _ endShort _ [] = - beginShort <> endShort - where -enclose beginShort beginLong sepShort sepLong endShort endLong docs = - Pretty.group - (Pretty.flatAlt - (Pretty.align - (mconcat (zipWith combineLong (beginLong : repeat sepLong) docsLong) <> endLong) - ) - (mconcat (zipWith combineShort (beginShort : repeat sepShort) docsShort) <> endShort) - ) - where - docsShort = fmap fst docs - - docsLong = fmap snd docs - - combineLong x y = x <> y <> Pretty.hardline - - combineShort x y = x <> y - -{-| Format an expression that holds a variable number of elements without a - trailing document such as nested `let`, nested lambdas, or nested `forall`s --} -enclose' - :: Doc ann - -- ^ Beginning document for compact representation - -> Doc ann - -- ^ Beginning document for multi-line representation - -> Doc ann - -- ^ Separator for compact representation - -> Doc ann - -- ^ Separator for multi-line representation - -> [(Doc ann, Doc ann)] - -- ^ Elements to format, each of which is a pair: @(compact, multi-line)@ - -> Doc ann -enclose' beginShort beginLong sepShort sepLong docs = - Pretty.group (Pretty.flatAlt long short) - where - longLines = zipWith (<>) (beginLong : repeat sepLong) docsLong - - long = - Pretty.align (mconcat (Data.List.intersperse Pretty.hardline longLines)) - - short = mconcat (zipWith (<>) (beginShort : repeat sepShort) docsShort) - - docsShort = fmap fst docs - - docsLong = fmap snd docs - -alpha :: Char -> Bool -alpha c = ('\x41' <= c && c <= '\x5A') || ('\x61' <= c && c <= '\x7A') - -digit :: Char -> Bool -digit c = '\x30' <= c && c <= '\x39' - -headCharacter :: Char -> Bool -headCharacter c = alpha c || c == '_' - -tailCharacter :: Char -> Bool -tailCharacter c = alpha c || digit c || c == '_' || c == '-' || c == '/' - -prettyLabel :: Text -> Doc Ann -prettyLabel a = label doc - where - doc = - case Text.uncons a of - Just (h, t) - | headCharacter h && Text.all tailCharacter t && not (Data.HashSet.member a reservedIdentifiers) - -> Pretty.pretty a - _ -> backtick <> Pretty.pretty a <> backtick - -prettyNumber :: Integer -> Doc Ann -prettyNumber = literal . Pretty.pretty - -prettyNatural :: Natural -> Doc Ann -prettyNatural = literal . Pretty.pretty - -prettyScientific :: Scientific -> Doc Ann -prettyScientific = literal . Pretty.pretty . show - -prettyChunks :: Pretty a => Chunks s a -> Doc Ann -prettyChunks (Chunks a b) = - if any (\(builder, _) -> hasNewLine builder) a || hasNewLine b - then Pretty.flatAlt long short - else short - where - long = - Pretty.align - ( literal ("''" <> Pretty.hardline) - <> Pretty.align - (foldMap prettyMultilineChunk a <> prettyMultilineBuilder b) - <> literal "''" - ) - - short = - literal "\"" <> foldMap prettyChunk a <> literal (prettyText b <> "\"") - - hasNewLine builder = Text.any (== '\n') lazyText - where - lazyText = Builder.toLazyText builder - - prettyMultilineChunk (c, d) = - prettyMultilineBuilder c <> dollar <> lbrace <> prettyExprA d <> rbrace - - prettyMultilineBuilder builder = literal (mconcat docs) - where - lazyText = Builder.toLazyText (escapeSingleQuotedText builder) - - lazyLines = Text.splitOn "\n" lazyText - - docs = - Data.List.intersperse Pretty.hardline (fmap Pretty.pretty lazyLines) - - prettyChunk (c, d) = prettyText c <> syntax "${" <> prettyExprA d <> syntax rbrace - - prettyText t = literal (Pretty.pretty (Builder.toLazyText (escapeText t))) - -prettyConst :: Const -> Doc Ann -prettyConst Type = builtin "Type" -prettyConst Kind = builtin "Kind" - -prettyVar :: Var -> Doc Ann -prettyVar (V x 0) = label (Pretty.unAnnotate (prettyLabel x)) -prettyVar (V x n) = label (Pretty.unAnnotate (prettyLabel x <> "@" <> prettyNumber n)) - -prettyExprA :: Pretty a => Expr s a -> Doc Ann -prettyExprA a0@(Annot _ _) = - enclose' - "" - " " - (" " <> colon <> " ") - (colon <> space) - (fmap duplicate (docs a0)) - where - docs (Annot a b) = prettyExprB a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprB b ] -prettyExprA (Note _ a) = - prettyExprA a -prettyExprA a0 = - prettyExprB a0 - -prettyExprB :: Pretty a => Expr s a -> Doc Ann -prettyExprB a0@(Lam _ _ _) = arrows (fmap duplicate (docs a0)) - where - docs (Lam a b c) = Pretty.group (Pretty.flatAlt long short) : docs c - where - long = (lambda <> space) - <> Pretty.align - ( (lparen <> space) - <> prettyLabel a - <> Pretty.hardline - <> (colon <> space) - <> prettyExprA b - <> Pretty.hardline - <> rparen - ) - - short = (lambda <> lparen) - <> prettyLabel a - <> (space <> colon <> space) - <> prettyExprA b - <> rparen - docs (Note _ c) = docs c - docs c = [ prettyExprB c ] -prettyExprB a0@(BoolIf _ _ _) = - enclose' "" " " (space <> keyword "else" <> space) (Pretty.hardline <> keyword "else" <> " ") (fmap duplicate (docs a0)) - where - docs (BoolIf a b c) = - Pretty.group (Pretty.flatAlt long short) : docs c - where - long = - Pretty.align - ( (keyword "if" <> " ") - <> prettyExprA a - <> Pretty.hardline - <> (keyword "then" <> " ") - <> prettyExprA b - ) - - short = (keyword "if" <> " ") - <> prettyExprA a - <> (space <> keyword "then" <> space) - <> prettyExprA b - docs (Note _ c) = docs c - docs c = [ prettyExprB c ] -prettyExprB a0@(Pi _ _ _) = - arrows (fmap duplicate (docs a0)) - where - docs (Pi "_" b c) = prettyExprC b : docs c - docs (Pi a b c) = Pretty.group (Pretty.flatAlt long short) : docs c - where - long = forall <> space - <> Pretty.align - ( lparen <> space - <> prettyLabel a - <> Pretty.hardline - <> colon <> space - <> prettyExprA b - <> Pretty.hardline - <> rparen - ) - - short = forall <> lparen - <> prettyLabel a - <> space <> colon <> space - <> prettyExprA b - <> rparen - docs (Note _ c) = docs c - docs c = [ prettyExprB c ] -prettyExprB a0@(Let _ _ _ _) = - enclose' "" " " (space <> keyword "in" <> space) (Pretty.hardline <> keyword "in" <> " ") - (fmap duplicate (docs a0)) - where - docs (Let a Nothing c d) = - Pretty.group (Pretty.flatAlt long short) : docs d - where - long = keyword "let" <> space - <> Pretty.align - ( prettyLabel a - <> space <> equals - <> Pretty.hardline - <> " " - <> prettyExprA c - ) - - short = keyword "let" <> space - <> prettyLabel a - <> (space <> equals <> space) - <> prettyExprA c - docs (Let a (Just b) c d) = - Pretty.group (Pretty.flatAlt long short) : docs d - where - long = keyword "let" <> space - <> Pretty.align - ( prettyLabel a - <> Pretty.hardline - <> colon <> space - <> prettyExprA b - <> Pretty.hardline - <> equals <> space - <> prettyExprA c - ) - - short = keyword "let" <> space - <> prettyLabel a - <> space <> colon <> space - <> prettyExprA b - <> space <> equals <> space - <> prettyExprA c - docs (Note _ d) = - docs d - docs d = - [ prettyExprB d ] -prettyExprB (ListLit Nothing b) = - list (map prettyExprA (Data.Foldable.toList b)) -prettyExprB (ListLit (Just a) b) = - list (map prettyExprA (Data.Foldable.toList b)) - <> " : " - <> prettyExprD (App List a) -prettyExprB (OptionalLit a b) = - list (map prettyExprA (Data.Foldable.toList b)) - <> " : " - <> prettyExprD (App Optional a) -prettyExprB (Merge a b (Just c)) = - Pretty.group (Pretty.flatAlt long short) - where - long = - Pretty.align - ( keyword "merge" - <> Pretty.hardline - <> prettyExprE a - <> Pretty.hardline - <> prettyExprE b - <> Pretty.hardline - <> colon <> space - <> prettyExprD c - ) - - short = keyword "merge" <> space - <> prettyExprE a - <> " " - <> prettyExprE b - <> space <> colon <> space - <> prettyExprD c -prettyExprB (Merge a b Nothing) = - Pretty.group (Pretty.flatAlt long short) - where - long = - Pretty.align - ( keyword "merge" - <> Pretty.hardline - <> prettyExprE a - <> Pretty.hardline - <> prettyExprE b - ) - - short = keyword "merge" <> space - <> prettyExprE a - <> " " - <> prettyExprE b -prettyExprB (Note _ b) = - prettyExprB b -prettyExprB a = - prettyExprC a - -prettyExprC :: Pretty a => Expr s a -> Doc Ann -prettyExprC = prettyExprC0 - -prettyExprC0 :: Pretty a => Expr s a -> Doc Ann -prettyExprC0 a0@(BoolOr _ _) = - enclose' "" " " (space <> operator "||" <> space) (operator "||" <> " ") (fmap duplicate (docs a0)) - where - docs (BoolOr a b) = prettyExprC1 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC1 b ] -prettyExprC0 (Note _ a) = - prettyExprC0 a -prettyExprC0 a0 = - prettyExprC1 a0 - -prettyExprC1 :: Pretty a => Expr s a -> Doc Ann -prettyExprC1 a0@(TextAppend _ _) = - enclose' "" " " (" " <> operator "++" <> " ") (operator "++" <> " ") (fmap duplicate (docs a0)) - where - docs (TextAppend a b) = prettyExprC2 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC2 b ] -prettyExprC1 (Note _ a) = - prettyExprC1 a -prettyExprC1 a0 = - prettyExprC2 a0 - -prettyExprC2 :: Pretty a => Expr s a -> Doc Ann -prettyExprC2 a0@(NaturalPlus _ _) = - enclose' "" " " (" " <> operator "+" <> " ") (operator "+" <> " ") (fmap duplicate (docs a0)) - where - docs (NaturalPlus a b) = prettyExprC3 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC3 b ] -prettyExprC2 (Note _ a) = - prettyExprC2 a -prettyExprC2 a0 = - prettyExprC3 a0 - -prettyExprC3 :: Pretty a => Expr s a -> Doc Ann -prettyExprC3 a0@(ListAppend _ _) = - enclose' "" " " (" " <> operator "#" <> " ") (operator "#" <> " ") (fmap duplicate (docs a0)) - where - docs (ListAppend a b) = prettyExprC4 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC4 b ] -prettyExprC3 (Note _ a) = - prettyExprC3 a -prettyExprC3 a0 = - prettyExprC4 a0 - -prettyExprC4 :: Pretty a => Expr s a -> Doc Ann -prettyExprC4 a0@(BoolAnd _ _) = - enclose' "" " " (" " <> operator "&&" <> " ") (operator "&&" <> " ") (fmap duplicate (docs a0)) - where - docs (BoolAnd a b) = prettyExprC5 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC5 b ] -prettyExprC4 (Note _ a) = - prettyExprC4 a -prettyExprC4 a0 = - prettyExprC5 a0 - -prettyExprC5 :: Pretty a => Expr s a -> Doc Ann -prettyExprC5 a0@(Combine _ _) = - enclose' "" " " (" " <> operator "∧" <> " ") (operator "∧" <> " ") (fmap duplicate (docs a0)) - where - docs (Combine a b) = prettyExprC6 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC6 b ] -prettyExprC5 (Note _ a) = - prettyExprC5 a -prettyExprC5 a0 = - prettyExprC6 a0 - -prettyExprC6 :: Pretty a => Expr s a -> Doc Ann -prettyExprC6 a0@(Prefer _ _) = - enclose' "" " " (" " <> operator "⫽" <> " ") (operator "⫽" <> " ") (fmap duplicate (docs a0)) - where - docs (Prefer a b) = prettyExprC7 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC7 b ] -prettyExprC6 (Note _ a) = - prettyExprC6 a -prettyExprC6 a0 = - prettyExprC7 a0 - -prettyExprC7 :: Pretty a => Expr s a -> Doc Ann -prettyExprC7 a0@(NaturalTimes _ _) = - enclose' "" " " (" " <> operator "*" <> " ") (operator "*" <> " ") (fmap duplicate (docs a0)) - where - docs (NaturalTimes a b) = prettyExprC8 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC8 b ] -prettyExprC7 (Note _ a) = - prettyExprC7 a -prettyExprC7 a0 = - prettyExprC8 a0 - -prettyExprC8 :: Pretty a => Expr s a -> Doc Ann -prettyExprC8 a0@(BoolEQ _ _) = - enclose' "" " " (" " <> operator "==" <> " ") (operator "==" <> " ") (fmap duplicate (docs a0)) - where - docs (BoolEQ a b) = prettyExprC9 a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprC9 b ] -prettyExprC8 (Note _ a) = - prettyExprC8 a -prettyExprC8 a0 = - prettyExprC9 a0 - -prettyExprC9 :: Pretty a => Expr s a -> Doc Ann -prettyExprC9 a0@(BoolNE _ _) = - enclose' "" " " (" " <> operator "!=" <> " ") (operator "!=" <> " ") (fmap duplicate (docs a0)) - where - docs (BoolNE a b) = prettyExprD a : docs b - docs (Note _ b) = docs b - docs b = [ prettyExprD b ] -prettyExprC9 (Note _ a) = - prettyExprC9 a -prettyExprC9 a0 = - prettyExprD a0 - -prettyExprD :: Pretty a => Expr s a -> Doc Ann -prettyExprD a0 = case a0 of - App _ _ -> result - Constructors _ -> result - Note _ b -> prettyExprD b - _ -> prettyExprE a0 - where - result = enclose' "" "" " " "" (fmap duplicate (reverse (docs a0))) - - docs (App a b) = prettyExprE b : docs a - docs (Constructors b) = [ prettyExprE b , keyword "constructors" ] - docs (Note _ b) = docs b - docs b = [ prettyExprE b ] - -prettyExprE :: Pretty a => Expr s a -> Doc Ann -prettyExprE (Field a b) = prettyExprE a <> dot <> prettyLabel b -prettyExprE (Note _ b) = prettyExprE b -prettyExprE a = prettyExprF a - -prettyExprF :: Pretty a => Expr s a -> Doc Ann -prettyExprF (Var a) = - prettyVar a -prettyExprF (Const k) = - prettyConst k -prettyExprF Bool = - builtin "Bool" -prettyExprF Natural = - builtin "Natural" -prettyExprF NaturalFold = - builtin "Natural/fold" -prettyExprF NaturalBuild = - builtin "Natural/build" -prettyExprF NaturalIsZero = - builtin "Natural/isZero" -prettyExprF NaturalEven = - builtin "Natural/even" -prettyExprF NaturalOdd = - builtin "Natural/odd" -prettyExprF NaturalToInteger = - builtin "Natural/toInteger" -prettyExprF NaturalShow = - builtin "Natural/show" -prettyExprF Integer = - builtin "Integer" -prettyExprF IntegerShow = - builtin "Integer/show" -prettyExprF Double = - builtin "Double" -prettyExprF DoubleShow = - builtin "Double/show" -prettyExprF Text = - builtin "Text" -prettyExprF List = - builtin "List" -prettyExprF ListBuild = - builtin "List/build" -prettyExprF ListFold = - builtin "List/fold" -prettyExprF ListLength = - builtin "List/length" -prettyExprF ListHead = - builtin "List/head" -prettyExprF ListLast = - builtin "List/last" -prettyExprF ListIndexed = - builtin "List/indexed" -prettyExprF ListReverse = - builtin "List/reverse" -prettyExprF Optional = - builtin "Optional" -prettyExprF OptionalFold = - builtin "Optional/fold" -prettyExprF OptionalBuild = - builtin "Optional/build" -prettyExprF (BoolLit True) = - builtin "True" -prettyExprF (BoolLit False) = - builtin "False" -prettyExprF (IntegerLit a) = - prettyNumber a -prettyExprF (NaturalLit a) = - literal "+" <> prettyNatural a -prettyExprF (DoubleLit a) = - prettyScientific a -prettyExprF (TextLit a) = - prettyChunks a -prettyExprF (Record a) = - prettyRecord a -prettyExprF (RecordLit a) = - prettyRecordLit a -prettyExprF (Union a) = - prettyUnion a -prettyExprF (UnionLit a b c) = - prettyUnionLit a b c -prettyExprF (ListLit Nothing b) = - list (map prettyExprA (Data.Foldable.toList b)) -prettyExprF (Embed a) = - Pretty.pretty a -prettyExprF (Note _ b) = - prettyExprF b -prettyExprF a = - Pretty.group (Pretty.flatAlt long short) - where - long = Pretty.align (lparen <> space <> prettyExprA a <> Pretty.hardline <> rparen) - - short = lparen <> prettyExprA a <> rparen - -prettyKeyValue :: Pretty a => Doc Ann -> (Text, Expr s a) -> (Doc Ann, Doc Ann) -prettyKeyValue separator (key, value) = - ( prettyLabel key <> " " <> separator <> " " <> prettyExprA value - , prettyLabel key - <> " " - <> separator - <> long - ) - where - long = Pretty.hardline <> " " <> prettyExprA value - -prettyRecord :: Pretty a => InsOrdHashMap Text (Expr s a) -> Doc Ann -prettyRecord = - braces . map (prettyKeyValue colon) . Data.HashMap.Strict.InsOrd.toList - -prettyRecordLit :: Pretty a => InsOrdHashMap Text (Expr s a) -> Doc Ann -prettyRecordLit a - | Data.HashMap.Strict.InsOrd.null a = - lbrace <> equals <> rbrace - | otherwise - = braces (map (prettyKeyValue equals) (Data.HashMap.Strict.InsOrd.toList a)) - -prettyUnion :: Pretty a => InsOrdHashMap Text (Expr s a) -> Doc Ann -prettyUnion = - angles . map (prettyKeyValue colon) . Data.HashMap.Strict.InsOrd.toList - -prettyUnionLit - :: Pretty a => Text -> Expr s a -> InsOrdHashMap Text (Expr s a) -> Doc Ann -prettyUnionLit a b c = - angles (front : map adapt (Data.HashMap.Strict.InsOrd.toList c)) - where - front = prettyKeyValue equals (a, b) - - adapt = prettyKeyValue colon - --- | Pretty-print a value -pretty :: Pretty a => a -> Text -pretty = Pretty.renderLazy . Pretty.layoutPretty options . Pretty.pretty - where - options = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded } - --- | Builder corresponding to the @label@ token in "Dhall.Parser" -buildLabel :: Text -> Builder -buildLabel l = case Text.uncons l of - Just (h, t) - | headCharacter h && Text.all tailCharacter t && not (Data.HashSet.member l reservedIdentifiers) - -> build l - _ -> "`" <> build l <> "`" - - --- | Builder corresponding to the @number@ token in "Dhall.Parser" -buildNumber :: Integer -> Builder -buildNumber a = build (show a) - --- | Builder corresponding to the @natural@ token in "Dhall.Parser" -buildNatural :: Natural -> Builder -buildNatural a = build (show a) - --- | Builder corresponding to the @double@ token in "Dhall.Parser" -buildScientific :: Scientific -> Builder -buildScientific = build . show - --- | Builder corresponding to the @text@ token in "Dhall.Parser" -buildChunks :: Buildable a => Chunks s a -> Builder -buildChunks (Chunks a b) = "\"" <> foldMap buildChunk a <> escapeText b <> "\"" - where - buildChunk (c, d) = escapeText c <> "${" <> buildExprA d <> "}" - --- | Escape a `Builder` literal using Dhall's escaping rules for single-quoted --- @Text@ -escapeSingleQuotedText :: Builder -> Builder -escapeSingleQuotedText inputBuilder = outputBuilder - where - inputText = Builder.toLazyText inputBuilder - - outputText = substitute "${" "''${" (substitute "''" "'''" inputText) - - outputBuilder = Builder.fromLazyText outputText - - substitute before after = Text.intercalate after . Text.splitOn before - -{-| Escape a `Builder` literal using Dhall's escaping rules - - Note that the result does not include surrounding quotes --} -escapeText :: Builder -> Builder -escapeText a = Builder.fromLazyText (Text.concatMap adapt text) - where - adapt c - | '\x20' <= c && c <= '\x21' = Text.singleton c - -- '\x22' == '"' - | '\x23' == c = Text.singleton c - -- '\x24' == '$' - | '\x25' <= c && c <= '\x5B' = Text.singleton c - -- '\x5C' == '\\' - | '\x5D' <= c && c <= '\x7F' = Text.singleton c - | c == '"' = "\\\"" - | c == '$' = "\\$" - | c == '\\' = "\\\\" - | c == '\b' = "\\b" - | c == '\f' = "\\f" - | c == '\n' = "\\n" - | c == '\r' = "\\r" - | c == '\t' = "\\t" - | otherwise = "\\u" <> showDigits (Data.Char.ord c) - - showDigits r0 = Text.pack (map showDigit [q1, q2, q3, r3]) - where - (q1, r1) = r0 `quotRem` 4096 - (q2, r2) = r1 `quotRem` 256 - (q3, r3) = r2 `quotRem` 16 - - showDigit n - | n < 10 = Data.Char.chr (Data.Char.ord '0' + n) - | otherwise = Data.Char.chr (Data.Char.ord 'A' + n - 10) - - text = Builder.toLazyText a - --- | Builder corresponding to the @expr@ parser in "Dhall.Parser" -buildExpr :: Buildable a => Expr s a -> Builder -buildExpr = buildExprA - --- | Builder corresponding to the @exprA@ parser in "Dhall.Parser" -buildExprA :: Buildable a => Expr s a -> Builder -buildExprA (Annot a b) = buildExprB a <> " : " <> buildExprA b -buildExprA (Note _ b) = buildExprA b -buildExprA a = buildExprB a - --- | Builder corresponding to the @exprB@ parser in "Dhall.Parser" -buildExprB :: Buildable a => Expr s a -> Builder -buildExprB (Lam a b c) = - "λ(" - <> buildLabel a - <> " : " - <> buildExprA b - <> ") → " - <> buildExprB c -buildExprB (BoolIf a b c) = - "if " - <> buildExprA a - <> " then " - <> buildExprA b - <> " else " - <> buildExprA c -buildExprB (Pi "_" b c) = - buildExprC b - <> " → " - <> buildExprB c -buildExprB (Pi a b c) = - "∀(" - <> buildLabel a - <> " : " - <> buildExprA b - <> ") → " - <> buildExprB c -buildExprB (Let a Nothing c d) = - "let " - <> buildLabel a - <> " = " - <> buildExprA c - <> " in " - <> buildExprB d -buildExprB (Let a (Just b) c d) = - "let " - <> buildLabel a - <> " : " - <> buildExprA b - <> " = " - <> buildExprA c - <> " in " - <> buildExprB d -buildExprB (ListLit Nothing b) = - "[" <> buildElems (Data.Foldable.toList b) <> "]" -buildExprB (ListLit (Just a) b) = - "[" <> buildElems (Data.Foldable.toList b) <> "] : List " <> buildExprE a -buildExprB (OptionalLit a b) = - "[" <> buildElems (Data.Foldable.toList b) <> "] : Optional " <> buildExprE a -buildExprB (Merge a b (Just c)) = - "merge " <> buildExprE a <> " " <> buildExprE b <> " : " <> buildExprD c -buildExprB (Merge a b Nothing) = - "merge " <> buildExprE a <> " " <> buildExprE b -buildExprB (Note _ b) = - buildExprB b -buildExprB a = - buildExprC a - --- | Builder corresponding to the @exprC@ parser in "Dhall.Parser" -buildExprC :: Buildable a => Expr s a -> Builder -buildExprC = buildExprC0 - --- | Builder corresponding to the @exprC0@ parser in "Dhall.Parser" -buildExprC0 :: Buildable a => Expr s a -> Builder -buildExprC0 (BoolOr a b) = buildExprC1 a <> " || " <> buildExprC0 b -buildExprC0 (Note _ b) = buildExprC0 b -buildExprC0 a = buildExprC1 a - --- | Builder corresponding to the @exprC1@ parser in "Dhall.Parser" -buildExprC1 :: Buildable a => Expr s a -> Builder -buildExprC1 (TextAppend a b) = buildExprC2 a <> " ++ " <> buildExprC1 b -buildExprC1 (Note _ b) = buildExprC1 b -buildExprC1 a = buildExprC2 a - --- | Builder corresponding to the @exprC2@ parser in "Dhall.Parser" -buildExprC2 :: Buildable a => Expr s a -> Builder -buildExprC2 (NaturalPlus a b) = buildExprC3 a <> " + " <> buildExprC2 b -buildExprC2 (Note _ b) = buildExprC2 b -buildExprC2 a = buildExprC3 a - --- | Builder corresponding to the @exprC3@ parser in "Dhall.Parser" -buildExprC3 :: Buildable a => Expr s a -> Builder -buildExprC3 (ListAppend a b) = buildExprC4 a <> " # " <> buildExprC3 b -buildExprC3 (Note _ b) = buildExprC3 b -buildExprC3 a = buildExprC4 a - --- | Builder corresponding to the @exprC4@ parser in "Dhall.Parser" -buildExprC4 :: Buildable a => Expr s a -> Builder -buildExprC4 (BoolAnd a b) = buildExprC5 a <> " && " <> buildExprC4 b -buildExprC4 (Note _ b) = buildExprC4 b -buildExprC4 a = buildExprC5 a - --- | Builder corresponding to the @exprC5@ parser in "Dhall.Parser" -buildExprC5 :: Buildable a => Expr s a -> Builder -buildExprC5 (Combine a b) = buildExprC6 a <> " ∧ " <> buildExprC5 b -buildExprC5 (Note _ b) = buildExprC5 b -buildExprC5 a = buildExprC6 a - --- | Builder corresponding to the @exprC6@ parser in "Dhall.Parser" -buildExprC6 :: Buildable a => Expr s a -> Builder -buildExprC6 (Prefer a b) = buildExprC7 a <> " ⫽ " <> buildExprC6 b -buildExprC6 (Note _ b) = buildExprC6 b -buildExprC6 a = buildExprC7 a - --- | Builder corresponding to the @exprC7@ parser in "Dhall.Parser" -buildExprC7 :: Buildable a => Expr s a -> Builder -buildExprC7 (NaturalTimes a b) = buildExprC8 a <> " * " <> buildExprC7 b -buildExprC7 (Note _ b) = buildExprC7 b -buildExprC7 a = buildExprC8 a - --- | Builder corresponding to the @exprC8@ parser in "Dhall.Parser" -buildExprC8 :: Buildable a => Expr s a -> Builder -buildExprC8 (BoolEQ a b) = buildExprC9 a <> " == " <> buildExprC8 b -buildExprC8 (Note _ b) = buildExprC8 b -buildExprC8 a = buildExprC9 a - --- | Builder corresponding to the @exprC9@ parser in "Dhall.Parser" -buildExprC9 :: Buildable a => Expr s a -> Builder -buildExprC9 (BoolNE a b) = buildExprD a <> " != " <> buildExprC9 b -buildExprC9 (Note _ b) = buildExprC9 b -buildExprC9 a = buildExprD a - --- | Builder corresponding to the @exprD@ parser in "Dhall.Parser" -buildExprD :: Buildable a => Expr s a -> Builder -buildExprD (App a b) = buildExprD a <> " " <> buildExprE b -buildExprD (Constructors b) = "constructors " <> buildExprE b -buildExprD (Note _ b) = buildExprD b -buildExprD a = buildExprE a - --- | Builder corresponding to the @exprE@ parser in "Dhall.Parser" -buildExprE :: Buildable a => Expr s a -> Builder -buildExprE (Field a b) = buildExprE a <> "." <> buildLabel b -buildExprE (Note _ b) = buildExprE b -buildExprE a = buildExprF a - --- | Builder corresponding to the @exprF@ parser in "Dhall.Parser" -buildExprF :: Buildable a => Expr s a -> Builder -buildExprF (Var a) = - buildVar a -buildExprF (Const k) = - buildConst k -buildExprF Bool = - "Bool" -buildExprF Natural = - "Natural" -buildExprF NaturalFold = - "Natural/fold" -buildExprF NaturalBuild = - "Natural/build" -buildExprF NaturalIsZero = - "Natural/isZero" -buildExprF NaturalEven = - "Natural/even" -buildExprF NaturalOdd = - "Natural/odd" -buildExprF NaturalToInteger = - "Natural/toInteger" -buildExprF NaturalShow = - "Natural/show" -buildExprF Integer = - "Integer" -buildExprF IntegerShow = - "Integer/show" -buildExprF Double = - "Double" -buildExprF DoubleShow = - "Double/show" -buildExprF Text = - "Text" -buildExprF List = - "List" -buildExprF ListBuild = - "List/build" -buildExprF ListFold = - "List/fold" -buildExprF ListLength = - "List/length" -buildExprF ListHead = - "List/head" -buildExprF ListLast = - "List/last" -buildExprF ListIndexed = - "List/indexed" -buildExprF ListReverse = - "List/reverse" -buildExprF Optional = - "Optional" -buildExprF OptionalFold = - "Optional/fold" -buildExprF OptionalBuild = - "Optional/build" -buildExprF (BoolLit True) = - "True" -buildExprF (BoolLit False) = - "False" -buildExprF (IntegerLit a) = - buildNumber a -buildExprF (NaturalLit a) = - "+" <> buildNatural a -buildExprF (DoubleLit a) = - buildScientific a -buildExprF (TextLit a) = - buildChunks a -buildExprF (Record a) = - buildRecord a -buildExprF (RecordLit a) = - buildRecordLit a -buildExprF (Union a) = - buildUnion a -buildExprF (UnionLit a b c) = - buildUnionLit a b c -buildExprF (ListLit Nothing b) = - "[" <> buildElems (Data.Foldable.toList b) <> "]" -buildExprF (Embed a) = - build a -buildExprF (Note _ b) = - buildExprF b -buildExprF a = - "(" <> buildExprA a <> ")" - --- | Builder corresponding to the @const@ parser in "Dhall.Parser" -buildConst :: Const -> Builder -buildConst Type = "Type" -buildConst Kind = "Kind" - --- | Builder corresponding to the @var@ parser in "Dhall.Parser" -buildVar :: Var -> Builder -buildVar (V x 0) = buildLabel x -buildVar (V x n) = buildLabel x <> "@" <> buildNumber n - --- | Builder corresponding to the @elems@ parser in "Dhall.Parser" -buildElems :: Buildable a => [Expr s a] -> Builder -buildElems [] = "" -buildElems [a] = buildExprA a -buildElems (a:bs) = buildExprA a <> ", " <> buildElems bs - --- | Builder corresponding to the @recordLit@ parser in "Dhall.Parser" -buildRecordLit :: Buildable a => InsOrdHashMap Text (Expr s a) -> Builder -buildRecordLit a | Data.HashMap.Strict.InsOrd.null a = - "{=}" -buildRecordLit a = - "{ " <> buildFieldValues (Data.HashMap.Strict.InsOrd.toList a) <> " }" - --- | Builder corresponding to the @fieldValues@ parser in "Dhall.Parser" -buildFieldValues :: Buildable a => [(Text, Expr s a)] -> Builder -buildFieldValues [] = "" -buildFieldValues [a] = buildFieldValue a -buildFieldValues (a:bs) = buildFieldValue a <> ", " <> buildFieldValues bs - --- | Builder corresponding to the @fieldValue@ parser in "Dhall.Parser" -buildFieldValue :: Buildable a => (Text, Expr s a) -> Builder -buildFieldValue (a, b) = buildLabel a <> " = " <> buildExprA b - --- | Builder corresponding to the @record@ parser in "Dhall.Parser" -buildRecord :: Buildable a => InsOrdHashMap Text (Expr s a) -> Builder -buildRecord a | Data.HashMap.Strict.InsOrd.null a = - "{}" -buildRecord a = - "{ " <> buildFieldTypes (Data.HashMap.Strict.InsOrd.toList a) <> " }" - --- | Builder corresponding to the @fieldTypes@ parser in "Dhall.Parser" -buildFieldTypes :: Buildable a => [(Text, Expr s a)] -> Builder -buildFieldTypes [] = "" -buildFieldTypes [a] = buildFieldType a -buildFieldTypes (a:bs) = buildFieldType a <> ", " <> buildFieldTypes bs - --- | Builder corresponding to the @fieldType@ parser in "Dhall.Parser" -buildFieldType :: Buildable a => (Text, Expr s a) -> Builder -buildFieldType (a, b) = buildLabel a <> " : " <> buildExprA b - --- | Builder corresponding to the @union@ parser in "Dhall.Parser" -buildUnion :: Buildable a => InsOrdHashMap Text (Expr s a) -> Builder -buildUnion a | Data.HashMap.Strict.InsOrd.null a = - "<>" -buildUnion a = - "< " <> buildAlternativeTypes (Data.HashMap.Strict.InsOrd.toList a) <> " >" - --- | Builder corresponding to the @alternativeTypes@ parser in "Dhall.Parser" -buildAlternativeTypes :: Buildable a => [(Text, Expr s a)] -> Builder -buildAlternativeTypes [] = - "" -buildAlternativeTypes [a] = - buildAlternativeType a -buildAlternativeTypes (a:bs) = - buildAlternativeType a <> " | " <> buildAlternativeTypes bs - --- | Builder corresponding to the @alternativeType@ parser in "Dhall.Parser" -buildAlternativeType :: Buildable a => (Text, Expr s a) -> Builder -buildAlternativeType (a, b) = buildLabel a <> " : " <> buildExprA b - --- | Builder corresponding to the @unionLit@ parser in "Dhall.Parser" -buildUnionLit - :: Buildable a - => Text -> Expr s a -> InsOrdHashMap Text (Expr s a) -> Builder -buildUnionLit a b c - | Data.HashMap.Strict.InsOrd.null c = - "< " - <> buildLabel a - <> " = " - <> buildExprA b - <> " >" - | otherwise = - "< " - <> buildLabel a - <> " = " - <> buildExprA b - <> " | " - <> buildAlternativeTypes (Data.HashMap.Strict.InsOrd.toList c) - <> " >" +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wall #-} + +{-| This module provides internal pretty-printing utilities which are used by + other modules but are not part of the public facing API +-} + +module Dhall.Pretty.Internal ( + Ann(..) + , annToAnsiStyle + , prettyExpr + , prettySrcExpr + + , CharacterSet(..) + , defaultCharacterSet + , detectCharacterSet + , prettyCharacterSet + , prettyImportExpression + + , prettyVar + , pretty_ + , escapeText_ + , escapeEnvironmentVariable + , prettyEnvironmentVariable + + , prettyConst + , UnescapedLabel(..) + , escapeLabel + , prettyLabel + , prettyAnyLabel + , prettyLabels + , prettyNatural + , prettyNumber + , prettyInt + , prettyDouble + , prettyToStrictText + , prettyToString + , prettyBase16 + , layout + , layoutOpts + + , docToStrictText + + , builtin + , keyword + , literal + , operator + + , colon + , comma + , dot + , equals + , forall_ + , label + , lambda + , langle + , lbrace + , lbracket + , lparen + , pipe + , rangle + , rarrow + , rbrace + , rbracket + , rparen + + , temporalToText + ) where + +import Control.DeepSeq (NFData) +import Data.Aeson + ( FromJSON (..) + , Value (String) + ) +import Data.Aeson.Types (typeMismatch, unexpected) +import Data.ByteString (ByteString) +import Data.Data (Data) +import Data.Foldable +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text (Text) +import Dhall.Map (Map) +import Dhall.Src (Src (..)) +import Dhall.Syntax +import {-# SOURCE #-} Dhall.Syntax.Instances.Pretty () +import GHC.Generics (Generic) +import Language.Haskell.TH.Syntax (Lift) +import Lens.Micro (cosmosOf, foldMapOf) +import Numeric.Natural (Natural) +import Prettyprinter (Doc, Pretty, space) + +import qualified Control.Exception as Exception +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.Char +import qualified Data.HashSet +import qualified Data.List as List +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Maybe +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding +import qualified Data.Time as Time +import qualified Dhall.Map as Map +import qualified Dhall.Syntax.Operations as Operations +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.String as Pretty +import qualified Prettyprinter.Render.Terminal as Terminal +import qualified Prettyprinter.Render.Text as Pretty +import qualified Text.Printf as Printf + +{-| Annotation type used to tag elements in a pretty-printed document for + syntax highlighting purposes +-} +data Ann + = Keyword -- ^ Used for syntactic keywords + | Syntax -- ^ Syntax punctuation such as commas, parenthesis, and braces + | Label -- ^ Record labels + | Literal -- ^ Literals such as integers and strings + | Builtin -- ^ Builtin types and values + | Operator -- ^ Operators + deriving Show + +{-| Convert annotations to their corresponding color for syntax highlighting + purposes +-} +annToAnsiStyle :: Ann -> Terminal.AnsiStyle +annToAnsiStyle Keyword = Terminal.bold <> Terminal.colorDull Terminal.Green +annToAnsiStyle Syntax = Terminal.bold <> Terminal.colorDull Terminal.Green +annToAnsiStyle Label = mempty +annToAnsiStyle Literal = Terminal.colorDull Terminal.Magenta +annToAnsiStyle Builtin = Terminal.underlined +annToAnsiStyle Operator = Terminal.bold <> Terminal.colorDull Terminal.Green + +-- | This type determines whether to render code as `ASCII` or `Unicode` +data CharacterSet = ASCII | Unicode + deriving (Eq, Ord, Show, Data, Generic, Lift, NFData) + +-- | Since ASCII is a subset of Unicode, if either argument is Unicode, the +-- result is Unicode +instance Semigroup CharacterSet where + Unicode <> _ = Unicode + _ <> other = other + +instance Monoid CharacterSet where + mempty = ASCII + +instance FromJSON CharacterSet where + parseJSON (String "unicode") = pure Unicode + parseJSON (String "ascii") = pure ASCII + parseJSON v@(String _) = unexpected v + parseJSON v = typeMismatch "String" v + +-- | The character set used by default in functions throughout the Dhall code +-- base. +defaultCharacterSet :: CharacterSet +defaultCharacterSet = Unicode + +-- | Detect which character set is used for the syntax of an expression +-- If any parts of the expression uses the Unicode syntax, the whole expression +-- is deemed to be using the Unicode syntax. +detectCharacterSet :: Expr Src a -> CharacterSet +detectCharacterSet = foldMapOf (cosmosOf subExpressions) exprToCharacterSet + where + exprToCharacterSet = \case + Embed _ -> mempty -- Don't go down the embed route, otherwise: <> + Lam (Just Unicode) _ _ -> Unicode + Pi (Just Unicode) _ _ _ -> Unicode + Combine (Just Unicode) _ _ _ -> Unicode + CombineTypes (Just Unicode) _ _ -> Unicode + Prefer (Just Unicode) _ _ _ -> Unicode + Equivalent (Just Unicode) _ _ -> Unicode + _ -> mempty + +-- | Pretty print an expression +prettyExpr :: Pretty a => Expr s a -> Doc Ann +prettyExpr = prettySrcExpr . denote + +prettySrcExpr :: Pretty a => Expr Src a -> Doc Ann +prettySrcExpr = prettyCharacterSet defaultCharacterSet + +{-| Internal utility for pretty-printing, used when generating element lists + to supply to `enclose` or `enclose'`. This utility indicates that the + compact represent is the same as the multi-line representation for each + element +-} +duplicate :: a -> (a, a) +duplicate x = (x, x) + +isWhitespace :: Char -> Bool +isWhitespace c = + case c of + ' ' -> True + '\n' -> True + '\t' -> True + '\r' -> True + _ -> False + +{-| Used to render inline `Src` spans preserved by the syntax tree + + >>> let unusedSourcePos = Text.Megaparsec.SourcePos "" (Text.Megaparsec.mkPos 1) (Text.Megaparsec.mkPos 1) + >>> let nonEmptySrc = Src unusedSourcePos unusedSourcePos "-- Documentation for x\n" + >>> "let" <> " " <> renderSrc id (Just nonEmptySrc) <> "x = 1 in x" + let -- Documentation for x + x = 1 in x + >>> let emptySrc = Src unusedSourcePos unusedSourcePos " " + >>> "let" <> " " <> renderSrc id (Just emptySrc) <> "x = 1 in x" + let x = 1 in x + >>> "let" <> " " <> renderSrc id Nothing <> "x = 1 in x" + let x = 1 in x +-} +renderSrc + :: (Text -> Text) + -- ^ Used to preprocess the comment string (e.g. to strip whitespace) + -> Maybe Src + -- ^ Source span to render (if present) + -> Doc Ann +renderSrc strip (Just (Src {..})) + | not (Text.all isWhitespace srcText) = + renderComment (strip srcText) +renderSrc _ _ = + mempty + +{-| Render a comment. + + Any preprocessing, such as whitespace stripping, needs to be handled by the + caller, see e.g. 'renderSrc'. + + See the documentation for 'renderSrc' for examples. +-} +renderComment :: Text -> Doc Ann +renderComment text = + Pretty.align (Pretty.concatWith f newLines <> suffix) + where + horizontalSpace c = c == ' ' || c == '\t' + + suffix = + if Text.null text || Text.last text == '\n' + then mempty + else " " + + oldLines = Text.splitOn "\n" text + + spacePrefix = Text.takeWhile horizontalSpace + + commonPrefix a b = case Text.commonPrefixes a b of + Nothing -> "" + Just (c, _, _) -> c + + sharedSpacePrefix [] = "" + sharedSpacePrefix (l : ls) = foldl' commonPrefix (spacePrefix l) ls + + blank = Text.all horizontalSpace + + newLines = + case oldLines of + [] -> + [] + l0 : ls -> + let sharedPrefix = + sharedSpacePrefix (filter (not . blank) ls) + + perLine l = + case Text.stripPrefix sharedPrefix l of + Nothing -> Pretty.pretty l + Just l' -> Pretty.pretty l' + + in Pretty.pretty l0 : map perLine ls + + f x y = x <> Pretty.hardline <> y + +{-| This is a variant of 'renderSrc' with the following differences: + + * The 'srcText' is stripped of all whitespace at the start and the end. + * When the stripped 'srcText' is empty, the result is 'Nothing'. +-} +renderSrcMaybe :: Maybe Src -> Maybe (Doc Ann) +renderSrcMaybe (Just Src{..}) = + case Text.dropAround isWhitespace srcText of + "" -> Nothing + t -> Just (renderComment t) +renderSrcMaybe _ = Nothing + +{-| @ + 'containsComment' mSrc ≡ 'Data.Maybe.isJust' ('renderSrcMaybe' mSrc) + @ +-} +containsComment :: Maybe Src -> Bool +containsComment Nothing = False +containsComment (Just Src{..}) = not (Text.all isWhitespace srcText) + +-- Annotation helpers +keyword, syntax, label, literal, builtin, operator :: Doc Ann -> Doc Ann +keyword = Pretty.annotate Keyword +syntax = Pretty.annotate Syntax +label = Pretty.annotate Label +literal = Pretty.annotate Literal +builtin = Pretty.annotate Builtin +operator = Pretty.annotate Operator + +comma, lbracket, rbracket, langle, rangle, lbrace, rbrace, lparen, rparen, pipe, dollar, colon, equals, dot :: Doc Ann +comma = syntax Pretty.comma +lbracket = syntax Pretty.lbracket +rbracket = syntax Pretty.rbracket +langle = syntax Pretty.langle +rangle = syntax Pretty.rangle +lbrace = syntax Pretty.lbrace +rbrace = syntax Pretty.rbrace +lparen = syntax Pretty.lparen +rparen = syntax Pretty.rparen +pipe = syntax Pretty.pipe +dollar = syntax "$" +colon = syntax ":" +equals = syntax "=" +dot = syntax "." + +lambda :: CharacterSet -> Doc Ann +lambda Unicode = syntax "λ" +lambda ASCII = syntax "\\" + +forall_ :: CharacterSet -> Doc Ann +forall_ Unicode = syntax "∀" +forall_ ASCII = syntax "forall " + +rarrow :: CharacterSet -> Doc Ann +rarrow Unicode = syntax "→" +rarrow ASCII = syntax "->" + +doubleColon :: Doc Ann +doubleColon = syntax "::" + +-- | Pretty-print a list +list :: [Doc Ann] -> Doc Ann +list [] = lbracket <> rbracket +list docs = + enclose + (lbracket <> space) + (lbracket <> space) + (comma <> space) + (comma <> space) + (space <> rbracket) + rbracket + (fmap duplicate docs) + +-- | Pretty-print union types and literals +angles :: [(Doc Ann, Doc Ann)] -> Doc Ann +angles [] = langle <> rangle +angles docs = + enclose + (langle <> space) + (langle <> space) + (space <> pipe <> space) + (pipe <> space) + (space <> rangle) + rangle + docs + +-- | Pretty-print record types and literals +braces :: [(Doc Ann, Doc Ann)] -> Doc Ann +braces [] = lbrace <> rbrace +braces docs = + enclose + (lbrace <> space) + (lbrace <> space) + (comma <> space) + (comma <> space) + (space <> rbrace) + rbrace + docs + +hangingBraces :: Int -> [(Doc Ann, Doc Ann)] -> Doc Ann +hangingBraces _ [] = + lbrace <> rbrace +hangingBraces n docs = + Pretty.group + (Pretty.flatAlt + ( lbrace + <> Pretty.hardline + <> Pretty.indent n + ( mconcat (map (combineLong separator) docsLong) + <> rbrace + ) + ) + (mconcat (zipWith (<>) (beginShort : repeat separator) docsShort) <> space <> rbrace) + ) + where + separator = comma <> space + + docsShort = fmap fst docs + + docsLong = fmap snd docs + + beginShort = lbrace <> space + + combineLong x y = x <> y <> Pretty.hardline + +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc (x0 : xs0) = Just (go id x0 xs0) + where + go diffXs x [] = (diffXs [], x) + go diffXs x (y : ys) = go (diffXs . (x:)) y ys + +-- | Pretty-print anonymous functions and function types +arrows :: CharacterSet -> [ Doc Ann ] -> Doc Ann +arrows characterSet docs = Pretty.group (Pretty.flatAlt long short) + where + long = Pretty.align (mconcat (List.intersperse Pretty.hardline docs')) + where + docs' = case unsnoc docs of + Nothing -> docs + + Just (init_, last_) -> init' ++ [ last' ] + where + appendArrow doc = doc <> space <> rarrow characterSet + + init' = map appendArrow init_ + + last' = space <> space <> last_ + + short = mconcat (List.intersperse separator docs) + where + separator = space <> rarrow characterSet <> space + +combine :: CharacterSet -> Text +combine ASCII = "/\\" +combine Unicode = "∧" + +combineTypes :: CharacterSet -> Text +combineTypes ASCII = "//\\\\" +combineTypes Unicode = "⩓" + +prefer :: CharacterSet -> Text +prefer ASCII = "//" +prefer Unicode = "⫽" + +equivalent :: CharacterSet -> Text +equivalent ASCII = "===" +equivalent Unicode = "≡" + +{-| Format an expression that holds a variable number of elements, such as a + list, record, or union +-} +enclose + :: Doc ann + -- ^ Beginning document for compact representation + -> Doc ann + -- ^ Beginning document for multi-line representation + -> Doc ann + -- ^ Separator for compact representation + -> Doc ann + -- ^ Separator for multi-line representation + -> Doc ann + -- ^ Ending document for compact representation + -> Doc ann + -- ^ Ending document for multi-line representation + -> [(Doc ann, Doc ann)] + -- ^ Elements to format, each of which is a pair: @(compact, multi-line)@ + -> Doc ann +enclose beginShort _ _ _ endShort _ [] = + beginShort <> endShort +enclose beginShort beginLong sepShort sepLong endShort endLong docs = + Pretty.group + (Pretty.flatAlt + (Pretty.align + (mconcat (zipWith combineLong (beginLong : repeat sepLong) docsLong) <> endLong) + ) + (mconcat (zipWith combineShort (beginShort : repeat sepShort) docsShort) <> endShort) + ) + where + docsShort = fmap fst docs + + docsLong = fmap snd docs + + combineLong x y = x <> y <> Pretty.hardline + + combineShort x y = x <> y + +{-| Format an expression that holds a variable number of elements without a + trailing document such as nested @let@, nested lambdas, or nested @forall@s +-} +enclose' + :: Doc ann + -- ^ Beginning document for compact representation + -> Doc ann + -- ^ Beginning document for multi-line representation + -> Doc ann + -- ^ Separator for compact representation + -> Doc ann + -- ^ Separator for multi-line representation + -> [(Doc ann, Doc ann)] + -- ^ Elements to format, each of which is a pair: @(compact, multi-line)@ + -> Doc ann +enclose' beginShort beginLong sepShort sepLong docs = + Pretty.group (Pretty.flatAlt long short) + where + longLines = zipWith (<>) (beginLong : repeat sepLong) docsLong + + long = + Pretty.align (mconcat (List.intersperse Pretty.hardline longLines)) + + short = mconcat (zipWith (<>) (beginShort : repeat sepShort) docsShort) + + docsShort = fmap fst docs + + docsLong = fmap snd docs + +alpha :: Char -> Bool +alpha c = ('\x41' <= c && c <= '\x5A') || ('\x61' <= c && c <= '\x7A') + +digit :: Char -> Bool +digit c = '\x30' <= c && c <= '\x39' + +alphaNum :: Char -> Bool +alphaNum c = alpha c || digit c + +headCharacter :: Char -> Bool +headCharacter c = alpha c || c == '_' + +tailCharacter :: Char -> Bool +tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/' + +-- | The set of labels which do not need to be escaped +data UnescapedLabel + = NonReservedLabel + -- ^ This corresponds to the `nonreserved-label` rule in the grammar + | AnyLabel + -- ^ This corresponds to the `any-label` rule in the grammar + | AnyLabelOrSome + -- ^ This corresponds to the `any-label-or-some` rule in the grammar + +-- | Escape a label if it is not valid when unquoted +escapeLabel :: UnescapedLabel -> Text -> Text +escapeLabel allowedLabel l = + case Text.uncons l of + Just (h, t) + | headCharacter h && Text.all tailCharacter t && allowed && l /= "?" + -> l + _ -> "`" <> l <> "`" + where + allowed = case allowedLabel of + NonReservedLabel -> notReservedIdentifier + AnyLabel -> notReservedKeyword + AnyLabelOrSome -> notReservedKeyword || l == "Some" + + notReservedIdentifier = not (Data.HashSet.member l reservedIdentifiers) + + notReservedKeyword = not (Data.HashSet.member l reservedKeywords) + +prettyLabelShared :: UnescapedLabel -> Text -> Doc Ann +prettyLabelShared b l = label (Pretty.pretty (escapeLabel b l)) + +prettyLabel :: Text -> Doc Ann +prettyLabel = prettyLabelShared NonReservedLabel + +prettyAnyLabel :: Text -> Doc Ann +prettyAnyLabel = prettyLabelShared AnyLabel + +prettyAnyLabelOrSome :: Text -> Doc Ann +prettyAnyLabelOrSome = prettyLabelShared AnyLabelOrSome + +prettyKeys + :: Foldable list + => (key -> Doc Ann) + -> list (Maybe Src, key, Maybe Src) + -> Doc Ann +prettyKeys prettyK keys = Pretty.group (Pretty.flatAlt long short) + where + short = (mconcat . Pretty.punctuate dot . map prettyKey . toList) keys + + long = + case map prettyKey (toList keys) of + [] -> mempty + [doc] -> doc + doc:docs -> + Pretty.align + . mconcat + . Pretty.punctuate (Pretty.hardline <> ". ") + $ Pretty.indent 2 doc : docs + + prettyKey (mSrc0, key, mSrc1) = + Pretty.align + . mconcat + . Pretty.punctuate Pretty.hardline + . Data.Maybe.catMaybes + $ [ renderSrcMaybe mSrc0 + , Just (prettyK key) + , renderSrcMaybe mSrc1 + ] + +prettyLabels :: [Text] -> Doc Ann +prettyLabels a + | null a = lbrace <> rbrace + | otherwise = braces (map (duplicate . prettyAnyLabelOrSome) a) + +prettyNumber :: Integer -> Doc Ann +prettyNumber = literal . Pretty.pretty + +prettyInt :: Int -> Doc Ann +prettyInt = literal . Pretty.pretty + +prettyNatural :: Natural -> Doc Ann +prettyNatural = literal . Pretty.pretty + +prettyDouble :: Double -> Doc Ann +prettyDouble = literal . Pretty.pretty + +prettyConst :: Const -> Doc Ann +prettyConst Type = builtin "Type" +prettyConst Kind = builtin "Kind" +prettyConst Sort = builtin "Sort" + +prettyVar :: Var -> Doc Ann +prettyVar (V x 0) = label (Pretty.unAnnotate (prettyLabel x)) +prettyVar (V x n) = label (Pretty.unAnnotate (prettyLabel x <> "@" <> prettyInt n)) + +prettyEnvironmentVariable :: Text -> Doc ann +prettyEnvironmentVariable t = Pretty.pretty (escapeEnvironmentVariable t) + +preserveSource :: Expr Src a -> Maybe (Doc Ann) +preserveSource (Note Src{..} (DoubleLit {})) = Just (Pretty.pretty srcText) +preserveSource (Note Src{..} (IntegerLit {})) = Just (Pretty.pretty srcText) +preserveSource (Note Src{..} (NaturalLit {})) = Just (Pretty.pretty srcText) +preserveSource _ = Nothing + +-- | Escape an environment variable if not a valid Bash environment variable +escapeEnvironmentVariable :: Text -> Text +escapeEnvironmentVariable t + | validBashEnvVar t = t + | otherwise = "\"" <> escapeText_ t <> "\"" + where + validBashEnvVar v = case Text.uncons v of + Nothing -> False + Just (c, v') -> + (alpha c || c == '_') + && Text.all (\c' -> alphaNum c' || c' == '_') v' + +{- There is a close correspondence between the pretty-printers in 'prettyCharacterSet' + and the sub-parsers in 'Dhall.Parser.Expression.parsers'. Most pretty-printers are + named after the corresponding parser and the relationship between pretty-printers + exactly matches the relationship between parsers. This leads to the nice emergent + property of automatically getting all the parentheses and precedences right. + + This approach has one major disadvantage: you can get an infinite loop if + you add a new constructor to the syntax tree without adding a matching + case the corresponding builder. +-} + +{-| Pretty-print an 'Expr' using the given 'CharacterSet'. + +'prettyCharacterSet' largely ignores 'Note's. 'Note's do however matter for +the layout of let-blocks: + +>>> let inner = Let (Binding Nothing "x" Nothing Nothing Nothing (NaturalLit 1)) (Var (V "x" 0)) :: Expr Src () +>>> prettyCharacterSet ASCII (Let (Binding Nothing "y" Nothing Nothing Nothing (NaturalLit 2)) inner) +let y = 2 let x = 1 in x +>>> prettyCharacterSet ASCII (Let (Binding Nothing "y" Nothing Nothing Nothing (NaturalLit 2)) (Note (Src unusedSourcePos unusedSourcePos "") inner)) +let y = 2 in let x = 1 in x + +This means the structure of parsed let-blocks is preserved. +-} +prettyCharacterSet :: Pretty a => CharacterSet -> Expr Src a -> Doc Ann +prettyCharacterSet characterSet = prettyCompleteExpression + where + PrettyPrinters{..} = prettyPrinters characterSet + +-- Mainly used by the `Pretty` instance for `Import` +prettyImportExpression :: Pretty a => Expr Src a -> Doc Ann +prettyImportExpression = prettyImportExpression_ + where + PrettyPrinters{..} = prettyPrinters Unicode + +data PrettyPrinters a = PrettyPrinters + { prettyCompleteExpression :: Expr Src a -> Doc Ann + , prettyImportExpression_ :: Expr Src a -> Doc Ann + } + +prettyPrinters :: Pretty a => CharacterSet -> PrettyPrinters a +prettyPrinters characterSet = + PrettyPrinters{..} + where + prettyCompleteExpression expression = + Pretty.group (prettyExpression expression) + + prettyExpression a0@(Lam _ _ _) = + arrows characterSet (docs a0) + where + docs (Lam _ (FunctionBinding { functionBindingVariable = a, functionBindingAnnotation = b }) c) = + Pretty.group (Pretty.flatAlt long short) : docs c + where + long = (lambda characterSet <> space) + <> Pretty.align + ( (lparen <> space) + <> prettyLabel a + <> Pretty.hardline + <> (colon <> space) + <> prettyExpression b + <> Pretty.hardline + <> rparen + ) + + short = (lambda characterSet <> lparen) + <> prettyLabel a + <> (space <> colon <> space) + <> prettyExpression b + <> rparen + docs c + | Just doc <- preserveSource c = + [ doc ] + | Note _ d <- c = + docs d + | otherwise = + [ prettyExpression c ] + prettyExpression a0@(BoolIf _ _ _) = + Pretty.group (Pretty.flatAlt long short) + where + prefixesLong = + "" + : cycle + [ keyword "then" <> " " + , keyword "else" <> " " + ] + + prefixesShort = + "" + : cycle + [ space <> keyword "then" <> space + , space <> keyword "else" <> space + ] + + longLines = zipWith (<>) prefixesLong (docsLong True a0) + + long = + Pretty.align (mconcat (List.intersperse Pretty.hardline longLines)) + + short = mconcat (zipWith (<>) prefixesShort (docsShort a0)) + + docsLong initial (BoolIf a b c) = + docLong ++ docsLong False c + where + padding + | initial = " " + | otherwise = mempty + + docLong = + [ keyword "if" <> padding <> " " <> prettyExpression a + , prettyExpression b + ] + docsLong initial c + | Just doc <- preserveSource c = + [ doc ] + | Note _ d <- c = + docsLong initial d + | otherwise = + [ prettyExpression c ] + + docsShort (BoolIf a b c) = + docShort ++ docsShort c + where + docShort = + [ keyword "if" <> " " <> prettyExpression a + , prettyExpression b + ] + docsShort c + | Just doc <- preserveSource c = + [ doc ] + | Note _ d <- c = + docsShort d + | otherwise = + [ prettyExpression c ] + prettyExpression (Let a0 b0) = + enclose' "" "" space Pretty.hardline + (fmap (duplicate . docA) (toList as) ++ [ docB ]) + where + MultiLet as b = multiLet a0 b0 + + isSpace c = c == ' ' || c == '\t' + stripSpaces = + Text.dropAround isSpace + . Text.intercalate "\n" + . map (Text.dropWhileEnd isSpace) + . Text.splitOn "\n" + + -- Strip a single newline character. Needed to ensure idempotency in + -- cases where we add hard line breaks. + stripNewline t = + case Text.uncons t' of + Just ('\n', t'') -> stripSpaces t'' + _ -> t' + where t' = stripSpaces t + + docA (Binding src0 c src1 Nothing src2 e) = + Pretty.group (Pretty.flatAlt long short) + where + long = keyword "let" <> space + <> Pretty.align + ( renderSrc stripSpaces src0 + <> prettyLabel c <> space <> renderSrc stripSpaces src1 + <> equals <> Pretty.hardline <> renderSrc stripNewline src2 + <> " " <> prettyExpression e + ) + + short = keyword "let" <> space <> renderSrc stripSpaces src0 + <> prettyLabel c <> space <> renderSrc stripSpaces src1 + <> equals <> space <> renderSrc stripSpaces src2 + <> prettyExpression e + docA (Binding src0 c src1 (Just (src3, d)) src2 e) = + keyword "let" <> space + <> Pretty.align + ( renderSrc stripSpaces src0 + <> prettyLabel c <> Pretty.hardline <> renderSrc stripNewline src1 + <> colon <> space <> renderSrc stripSpaces src3 <> prettyExpression d <> Pretty.hardline + <> equals <> space <> renderSrc stripSpaces src2 + <> prettyExpression e + ) + + docB = + ( keyword "in" <> " " <> prettyExpression b + , keyword "in" <> " " <> prettyExpression b + ) + prettyExpression a0@(Pi _ _ _ _) = + arrows characterSet (docs a0) + where + docs (Pi _ "_" b c) = prettyOperatorExpression b : docs c + docs (Pi _ a b c) = Pretty.group (Pretty.flatAlt long short) : docs c + where + long = forall_ characterSet <> space + <> Pretty.align + ( lparen <> space + <> prettyLabel a + <> Pretty.hardline + <> colon <> space + <> prettyExpression b + <> Pretty.hardline + <> rparen + ) + + short = forall_ characterSet <> lparen + <> prettyLabel a + <> space <> colon <> space + <> prettyExpression b + <> rparen + docs c + | Just doc <- preserveSource c = + [ doc ] + | Note _ d <- c = + docs d + | otherwise = + [ prettyExpression c ] + prettyExpression (With (Dhall.Syntax.shallowDenote -> a) b c) = + case a of + With{} -> + -- Don't parenthesize an inner with-expression + prettyExpression a + _ -> + prettyImportExpression_ a + <> Pretty.flatAlt long short + where + short = " " <> keyword "with" <> " " <> update + + long = Pretty.hardline + <> " " + <> Pretty.align (keyword "with" <> " " <> update) + + (update, _) = + prettyKeyValue prettyKey prettyOperatorExpression equals + (makeKeyValue b c) + + prettyKey (WithLabel text) = prettyAnyLabelOrSome text + prettyKey WithQuestion = syntax "?" + prettyExpression (Assert a) = + Pretty.group (Pretty.flatAlt long short) + where + short = keyword "assert" <> " " <> colon <> " " <> prettyExpression a + + long = + Pretty.align + ( " " <> keyword "assert" + <> Pretty.hardline <> colon <> " " <> prettyExpression a + ) + prettyExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyExpression b + | otherwise = + prettyAnnotatedExpression a + + prettyAnnotatedExpression :: Pretty a => Expr Src a -> Doc Ann + prettyAnnotatedExpression (Merge a b (Just c)) = + Pretty.group (Pretty.flatAlt long short) + where + long = + Pretty.align + ( keyword "merge" + <> Pretty.hardline + <> Pretty.indent 2 (prettyImportExpression_ a) + <> Pretty.hardline + <> Pretty.indent 2 (prettyImportExpression_ b) + <> Pretty.hardline + <> colon <> space + <> prettyExpression c + ) + + short = keyword "merge" <> space + <> prettyImportExpression_ a + <> " " + <> prettyImportExpression_ b + <> space <> colon <> space + <> prettyExpression c + prettyAnnotatedExpression (ToMap a (Just b)) = + Pretty.group (Pretty.flatAlt long short) + where + long = + Pretty.align + ( keyword "toMap" + <> Pretty.hardline + <> Pretty.indent 2 (prettyImportExpression_ a) + <> Pretty.hardline + <> colon <> space + <> prettyExpression b + ) + + short = keyword "toMap" <> space + <> prettyImportExpression_ a + <> space <> colon <> space + <> prettyExpression b + prettyAnnotatedExpression a0@(Annot _ _) = + enclose' + "" + " " + (" " <> colon <> " ") + (colon <> space) + (fmap duplicate (docs a0)) + where + docs (Annot a b) = prettyOperatorExpression a : docs b + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyExpression a ] + prettyAnnotatedExpression (ListLit (Just a) b) = + list (map prettyExpression (Data.Foldable.toList b)) + <> " : " + <> prettyExpression a + prettyAnnotatedExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyAnnotatedExpression b + | otherwise = + prettyOperatorExpression a + + prettyOperatorExpression :: Pretty a => Expr Src a -> Doc Ann + prettyOperatorExpression = prettyEquivalentExpression + + prettyOperator :: Text -> [Doc Ann] -> Doc Ann + prettyOperator op docs = + enclose' + "" + prefix + (" " <> operator (Pretty.pretty op) <> " ") + (operator (Pretty.pretty op) <> spacer) + (reverse (fmap duplicate docs)) + where + prefix = if Text.length op == 1 then " " else " " + + spacer = if Text.length op == 1 then " " else " " + + prettyEquivalentExpression :: Pretty a => Expr Src a -> Doc Ann + prettyEquivalentExpression a0@(Equivalent _ _ _) = + prettyOperator (equivalent characterSet) (docs a0) + where + docs (Equivalent _ a b) = prettyImportAltExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyImportAltExpression a ] + prettyEquivalentExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyEquivalentExpression b + | otherwise = + prettyImportAltExpression a + + prettyImportAltExpression :: Pretty a => Expr Src a -> Doc Ann + prettyImportAltExpression a0@(ImportAlt _ _) = + prettyOperator "?" (docs a0) + where + docs (ImportAlt a b) = prettyOrExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyOrExpression a ] + prettyImportAltExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyImportAltExpression b + | otherwise = + prettyOrExpression a + + prettyOrExpression :: Pretty a => Expr Src a -> Doc Ann + prettyOrExpression a0@(BoolOr _ _) = + prettyOperator "||" (docs a0) + where + docs (BoolOr a b) = prettyPlusExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyPlusExpression a ] + prettyOrExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyOrExpression b + | otherwise = + prettyPlusExpression a + + prettyPlusExpression :: Pretty a => Expr Src a -> Doc Ann + prettyPlusExpression a0@(NaturalPlus _ _) = + prettyOperator "+" (docs a0) + where + docs (NaturalPlus a b) = prettyTextAppendExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyTextAppendExpression a ] + prettyPlusExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyPlusExpression b + | otherwise = + prettyTextAppendExpression a + + prettyTextAppendExpression :: Pretty a => Expr Src a -> Doc Ann + prettyTextAppendExpression a0@(TextAppend _ _) = + prettyOperator "++" (docs a0) + where + docs (TextAppend a b) = prettyListAppendExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyListAppendExpression a ] + prettyTextAppendExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyTextAppendExpression b + | otherwise = + prettyListAppendExpression a + + prettyListAppendExpression :: Pretty a => Expr Src a -> Doc Ann + prettyListAppendExpression a0@(ListAppend _ _) = + prettyOperator "#" (docs a0) + where + docs (ListAppend a b) = prettyAndExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyAndExpression a ] + prettyListAppendExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyListAppendExpression b + | otherwise = + prettyAndExpression a + + prettyAndExpression :: Pretty a => Expr Src a -> Doc Ann + prettyAndExpression a0@(BoolAnd _ _) = + prettyOperator "&&" (docs a0) + where + docs (BoolAnd a b) = prettyCombineExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyCombineExpression a ] + prettyAndExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyAndExpression b + | otherwise = + prettyCombineExpression a + + prettyCombineExpression :: Pretty a => Expr Src a -> Doc Ann + prettyCombineExpression a0@(Combine _ _ _ _) = + prettyOperator (combine characterSet) (docs a0) + where + docs (Combine _ _ a b) = prettyPreferExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyPreferExpression a ] + prettyCombineExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyCombineExpression b + | otherwise = + prettyPreferExpression a + + prettyPreferExpression :: Pretty a => Expr Src a -> Doc Ann + prettyPreferExpression a0@(Prefer {}) = + prettyOperator (prefer characterSet) (docs a0) + where + docs (Prefer _ _ a b) = prettyCombineTypesExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyCombineTypesExpression a ] + prettyPreferExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyPreferExpression b + | otherwise = + prettyCombineTypesExpression a + + prettyCombineTypesExpression :: Pretty a => Expr Src a -> Doc Ann + prettyCombineTypesExpression a0@(CombineTypes _ _ _) = + prettyOperator (combineTypes characterSet) (docs a0) + where + docs (CombineTypes _ a b) = prettyTimesExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyTimesExpression a ] + prettyCombineTypesExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyCombineTypesExpression b + | otherwise = + prettyTimesExpression a + + prettyTimesExpression :: Pretty a => Expr Src a -> Doc Ann + prettyTimesExpression a0@(NaturalTimes _ _) = + prettyOperator "*" (docs a0) + where + docs (NaturalTimes a b) = prettyEqualExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyEqualExpression a ] + prettyTimesExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyTimesExpression b + | otherwise = + prettyEqualExpression a + + prettyEqualExpression :: Pretty a => Expr Src a -> Doc Ann + prettyEqualExpression a0@(BoolEQ _ _) = + prettyOperator "==" (docs a0) + where + docs (BoolEQ a b) = prettyNotEqualExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyNotEqualExpression a ] + prettyEqualExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyEqualExpression b + | otherwise = + prettyNotEqualExpression a + + prettyNotEqualExpression :: Pretty a => Expr Src a -> Doc Ann + prettyNotEqualExpression a0@(BoolNE _ _) = + prettyOperator "!=" (docs a0) + where + docs (BoolNE a b) = prettyApplicationExpression b : docs a + docs a + | Just doc <- preserveSource a = + [ doc ] + | Note _ b <- a = + docs b + | otherwise = + [ prettyApplicationExpression a ] + prettyNotEqualExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyNotEqualExpression b + | otherwise = + prettyApplicationExpression a + + prettyApplicationExpression :: Pretty a => Expr Src a -> Doc Ann + prettyApplicationExpression = go [] + where + go args = \case + App a b -> go (b : args) a + Some a -> app (builtin "Some") (a : args) + Merge a b Nothing -> app (keyword "merge") (a : b : args) + ToMap a Nothing -> app (keyword "toMap") (a : args) + ShowConstructor a -> app (keyword "showConstructor") (a : args) + e | Note _ b <- e -> + go args b + | null args -> + prettyImportExpression_ e -- just a performance optimization + | Just doc <- preserveSource e -> + app doc args + | otherwise -> + app (prettyImportExpression_ e) args + + app f args = + enclose' + "" "" " " "" + ( duplicate f + : map (fmap (Pretty.indent 2) . duplicate . prettyImportExpression_) args + ) + + prettyImportExpression_ :: Pretty a => Expr Src a -> Doc Ann + prettyImportExpression_ (Embed a) = + Pretty.pretty a + prettyImportExpression_ a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyImportExpression_ b + | otherwise = + prettyCompletionExpression a + + prettyCompletionExpression :: Pretty a => Expr Src a -> Doc Ann + prettyCompletionExpression (RecordCompletion a b) = + case shallowDenote b of + RecordLit kvs -> + Pretty.align + ( prettySelectorExpression a + <> doubleColon + <> prettyCompletionLit 0 kvs + ) + _ -> prettySelectorExpression a + <> doubleColon + <> prettySelectorExpression b + prettyCompletionExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyCompletionExpression b + | otherwise = + prettySelectorExpression a + + prettySelectorExpression :: Pretty a => Expr Src a -> Doc Ann + prettySelectorExpression (Field a (Dhall.Syntax.fieldSelectionLabel -> b)) = + prettySelectorExpression a <> dot <> prettyAnyLabel b + prettySelectorExpression (Project a (Left b)) = + prettySelectorExpression a <> dot <> prettyLabels b + prettySelectorExpression (Project a (Right b)) = + prettySelectorExpression a + <> dot + <> lparen + <> prettyExpression b + <> rparen + prettySelectorExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettySelectorExpression b + | otherwise = + prettyPrimitiveExpression a + + prettyPrimitiveExpression :: Pretty a => Expr Src a -> Doc Ann + prettyPrimitiveExpression (Var a) = + prettyVar a + prettyPrimitiveExpression (Const k) = + prettyConst k + prettyPrimitiveExpression Bool = + builtin "Bool" + prettyPrimitiveExpression Bytes = + builtin "Bytes" + prettyPrimitiveExpression Natural = + builtin "Natural" + prettyPrimitiveExpression NaturalFold = + builtin "Natural/fold" + prettyPrimitiveExpression NaturalBuild = + builtin "Natural/build" + prettyPrimitiveExpression NaturalIsZero = + builtin "Natural/isZero" + prettyPrimitiveExpression NaturalEven = + builtin "Natural/even" + prettyPrimitiveExpression NaturalOdd = + builtin "Natural/odd" + prettyPrimitiveExpression NaturalToInteger = + builtin "Natural/toInteger" + prettyPrimitiveExpression NaturalShow = + builtin "Natural/show" + prettyPrimitiveExpression NaturalSubtract = + builtin "Natural/subtract" + prettyPrimitiveExpression Integer = + builtin "Integer" + prettyPrimitiveExpression IntegerClamp = + builtin "Integer/clamp" + prettyPrimitiveExpression IntegerNegate = + builtin "Integer/negate" + prettyPrimitiveExpression IntegerShow = + builtin "Integer/show" + prettyPrimitiveExpression IntegerToDouble = + builtin "Integer/toDouble" + prettyPrimitiveExpression Double = + builtin "Double" + prettyPrimitiveExpression DoubleShow = + builtin "Double/show" + prettyPrimitiveExpression Text = + builtin "Text" + prettyPrimitiveExpression TextReplace = + builtin "Text/replace" + prettyPrimitiveExpression TextShow = + builtin "Text/show" + prettyPrimitiveExpression Date = + builtin "Date" + prettyPrimitiveExpression (DateLiteral day) = + literal + ( Pretty.pretty (Printf.printf "%04d" _HHHH :: String) + <> "-" + <> Pretty.pretty (Printf.printf "%02d" _MM :: String) + <> "-" + <> Pretty.pretty (Printf.printf "%02d" _DD :: String) + ) + where + (_HHHH, _MM, _DD) = Time.toGregorian day + prettyPrimitiveExpression DateShow = + builtin "Date/show" + prettyPrimitiveExpression Time = + builtin "Time" + prettyPrimitiveExpression (TimeLiteral (Time.TimeOfDay hh mm seconds) precision) = + literal + ( Pretty.pretty (Printf.printf "%02d" hh :: String) + <> ":" + <> Pretty.pretty (Printf.printf "%02d" mm :: String) + <> ":" + <> Pretty.pretty (Printf.printf "%02d" ss :: String) + <> suffix + ) + where + magnitude :: Integer + magnitude = 10 ^ precision + + (ss, fraction) = truncate (seconds * fromInteger magnitude) `divMod` magnitude + + suffix + | precision == 0 = "" + | otherwise = "." <> Pretty.pretty (Printf.printf "%0*d" precision fraction :: String) + prettyPrimitiveExpression TimeShow = + builtin "Time/show" + prettyPrimitiveExpression TimeZone = + builtin "TimeZone" + prettyPrimitiveExpression (TimeZoneLiteral (Time.TimeZone minutes _ _)) = + literal + ( sign + <> Pretty.pretty (Printf.printf "%02d" _HH :: String) + <> ":" + <> Pretty.pretty (Printf.printf "%02d" _MM :: String) + ) + where + sign = if 0 <= minutes then "+" else "-" + + (_HH, _MM) = abs minutes `divMod` 60 + prettyPrimitiveExpression TimeZoneShow = + builtin "TimeZone/show" + prettyPrimitiveExpression List = + builtin "List" + prettyPrimitiveExpression ListBuild = + builtin "List/build" + prettyPrimitiveExpression ListFold = + builtin "List/fold" + prettyPrimitiveExpression ListLength = + builtin "List/length" + prettyPrimitiveExpression ListHead = + builtin "List/head" + prettyPrimitiveExpression ListLast = + builtin "List/last" + prettyPrimitiveExpression ListIndexed = + builtin "List/indexed" + prettyPrimitiveExpression ListReverse = + builtin "List/reverse" + prettyPrimitiveExpression Optional = + builtin "Optional" + prettyPrimitiveExpression None = + builtin "None" + prettyPrimitiveExpression (BoolLit True) = + builtin "True" + prettyPrimitiveExpression (BoolLit False) = + builtin "False" + prettyPrimitiveExpression (IntegerLit a) + | 0 <= a = literal "+" <> prettyNumber a + | otherwise = prettyNumber a + prettyPrimitiveExpression (NaturalLit a) = + prettyNatural a + prettyPrimitiveExpression (DoubleLit (DhallDouble a)) = + prettyDouble a + prettyPrimitiveExpression (TextLit a) = + prettyChunks a + prettyPrimitiveExpression (BytesLit a) = + prettyBytes a + prettyPrimitiveExpression (Record a) = + prettyRecord a + prettyPrimitiveExpression (RecordLit a) = + prettyRecordLit a + prettyPrimitiveExpression (Union a) = + prettyUnion a + prettyPrimitiveExpression (ListLit Nothing b) = + list (map prettyExpression (Data.Foldable.toList b)) + prettyPrimitiveExpression a + | Just doc <- preserveSource a = + doc + | Note _ b <- a = + prettyPrimitiveExpression b + | otherwise = + Pretty.group (Pretty.flatAlt long short) + where + long = + Pretty.align + (lparen <> space <> prettyExpression a <> Pretty.hardline <> rparen) + + short = lparen <> prettyExpression a <> rparen + + prettyKeyValue + :: Pretty a + => (key -> Doc Ann) + -> (Expr Src a -> Doc Ann) + -> Doc Ann + -> KeyValue key Src a + -> (Doc Ann, Doc Ann) + prettyKeyValue prettyKey prettyValue separator (KeyValue key mSrc val) = + duplicate (Pretty.group (Pretty.flatAlt long short)) + where + completion _T r = + prettySelectorExpression _T + <> doubleColon + <> case shallowDenote r of + RecordLit kvs -> + prettyCompletionLit 2 kvs + _ -> + prettySelectorExpression r + + short = prettyKeys prettyKey key + <> " " + <> separator + <> " " + <> case renderSrcMaybe mSrc of + Nothing -> mempty + Just doc -> doc <> Pretty.hardline + <> prettyValue val + + long = Pretty.align + ( prettyKeys prettyKey key + <> preSeparator + ) + <> separator + <> case renderSrcMaybe mSrc of + Just doc -> + preComment + <> Pretty.align + ( doc + <> Pretty.hardline + <> prettyValue val + ) + Nothing -> + case shallowDenote val of + Some val' -> + " " + <> builtin "Some" + <> case shallowDenote val' of + RecordCompletion _T r -> + " " + <> completion _T r + + RecordLit _ -> + Pretty.hardline + <> " " + <> prettyImportExpression_ val' + + ListLit _ xs + | not (null xs) -> + Pretty.hardline + <> " " + <> prettyImportExpression_ val' + + _ -> Pretty.hardline + <> " " + <> prettyImportExpression_ val' + + ToMap val' Nothing -> + " " + <> keyword "toMap" + <> case shallowDenote val' of + RecordCompletion _T r -> + " " + <> completion _T r + _ -> Pretty.hardline + <> " " + <> prettyImportExpression_ val' + + ShowConstructor val' -> + " " + <> keyword "showConstructor" + <> case shallowDenote val' of + RecordCompletion _T r -> + " " + <> completion _T r + _ -> Pretty.hardline + <> " " + <> prettyImportExpression_ val' + + RecordCompletion _T r -> + " " <> completion _T r + + RecordLit _ -> + Pretty.hardline + <> " " + <> prettyValue val + + ListLit _ xs + | not (null xs) -> + Pretty.hardline + <> " " + <> prettyValue val + + _ -> + Pretty.group + ( Pretty.flatAlt (Pretty.hardline <> " ") " " + <> prettyValue val + ) + where + (preSeparator, preComment) = + case key of + (_, _, mSrc2) :| [] | not (containsComment mSrc2) -> + (" ", Pretty.hardline <> " ") + _ -> + (Pretty.hardline, " ") + + + prettyRecord :: Pretty a => Map Text (RecordField Src a) -> Doc Ann + prettyRecord = + ( braces + . map (prettyKeyValue prettyAnyLabelOrSome prettyExpression colon . adapt) + . Map.toList + ) + where + adapt (key, RecordField mSrc0 val mSrc1 mSrc2) = KeyValue (pure (mSrc0, key, mSrc1)) mSrc2 val + + prettyRecordLit :: Pretty a => Map Text (RecordField Src a) -> Doc Ann + prettyRecordLit m + | [ ("date" , field -> d@DateLiteral{}) + , ("time" , field -> t@TimeLiteral{}) + , ("timeZone", field -> z@TimeZoneLiteral{}) + ] <- List.sortOn fst (Map.toList m) = + literal + ( prettyPrimitiveExpression d + <> "T" + <> prettyPrimitiveExpression t + <> prettyPrimitiveExpression z + ) + | [ ("date" , field -> d@DateLiteral{}) + , ("time" , field -> t@TimeLiteral{}) + ] <- List.sortOn fst (Map.toList m) = + literal + ( prettyPrimitiveExpression d + <> "T" + <> prettyPrimitiveExpression t + ) + | [ ("time" , field -> t@TimeLiteral{}) + , ("timeZone", field -> z@TimeZoneLiteral{}) + ] <- List.sortOn fst (Map.toList m) = + literal + ( prettyPrimitiveExpression t + <> prettyPrimitiveExpression z + ) + where + field = Dhall.Syntax.shallowDenote . recordFieldValue + prettyRecordLit m = prettyRecordLike braces m + + prettyCompletionLit :: Pretty a => Int -> Map Text (RecordField Src a) -> Doc Ann + prettyCompletionLit = prettyRecordLike . hangingBraces + + prettyRecordLike + :: Pretty a + => ([(Doc Ann, Doc Ann)] -> Doc Ann) + -> Map Text (RecordField Src a) + -> Doc Ann + prettyRecordLike braceStyle a + | Data.Foldable.null a = + lbrace <> equals <> rbrace + | otherwise = + braceStyle (map prettyRecordEntry (consolidateRecordLiteral a)) + where + prettyRecordEntry kv@(KeyValue keys mSrc2 val) = + case keys of + (mSrc0, key, mSrc1) :| [] + | Var (V key' 0) <- Dhall.Syntax.shallowDenote val + , key == key' + , not (containsComment mSrc2) -> + duplicate (prettyKeys prettyAnyLabelOrSome [(mSrc0, key, mSrc1)]) + _ -> + prettyKeyValue prettyAnyLabelOrSome prettyExpression equals kv + + prettyAlternative (key, Just val) = + prettyKeyValue prettyAnyLabelOrSome prettyExpression colon (makeKeyValue (pure key) val) + prettyAlternative (key, Nothing) = + duplicate (prettyAnyLabelOrSome key) + + prettyUnion :: Pretty a => Map Text (Maybe (Expr Src a)) -> Doc Ann + prettyUnion = + angles . map prettyAlternative . Map.toList + + prettyBytes :: ByteString -> Doc Ann + prettyBytes bytes = + literal (Pretty.pretty ("0x\"" <> prettyBase16 bytes <> "\"")) + + prettyChunks :: Pretty a => Chunks Src a -> Doc Ann + prettyChunks chunks@(Chunks a b) + | anyText (== '\n') = + if not (null a) || anyText (/= '\n') + then long + else Pretty.group (Pretty.flatAlt long short) + | otherwise = + short + where + long = + Pretty.align + ( literal "''" <> Pretty.hardline + <> Pretty.align + (foldMap prettyMultilineChunk a' <> prettyMultilineText b') + <> literal "''" + ) + where + Chunks a' b' = multilineChunks chunks + + short = + literal "\"" <> foldMap prettyChunk a <> literal (prettyText b <> "\"") + + anyText predicate = any (\(text, _) -> Text.any predicate text) a || Text.any predicate b + + prettyMultilineChunk (c, d) = + prettyMultilineText c + <> dollar + <> lbrace + <> prettyExpression d + <> rbrace + + prettyMultilineText text = mconcat docs + where + lines_ = Text.splitOn "\n" text + + -- Annotate only non-empty lines so trailing whitespace can be + -- removed on empty ones. + prettyLine line = + (if Text.null line then id else literal) + (Pretty.pretty line) + + docs = List.intersperse Pretty.hardline (map prettyLine lines_) + + prettyChunk (c, d) = + prettyText c + <> syntax "${" + <> prettyExpression d + <> syntax rbrace + + prettyText t = literal (Pretty.pretty (escapeText_ t)) + + +-- | Prepare 'Chunks' for multi-line formatting by escaping problematic +-- character sequences via string interpolations +-- +-- >>> multilineChunks (Chunks [] "\n \tx") +-- Chunks [("\n",TextLit (Chunks [] " \t"))] "x" +-- >>> multilineChunks (Chunks [] "\n\NUL\b\f\t") +-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t" +multilineChunks :: Chunks s a -> Chunks s a +multilineChunks = + escapeSingleQuotedText + . escapeTrailingSingleQuote + . escapeControlCharacters + . escapeSingleQuoteBeforeInterpolation + . escapeSharedWhitespacePrefix + +-- | Escape any leading whitespace shared by all lines +-- +-- This ensures that significant shared leading whitespace is not stripped +-- +-- >>> escapeSharedWhitespacePrefix (Chunks [] "\n \tx") +-- Chunks [("\n",TextLit (Chunks [] " \t"))] "x" +-- >>> escapeSharedWhitespacePrefix (Chunks [("\n",Var (V "x" 0))] " ") +-- Chunks [("\n",Var (V "x" 0))] " " +-- >>> escapeSharedWhitespacePrefix (Chunks [("\n ",Var (V "x" 0))] "") +-- Chunks [("\n",TextLit (Chunks [] " ")),("",Var (V "x" 0))] "" +-- >>> escapeSharedWhitespacePrefix (Chunks [("\n ",Var (V "x" 0))] "\n") +-- Chunks [("\n ",Var (V "x" 0))] "\n" +-- >>> escapeSharedWhitespacePrefix (Chunks [] " ") +-- Chunks [("",TextLit (Chunks [] " "))] "" +escapeSharedWhitespacePrefix :: Chunks s a -> Chunks s a +escapeSharedWhitespacePrefix literal_ = unlinesLiteral literals₁ + where + literals₀ = linesLiteral literal_ + + sharedPrefix = longestSharedWhitespacePrefix literals₀ + + stripPrefix = Text.drop (Text.length sharedPrefix) + + escapeSharedPrefix (Chunks [] prefix₀) + | Text.isPrefixOf sharedPrefix prefix₀ = + Chunks [ ("", TextLit (Chunks [] sharedPrefix)) ] prefix₁ + where + prefix₁ = stripPrefix prefix₀ + escapeSharedPrefix (Chunks ((prefix₀, y) : xys) z) + | Text.isPrefixOf sharedPrefix prefix₀ = + Chunks (("", TextLit (Chunks [] sharedPrefix)) : (prefix₁, y) : xys) z + where + prefix₁ = stripPrefix prefix₀ + escapeSharedPrefix line = line + + literals₁ + | not (Text.null sharedPrefix) = fmap escapeSharedPrefix literals₀ + | otherwise = literals₀ + +-- | Escape control characters by moving them into string interpolations +-- +-- >>> escapeControlCharacters (Chunks [] "\n\NUL\b\f\t") +-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t" +escapeControlCharacters :: Chunks s a -> Chunks s a +escapeControlCharacters = splitWith (splitOnPredicate predicate) + where + predicate c = Data.Char.isControl c && c /= ' ' && c /= '\t' && c /= '\n' + +-- | Escape @'${@ correctly +-- +-- See: https://github.com/dhall-lang/dhall-haskell/issues/2078 +escapeSingleQuoteBeforeInterpolation :: Chunks s a -> Chunks s a +escapeSingleQuoteBeforeInterpolation = splitWith f + where + f text = + case Text.splitOn "'${" text of + -- `splitOn` should never return an empty list, but just in case… + [] -> mempty + t : ts -> loop t ts + + loop head_ tail_ = + case tail_ of + [] -> + Chunks [] head_ + newHead : newTail -> + Chunks [ (head_, TextLit (Chunks [] "'")) ] "${" + <> loop newHead newTail + +{-| You can think of this as sort of like `concatMap` for `Chunks` + + Given a function that splits plain text into interpolated chunks, apply + that function to each uninterpolated span to yield a new + possibly-interpolated span, and flatten the results. +-} +splitWith :: (Text -> Chunks s a) -> Chunks s a -> Chunks s a +splitWith splitter (Chunks xys z) = mconcat (xys' ++ [ splitter z ]) + where + xys' = do + (x, y) <- xys + + [ splitter x, Chunks [ ("", y) ] "" ] + +-- | Split `Data.Text.Text` into interpolated chunks, where all characters +-- matching the predicate are pushed into a string interpolation. +-- +-- >>> splitOnPredicate (== 'x') "" +-- Chunks [] "" +-- >>> splitOnPredicate (== 'x') " xx " +-- Chunks [(" ",TextLit (Chunks [] "xx"))] " " +-- >>> splitOnPredicate (== 'x') "xx" +-- Chunks [("",TextLit (Chunks [] "xx"))] "" +-- +-- prop> \(Fun _ p) s -> let {t = Text.pack s; Chunks xys z = splitOnPredicate p t} in foldMap (\(x, TextLit (Chunks [] y)) -> x <> y) xys <> z == t +splitOnPredicate :: (Char -> Bool) -> Text -> Chunks s a +splitOnPredicate predicate text + | Text.null b = + Chunks [] a + | otherwise = + Chunks ((a, TextLit (Chunks [] c)) : e) f + where + (a, b) = Text.break predicate text + + (c, d) = Text.span predicate b + + Chunks e f = splitOnPredicate predicate d + +-- | Escape a trailing single quote by moving it into a string interpolation +-- +-- Otherwise the multiline-string would end with @'''@, which would be parsed +-- as an escaped @''@. +-- +-- >>> escapeTrailingSingleQuote (Chunks [] "\n'") +-- Chunks [("\n",TextLit (Chunks [] "'"))] "" +escapeTrailingSingleQuote :: Chunks s a -> Chunks s a +escapeTrailingSingleQuote chunks@(Chunks as b) = + case Text.unsnoc b of + Just (b', '\'') -> Chunks (as ++ [(b', TextLit (Chunks [] "'"))]) "" + _ -> chunks + +-- | Pretty-print a value +pretty_ :: Pretty a => a -> Text +pretty_ = prettyToStrictText + +data KeyValue k s a = KeyValue + { _keyValueKeys :: NonEmpty (Maybe s, k , Maybe s) + , _keyValueSrc :: Maybe s + , _keyValueValue :: Expr s a + } + +makeKeyValue :: NonEmpty key -> Expr s a -> KeyValue key s a +makeKeyValue keys expr = KeyValue (adapt <$> keys) Nothing expr + where + adapt key = (Nothing, key, Nothing) + +{- This utility function converts + `{ x = { y = { z = 1 } } }` to `{ x.y.z = 1 }` +-} +consolidateRecordLiteral + :: Map Text (RecordField Src a) -> [KeyValue Text Src a] +consolidateRecordLiteral = concatMap adapt . Map.toList + where + adapt :: (Text, RecordField Src a) -> [KeyValue Text Src a] + adapt (key, RecordField mSrc0 val mSrc1 mSrc2) + | not (containsComment mSrc2) + , RecordLit m <- e + , [ KeyValue keys mSrc2' val' ] <- concatMap adapt (Map.toList m) = + [ KeyValue (NonEmpty.cons (mSrc0, key, mSrc1) keys) mSrc2' val' ] + + | Combine _ (Just _) l r <- e = + adapt (key, makeRecordField l) <> adapt (key, makeRecordField r) + | otherwise = + [ KeyValue (pure (mSrc0, key, mSrc1)) mSrc2 val ] + where + e = shallowDenote val + +-- | Escape a `Data.Text.Text` literal using Dhall's escaping rules for +-- single-quoted @Text@ +escapeSingleQuotedText :: Chunks s a -> Chunks s a +escapeSingleQuotedText = splitWith f + where + f inputText = Chunks [] outputText + where + outputText = + Text.replace "${" "''${" (Text.replace "''" "'''" inputText) + +{-| Escape a `Data.Text.Text` literal using Dhall's escaping rules + + Note that the result does not include surrounding quotes +-} +escapeText_ :: Text -> Text +escapeText_ text = Text.concatMap adapt text + where + adapt c + | '\x20' <= c && c <= '\x21' = Text.singleton c + -- '\x22' == '"' + | '\x23' == c = Text.singleton c + -- '\x24' == '$' + | '\x25' <= c && c <= '\x5B' = Text.singleton c + -- '\x5C' == '\\' + | '\x5D' <= c && c <= '\x10FFFF' = Text.singleton c + | c == '"' = "\\\"" + | c == '$' = "\\$" + | c == '\\' = "\\\\" + | c == '\b' = "\\b" + | c == '\f' = "\\f" + | c == '\n' = "\\n" + | c == '\r' = "\\r" + | c == '\t' = "\\t" + | otherwise = "\\u" <> showDigits (Data.Char.ord c) + + showDigits r0 = Text.pack (map showDigit [q1, q2, q3, r3]) + where + (q1, r1) = r0 `quotRem` 4096 + (q2, r2) = r1 `quotRem` 256 + (q3, r3) = r2 `quotRem` 16 + + showDigit n + | n < 10 = Data.Char.chr (Data.Char.ord '0' + n) + | otherwise = Data.Char.chr (Data.Char.ord 'A' + n - 10) + +prettyToString :: Pretty a => a -> String +prettyToString = + Pretty.renderString . layout . Pretty.pretty + +docToStrictText :: Doc ann -> Text.Text +docToStrictText = Pretty.renderStrict . layout + +prettyToStrictText :: Pretty a => a -> Text.Text +prettyToStrictText = docToStrictText . Pretty.pretty + +-- | Layout using 'layoutOpts' +-- +-- Tries hard to fit the document into 80 columns. +-- +-- This also removes trailing space characters (@' '@) /unless/ +-- they are enclosed in an annotation. +layout :: Pretty.Doc ann -> Pretty.SimpleDocStream ann +layout = Pretty.removeTrailingWhitespace . Pretty.layoutSmart layoutOpts + +-- | Default layout options +layoutOpts :: Pretty.LayoutOptions +layoutOpts = + Pretty.defaultLayoutOptions + { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } + +{-| Convert an expression representing a temporal value to `Data.Text.Text`, if + possible + + This is used by downstream integrations (e.g. `dhall-json` for treating + temporal values as strings +-} +temporalToText :: Pretty a => Expr s a -> Maybe Text +temporalToText e = case e of + RecordLit m + | [ ("date" , field -> DateLiteral{}) + , ("time" , field -> TimeLiteral{}) + , ("timeZone", field -> TimeZoneLiteral{}) + ] <- List.sortOn fst (Map.toList m) -> rendered + | [ ("date" , field -> DateLiteral{}) + , ("time" , field -> TimeLiteral{}) + ] <- List.sortOn fst (Map.toList m) -> rendered + | [ ("time" , field -> TimeLiteral{}) + , ("timeZone", field -> TimeZoneLiteral{}) + ] <- List.sortOn fst (Map.toList m) -> rendered + DateLiteral{} -> rendered + TimeLiteral{} -> rendered + TimeZoneLiteral{} -> rendered + _ -> Nothing + where + field = Dhall.Syntax.shallowDenote . recordFieldValue + + rendered = Just (prettyToStrictText e) + +prettyBase16 :: ByteString -> Text +prettyBase16 bytes = + case Encoding.decodeUtf8' (Base16.encode bytes) of + Left exception -> + Operations.internalError + ("prettyBase16: base16-encoded bytes could not be decoded as UTF-8 text: " <> Text.pack (Exception.displayException exception)) + Right text -> + Text.toUpper text + +{- $setup +>>> import Test.QuickCheck (Fun(..)) +-} diff --git a/src/Dhall/Pretty/Internal.hs-boot b/src/Dhall/Pretty/Internal.hs-boot --- a/src/Dhall/Pretty/Internal.hs-boot +++ b/src/Dhall/Pretty/Internal.hs-boot @@ -1,31 +1,35 @@ module Dhall.Pretty.Internal where -import Data.Scientific (Scientific) -import Data.Text.Buildable (Buildable) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Builder (Builder) -import Data.Text.Prettyprint.Doc (Pretty, Doc) -import Numeric.Natural (Natural) -import Prelude +import Control.DeepSeq (NFData) +import Data.Data (Data) +import Data.Text (Text) +import Dhall.Src (Src) +import Language.Haskell.TH.Syntax (Lift) +import Prettyprinter (Doc, Pretty) -import {-# SOURCE #-} Dhall.Core +import Dhall.Syntax.Const +import {-# SOURCE #-} Dhall.Syntax.Expr +import Dhall.Syntax.Var data Ann -buildConst :: Const -> Builder - -buildVar :: Var -> Builder - -buildExpr :: Buildable a => Expr s a -> Builder +data CharacterSet = ASCII | Unicode -prettyExpr :: Pretty a => Expr s a -> Doc Ann +instance Eq CharacterSet +instance Ord CharacterSet +instance Show CharacterSet +instance Data CharacterSet +instance Lift CharacterSet +instance NFData CharacterSet +instance Semigroup CharacterSet +instance Monoid CharacterSet -buildNatural :: Natural -> Builder +prettyVar :: Var -> Doc Ann -buildNumber :: Integer -> Builder +prettyConst :: Const -> Doc Ann -buildScientific :: Scientific -> Builder +prettyExpr :: Pretty a => Expr s a -> Doc Ann -pretty :: Pretty a => a -> Text +prettyEnvironmentVariable :: Text -> Doc ann -escapeText :: Builder -> Builder +prettyImportExpression :: Pretty a => Expr Src a -> Doc Ann diff --git a/src/Dhall/Repl.hs b/src/Dhall/Repl.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Repl.hs @@ -0,0 +1,680 @@ +-- | This module contains the implementation of the @dhall repl@ subcommand + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module Dhall.Repl + ( -- * Repl + repl + ) where + +import Control.Exception + ( SomeException (SomeException) + , displayException + , throwIO + ) +import Control.Monad (forM_) +#if !(MIN_VERSION_base(4,13,0)) +import Control.Monad.Fail (MonadFail) +#endif +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.State.Class (MonadState, get, modify) +import Control.Monad.State.Strict (evalStateT) +import Data.Char (isSpace) +import Data.List + ( dropWhileEnd + , groupBy + , isPrefixOf + , nub + ) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Context (Context) +import Dhall.Import (hashExpressionToCode) +import Dhall.Parser (Parser (..)) +import Dhall.Pretty (CharacterSet (..)) +import Dhall.Src (Src) +import System.Console.Haskeline (Interrupt (..)) +import System.Console.Haskeline.Completion (Completion, simpleCompletion) +import System.Directory (getDirectoryContents) +import System.Environment (getEnvironment) + +import qualified Control.Monad.Fail as Fail +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.HashSet +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall +import qualified Dhall.Context +import qualified Dhall.Core +import qualified Dhall.Core as Dhall + ( Expr + , Var (V) + , normalize + ) +import qualified Dhall.Core as Expr (Expr (..)) +import qualified Dhall.Import as Dhall +import qualified Dhall.Map as Map +import qualified Dhall.Parser as Dhall +import qualified Dhall.Parser.Expression as Parser.Expression +import qualified Dhall.Pretty +import qualified Dhall.Pretty.Internal +import qualified Dhall.Syntax as Syntax +import qualified Dhall.TypeCheck as Dhall +import qualified Dhall.Version as Meta +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Terminal as Pretty (renderIO) +import qualified System.Console.ANSI +import qualified System.Console.Haskeline.Completion as Haskeline +import qualified System.Console.Repline as Repline +import qualified System.IO +import qualified Text.Megaparsec as Megaparsec + +#if MIN_VERSION_haskeline(0,8,0) +import qualified Control.Monad.Catch +#else +import qualified System.Console.Haskeline.MonadException +#endif + +type Repl = Repline.HaskelineT (State.StateT Env IO) + +-- | Implementation of the @dhall repl@ subcommand +repl :: CharacterSet -> Bool -> IO () +repl characterSet explain = + if explain then Dhall.detailed io else io + where + io = + evalStateT + ( Repline.evalRepl + banner + ( dontCrash . eval ) + options + ( Just optionsPrefix ) + ( Just "paste" ) + completer + greeter + finaliser + ) + (emptyEnv { characterSet, explain }) + + banner = pure . \case + Repline.SingleLine -> turnstile <> " " + Repline.MultiLine -> "| " + + turnstile = + case characterSet of + Unicode -> "⊢" + ASCII -> "|-" + +data Env = Env + { envBindings :: Dhall.Context.Context Binding + , envIt :: Maybe Binding + , explain :: Bool + , characterSet :: CharacterSet + , outputHandle :: Maybe System.IO.Handle + } + + +emptyEnv :: Env +emptyEnv = + Env + { envBindings = Dhall.Context.empty + , envIt = Nothing + , explain = False + , characterSet = Unicode + , outputHandle = Just System.IO.stdout + } + + +data Binding = Binding + { bindingExpr :: Dhall.Expr Dhall.Src Void + , bindingType :: Dhall.Expr Dhall.Src Void + } + + +envToContext :: Env -> Dhall.Context.Context Binding +envToContext Env{ envBindings, envIt } = + case envIt of + Nothing -> + envBindings + + Just it -> + Dhall.Context.insert "it" it envBindings + + +parseAndLoad + :: MonadIO m => String -> m ( Dhall.Expr Dhall.Src Void) +parseAndLoad src = do + parsed <- + case Dhall.exprFromText "(input)" (Text.pack src <> "\n") of + Left e -> + liftIO ( throwIO e ) + + Right a -> + return a + + let status = Dhall.emptyStatus "." + + liftIO ( State.evalStateT (Dhall.loadWith parsed) status ) + + +eval :: ( MonadIO m, MonadState Env m ) => String -> m () +eval src = do + loaded <- + parseAndLoad src + + exprType <- + typeCheck loaded + + expr <- + normalize loaded + + modify ( \e -> e { envIt = Just ( Binding expr exprType ) } ) + + output expr + + + +typeOf :: ( MonadFail m, MonadIO m, MonadState Env m ) => String -> m () +typeOf src = do + loaded <- + parseAndLoad src + + exprType <- + typeCheck loaded + + output exprType + + +applyContext + :: Context Binding + -> Dhall.Expr Dhall.Src Void + -> Dhall.Expr Dhall.Src Void +applyContext context expression = + Dhall.Core.wrapInLets bindings expression + where + definitions = reverse $ Dhall.Context.toList context + + convertBinding (variable, Binding expr _) = + Dhall.Core.Binding Nothing variable Nothing Nothing Nothing expr + + bindings = fmap convertBinding definitions + +normalize + :: MonadState Env m + => Dhall.Expr Dhall.Src Void -> m ( Dhall.Expr t Void ) +normalize e = do + env <- get + + return (Dhall.normalize (applyContext (envToContext env) e)) + + +typeCheck + :: ( MonadIO m, MonadState Env m ) + => Dhall.Expr Dhall.Src Void -> m ( Dhall.Expr Dhall.Src Void ) +typeCheck expression = do + env <- get + + let wrap = if explain env then Dhall.detailed else id + + case Dhall.typeOf (applyContext (envToContext env) expression) of + Left e -> liftIO ( wrap (throwIO e) ) + Right a -> return a + +-- Split on the first '=' if there is any +parseAssignment :: String -> Either String (String, String) +parseAssignment str + | (var, '=' : expr) <- break (== '=') str + = Right (trim var, expr) + | otherwise + = Left (trim str) + +addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => String -> m () +addBinding string = do + let parseBinding = + Parser.Expression.letBinding + (Parser.Expression.parsers + (Megaparsec.try Parser.Expression.import_) + ) + + let input = "let " <> Text.pack string + + Syntax.Binding{ variable, annotation, value } <- case Megaparsec.parse (unParser parseBinding) "(input)" input of + Left _ -> Fail.fail ":let should be of the form `:let x [: T] = y`" + Right binding -> return binding + + (resolved, bindingType) <- case annotation of + Just (_, unresolvedType) -> do + let annotated = Syntax.Annot value unresolvedType + + resolved <- liftIO (Dhall.load annotated) + + _ <- typeCheck resolved + + bindingType <- liftIO (Dhall.load unresolvedType) + + return (resolved, bindingType) + _ -> do + resolved <- liftIO (Dhall.load value) + + bindingType <- typeCheck resolved + + return (resolved, bindingType) + + bindingExpr <- normalize resolved + + modify + ( \e -> + e { envBindings = + Dhall.Context.insert + variable + Binding{ bindingType, bindingExpr } + ( envBindings e ) + } + ) + + output (Expr.Annot (Expr.Var (Dhall.V variable 0)) bindingType) + +clearBindings :: (MonadFail m, MonadState Env m) => String -> m () +clearBindings _ = modify adapt + where + adapt (Env {..}) = Env { envBindings = Dhall.Context.empty, ..} + +hashBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => String -> m () +hashBinding src = do + loadedExpression <- parseAndLoad src + + _ <- typeCheck loadedExpression + + normalizedExpression <- normalize loadedExpression + + writeOutputHandle + (hashExpressionToCode (Dhall.Core.alphaNormalize normalizedExpression)) + +saveFilePrefix :: FilePath +saveFilePrefix = ".dhall-repl" + +-- | Find the index for the current _active_ dhall save file +currentSaveFileIndex :: MonadIO m => m (Maybe Int) +currentSaveFileIndex = do + files <- liftIO $ getDirectoryContents "." + + let parseIndex file + | saveFilePrefix `isPrefixOf` file + , '-':index <- drop (length saveFilePrefix) file + , [(x, "")] <- reads index -- safe version of read + = Just x + + | otherwise + = Nothing + + pure $ case mapMaybe parseIndex files of + [] -> Nothing + xs -> Just $ maximum xs + +-- | Find the name for the current _active_ dhall save file +currentSaveFile :: MonadIO m => m (Maybe FilePath) +currentSaveFile = + (fmap . fmap) (\i -> saveFilePrefix <> "-" <> show i) currentSaveFileIndex + +-- | Find the name for the next dhall save file +nextSaveFile :: MonadIO m => m FilePath +nextSaveFile = do + mIndex <- currentSaveFileIndex + + let nextIndex = maybe 0 succ mIndex + + pure $ saveFilePrefix <> "-" <> show nextIndex + +loadBinding :: String -> Repl () +loadBinding "" = do + mFile <- currentSaveFile + + case mFile of + Just file -> loadBinding file + Nothing -> + Fail.fail $ ":load couldn't find any `" <> saveFilePrefix <> "-*` files" + +loadBinding file = do + -- Read commands from the save file + -- Some commands can span multiple lines, only the first line will start with + -- the optionsPrefix + loadedLines <- lines <$> liftIO (readFile file) + + let -- Group lines that belong to the same command + commands = flip groupBy loadedLines $ \_prev next -> + not $ [optionsPrefix] `isPrefixOf` next + + runCommand line@(words -> (c:cmd):_) + | c == optionsPrefix + = case lookup cmd options of + Just action -> action (drop (1 + length cmd + 1) line) + Nothing -> Fail.fail $ + ":load unexpected command `" <> cmd <> "` in file `" <> file <> "`" + runCommand _ = Fail.fail $ + ":load expects `" <> file <> "` to contain a command" + + -- Keep current handle in scope + Env { outputHandle } <- get + + -- Discard output + modify (\e -> e { outputHandle = Nothing }) + + -- Run all the commands + forM_ commands (runCommand . unlines) + + -- Restore the previous handle + modify (\e -> e { outputHandle = outputHandle }) + + writeOutputHandle $ "Loaded `" <> Text.pack file <> "`\n" + +saveBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => Either String (String, String) -> m () +-- Save all the bindings into a context save file +saveBinding (Left "") = do + file <- nextSaveFile + + saveBinding (Left file) + +-- Save all the bindings into `file` +saveBinding (Left file) = do + env <- get + + let bindings + = reverse + . (fmap . fmap) bindingExpr + . Dhall.Context.toList + $ envBindings env + + handler handle = + State.evalStateT + (forM_ bindings $ \(name, expr) -> do + let doc = Dhall.Pretty.Internal.prettyLabel name + + let label = Dhall.Pretty.Internal.docToStrictText doc + + liftIO (System.IO.hPutStr handle $ ":let " <> Text.unpack label <> " = ") + outputWithoutSpacing expr) + (env { outputHandle = Just handle }) + + liftIO (System.IO.withFile file System.IO.WriteMode handler) + + writeOutputHandle $ "Context saved to `" <> Text.pack file <> "`\n" + +-- Save a single expression to `file` +saveBinding (Right (file, src)) = do + loadedExpression <- parseAndLoad src + + _ <- typeCheck loadedExpression + + normalizedExpression <- normalize loadedExpression + + env <- get + + let handler handle = + State.evalStateT + (output normalizedExpression) + (env { outputHandle = Just handle }) + + liftIO (System.IO.withFile file System.IO.WriteMode handler) + + writeOutputHandle $ "Expression saved to `" <> Text.pack file <> "`\n" + +setOption :: ( MonadIO m, MonadState Env m ) => String -> m () +setOption "--explain" = + modify (\e -> e { explain = True }) +setOption _ = + writeOutputHandle ":set should be of the form `:set `" + +unsetOption :: ( MonadIO m, MonadState Env m ) => String -> m () +unsetOption "--explain" = + modify (\e -> e { explain = False }) +unsetOption _ = + writeOutputHandle ":unset should be of the form `:unset `" + +quitMessage :: String +quitMessage = "Goodbye." + +cmdQuit :: ( MonadIO m, MonadState Env m ) => String -> m () +cmdQuit _ = do + liftIO (putStrLn quitMessage) + liftIO (throwIO Interrupt) + +help + :: ( MonadFail m, MonadIO m, MonadState Env m ) + => HelpOptions m -> String -> m () +help hs _ = do + liftIO (putStrLn "Type any expression to normalize it or use one of the following commands:") + forM_ hs $ \h -> do + let name = helpOptionName h + syntax = helpOptionSyntax h + doc = helpOptionDoc h + liftIO (putStrLn (":" <> name <> " " <> syntax)) + liftIO (putStrLn (" " <> doc)) + +optionsPrefix :: Char +optionsPrefix = ':' + +trim :: String -> String +trim = dropWhile isSpace . dropWhileEnd isSpace + +data HelpOption m = HelpOption + { helpOptionName :: String + , helpOptionSyntax :: String + , helpOptionDoc :: String + , helpOptionFunction :: Repline.Cmd m + } + +type HelpOptions m = [HelpOption m] + +helpOptions :: HelpOptions Repl +helpOptions = + [ HelpOption + "help" + "" + "Print help text and describe options" + (dontCrash . help helpOptions) + , HelpOption + "paste" + "" + "Start a multi-line input. Submit with " + (error "Dhall.Repl.helpOptions: Unreachable") + , HelpOption + "type" + "EXPRESSION" + "Infer the type of an expression" + (dontCrash . typeOf) + , HelpOption + "hash" + "EXPRESSION" + "Hash the normalized value of an expression" + (dontCrash . hashBinding) + , HelpOption + "let" + "IDENTIFIER = EXPRESSION" + "Assign an expression to a variable" + (dontCrash . addBinding) + , HelpOption + "clear" + "" + "Clear all bound variables" + (dontCrash . clearBindings) + , HelpOption + "load" + "[FILENAME]" + "Load bound variables from a file" + (dontCrash . loadBinding . trim) + , HelpOption + "save" + "[FILENAME | FILENAME = EXPRESSION]" + "Save bound variables or a given expression to a file" + (dontCrash . saveBinding . parseAssignment) + , HelpOption + "set" + "OPTION" + "Set an option. Currently supported: --explain" + (dontCrash . setOption . trim) + , HelpOption + "unset" + "OPTION" + "Unset an option" + (dontCrash . unsetOption . trim) + , HelpOption + "quit" + "" + "Exit the REPL" + cmdQuit + ] + +options :: Repline.Options Repl +options = (\h -> (helpOptionName h, helpOptionFunction h)) <$> helpOptions + +completer + :: (Monad m, MonadFail m, MonadIO m, MonadState Env m) + => Repline.CompleterStyle m +completer = + Repline.Prefix + (Haskeline.completeWordWithPrev (Just '\\') separators completeFunc) + [] + where + -- Separators that can be found on the left of something we want to + -- autocomplete + separators :: String + separators = " \t[(,=+*&|}#?>:" + +completeFunc + :: (Monad m, MonadFail m, MonadIO m, MonadState Env m) + => String -> String -> m [Completion] +completeFunc reversedPrev word + + -- Complete commands + | reversedPrev == ":" + = pure . listCompletion $ fst <$> (options :: Repline.Options Repl) + + -- Complete load command + | reversedPrev == reverse ":load " + = Haskeline.listFiles word + + -- Complete file paths + | any (`isPrefixOf` word) [ "/", "./", "../", "~/" ] + = Haskeline.listFiles word + + -- Complete environment variables + | reverse "env:" `isPrefixOf` reversedPrev + = listCompletion . fmap fst <$> liftIO getEnvironment + + -- Complete record fields and union alternatives + | var : subFields <- Text.split (== '.') (Text.pack word) + , not $ null subFields + = do + Env { envBindings } <- get + + case Dhall.Context.lookup var 0 envBindings of + + Nothing -> pure [] + + Just binding -> do + let candidates = algebraicComplete subFields (bindingExpr binding) + pure $ listCompletion (Text.unpack . (var <>) <$> candidates) + + -- Complete variables in scope and all reserved identifiers + | otherwise + = do + Env { envBindings } <- get + + let vars = map fst $ Dhall.Context.toList envBindings + reserved = Data.HashSet.toList Dhall.Core.reservedIdentifiers + + pure . listCompletion . map Text.unpack . nub $ vars ++ reserved + + where + listCompletion = map simpleCompletion . filter (word `isPrefixOf`) + + algebraicComplete + :: [Text.Text] -> Dhall.Expr Dhall.Src Void -> [Text.Text] + algebraicComplete subFields expr = + let keys = fmap ("." <>) . Map.keys + + withMap m = + case subFields of + [] -> keys m + -- Stop on last subField (we care about the keys at this level) + [_] -> keys m + f:fs -> + case Map.lookup f m of + Nothing -> + [] + Just Nothing -> + keys m + Just (Just e) -> + fmap (("." <> f) <>) (algebraicComplete fs e) + + in case expr of + Dhall.Core.RecordLit m -> withMap (fmap (Just . Dhall.Core.recordFieldValue) m) + Dhall.Core.Union m -> withMap m + _ -> [] + + +greeter :: MonadIO m => m () +greeter = + let version = Meta.dhallVersionString + message = "Welcome to the Dhall v" <> version <> " REPL! Type :help for more information." + in liftIO (putStrLn message) + +finaliser :: MonadIO m => m Repline.ExitDecision +finaliser = do + liftIO (putStrLn quitMessage) + pure Repline.Exit + +dontCrash :: Repl () -> Repl () +dontCrash m = +#if MIN_VERSION_haskeline(0,8,0) + Control.Monad.Catch.catch +#else + System.Console.Haskeline.MonadException.catch +#endif + m + ( \ e@SomeException{} -> liftIO ( putStrLn ( displayException e ) ) ) + +writeOutputHandle :: (MonadIO m, MonadState Env m) => Text -> m () +writeOutputHandle txt = do + Env { outputHandle } <- get + + case outputHandle of + Just handle -> liftIO $ Text.IO.hPutStrLn handle txt + Nothing -> pure () + +output + :: (Pretty.Pretty a, MonadState Env m, MonadIO m) + => Dhall.Expr Src a -> m () +output expr = do + writeOutputHandle "" -- Visual spacing + + outputWithoutSpacing expr + + writeOutputHandle "" -- Visual spacing + +outputWithoutSpacing + :: (Pretty.Pretty a, MonadState Env m, MonadIO m) + => Dhall.Expr Src a -> m () +outputWithoutSpacing expr = do + Env { characterSet, outputHandle } <- get + + case outputHandle of + Nothing -> pure () + Just handle -> do + let stream = Dhall.Pretty.layout (Dhall.Pretty.prettyCharacterSet characterSet expr) + + supportsANSI <- liftIO (System.Console.ANSI.hSupportsANSI handle) + let ansiStream = + if supportsANSI + then fmap Dhall.Pretty.annToAnsiStyle stream + else Pretty.unAnnotateS stream + + liftIO (Pretty.renderIO handle ansiStream) + liftIO (System.IO.hPutStrLn handle "") -- Pretty printing doesn't end with a new line diff --git a/src/Dhall/Schemas.hs b/src/Dhall/Schemas.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Schemas.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-| This module contains the implementation of the @dhall rewrite-with-schemas@ + subcommand +-} + +module Dhall.Schemas + ( -- | Schemas + schemasCommand + , Schemas(..) + , rewriteWithSchemas + , SchemasError(..) + ) where + +import Control.Applicative (empty) +import Control.Exception (Exception) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Crypto (SHA256Digest) +import Dhall.Map (Map) +import Dhall.Pretty (CharacterSet (..), detectCharacterSet) +import Dhall.Src (Src) +import Dhall.Syntax (Expr (..), Import, Var (..)) +import Dhall.Util + ( Censor (..) + , Header (..) + , Input (..) + , MultipleCheckFailed (..) + , OutputMode (..) + ) + +import qualified Control.Exception as Exception +import qualified Data.Map +import qualified Data.Maybe as Maybe +import qualified Data.Text.IO as Text.IO +import qualified Data.Void as Void +import qualified Dhall.Core as Core +import qualified Dhall.Import as Import +import qualified Dhall.Map as Map +import qualified Dhall.Normalize as Normalize +import qualified Dhall.Parser as Parser +import qualified Dhall.Pretty +import qualified Dhall.Substitution as Substitution +import qualified Dhall.Syntax as Syntax +import qualified Dhall.TypeCheck as TypeCheck +import qualified Dhall.Util as Util +import qualified Lens.Micro as Lens +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Terminal as Pretty.Terminal +import qualified Prettyprinter.Render.Text as Pretty.Text +import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite +import qualified System.Console.ANSI as ANSI +import qualified System.IO as IO + +-- | Arguments to the @rewrite-with-schemas@ subcommand +data Schemas = Schemas + { chosenCharacterSet :: Maybe CharacterSet + , censor :: Censor + , input :: Input + , outputMode :: OutputMode + , schemas :: Text + } + +-- | Implementation of the @dhall rewrite-with-schemas@ subcommand +schemasCommand :: Schemas -> IO () +schemasCommand Schemas{..} = do + (inputName, originalText) <- case input of + InputFile file -> (,) file <$> Text.IO.readFile file + StandardInput -> (,) "(input)" <$> Text.IO.getContents + + (Header header, expression) <- Util.getExpressionAndHeaderFromStdinText censor inputName originalText + + let characterSet = fromMaybe (detectCharacterSet expression) chosenCharacterSet + + schemasRecord <- Core.throws (Parser.exprFromText "(schemas)" schemas) + + schemasExpression <- rewriteWithSchemas schemasRecord expression + + let docStream = + Dhall.Pretty.layout + ( Pretty.pretty header + <> Dhall.Pretty.prettyCharacterSet characterSet schemasExpression + <> "\n" + ) + + let schemasText = Pretty.Text.renderStrict docStream + + case outputMode of + Write -> + case input of + InputFile file -> + if originalText == schemasText + then return () + else AtomicWrite.atomicWriteFile + file + (Pretty.Text.renderLazy docStream) + StandardInput -> do + supportsANSI <- ANSI.hSupportsANSI IO.stdout + + Pretty.Terminal.renderIO + IO.stdout + (if supportsANSI + then fmap Dhall.Pretty.annToAnsiStyle docStream + else Pretty.unAnnotateS docStream) + + Check -> + if originalText == schemasText + then return () + else do + let command = "rewrite-with-schemas" + + let modified = "rewritten" + + let inputs = pure input + + Exception.throwIO MultipleCheckFailed{..} + +decodeSchema :: Expr s Void -> Maybe (Expr s Void, Map Text (Expr s Void)) +decodeSchema (RecordLit m) + | Just _Type <- Core.recordFieldValue <$> Map.lookup "Type" m + , Just (RecordLit _default) <- Core.recordFieldValue <$> Map.lookup "default" m = + Just (_Type, Core.recordFieldValue <$> _default) +decodeSchema _ = + Nothing + +decodeSchemas + :: Expr s Void + -> Maybe (Data.Map.Map SHA256Digest (Text, Map Text (Expr s Void))) +decodeSchemas (RecordLit keyValues) = do + m <- traverse (decodeSchema . Core.recordFieldValue) keyValues + + let typeMetadata = Data.Map.fromList $ do + (name, (_Type, _default)) <- Map.toList m + + return (Import.hashExpression (Syntax.denote _Type), (name, _default)) + + return typeMetadata +decodeSchemas _ = + empty + +-- | Simplify a Dhall expression using a record of schemas +rewriteWithSchemas + :: Expr Src Import + -- ^ Record of schemas + -> Expr Src Import + -- ^ Expression to simplify using the supplied schemas + -> IO (Expr Src Import) +rewriteWithSchemas _schemas expression = do + resolvedSchemas <- Import.load _schemas + resolvedExpression <- Import.load expression + + _ <- Core.throws (TypeCheck.typeOf resolvedSchemas) + _ <- Core.throws (TypeCheck.typeOf resolvedExpression) + + let normalizedSchemas = Normalize.normalize resolvedSchemas + let normalizedExpression = Normalize.normalize resolvedExpression + + typeMetadata <- case decodeSchemas normalizedSchemas of + Just typeMetadata -> return typeMetadata + Nothing -> Exception.throwIO NotASchemaRecord + + let schemasRewrite subExpression@(RecordLit keyValues) = + Maybe.fromMaybe subExpression $ do + let substitutions = Map.singleton "schemas" normalizedSchemas + + let substitutedExpression = + Substitution.substitute subExpression substitutions + + hash <- case TypeCheck.typeOf substitutedExpression of + Left _ -> + empty + Right subExpressionType -> + return (Import.hashExpression (Syntax.denote subExpressionType)) + + (name, _default) <- Data.Map.lookup hash typeMetadata + + let diff a b | a == b = Nothing + | otherwise = Just a + + let defaultedKeyValues = + Core.makeRecordField <$> + Map.fromMap ( + Data.Map.differenceWith diff + (Map.toMap $ Core.recordFieldValue <$> keyValues) + (Map.toMap _default)) + + let defaultedRecord = RecordLit defaultedKeyValues + + return (RecordCompletion (Field "schemas" $ Core.makeFieldSelection name) defaultedRecord) + schemasRewrite subExpression = + subExpression + + let rewrittenExpression :: Expr Src Import + rewrittenExpression = + fmap Void.absurd (Lens.transformOf Syntax.subExpressions schemasRewrite normalizedExpression) + + if Normalize.freeIn (V "schemas" 0) rewrittenExpression + then return (Let (Syntax.makeBinding "schemas" _schemas) rewrittenExpression) + else return expression + +-- | Errors that can be thrown by `rewriteWithSchemas` +data SchemasError = NotASchemaRecord + deriving (Exception) + +instance Show SchemasError where + show NotASchemaRecord = + Util._ERROR <> ": The --schemas argument is not a record of schemas" diff --git a/src/Dhall/Set.hs b/src/Dhall/Set.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Set.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} + +-- | This module only exports ways of constructing a Set, +-- retrieving List, Set, and Seq representations of the same data, +-- as well as a novel "difference" function. +-- Any other Set-like or List-like functionality +-- should be obtained through toSet and toList, respectively. +module Dhall.Set ( + Set(..) + , toList + , toAscList + , toSet + , toSeq + , fromList + , fromSet + , append + , empty + , difference + , sort + , isSorted + , null + , size + ) where + +import Control.DeepSeq (NFData) +import Data.Data (Data) +import Data.List (foldl') +import Data.Sequence (Seq, (|>)) +import GHC.Generics (Generic) +import Instances.TH.Lift () +import Language.Haskell.TH.Syntax (Lift) +import Prelude hiding (null) + +import qualified Data.Foldable +import qualified Data.Sequence +import qualified Data.Set + +{-| This is a variation on @"Data.Set".`Data.Set.Set`@ that remembers the + original order of elements. This ensures that ordering is not lost when + formatting Dhall code +-} +data Set a = Set (Data.Set.Set a) (Seq a) + deriving (Generic, Show, Data, NFData, Lift) +-- Invariant: In @Set set seq@, @toAscList set == sort (toList seq)@. + +instance Eq a => Eq (Set a) where + (Set _ x) == (Set _ y) = x == y + {-# INLINABLE (==) #-} + +instance Ord a => Ord (Set a) where + compare (Set _ x) (Set _ y) = compare x y + {-# INLINABLE compare #-} + +instance Foldable Set where + foldMap f (Set _ x) = foldMap f x + {-# INLINABLE foldMap #-} + + toList = Dhall.Set.toList + {-# INLINABLE toList #-} + + null = Dhall.Set.null + {-# INLINABLE null #-} + + length = Dhall.Set.size + {-# INLINABLE length #-} + +-- | Convert to an unordered @"Data.Set".`Data.Set.Set`@ +toSet :: Set a -> Data.Set.Set a +toSet (Set s _) = s + +-- | Convert to an ordered `Seq` +toSeq :: Set a -> Seq a +toSeq (Set _ xs) = xs + +{-| Convert a `Dhall.Set.Set` to a list, preserving the original order of the + elements +-} +toList :: Set a -> [a] +toList (Set _ xs) = Data.Foldable.toList xs + +-- | Convert a `Dhall.Set.Set` to a list of ascending elements +toAscList :: Set a -> [a] +toAscList (Set s _) = Data.Set.toAscList s + +-- | Convert a list to a `Dhall.Set.Set`, remembering the element order +fromList :: Ord a => [a] -> Set a +fromList = foldl' (flip append) empty +-- O(n log n) time complexity, O(n) space complexity. +-- Implementing it this way is a little silly, but is faster than (nub xs). +-- n.b. toList . fromList = id, only if the list elements are unique + +-- | Convert a @"Data.Set".`Data.Set.Set`@ to a sorted `Dhall.Set.Set` +fromSet :: Data.Set.Set a -> Set a +fromSet s = Set s (Data.Sequence.fromList (Data.Set.elems s)) + +-- | Append an element to the end of a `Dhall.Set.Set` +append :: Ord a => a -> Set a -> Set a +append x os@(Set s xs) + | Data.Set.member x s = os + | otherwise = Set (Data.Set.insert x s) (xs |> x) +-- O(log n) time complexity. + +-- | The empty `Dhall.Set.Set` +empty :: Set a +empty = Set Data.Set.empty Data.Sequence.empty + +-- | Returns, in order, all elements of the first Set not present in the second. +-- (It doesn't matter in what order the elements appear in the second Set.) +difference :: Ord a => Set a -> Set a -> [a] +difference os (Set s _) = + filter (\ x -> not (Data.Set.member x s)) (toList os) + +{-| Sort the set elements, forgetting their original ordering. + +>>> sort (fromList [2, 1]) == fromList [1, 2] +True +-} +sort :: Ord a => Set a -> Set a +sort (Set s _) = Set s (Data.Sequence.fromList (Data.Set.toList s)) + +{-| +>>> isSorted (fromList [2, 1]) +False +>>> isSorted (fromList [1, 2]) +True +-} +isSorted :: Ord a => Set a -> Bool +isSorted s = toList s == Data.Set.toList (toSet s) + +{-| +>>> null (fromList [1]) +False +>>> null (fromList []) +True +-} +null :: Set a -> Bool +null (Set s _) = Data.Set.null s + +{-| +>>> size (fromList [1]) +1 +-} +size :: Set a -> Int +size (Set s _) = Data.Set.size s diff --git a/src/Dhall/Src.hs b/src/Dhall/Src.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Src.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | This module provides the `Src` type used for source spans in error messages + +module Dhall.Src + ( -- * Type + Src(..) + ) where + +import Control.DeepSeq (NFData) +import Data.Data (Data) +import Data.Text (Text) +import GHC.Generics (Generic) +import Instances.TH.Lift () +import Language.Haskell.TH.Syntax (Lift (..)) +import Prettyprinter (Pretty (..)) +import Text.Megaparsec (SourcePos (SourcePos), mkPos, unPos) + +import {-# SOURCE #-} qualified Dhall.Util + +import qualified Data.Text as Text +import qualified Text.Megaparsec as Megaparsec +import qualified Text.Printf as Printf + +-- | Source code extract +data Src = Src + { srcStart :: !SourcePos + , srcEnd :: !SourcePos + , srcText :: Text -- Text field is intentionally lazy + } deriving (Data, Eq, Generic, Ord, Show, NFData) + + +instance Lift Src where +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped (Src (SourcePos a b c) (SourcePos d e f) g) = + [|| Src (SourcePos a (mkPos b') (mkPos c')) (SourcePos d (mkPos e') (mkPos f')) g ||] +#else + lift (Src (SourcePos a b c) (SourcePos d e f) g) = + [| Src (SourcePos a (mkPos b') (mkPos c')) (SourcePos d (mkPos e') (mkPos f')) g |] +#endif + where + b' = unPos b + c' = unPos c + e' = unPos e + f' = unPos f + + +instance Pretty Src where + pretty (Src begin _ text) = + pretty (Dhall.Util.snip numberedLines) + <> "\n" + <> pretty (Megaparsec.sourcePosPretty begin) + where + prefix = Text.replicate (n - 1) " " + where + n = Megaparsec.unPos (Megaparsec.sourceColumn begin) + + ls = Text.lines (prefix <> text) + + numberOfLines = length ls + + minimumNumber = + Megaparsec.unPos (Megaparsec.sourceLine begin) + + maximumNumber = minimumNumber + numberOfLines - 1 + + numberWidth :: Int + numberWidth = + truncate (logBase (10 :: Double) (fromIntegral maximumNumber)) + 1 + + adapt n line = Text.pack outputString + where + inputString = Text.unpack line + + outputString = + Printf.printf ("%" <> show numberWidth <> "d│ %s") n inputString + + numberedLines = Text.unlines (zipWith adapt [minimumNumber..] ls) diff --git a/src/Dhall/Substitution.hs b/src/Dhall/Substitution.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Substitution.hs @@ -0,0 +1,34 @@ +{- | This module provides types and functions used in the substitution step + which is done before type checking and normalization. +-} + +module Dhall.Substitution where + +import Data.Text (Text) +import Dhall.Normalize (subst) +import Dhall.Syntax (Expr, Var (..)) + +import qualified Dhall.Map + +{- | Substitutions map variables to arbitrary Dhall expressions. + Note that we use "Dhall.Map.Map" as an underlying structure. Hence we respect insertion order. +-} +type Substitutions s a = Dhall.Map.Map Text (Expr s a) + +{- | An empty substitution map. +-} +empty :: Substitutions s a +empty = Dhall.Map.empty + +-- | @substitute expr s@ replaces all variables in @expr@ (or its subexpression) with their substitute. +-- For example, if the substitution map maps the variable @Foo@ to the text \"Foo\" all occurrences of @Foo@ with the text \"Foo\". +-- +-- The substitutions will be done in the order they are inserted into the substitution map: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > substitute (Dhall.Core.Var "Foo") (Dhall.Map.fromList [("Foo", Dhall.Core.Var "Bar"), ("Bar", Dhall.Core.Var "Baz")]) +-- +-- results in @Dhall.Core.Var \"Baz\"@ since we first substitute \"Foo\" with \"Bar\" and then the resulting \"Bar\" with the final \"Baz\". +substitute :: Expr s a -> Substitutions s a -> Expr s a +substitute expr = foldl (\memo (k, v) -> subst (V k 0) v memo) expr . Dhall.Map.toList diff --git a/src/Dhall/Syntax.hs b/src/Dhall/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax.hs @@ -0,0 +1,31 @@ +module Dhall.Syntax + ( module Export + ) where + +import {-# SOURCE #-} Dhall.Pretty.Internal as Export + ( CharacterSet (..) + ) +import Dhall.Syntax.Binding as Export +import Dhall.Syntax.Chunks as Export +import Dhall.Syntax.Const as Export +import Dhall.Syntax.Expr as Export +import Dhall.Syntax.FunctionBinding as Export +import Dhall.Syntax.Import as Export +import Dhall.Syntax.Instances.Applicative as Export () +import Dhall.Syntax.Instances.Bifunctor as Export () +import Dhall.Syntax.Instances.Data as Export () +import Dhall.Syntax.Instances.Eq as Export () +import Dhall.Syntax.Instances.Foldable as Export () +import Dhall.Syntax.Instances.Functor as Export () +import Dhall.Syntax.Instances.Lift as Export () +import Dhall.Syntax.Instances.Monad as Export () +import Dhall.Syntax.Instances.NFData as Export () +import Dhall.Syntax.Instances.Ord as Export () +import Dhall.Syntax.Instances.Pretty as Export +import Dhall.Syntax.Instances.Show as Export () +import Dhall.Syntax.Instances.Traversable as Export () +import Dhall.Syntax.MultiLet as Export +import Dhall.Syntax.Operations as Export +import Dhall.Syntax.RecordField as Export +import Dhall.Syntax.Types as Export +import Dhall.Syntax.Var as Export diff --git a/src/Dhall/Syntax/Binding.hs b/src/Dhall/Syntax/Binding.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Binding.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.Binding + ( Binding(..) + , makeBinding + + -- * Optics + , bindingExprs + ) where + +import Data.Text (Text) +import {-# SOURCE #-} Dhall.Syntax.Expr (Expr) +import GHC.Generics (Generic) + +-- | Record the binding part of a @let@ expression. +-- +-- For example, +-- +-- > let {- A -} x {- B -} : {- C -} Bool = {- D -} True in x +-- +-- … will be instantiated as follows: +-- +-- * @bindingSrc0@ corresponds to the @A@ comment. +-- * @variable@ is @"x"@ +-- * @bindingSrc1@ corresponds to the @B@ comment. +-- * @annotation@ is 'Just' a pair, corresponding to the @C@ comment and @Bool@. +-- * @bindingSrc2@ corresponds to the @D@ comment. +-- * @value@ corresponds to @True@. +data Binding s a = Binding + { bindingSrc0 :: Maybe s + , variable :: Text + , bindingSrc1 :: Maybe s + , annotation :: Maybe (Maybe s, Expr s a) + , bindingSrc2 :: Maybe s + , value :: Expr s a + } deriving Generic + +{-| Construct a 'Binding' with no source information and no type annotation. +-} +makeBinding :: Text -> Expr s a -> Binding s a +makeBinding name = Binding Nothing name Nothing Nothing Nothing + +{-| Traverse over the immediate 'Expr' children in a 'Binding'. +-} +bindingExprs + :: (Applicative f) + => (Expr s a -> f (Expr s b)) + -> Binding s a -> f (Binding s b) +bindingExprs f (Binding s0 n s1 t s2 v) = + Binding + <$> pure s0 + <*> pure n + <*> pure s1 + <*> traverse (traverse f) t + <*> pure s2 + <*> f v +{-# INLINABLE bindingExprs #-} diff --git a/src/Dhall/Syntax/Chunks.hs b/src/Dhall/Syntax/Chunks.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Chunks.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Syntax.Chunks + ( Chunks(..) + + -- * Optics + , chunkExprs + + -- * `Data.Text.Text` manipulation + , toDoubleQuoted + , longestSharedWhitespacePrefix + , linesLiteral + , unlinesLiteral + ) where + +import Data.List.NonEmpty (NonEmpty (..)) +import Data.String (IsString (..)) +import Data.Text (Text) +import Dhall.Src (Src) +import {-# SOURCE #-} Dhall.Syntax.Expr (Expr) +import GHC.Generics (Generic) + +import qualified Data.Foldable +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Text + +-- | The body of an interpolated @Text@ literal +data Chunks s a = Chunks [(Text, Expr s a)] Text + deriving Generic + +instance IsString (Chunks s a) where + fromString str = Chunks [] (fromString str) + +instance Semigroup (Chunks s a) where + Chunks xysL zL <> Chunks [] zR = + Chunks xysL (zL <> zR) + Chunks xysL zL <> Chunks ((x, y):xysR) zR = + Chunks (xysL ++ (zL <> x, y):xysR) zR + +instance Monoid (Chunks s a) where + mempty = Chunks [] mempty + +-- | A traversal over the immediate sub-expressions in 'Chunks'. +chunkExprs + :: Applicative f + => (Expr s a -> f (Expr t b)) + -> Chunks s a -> f (Chunks t b) +chunkExprs f (Chunks chunks final) = + flip Chunks final <$> traverse (traverse f) chunks +{-# INLINABLE chunkExprs #-} + +-- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result +splitOn :: Text -> Text -> NonEmpty Text +splitOn needle haystack = + case Data.Text.splitOn needle haystack of + [] -> "" :| [] + t : ts -> t :| ts + +-- | Split `Chunks` by lines +linesLiteral :: Chunks s a -> NonEmpty (Chunks s a) +linesLiteral (Chunks [] suffix) = + fmap (Chunks []) (splitOn "\n" suffix) +linesLiteral (Chunks ((prefix, interpolation) : pairs₀) suffix₀) = + foldr + NonEmpty.cons + (Chunks ((lastLine, interpolation) : pairs₁) suffix₁ :| chunks) + (fmap (Chunks []) initLines) + where + splitLines = splitOn "\n" prefix + + initLines = NonEmpty.init splitLines + lastLine = NonEmpty.last splitLines + + Chunks pairs₁ suffix₁ :| chunks = linesLiteral (Chunks pairs₀ suffix₀) + +-- | Flatten several `Chunks` back into a single `Chunks` by inserting newlines +unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a +unlinesLiteral chunks = + Data.Foldable.fold (NonEmpty.intersperse "\n" chunks) + +-- | Returns `True` if the `Chunks` represents a blank line +emptyLine :: Chunks s a -> Bool +emptyLine (Chunks [] "" ) = True +emptyLine (Chunks [] "\r") = True -- So that `\r\n` is treated as a blank line +emptyLine _ = False + +-- | Return the leading whitespace for a `Chunks` literal +leadingSpaces :: Chunks s a -> Text +leadingSpaces chunks = Data.Text.takeWhile isSpace firstText + where + isSpace c = c == ' ' || c == '\t' + + firstText = + case chunks of + Chunks [] suffix -> suffix + Chunks ((prefix, _) : _ ) _ -> prefix + +{-| Compute the longest shared whitespace prefix for the purposes of stripping + leading indentation +-} +longestSharedWhitespacePrefix :: NonEmpty (Chunks s a) -> Text +longestSharedWhitespacePrefix literals = + case fmap leadingSpaces filteredLines of + l : ls -> Data.Foldable.foldl' sharedPrefix l ls + [] -> "" + where + sharedPrefix ab ac = + case Data.Text.commonPrefixes ab ac of + Just (a, _b, _c) -> a + Nothing -> "" + + -- The standard specifies to filter out blank lines for all lines *except* + -- for the last line + filteredLines = newInit <> pure oldLast + where + oldInit = NonEmpty.init literals + + oldLast = NonEmpty.last literals + + newInit = filter (not . emptyLine) oldInit + +-- | Drop the first @n@ characters for a `Chunks` literal +dropLiteral :: Int -> Chunks s a -> Chunks s a +dropLiteral n (Chunks [] suffix) = + Chunks [] (Data.Text.drop n suffix) +dropLiteral n (Chunks ((prefix, interpolation) : rest) suffix) = + Chunks ((Data.Text.drop n prefix, interpolation) : rest) suffix + +{-| Convert a single-quoted `Chunks` literal to the equivalent double-quoted + `Chunks` literal +-} +toDoubleQuoted :: Chunks Src a -> Chunks Src a +toDoubleQuoted literal = + unlinesLiteral (fmap (dropLiteral indent) literals) + where + literals = linesLiteral literal + + longestSharedPrefix = longestSharedWhitespacePrefix literals + + indent = Data.Text.length longestSharedPrefix diff --git a/src/Dhall/Syntax/Chunks.hs-boot b/src/Dhall/Syntax/Chunks.hs-boot new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Chunks.hs-boot @@ -0,0 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + +module Dhall.Syntax.Chunks where + +import Data.Kind (Type) + +type Chunks :: Type -> Type -> Type +data Chunks s a diff --git a/src/Dhall/Syntax/Const.hs b/src/Dhall/Syntax/Const.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Const.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.Const + ( Const(..) + ) where + +import GHC.Generics (Generic) + +{-| Constants for a pure type system + + The axioms are: + +> ⊦ Type : Kind +> ⊦ Kind : Sort + + ... and the valid rule pairs are: + +> ⊦ Type ↝ Type : Type -- Functions from terms to terms (ordinary functions) +> ⊦ Kind ↝ Type : Type -- Functions from types to terms (type-polymorphic functions) +> ⊦ Sort ↝ Type : Type -- Functions from kinds to terms +> ⊦ Kind ↝ Kind : Kind -- Functions from types to types (type-level functions) +> ⊦ Sort ↝ Kind : Sort -- Functions from kinds to types (kind-polymorphic functions) +> ⊦ Sort ↝ Sort : Sort -- Functions from kinds to kinds (kind-level functions) + + Note that Dhall does not support functions from terms to types and therefore + Dhall is not a dependently typed language +-} +data Const = Type | Kind | Sort + deriving (Bounded, Enum, Generic) diff --git a/src/Dhall/Syntax/Expr.hs b/src/Dhall/Syntax/Expr.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Expr.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneKindSignatures #-} + +module Dhall.Syntax.Expr + ( Expr(..) + ) where + +import Data.ByteString (ByteString) +import Data.Kind (Type) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Sequence (Seq) +import Data.String (IsString (..)) +import Data.Text (Text) +import Data.Traversable () +import Dhall.Map (Map) +import {-# SOURCE #-} Dhall.Pretty.Internal (CharacterSet (..)) +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var +import GHC.Generics (Generic) +import Numeric.Natural (Natural) + +import qualified Data.Time as Time + +{-| Syntax tree for expressions + + The @s@ type parameter is used to track the presence or absence of + `Dhall.Src.Src` spans: + + * If @s = `Dhall.Src.Src`@ then the code may contains `Dhall.Src.Src` spans + (either in a `Note` constructor or inline within another constructor, like + `Let`) + * If @s = `Data.Void.Void`@ then the code has no `Dhall.Src.Src` spans + + The @a@ type parameter is used to track the presence or absence of imports + + * If @a = `Dhall.Syntax.Import.Import`@ then the code may contain unresolved + `Dhall.Syntax.Import.Import`s + * If @a = `Data.Void.Void`@ then the code has no + `Dhall.Syntax.Import.Import`s +-} +type Expr :: Type -> Type -> Type +data Expr s a + -- | > Const c ~ c + = Const Const + -- | > Var (V x 0) ~ x + -- > Var (V x n) ~ x@n + | Var Var + -- | > Lam _ (FunctionBinding _ "x" _ _ A) b ~ λ(x : A) -> b + | Lam (Maybe CharacterSet) (FunctionBinding s a) (Expr s a) + -- | > Pi _ "_" A B ~ A -> B + -- > Pi _ x A B ~ ∀(x : A) -> B + | Pi (Maybe CharacterSet) Text (Expr s a) (Expr s a) + -- | > App f a ~ f a + | App (Expr s a) (Expr s a) + -- | > Let (Binding _ x _ Nothing _ r) e ~ let x = r in e + -- > Let (Binding _ x _ (Just t ) _ r) e ~ let x : t = r in e + -- + -- The difference between + -- + -- > let x = a let y = b in e + -- + -- and + -- + -- > let x = a in let y = b in e + -- + -- is only an additional 'Note' around @'Let' "y" …@ in the second + -- example. + -- + -- See `Dhall.Syntax.MultiLet.MultiLet` for a representation of let-blocks + -- that mirrors the source code more closely. + | Let (Binding s a) (Expr s a) + -- | > Annot x t ~ x : t + | Annot (Expr s a) (Expr s a) + -- | > Bool ~ Bool + | Bool + -- | > BoolLit b ~ b + | BoolLit Bool + -- | > BoolAnd x y ~ x && y + | BoolAnd (Expr s a) (Expr s a) + -- | > BoolOr x y ~ x || y + | BoolOr (Expr s a) (Expr s a) + -- | > BoolEQ x y ~ x == y + | BoolEQ (Expr s a) (Expr s a) + -- | > BoolNE x y ~ x != y + | BoolNE (Expr s a) (Expr s a) + -- | > BoolIf x y z ~ if x then y else z + | BoolIf (Expr s a) (Expr s a) (Expr s a) + -- | > Bytes ~ Bytes + | Bytes + -- | > BytesLit "\x00\xFF" ~ 0x"00FF" + | BytesLit ByteString + -- | > Natural ~ Natural + | Natural + -- | > NaturalLit n ~ n + | NaturalLit Natural + -- | > NaturalFold ~ Natural/fold + | NaturalFold + -- | > NaturalBuild ~ Natural/build + | NaturalBuild + -- | > NaturalIsZero ~ Natural/isZero + | NaturalIsZero + -- | > NaturalEven ~ Natural/even + | NaturalEven + -- | > NaturalOdd ~ Natural/odd + | NaturalOdd + -- | > NaturalToInteger ~ Natural/toInteger + | NaturalToInteger + -- | > NaturalShow ~ Natural/show + | NaturalShow + -- | > NaturalSubtract ~ Natural/subtract + | NaturalSubtract + -- | > NaturalPlus x y ~ x + y + | NaturalPlus (Expr s a) (Expr s a) + -- | > NaturalTimes x y ~ x * y + | NaturalTimes (Expr s a) (Expr s a) + -- | > Integer ~ Integer + | Integer + -- | > IntegerLit n ~ ±n + | IntegerLit Integer + -- | > IntegerClamp ~ Integer/clamp + | IntegerClamp + -- | > IntegerNegate ~ Integer/negate + | IntegerNegate + -- | > IntegerShow ~ Integer/show + | IntegerShow + -- | > IntegerToDouble ~ Integer/toDouble + | IntegerToDouble + -- | > Double ~ Double + | Double + -- | > DoubleLit n ~ n + | DoubleLit DhallDouble + -- | > DoubleShow ~ Double/show + | DoubleShow + -- | > Text ~ Text + | Text + -- | > TextLit (Chunks [(t1, e1), (t2, e2)] t3) ~ "t1${e1}t2${e2}t3" + | TextLit (Chunks s a) + -- | > TextAppend x y ~ x ++ y + | TextAppend (Expr s a) (Expr s a) + -- | > TextReplace ~ Text/replace + | TextReplace + -- | > TextShow ~ Text/show + | TextShow + -- | > Date ~ Date + | Date + -- | > DateLiteral (fromGregorian _YYYY _MM _DD) ~ YYYY-MM-DD + | DateLiteral Time.Day + -- | > DateShow ~ Date/show + | DateShow + -- | > Time ~ Time + | Time + -- | > TimeLiteral (TimeOfDay hh mm ss) _ ~ hh:mm:ss + | TimeLiteral + Time.TimeOfDay + Word + -- ^ Precision + -- | > TimeShow ~ Time/show + | TimeShow + -- | > TimeZone ~ TimeZone + | TimeZone + -- | > TimeZoneLiteral (TimeZone ( 60 * _HH + _MM) _ _) ~ +HH:MM + -- | > TimeZoneLiteral (TimeZone (-60 * _HH + _MM) _ _) ~ -HH:MM + | TimeZoneLiteral Time.TimeZone + -- | > TimeZoneShow ~ TimeZone/Show + | TimeZoneShow + -- | > List ~ List + | List + -- | > ListLit (Just t ) [] ~ [] : t + -- > ListLit Nothing [x, y, z] ~ [x, y, z] + -- + -- Invariant: A non-empty list literal is always represented as + -- @ListLit Nothing xs@. + -- + -- When an annotated, non-empty list literal is parsed, it is represented + -- as + -- + -- > Annot (ListLit Nothing [x, y, z]) t ~ [x, y, z] : t + + -- Eventually we should have separate constructors for empty and non-empty + -- list literals. For now it's easier to check the invariant in @infer@. + -- See https://github.com/dhall-lang/dhall-haskell/issues/1359#issuecomment-537087234. + | ListLit (Maybe (Expr s a)) (Seq (Expr s a)) + -- | > ListAppend x y ~ x # y + | ListAppend (Expr s a) (Expr s a) + -- | > ListBuild ~ List/build + | ListBuild + -- | > ListFold ~ List/fold + | ListFold + -- | > ListLength ~ List/length + | ListLength + -- | > ListHead ~ List/head + | ListHead + -- | > ListLast ~ List/last + | ListLast + -- | > ListIndexed ~ List/indexed + | ListIndexed + -- | > ListReverse ~ List/reverse + | ListReverse + -- | > Optional ~ Optional + | Optional + -- | > Some e ~ Some e + | Some (Expr s a) + -- | > None ~ None + | None + -- | > Record [ (k1, RecordField _ t1) ~ { k1 : t1, k2 : t1 } + -- > , (k2, RecordField _ t2) + -- > ] + | Record (Map Text (RecordField s a)) + -- | > RecordLit [ (k1, RecordField _ v1) ~ { k1 = v1, k2 = v2 } + -- > , (k2, RecordField _ v2) + -- > ] + | RecordLit (Map Text (RecordField s a)) + -- | > Union [(k1, Just t1), (k2, Nothing)] ~ < k1 : t1 | k2 > + | Union (Map Text (Maybe (Expr s a))) + -- | > Combine _ Nothing x y ~ x ∧ y + -- + -- The first field is a `Just` when the `Combine` operator is introduced + -- as a result of desugaring duplicate record fields: + -- + -- > RecordLit [ ( k ~ { k = x, k = y } + -- > , RecordField + -- > _ + -- > (Combine (Just k) x y) + -- > )] + | Combine (Maybe CharacterSet) (Maybe Text) (Expr s a) (Expr s a) + -- | > CombineTypes _ x y ~ x ⩓ y + | CombineTypes (Maybe CharacterSet) (Expr s a) (Expr s a) + -- | > Prefer _ _ x y ~ x ⫽ y + | Prefer (Maybe CharacterSet) PreferAnnotation (Expr s a) (Expr s a) + -- | > RecordCompletion x y ~ x::y + | RecordCompletion (Expr s a) (Expr s a) + -- | > Merge x y (Just t ) ~ merge x y : t + -- > Merge x y Nothing ~ merge x y + | Merge (Expr s a) (Expr s a) (Maybe (Expr s a)) + -- | > ToMap x (Just t) ~ toMap x : t + -- > ToMap x Nothing ~ toMap x + | ToMap (Expr s a) (Maybe (Expr s a)) + -- | > ShowConstructor x ~ showConstructor x + | ShowConstructor (Expr s a) + -- | > Field e (FieldSelection _ x _) ~ e.x + | Field (Expr s a) (FieldSelection s) + -- | > Project e (Left xs) ~ e.{ xs } + -- > Project e (Right t) ~ e.(t) + | Project (Expr s a) (Either [Text] (Expr s a)) + -- | > Assert e ~ assert : e + | Assert (Expr s a) + -- | > Equivalent _ x y ~ x ≡ y + | Equivalent (Maybe CharacterSet) (Expr s a) (Expr s a) + -- | > With x y e ~ x with y = e + | With (Expr s a) (NonEmpty WithComponent) (Expr s a) + -- | > Note s x ~ e + | Note s (Expr s a) + -- | > ImportAlt ~ e1 ? e2 + | ImportAlt (Expr s a) (Expr s a) + -- | > Embed import ~ import + | Embed a + deriving (Generic) +-- NB: If you add a constructor to Expr, please also update the Arbitrary +-- instance in Dhall.Test.QuickCheck. + +instance IsString (Expr s a) where + fromString str = Var (fromString str) diff --git a/src/Dhall/Syntax/Expr.hs-boot b/src/Dhall/Syntax/Expr.hs-boot new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Expr.hs-boot @@ -0,0 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + +module Dhall.Syntax.Expr where + +import Data.Kind (Type) + +type Expr :: Type -> Type -> Type +data Expr s a diff --git a/src/Dhall/Syntax/FunctionBinding.hs b/src/Dhall/Syntax/FunctionBinding.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/FunctionBinding.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.FunctionBinding + ( FunctionBinding(..) + , makeFunctionBinding + + -- * Optics + , functionBindingExprs + ) where + +import Data.Text (Text) +import {-# SOURCE #-} Dhall.Syntax.Expr (Expr) +import GHC.Generics (Generic) + +-- | Record the label of a function or a function-type expression +-- +-- For example, +-- +-- > λ({- A -} a {- B -} : {- C -} T) -> e +-- +-- … will be instantiated as follows: +-- +-- * @functionBindingSrc0@ corresponds to the @A@ comment +-- * @functionBindingVariable@ is @a@ +-- * @functionBindingSrc1@ corresponds to the @B@ comment +-- * @functionBindingSrc2@ corresponds to the @C@ comment +-- * @functionBindingAnnotation@ is @T@ +data FunctionBinding s a = FunctionBinding + { functionBindingSrc0 :: Maybe s + , functionBindingVariable :: Text + , functionBindingSrc1 :: Maybe s + , functionBindingSrc2 :: Maybe s + , functionBindingAnnotation :: Expr s a + } deriving Generic + +-- | Smart constructor for 'FunctionBinding' with no src information +makeFunctionBinding :: Text -> Expr s a -> FunctionBinding s a +makeFunctionBinding l t = FunctionBinding Nothing l Nothing Nothing t + +{-| Traverse over the immediate 'Expr' children in a 'FunctionBinding'. +-} +functionBindingExprs + :: Applicative f + => (Expr s a -> f (Expr s b)) + -> FunctionBinding s a -> f (FunctionBinding s b) +functionBindingExprs f (FunctionBinding s0 label s1 s2 type_) = + FunctionBinding + <$> pure s0 + <*> pure label + <*> pure s1 + <*> pure s2 + <*> f type_ +{-# INLINABLE functionBindingExprs #-} diff --git a/src/Dhall/Syntax/Import.hs b/src/Dhall/Syntax/Import.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Import.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.Syntax.Import + ( Directory(..) + , File(..) + , FilePrefix(..) + , Import(..) + , ImportHashed(..) + , ImportMode(..) + , ImportType(..) + , URL(..) + , Scheme(..) + ) where + +import Data.Data (Data) +import Data.Text (Text) +import Dhall.Src (Src (..)) +import Dhall.Syntax.Expr (Expr (..)) +import Dhall.Syntax.Instances.Data () +import Dhall.Syntax.Instances.Functor () +import GHC.Generics (Generic) + +import qualified Dhall.Crypto + +{-| Internal representation of a directory that stores the path components in + reverse order + + In other words, the directory @\/foo\/bar\/baz@ is encoded as + @Directory { components = [ "baz", "bar", "foo" ] }@ +-} +newtype Directory = Directory { components :: [Text] } + deriving (Data, Generic) + +{-| A `File` is a `directory` followed by one additional path component + representing the `file` name +-} +data File = File + { directory :: Directory + , file :: Text + } deriving (Data, Generic) + +-- | The beginning of a file path which anchors subsequent path components +data FilePrefix + = Absolute + -- ^ Absolute path + | Here + -- ^ Path relative to @.@ + | Parent + -- ^ Path relative to @..@ + | Home + -- ^ Path relative to @~@ + deriving (Data, Generic) + +-- | The URI scheme +data Scheme = HTTP | HTTPS + deriving (Data, Generic) + +-- | This type stores all of the components of a remote import +data URL = URL + { scheme :: Scheme + , authority :: Text + , path :: File + , query :: Maybe Text + , headers :: Maybe (Expr Src Import) + } deriving (Data, Generic) + +-- | The type of import (i.e. local vs. remote vs. environment) +data ImportType + = Local FilePrefix File + -- ^ Local path + | Remote URL + -- ^ URL of remote resource and optional headers stored in an import + | Env Text + -- ^ Environment variable + | Missing + deriving (Data, Generic) + +-- | How to interpret the import's contents (i.e. as Dhall code or raw text) +data ImportMode = Code | RawText | Location | RawBytes + deriving (Data, Generic) + +-- | A `ImportType` extended with an optional hash for semantic integrity checks +data ImportHashed = ImportHashed + { hash :: Maybe Dhall.Crypto.SHA256Digest + , importType :: ImportType + } deriving (Data, Generic) + +-- | Reference to an external resource +data Import = Import + { importHashed :: ImportHashed + , importMode :: ImportMode + } deriving (Data, Generic) + + + + +instance Semigroup Directory where + Directory components0 <> Directory components1 = + Directory (components1 <> components0) + +instance Semigroup File where + File directory0 _ <> File directory1 file = + File (directory0 <> directory1) file + +instance Semigroup ImportType where + Local prefix file0 <> Local Here file1 = Local prefix (file0 <> file1) + + Remote (URL { path = path0, ..}) <> Local Here path1 = + Remote (URL { path = path0 <> path1, ..}) + + Local prefix file0 <> Local Parent file1 = + Local prefix (file0 <> parent <> file1) + + Remote (URL { path = path0, .. }) <> Local Parent path1 = + Remote (URL { path = path0 <> parent <> path1, .. }) + + import0 <> Remote (URL { headers = headers0, .. }) = + Remote (URL { headers = headers1, .. }) + where + importHashed0 = Import (ImportHashed Nothing import0) Code + + headers1 = fmap (fmap (importHashed0 <>)) headers0 + + _ <> import1 = + import1 + +instance Semigroup ImportHashed where + ImportHashed _ importType0 <> ImportHashed hash importType1 = + ImportHashed hash (importType0 <> importType1) + +instance Semigroup Import where + Import importHashed0 _ <> Import importHashed1 code = + Import (importHashed0 <> importHashed1) code + +parent :: File +parent = File { directory = Directory { components = [ ".." ] }, file = "" } diff --git a/src/Dhall/Syntax/Instances/Applicative.hs b/src/Dhall/Syntax/Instances/Applicative.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Applicative.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Applicative () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Instances.Functor () +import Dhall.Syntax.Operations +import Dhall.Syntax.RecordField + +import qualified Lens.Micro as Lens + +instance Applicative (Expr s) where + pure = Embed + + expression <*> k = case expression of + Embed a -> a <$> k + Let a b -> Let (adaptBinding a) (b <*> k) + Note a b -> Note a (b <*> k) + Record a -> Record $ adaptRecordField <$> a + RecordLit a -> RecordLit $ adaptRecordField <$> a + Lam cs a b -> Lam cs (adaptFunctionBinding a) (b <*> k) + Field a b -> Field (a <*> k) b + _ -> Lens.over unsafeSubExpressions (<*> k) expression + where + adaptRecordField (RecordField s0 e s1 s2) = + RecordField s0 (e <*> k) s1 s2 + + adaptBinding (Binding src0 c src1 d src2 e) = + Binding src0 c src1 (fmap adaptBindingAnnotation d) src2 (e <*> k) + + adaptFunctionBinding (FunctionBinding src0 label src1 src2 type_) = + FunctionBinding src0 label src1 src2 (type_ <*> k) + + adaptBindingAnnotation (src3, f) = (src3, f <*> k) diff --git a/src/Dhall/Syntax/Instances/Bifunctor.hs b/src/Dhall/Syntax/Instances/Bifunctor.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Bifunctor.hs @@ -0,0 +1,44 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Bifunctor () where + +import Data.Bifunctor (Bifunctor (..)) +import Dhall.Syntax.Binding +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Instances.Functor () +import Dhall.Syntax.Operations +import Dhall.Syntax.RecordField + +import qualified Lens.Micro as Lens + +instance Bifunctor Binding where + first k (Binding src0 a src1 b src2 c) = + Binding (fmap k src0) a (fmap k src1) (fmap adapt0 b) (fmap k src2) (first k c) + where + adapt0 (src3, d) = (fmap k src3, first k d) + + second = fmap + +instance Bifunctor RecordField where + first k (RecordField s0 value' s1 s2) = + RecordField (k <$> s0) (first k value') (k <$> s1) (k <$> s2) + second = fmap + +instance Bifunctor FunctionBinding where + first k (FunctionBinding src0 label src1 src2 type_) = + FunctionBinding (k <$> src0) label (k <$> src1) (k <$> src2) (first k type_) + + second = fmap + +instance Bifunctor Expr where + first k (Note a b ) = Note (k a) (first k b) + first _ (Embed a ) = Embed a + first k (Let a b ) = Let (first k a) (first k b) + first k (Record a ) = Record $ first k <$> a + first k (RecordLit a) = RecordLit $ first k <$> a + first k (Lam cs a b ) = Lam cs (first k a) (first k b) + first k (Field a b ) = Field (first k a) (k <$> b) + first k expression = Lens.over unsafeSubExpressions (first k) expression + + second = fmap diff --git a/src/Dhall/Syntax/Instances/Data.hs b/src/Dhall/Syntax/Instances/Data.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Data.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Data () where + +import Data.Data (Data) +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var + +deriving instance Data Const +deriving instance Data Var +deriving instance (Data a, Data s) => Data (Binding s a) +deriving instance Data DhallDouble +deriving instance (Data a, Data s) => Data (Chunks s a) +deriving instance Data PreferAnnotation +deriving instance (Data a, Data s) => Data (RecordField s a) +deriving instance (Data a, Data s) => Data (FunctionBinding s a) +deriving instance Data s => Data (FieldSelection s) +deriving instance Data WithComponent +deriving instance (Data a, Data s) => Data (Expr s a) diff --git a/src/Dhall/Syntax/Instances/Eq.hs b/src/Dhall/Syntax/Instances/Eq.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Eq.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Eq () where + +import Data.Bits (xor) +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Import +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var + +-- $setup +-- >>> import Data.Void (Void) +-- >>> import Dhall.Binary () -- For the orphan instance for `Serialise (Expr Void Import)` + +deriving instance Eq Const +deriving instance Eq Var +deriving instance (Eq s, Eq a) => Eq (Binding s a) +deriving instance (Eq s, Eq a) => Eq (Chunks s a) +deriving instance Eq PreferAnnotation +deriving instance (Eq s, Eq a) => Eq (RecordField s a) +deriving instance (Eq s, Eq a) => Eq (FunctionBinding s a) +deriving instance Eq s => Eq (FieldSelection s) +deriving instance Eq WithComponent +-- | This instance encodes what the Dhall standard calls an \"exact match\" +-- between two expressions. +-- +-- Note that +-- +-- >>> nan = DhallDouble (0/0) +-- >>> DoubleLit nan == DoubleLit nan +-- True +deriving instance (Eq s, Eq a) => Eq (Expr s a) +deriving instance Eq Directory +deriving instance Eq File +deriving instance Eq FilePrefix +deriving instance Eq Scheme +deriving instance Eq URL +deriving instance Eq ImportType +deriving instance Eq ImportMode +deriving instance Eq ImportHashed +deriving instance Eq Import + +-- | This instance satisfies all the customary 'Eq' laws except substitutivity. +-- +-- In particular: +-- +-- >>> nan = DhallDouble (0/0) +-- >>> nan == nan +-- True +-- +-- This instance is also consistent with with the binary encoding of Dhall @Double@s: +-- +-- >>> toBytes n = Dhall.Binary.encodeExpression (DoubleLit n :: Expr Void Import) +-- +-- prop> \a b -> (a == b) == (toBytes a == toBytes b) +instance Eq DhallDouble where + DhallDouble a == DhallDouble b + | isNaN a && isNaN b = True + | isNegativeZero a `xor` isNegativeZero b = False + | otherwise = a == b diff --git a/src/Dhall/Syntax/Instances/Foldable.hs b/src/Dhall/Syntax/Instances/Foldable.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Foldable.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Foldable () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types + +deriving instance Foldable (Binding s) +deriving instance Foldable (Chunks s) +deriving instance Foldable (RecordField s) +deriving instance Foldable (FunctionBinding s) +deriving instance Foldable FieldSelection +deriving instance Foldable (Expr s) diff --git a/src/Dhall/Syntax/Instances/Functor.hs b/src/Dhall/Syntax/Instances/Functor.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Functor.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Functor () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import {-# SOURCE #-} Dhall.Syntax.Operations (unsafeSubExpressions) +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types + +import qualified Lens.Micro as Lens + +deriving instance Functor (Binding s) +deriving instance Functor (Chunks s) +deriving instance Functor (RecordField s) +deriving instance Functor (FunctionBinding s) +deriving instance Functor FieldSelection + +-- This instance is hand-written due to the fact that deriving +-- it does not give us an INLINABLE pragma. We annotate this fmap +-- implementation with this pragma below to allow GHC to, possibly, +-- inline the implementation for performance improvements. +instance Functor (Expr s) where + fmap f (Embed a) = Embed (f a) + fmap f (Let b e2) = Let (fmap f b) (fmap f e2) + fmap f (Note s e1) = Note s (fmap f e1) + fmap f (Record a) = Record $ fmap f <$> a + fmap f (RecordLit a) = RecordLit $ fmap f <$> a + fmap f (Lam cs fb e) = Lam cs (f <$> fb) (f <$> e) + fmap f (Field a b) = Field (f <$> a) b + fmap f expression = Lens.over unsafeSubExpressions (fmap f) expression + {-# INLINABLE fmap #-} diff --git a/src/Dhall/Syntax/Instances/Lift.hs b/src/Dhall/Syntax/Instances/Lift.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Lift.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Lift () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var +import Language.Haskell.TH.Syntax (Lift) + +#if !MIN_VERSION_template_haskell(2,21,0) +import qualified Data.Fixed as Fixed +#endif +import qualified Data.Time as Time + +#if !MIN_VERSION_time(1,14,0) +deriving instance Lift Time.Day +#endif +deriving instance Lift Time.TimeOfDay +deriving instance Lift Time.TimeZone +#if !MIN_VERSION_template_haskell(2,21,0) +deriving instance Lift (Fixed.Fixed a) +#endif +deriving instance Lift Const +deriving instance Lift Var +deriving instance (Lift s, Lift a) => Lift (Binding s a) +deriving instance Lift DhallDouble +deriving instance (Lift s, Lift a) => Lift (Chunks s a) +deriving instance Lift PreferAnnotation +deriving instance (Lift s, Lift a) => Lift (RecordField s a) +deriving instance (Lift s, Lift a) => Lift (FunctionBinding s a) +deriving instance Lift s => Lift (FieldSelection s) +deriving instance Lift WithComponent +deriving instance (Lift s, Lift a) => Lift (Expr s a) diff --git a/src/Dhall/Syntax/Instances/Monad.hs b/src/Dhall/Syntax/Instances/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Monad.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Monad () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Instances.Applicative () +import Dhall.Syntax.Operations +import Dhall.Syntax.RecordField + +import qualified Lens.Micro as Lens + +instance Monad (Expr s) where + return = pure + + expression >>= k = case expression of + Embed a -> k a + Let a b -> Let (adaptBinding a) (b >>= k) + Note a b -> Note a (b >>= k) + Record a -> Record $ bindRecordKeyValues <$> a + RecordLit a -> RecordLit $ bindRecordKeyValues <$> a + Lam cs a b -> Lam cs (adaptFunctionBinding a) (b >>= k) + Field a b -> Field (a >>= k) b + _ -> Lens.over unsafeSubExpressions (>>= k) expression + where + bindRecordKeyValues (RecordField s0 e s1 s2) = + RecordField s0 (e >>= k) s1 s2 + + adaptBinding (Binding src0 c src1 d src2 e) = + Binding src0 c src1 (fmap adaptBindingAnnotation d) src2 (e >>= k) + + adaptFunctionBinding (FunctionBinding src0 label src1 src2 type_) = + FunctionBinding src0 label src1 src2 (type_ >>= k) + + adaptBindingAnnotation (src3, f) = (src3, f >>= k) diff --git a/src/Dhall/Syntax/Instances/NFData.hs b/src/Dhall/Syntax/Instances/NFData.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/NFData.hs @@ -0,0 +1,35 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.NFData () where + +import Control.DeepSeq (NFData) +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Import +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var + +instance NFData Const +instance NFData Var +instance (NFData s, NFData a) => NFData (Binding s a) +instance NFData DhallDouble +instance (NFData s, NFData a) => NFData (Chunks s a) +instance NFData PreferAnnotation +instance (NFData s, NFData a) => NFData (RecordField s a) +instance (NFData s, NFData a) => NFData (FunctionBinding s a) +instance NFData s => NFData (FieldSelection s) +instance NFData WithComponent +instance (NFData s, NFData a) => NFData (Expr s a) +instance NFData Directory +instance NFData File +instance NFData FilePrefix +instance NFData Scheme +instance NFData URL +instance NFData ImportType +instance NFData ImportMode +instance NFData ImportHashed +instance NFData Import diff --git a/src/Dhall/Syntax/Instances/Ord.hs b/src/Dhall/Syntax/Instances/Ord.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Ord.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Ord () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Import +import Dhall.Syntax.Instances.Eq () +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var + +deriving instance Ord Const +deriving instance Ord Var +deriving instance (Ord s, Ord a) => Ord (Binding s a) +deriving instance (Ord s, Ord a) => Ord (Chunks s a) +deriving instance Ord PreferAnnotation +deriving instance (Ord s, Ord a) => Ord (RecordField s a) +deriving instance (Ord s, Ord a) => Ord (FunctionBinding s a) +deriving instance Ord s => Ord (FieldSelection s) +deriving instance Ord WithComponent +-- | Note that this 'Ord' instance inherits `DhallDouble`'s defects. +deriving instance (Ord s, Ord a) => Ord (Expr s a) +deriving instance Ord Directory +deriving instance Ord File +deriving instance Ord FilePrefix +deriving instance Ord Scheme +deriving instance Ord URL +deriving instance Ord ImportType +deriving instance Ord ImportMode +deriving instance Ord ImportHashed +deriving instance Ord Import + +-- | This instance relies on the 'Eq' instance for 'DhallDouble' but cannot +-- satisfy the customary 'Ord' laws when @NaN@ is involved. +instance Ord DhallDouble where + compare a@(DhallDouble a') b@(DhallDouble b') = + if a == b + then EQ + else compare a' b' diff --git a/src/Dhall/Syntax/Instances/Pretty.hs b/src/Dhall/Syntax/Instances/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Pretty.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Pretty + ( pathCharacter + ) where + +import Data.Text (Text) +import {-# SOURCE #-} Dhall.Pretty.Internal +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.Import +import Dhall.Syntax.Var +import Prettyprinter (Doc, Pretty) + +import qualified Data.Text +import qualified Network.URI as URI +import qualified Prettyprinter as Pretty + +instance Pretty Const where + pretty = Pretty.unAnnotate . prettyConst + +instance Pretty Var where + pretty = Pretty.unAnnotate . prettyVar + +-- | Generates a syntactically valid Dhall program +instance Pretty a => Pretty (Expr s a) where + pretty = Pretty.unAnnotate . prettyExpr + +instance Pretty Directory where + pretty (Directory {..}) = foldMap prettyPathComponent (reverse components) + +prettyPathComponent :: Text -> Doc ann +prettyPathComponent text + | Data.Text.all pathCharacter text = + "/" <> Pretty.pretty text + | otherwise = + "/\"" <> Pretty.pretty text <> "\"" + +instance Pretty File where + pretty (File {..}) = + Pretty.pretty directory + <> prettyPathComponent file + +instance Pretty FilePrefix where + pretty Absolute = "" + pretty Here = "." + pretty Parent = ".." + pretty Home = "~" + +instance Pretty URL where + pretty (URL {..}) = + schemeDoc + <> "://" + <> Pretty.pretty authority + <> pathDoc + <> queryDoc + <> foldMap prettyHeaders headers + where + prettyHeaders h = + " using (" <> Pretty.unAnnotate (Pretty.pretty h) <> ")" + + File {..} = path + + Directory {..} = directory + + pathDoc = + foldMap prettyURIComponent (reverse components) + <> prettyURIComponent file + + schemeDoc = case scheme of + HTTP -> "http" + HTTPS -> "https" + + queryDoc = case query of + Nothing -> "" + Just q -> "?" <> Pretty.pretty q + +prettyURIComponent :: Text -> Doc ann +prettyURIComponent text = + Pretty.pretty $ URI.normalizeCase $ URI.normalizeEscape $ "/" <> Data.Text.unpack text + +instance Pretty ImportType where + pretty (Local prefix file) = + Pretty.pretty prefix <> Pretty.pretty file + + pretty (Remote url) = Pretty.pretty url + + pretty (Env env) = "env:" <> prettyEnvironmentVariable env + + pretty Missing = "missing" + +instance Pretty ImportHashed where + pretty (ImportHashed Nothing p) = + Pretty.pretty p + pretty (ImportHashed (Just h) p) = + Pretty.group (Pretty.flatAlt long short) + where + long = + Pretty.align + ( Pretty.pretty p <> Pretty.hardline + <> " sha256:" <> Pretty.pretty (show h) + ) + + short = Pretty.pretty p <> " sha256:" <> Pretty.pretty (show h) + +instance Pretty Import where + pretty (Import {..}) = Pretty.pretty importHashed <> Pretty.pretty suffix + where + suffix :: Text + suffix = case importMode of + RawText -> " as Text" + Location -> " as Location" + Code -> "" + RawBytes -> " as Bytes" + +{-| Returns `True` if the given `Char` is valid within an unquoted path + component + + This is exported for reuse within the @"Dhall.Parser.Token"@ module +-} +pathCharacter :: Char -> Bool +pathCharacter c = + '\x21' == c + || ('\x24' <= c && c <= '\x27') + || ('\x2A' <= c && c <= '\x2B') + || ('\x2D' <= c && c <= '\x2E') + || ('\x30' <= c && c <= '\x3B') + || c == '\x3D' + || ('\x40' <= c && c <= '\x5A') + || ('\x5E' <= c && c <= '\x7A') + || c == '\x7C' + || c == '\x7E' diff --git a/src/Dhall/Syntax/Instances/Pretty.hs-boot b/src/Dhall/Syntax/Instances/Pretty.hs-boot new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Pretty.hs-boot @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Pretty where + +import Dhall.Syntax.Expr (Expr) +import Prettyprinter (Pretty) + +instance Pretty a => Pretty (Expr s a) diff --git a/src/Dhall/Syntax/Instances/Show.hs b/src/Dhall/Syntax/Instances/Show.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Show.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Show () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Const +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Import +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types +import Dhall.Syntax.Var + +deriving instance Show Const +deriving instance Show Var +deriving instance (Show s, Show a) => Show (Binding s a) +deriving instance Show DhallDouble +deriving instance (Show s, Show a) => Show (Chunks s a) +deriving instance Show PreferAnnotation +deriving instance (Show s, Show a) => Show (RecordField s a) +deriving instance (Show s, Show a) => Show (FunctionBinding s a) +deriving instance Show s => Show (FieldSelection s) +deriving instance Show WithComponent +deriving instance (Show s, Show a) => Show (Expr s a) +deriving instance Show Directory +deriving instance Show File +deriving instance Show FilePrefix +deriving instance Show Scheme +deriving instance Show URL +deriving instance Show ImportType +deriving instance Show ImportMode +deriving instance Show ImportHashed +deriving instance Show Import diff --git a/src/Dhall/Syntax/Instances/Traversable.hs b/src/Dhall/Syntax/Instances/Traversable.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Instances/Traversable.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE StandaloneDeriving #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Dhall.Syntax.Instances.Traversable () where + +import Dhall.Syntax.Binding +import Dhall.Syntax.Chunks +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.Instances.Foldable () +import Dhall.Syntax.Instances.Functor () +import Dhall.Syntax.RecordField +import Dhall.Syntax.Types + +deriving instance Traversable (Binding s) +deriving instance Traversable (Chunks s) +deriving instance Traversable (RecordField s) +deriving instance Traversable (FunctionBinding s) +deriving instance Traversable FieldSelection +deriving instance Traversable (Expr s) diff --git a/src/Dhall/Syntax/MultiLet.hs b/src/Dhall/Syntax/MultiLet.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/MultiLet.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE LambdaCase #-} + +{- | Instead of converting explicitly between 'Expr's and 'MultiLet', it might +be nicer to use a pattern synonym: + +> pattern MultiLet' :: NonEmpty (Binding s a) -> Expr s a -> Expr s a +> pattern MultiLet' as b <- (multiLetFromExpr -> Just (MultiLet as b)) where +> MultiLet' as b = wrapInLets as b +> +> multiLetFromExpr :: Expr s a -> Maybe (MultiLet s a) +> multiLetFromExpr = \case +> Let x mA a b -> Just (multiLet x mA a b) +> _ -> Nothing + +This works in principle, but GHC as of v8.8.1 doesn't handle it well: +https://gitlab.haskell.org/ghc/ghc/issues/17096 + +This should be fixed by GHC-8.10, so it might be worth revisiting then. +-} + +module Dhall.Syntax.MultiLet + ( MultiLet(..) + , multiLet + , wrapInLets + ) where + +import Data.List.NonEmpty (NonEmpty (..)) +import Dhall.Syntax.Binding (Binding) +import Dhall.Syntax.Expr (Expr (..)) + +import qualified Data.List.NonEmpty as NonEmpty + +{-| Generate a 'MultiLet' from the contents of a 'Let'. + + In the resulting @'MultiLet' bs e@, @e@ is guaranteed not to be a 'Let', + but it might be a @('Note' … ('Let' …))@. + + Given parser output, 'multiLet' consolidates @let@s that formed a + let-block in the original source. +-} +multiLet :: Binding s a -> Expr s a -> MultiLet s a +multiLet b0 = \case + Let b1 e1 -> + let MultiLet bs e = multiLet b1 e1 + in MultiLet (NonEmpty.cons b0 bs) e + e -> MultiLet (b0 :| []) e + +{-| Wrap let-'Binding's around an 'Expr'. + +'wrapInLets' can be understood as an inverse for 'multiLet': + +> let MultiLet bs e1 = multiLet b e0 +> +> wrapInLets bs e1 == Let b e0 +-} +wrapInLets :: Foldable f => f (Binding s a) -> Expr s a -> Expr s a +wrapInLets bs e = foldr Let e bs + +{-| This type represents 1 or more nested `Let` bindings that have been + coalesced together for ease of manipulation +-} +data MultiLet s a = MultiLet (NonEmpty (Binding s a)) (Expr s a) diff --git a/src/Dhall/Syntax/Operations.hs b/src/Dhall/Syntax/Operations.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Operations.hs @@ -0,0 +1,394 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Dhall.Syntax.Operations + ( -- * Optics + subExpressions + , subExpressionsWith + , unsafeSubExpressions + + -- * Handling 'Note's + , denote + , renote + , shallowDenote + + -- * Reserved identifiers + , reservedIdentifiers + , reservedKeywords + + -- * Utilities + , internalError + -- `shift` should really be in `Dhall.Normalize`, but it's here to avoid a + -- module cycle + , shift + ) where + +import Data.HashSet (HashSet) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Syntax.Binding (Binding (..), bindingExprs) +import Dhall.Syntax.Chunks (chunkExprs) +import Dhall.Syntax.Expr +import Dhall.Syntax.FunctionBinding +import Dhall.Syntax.RecordField (RecordField (..), recordFieldExprs) +import Dhall.Syntax.Types +import Dhall.Syntax.Var +import Unsafe.Coerce (unsafeCoerce) + +import qualified Data.HashSet +import qualified Data.Text +import qualified Lens.Micro as Lens + + +-- | A traversal over the immediate sub-expressions of an expression. +subExpressions + :: Applicative f => (Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a) +subExpressions = subExpressionsWith (pure . Embed) +{-# INLINABLE subExpressions #-} + +{-| A traversal over the immediate sub-expressions of an expression which + allows mapping embedded values +-} +subExpressionsWith + :: Applicative f => (a -> f (Expr s b)) -> (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b) +subExpressionsWith h _ (Embed a) = h a +subExpressionsWith _ f (Note a b) = Note a <$> f b +subExpressionsWith _ f (Let a b) = Let <$> bindingExprs f a <*> f b +subExpressionsWith _ f (Record a) = Record <$> traverse (recordFieldExprs f) a +subExpressionsWith _ f (RecordLit a) = RecordLit <$> traverse (recordFieldExprs f) a +subExpressionsWith _ f (Lam cs fb e) = Lam cs <$> functionBindingExprs f fb <*> f e +subExpressionsWith _ f (Field a b) = Field <$> f a <*> pure b +subExpressionsWith _ f expression = unsafeSubExpressions f expression +{-# INLINABLE subExpressionsWith #-} + +{-| An internal utility used to implement transformations that require changing + one of the type variables of the `Expr` type + + This utility only works because the implementation is partial, not + handling the `Let`, `Note`, or `Embed` cases, which need to be handled by + the caller. +-} +unsafeSubExpressions + :: Applicative f => (Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b) +unsafeSubExpressions _ (Const c) = pure (Const c) +unsafeSubExpressions _ (Var v) = pure (Var v) +unsafeSubExpressions f (Pi cs a b c) = Pi cs a <$> f b <*> f c +unsafeSubExpressions f (App a b) = App <$> f a <*> f b +unsafeSubExpressions f (Annot a b) = Annot <$> f a <*> f b +unsafeSubExpressions _ Bool = pure Bool +unsafeSubExpressions _ (BoolLit b) = pure (BoolLit b) +unsafeSubExpressions f (BoolAnd a b) = BoolAnd <$> f a <*> f b +unsafeSubExpressions f (BoolOr a b) = BoolOr <$> f a <*> f b +unsafeSubExpressions f (BoolEQ a b) = BoolEQ <$> f a <*> f b +unsafeSubExpressions f (BoolNE a b) = BoolNE <$> f a <*> f b +unsafeSubExpressions f (BoolIf a b c) = BoolIf <$> f a <*> f b <*> f c +unsafeSubExpressions _ Bytes = pure Bytes +unsafeSubExpressions _ (BytesLit a) = pure (BytesLit a) +unsafeSubExpressions _ Natural = pure Natural +unsafeSubExpressions _ (NaturalLit n) = pure (NaturalLit n) +unsafeSubExpressions _ NaturalFold = pure NaturalFold +unsafeSubExpressions _ NaturalBuild = pure NaturalBuild +unsafeSubExpressions _ NaturalIsZero = pure NaturalIsZero +unsafeSubExpressions _ NaturalEven = pure NaturalEven +unsafeSubExpressions _ NaturalOdd = pure NaturalOdd +unsafeSubExpressions _ NaturalToInteger = pure NaturalToInteger +unsafeSubExpressions _ NaturalShow = pure NaturalShow +unsafeSubExpressions _ NaturalSubtract = pure NaturalSubtract +unsafeSubExpressions f (NaturalPlus a b) = NaturalPlus <$> f a <*> f b +unsafeSubExpressions f (NaturalTimes a b) = NaturalTimes <$> f a <*> f b +unsafeSubExpressions _ Integer = pure Integer +unsafeSubExpressions _ (IntegerLit n) = pure (IntegerLit n) +unsafeSubExpressions _ IntegerClamp = pure IntegerClamp +unsafeSubExpressions _ IntegerNegate = pure IntegerNegate +unsafeSubExpressions _ IntegerShow = pure IntegerShow +unsafeSubExpressions _ IntegerToDouble = pure IntegerToDouble +unsafeSubExpressions _ Double = pure Double +unsafeSubExpressions _ (DoubleLit n) = pure (DoubleLit n) +unsafeSubExpressions _ DoubleShow = pure DoubleShow +unsafeSubExpressions _ Text = pure Text +unsafeSubExpressions f (TextLit chunks) = TextLit <$> chunkExprs f chunks +unsafeSubExpressions f (TextAppend a b) = TextAppend <$> f a <*> f b +unsafeSubExpressions _ TextReplace = pure TextReplace +unsafeSubExpressions _ TextShow = pure TextShow +unsafeSubExpressions _ Date = pure Date +unsafeSubExpressions _ (DateLiteral a) = pure (DateLiteral a) +unsafeSubExpressions _ DateShow = pure DateShow +unsafeSubExpressions _ Time = pure Time +unsafeSubExpressions _ (TimeLiteral a b) = pure (TimeLiteral a b) +unsafeSubExpressions _ TimeShow = pure TimeShow +unsafeSubExpressions _ TimeZone = pure TimeZone +unsafeSubExpressions _ (TimeZoneLiteral a) = pure (TimeZoneLiteral a) +unsafeSubExpressions _ TimeZoneShow = pure TimeZoneShow +unsafeSubExpressions _ List = pure List +unsafeSubExpressions f (ListLit a b) = ListLit <$> traverse f a <*> traverse f b +unsafeSubExpressions f (ListAppend a b) = ListAppend <$> f a <*> f b +unsafeSubExpressions _ ListBuild = pure ListBuild +unsafeSubExpressions _ ListFold = pure ListFold +unsafeSubExpressions _ ListLength = pure ListLength +unsafeSubExpressions _ ListHead = pure ListHead +unsafeSubExpressions _ ListLast = pure ListLast +unsafeSubExpressions _ ListIndexed = pure ListIndexed +unsafeSubExpressions _ ListReverse = pure ListReverse +unsafeSubExpressions _ Optional = pure Optional +unsafeSubExpressions f (Some a) = Some <$> f a +unsafeSubExpressions _ None = pure None +unsafeSubExpressions f (Union a) = Union <$> traverse (traverse f) a +unsafeSubExpressions f (Combine cs a b c) = Combine cs a <$> f b <*> f c +unsafeSubExpressions f (CombineTypes cs a b) = CombineTypes cs <$> f a <*> f b +unsafeSubExpressions f (Prefer cs a b c) = Prefer cs <$> pure a <*> f b <*> f c +unsafeSubExpressions f (RecordCompletion a b) = RecordCompletion <$> f a <*> f b +unsafeSubExpressions f (Merge a b t) = Merge <$> f a <*> f b <*> traverse f t +unsafeSubExpressions f (ToMap a t) = ToMap <$> f a <*> traverse f t +unsafeSubExpressions f (ShowConstructor a) = ShowConstructor <$> f a +unsafeSubExpressions f (Project a b) = Project <$> f a <*> traverse f b +unsafeSubExpressions f (Assert a) = Assert <$> f a +unsafeSubExpressions f (Equivalent cs a b) = Equivalent cs <$> f a <*> f b +unsafeSubExpressions f (With a b c) = With <$> f a <*> pure b <*> f c +unsafeSubExpressions f (ImportAlt l r) = ImportAlt <$> f l <*> f r +unsafeSubExpressions _ (Let {}) = unhandledConstructor "Let" +unsafeSubExpressions _ (Note {}) = unhandledConstructor "Note" +unsafeSubExpressions _ (Embed {}) = unhandledConstructor "Embed" +unsafeSubExpressions _ (Record {}) = unhandledConstructor "Record" +unsafeSubExpressions _ (RecordLit {}) = unhandledConstructor "RecordLit" +unsafeSubExpressions _ (Lam {}) = unhandledConstructor "Lam" +unsafeSubExpressions _ (Field {}) = unhandledConstructor "Field" +{-# INLINABLE unsafeSubExpressions #-} + +unhandledConstructor :: Text -> a +unhandledConstructor constructor = + internalError + ( "Dhall.Syntax.unsafeSubExpressions: Unhandled " + <> constructor + <> " construtor" + ) + +-- | Remove all `Note` constructors from an `Expr` (i.e. de-`Note`) +-- +-- This also remove CharacterSet annotations. +denote :: Expr s a -> Expr t a +denote = \case + Note _ b -> denote b + Let a b -> Let (denoteBinding a) (denote b) + Embed a -> Embed a + Combine _ _ b c -> Combine Nothing Nothing (denote b) (denote c) + CombineTypes _ b c -> CombineTypes Nothing (denote b) (denote c) + Prefer _ a b c -> Lens.over unsafeSubExpressions denote $ Prefer Nothing a b c + Record a -> Record $ denoteRecordField <$> a + RecordLit a -> RecordLit $ denoteRecordField <$> a + Lam _ a b -> Lam Nothing (denoteFunctionBinding a) (denote b) + Pi _ t a b -> Pi Nothing t (denote a) (denote b) + Field a (FieldSelection _ b _) -> Field (denote a) (FieldSelection Nothing b Nothing) + Equivalent _ a b -> Equivalent Nothing (denote a) (denote b) + expression -> Lens.over unsafeSubExpressions denote expression + where + denoteRecordField (RecordField _ e _ _) = RecordField Nothing (denote e) Nothing Nothing + + denoteBinding (Binding _ c _ d _ e) = + Binding Nothing c Nothing (fmap denoteBindingAnnotation d) Nothing (denote e) + + denoteBindingAnnotation (_, f) = (Nothing, denote f) + + denoteFunctionBinding (FunctionBinding _ l _ _ t) = + FunctionBinding Nothing l Nothing Nothing (denote t) + +-- | The \"opposite\" of `denote`, like @first absurd@ but faster +renote :: Expr Void a -> Expr s a +renote = unsafeCoerce +{-# INLINE renote #-} + +{-| Remove any outermost `Note` constructors + + This is typically used when you want to get the outermost non-`Note` + constructor without removing internal `Note` constructors +-} +shallowDenote :: Expr s a -> Expr s a +shallowDenote (Note _ e) = shallowDenote e +shallowDenote e = e + +-- | The set of reserved keywords according to the @keyword@ rule in the grammar +reservedKeywords :: HashSet Text +reservedKeywords = + Data.HashSet.fromList + [ "if" + , "then" + , "else" + , "let" + , "in" + , "using" + , "missing" + , "as" + , "Infinity" + , "NaN" + , "merge" + , "Some" + , "toMap" + , "assert" + , "forall" + , "with" + ] + +-- | The set of reserved identifiers for the Dhall language +-- | Contains also all keywords from "reservedKeywords" +reservedIdentifiers :: HashSet Text +reservedIdentifiers = reservedKeywords <> + Data.HashSet.fromList + [ -- Builtins according to the `builtin` rule in the grammar + "Natural/fold" + , "Natural/build" + , "Natural/isZero" + , "Natural/even" + , "Natural/odd" + , "Natural/toInteger" + , "Natural/show" + , "Natural/subtract" + , "Integer" + , "Integer/clamp" + , "Integer/negate" + , "Integer/show" + , "Integer/toDouble" + , "Integer/show" + , "Natural/subtract" + , "Double/show" + , "List/build" + , "List/fold" + , "List/length" + , "List/head" + , "List/last" + , "List/indexed" + , "List/reverse" + , "Text/replace" + , "Text/show" + , "Date/show" + , "Time/show" + , "TimeZone/show" + , "Bool" + , "Bytes" + , "True" + , "False" + , "Optional" + , "None" + , "Natural" + , "Integer" + , "Double" + , "Text" + , "Date" + , "Time" + , "TimeZone" + , "List" + , "Type" + , "Kind" + , "Sort" + ] + +{-| `shift` is used by both normalization and type-checking to avoid variable + capture by shifting variable indices + + For example, suppose that you were to normalize the following expression: + +> λ(a : Type) → λ(x : a) → (λ(y : a) → λ(x : a) → y) x + + If you were to substitute @y@ with @x@ without shifting any variable + indices, then you would get the following incorrect result: + +> λ(a : Type) → λ(x : a) → λ(x : a) → x -- Incorrect normalized form + + In order to substitute @x@ in place of @y@ we need to `shift` @x@ by @1@ in + order to avoid being misinterpreted as the @x@ bound by the innermost + lambda. If we perform that `shift` then we get the correct result: + +> λ(a : Type) → λ(x : a) → λ(x : a) → x@1 + + As a more worked example, suppose that you were to normalize the following + expression: + +> λ(a : Type) +> → λ(f : a → a → a) +> → λ(x : a) +> → λ(x : a) +> → (λ(x : a) → f x x@1) x@1 + + The correct normalized result would be: + +> λ(a : Type) +> → λ(f : a → a → a) +> → λ(x : a) +> → λ(x : a) +> → f x@1 x + + The above example illustrates how we need to both increase and decrease + variable indices as part of substitution: + + * We need to increase the index of the outer @x\@1@ to @x\@2@ before we + substitute it into the body of the innermost lambda expression in order + to avoid variable capture. This substitution changes the body of the + lambda expression to @(f x\@2 x\@1)@ + + * We then remove the innermost lambda and therefore decrease the indices of + both @x@s in @(f x\@2 x\@1)@ to @(f x\@1 x)@ in order to reflect that one + less @x@ variable is now bound within that scope + + Formally, @(shift d (V x n) e)@ modifies the expression @e@ by adding @d@ to + the indices of all variables named @x@ whose indices are greater than + @(n + m)@, where @m@ is the number of bound variables of the same name + within that scope + + In practice, @d@ is always @1@ or @-1@ because we either: + + * increment variables by @1@ to avoid variable capture during substitution + * decrement variables by @1@ when deleting lambdas after substitution + + @n@ starts off at @0@ when substitution begins and increments every time we + descend into a lambda or let expression that binds a variable of the same + name in order to avoid shifting the bound variables by mistake. +-} +shift :: Int -> Var -> Expr s a -> Expr s a +shift d (V x n) (Var (V x' n')) = Var (V x' n'') + where + n'' = if x == x' && n <= n' then n' + d else n' +shift d (V x n) (Lam cs (FunctionBinding src0 x' src1 src2 _A) b) = + Lam cs (FunctionBinding src0 x' src1 src2 _A') b' + where + _A' = shift d (V x n ) _A + b' = shift d (V x n') b + where + n' = if x == x' then n + 1 else n +shift d (V x n) (Pi cs x' _A _B) = Pi cs x' _A' _B' + where + _A' = shift d (V x n ) _A + _B' = shift d (V x n') _B + where + n' = if x == x' then n + 1 else n +shift d (V x n) (Let (Binding src0 f src1 mt src2 r) e) = + Let (Binding src0 f src1 mt' src2 r') e' + where + e' = shift d (V x n') e + where + n' = if x == f then n + 1 else n + + mt' = fmap (fmap (shift d (V x n))) mt + r' = shift d (V x n) r +shift d v expression = Lens.over subExpressions (shift d v) expression + +_ERROR :: String +_ERROR = "\ESC[1;31mError\ESC[0m" + +{-| Utility function used to throw internal errors that should never happen + (in theory) but that are not enforced by the type system +-} +internalError :: Data.Text.Text -> forall b . b +internalError text = error (unlines + [ _ERROR <> ": Compiler bug " + , " " + , "Explanation: This error message means that there is a bug in the Dhall compiler." + , "You didn't do anything wrong, but if you would like to see this problem fixed " + , "then you should report the bug at: " + , " " + , "https://github.com/dhall-lang/dhall-haskell/issues " + , " " + , "Please include the following text in your bug report: " + , " " + , "``` " + , Data.Text.unpack text <> " " + , "``` " + ] ) diff --git a/src/Dhall/Syntax/Operations.hs-boot b/src/Dhall/Syntax/Operations.hs-boot new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Operations.hs-boot @@ -0,0 +1,5 @@ +module Dhall.Syntax.Operations where + +import Dhall.Syntax.Expr (Expr) + +unsafeSubExpressions :: Applicative f => (Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b) diff --git a/src/Dhall/Syntax/RecordField.hs b/src/Dhall/Syntax/RecordField.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/RecordField.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.RecordField + ( RecordField(..) + , makeRecordField + + -- * Optics + , recordFieldExprs + ) where + +import {-# SOURCE #-} Dhall.Syntax.Expr (Expr) +import GHC.Generics (Generic) + +-- | Record the field of a record-type and record-literal expression. +-- The reason why we use the same ADT for both of them is because they store +-- the same information. +-- +-- For example, +-- +-- > { {- A -} x {- B -} : {- C -} T } +-- +-- ... or +-- +-- > { {- A -} x {- B -} = {- C -} T } +-- +-- will be instantiated as follows: +-- +-- * @recordFieldSrc0@ corresponds to the @A@ comment. +-- * @recordFieldValue@ is @"T"@ +-- * @recordFieldSrc1@ corresponds to the @B@ comment. +-- * @recordFieldSrc2@ corresponds to the @C@ comment. +-- +-- Although the @A@ comment isn't annotating the @"T"@ Record Field, +-- this is the best place to keep these comments. +-- +-- Note that @recordFieldSrc2@ is always 'Nothing' when the 'RecordField' is for +-- a punned entry, because there is no @=@ sign. For example, +-- +-- > { {- A -} x {- B -} } +-- +-- will be instantiated as follows: +-- +-- * @recordFieldSrc0@ corresponds to the @A@ comment. +-- * @recordFieldValue@ corresponds to @(Var "x")@ +-- * @recordFieldSrc1@ corresponds to the @B@ comment. +-- * @recordFieldSrc2@ will be 'Nothing' +-- +-- The labels involved in a record using dot-syntax like in this example: +-- +-- > { {- A -} a {- B -} . {- C -} b {- D -} . {- E -} c {- F -} = {- G -} e } +-- +-- will be instantiated as follows: +-- +-- * For both the @a@ and @b@ field, @recordfieldSrc2@ is 'Nothing' +-- * For the @a@ field: +-- * @recordFieldSrc0@ corresponds to the @A@ comment +-- * @recordFieldSrc1@ corresponds to the @B@ comment +-- * For the @b@ field: +-- * @recordFieldSrc0@ corresponds to the @C@ comment +-- * @recordFieldSrc1@ corresponds to the @D@ comment +-- * For the @c@ field: +-- * @recordFieldSrc0@ corresponds to the @E@ comment +-- * @recordFieldSrc1@ corresponds to the @F@ comment +-- * @recordFieldSrc2@ corresponds to the @G@ comment +-- +-- That is, for every label except the last one the semantics of +-- @recordFieldSrc0@ and @recordFieldSrc1@ are the same from a regular record +-- label but @recordFieldSrc2@ is always 'Nothing'. For the last keyword, all +-- srcs are 'Just' +data RecordField s a = RecordField + { recordFieldSrc0 :: Maybe s + , recordFieldValue :: Expr s a + , recordFieldSrc1 :: Maybe s + , recordFieldSrc2 :: Maybe s + } deriving Generic + +-- | Construct a 'RecordField' with no src information +makeRecordField :: Expr s a -> RecordField s a +makeRecordField e = RecordField Nothing e Nothing Nothing + +{-| Traverse over the immediate 'Expr' children in a 'RecordField'. +-} +recordFieldExprs + :: Applicative f + => (Expr s a -> f (Expr s b)) + -> RecordField s a -> f (RecordField s b) +recordFieldExprs f (RecordField s0 e s1 s2) = + RecordField + <$> pure s0 + <*> f e + <*> pure s1 + <*> pure s2 +{-# INLINABLE recordFieldExprs #-} diff --git a/src/Dhall/Syntax/Types.hs b/src/Dhall/Syntax/Types.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Types.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.Types + ( DhallDouble(..) + , PreferAnnotation(..) + , FieldSelection(..) + , makeFieldSelection + , WithComponent(..) + ) where + +import Data.Text (Text) +import GHC.Generics (Generic) + +-- | This wrapper around 'Prelude.Double' exists for its 'Eq' instance which is +-- defined via the binary encoding of Dhall @Double@s. +newtype DhallDouble = DhallDouble { getDhallDouble :: Double } + deriving Generic + +-- | Used to record the origin of a @//@ operator (i.e. from source code or a +-- product of desugaring) +data PreferAnnotation + = PreferFromSource + | PreferFromCompletion + deriving Generic + +-- | Record the field on a selector-expression +-- +-- For example, +-- +-- > e . {- A -} x {- B -} +-- +-- … will be instantiated as follows: +-- +-- * @fieldSelectionSrc0@ corresponds to the @A@ comment +-- * @fieldSelectionLabel@ corresponds to @x@ +-- * @fieldSelectionSrc1@ corresponds to the @B@ comment +-- +-- Given our limitation that not all expressions recover their whitespaces, the +-- purpose of @fieldSelectionSrc1@ is to save the 'Text.Megaparsec.SourcePos' +-- where the @fieldSelectionLabel@ ends, but we /still/ use a +-- 'Maybe Dhall.Src.Src' (@s = 'Dhall.Src.Src'@) to be consistent with similar +-- data types such as 'Dhall.Syntax.Binding.Binding', for example. +data FieldSelection s = FieldSelection + { fieldSelectionSrc0 :: Maybe s + , fieldSelectionLabel :: !Text + , fieldSelectionSrc1 :: Maybe s + } deriving Generic + +-- | Smart constructor for 'FieldSelection' with no src information +makeFieldSelection :: Text -> FieldSelection s +makeFieldSelection t = FieldSelection Nothing t Nothing + +-- | A path component for a @with@ expression +data WithComponent = WithLabel Text | WithQuestion + deriving Generic diff --git a/src/Dhall/Syntax/Types.hs-boot b/src/Dhall/Syntax/Types.hs-boot new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Types.hs-boot @@ -0,0 +1,14 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + +module Dhall.Syntax.Types where + +import Data.Kind (Type) + +data DhallDouble + +data PreferAnnotation + +type FieldSelection :: Type -> Type +data FieldSelection s + +data WithComponent diff --git a/src/Dhall/Syntax/Var.hs b/src/Dhall/Syntax/Var.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Syntax/Var.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.Var + ( Var(..) + ) where + +import Data.String (IsString (..)) +import Data.Text (Text) +import GHC.Generics (Generic) + +{-| Label for a bound variable + + The `Data.Text.Text` field is the variable's name (i.e. \"@x@\"). + + The `Int` field disambiguates variables with the same name if there are + multiple bound variables of the same name in scope. Zero refers to the + nearest bound variable and the index increases by one for each bound + variable of the same name going outward. The following diagram may help: + +> ┌──refers to──┐ +> │ │ +> v │ +> λ(x : Type) → λ(y : Type) → λ(x : Type) → x@0 +> +> ┌─────────────────refers to─────────────────┐ +> │ │ +> v │ +> λ(x : Type) → λ(y : Type) → λ(x : Type) → x@1 + + This `Int` behaves like a De Bruijn index in the special case where all + variables have the same name. + + You can optionally omit the index if it is @0@: + +> ┌─refers to─┐ +> │ │ +> v │ +> λ(x : Type) → λ(y : Type) → λ(x : Type) → x + + Zero indices are omitted when pretty-printing @Var@s and non-zero indices + appear as a numeric suffix. +-} +data Var = V Text !Int + deriving Generic + +instance IsString Var where + fromString str = V (fromString str) 0 diff --git a/src/Dhall/TH.hs b/src/Dhall/TH.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/TH.hs @@ -0,0 +1,635 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | Template Haskell utilities +module Dhall.TH + ( -- * Embedding Dhall in Haskell + staticDhallExpression + , dhall + -- * Generating Haskell from Dhall expressions + , makeHaskellTypeFromUnion + , makeHaskellTypes + , makeHaskellTypesWith + , HaskellType(..) + , GenerateOptions(..) + , defaultGenerateOptions + ) where + +import Control.Monad (forM_) +import Data.Bifunctor (first) +import Data.Text (Text) +import Dhall (FromDhall, ToDhall) +import Dhall.Syntax (Expr (..), FunctionBinding (..), Var (..)) +import GHC.Generics (Generic) +import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) +import Lens.Micro.Extras (view) +import Prettyprinter (Pretty) + +import Language.Haskell.TH.Syntax + ( Bang (..) + , Body (..) + , Con (..) + , Dec (..) + , Exp (..) + , Match (..) + , Pat (..) + , Q + , SourceStrictness (..) + , SourceUnpackedness (..) + , Type (..) + ) + +import Language.Haskell.TH.Syntax (DerivClause (..), DerivStrategy (..)) + +import qualified Data.List as List +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Data.Typeable as Typeable +import qualified Dhall +import qualified Dhall.Core as Core +import qualified Dhall.Import +import qualified Dhall.Map +import qualified Dhall.Pretty +import qualified Dhall.Util +import qualified GHC.IO.Encoding +import qualified Language.Haskell.TH.Syntax as TH +import qualified Numeric.Natural +import qualified Prettyprinter.Render.String as Pretty +import qualified System.IO + + +{-| This fully resolves, type checks, and normalizes the expression, so the + resulting AST is self-contained. + + This can be used to resolve all of an expression’s imports at compile time, + allowing one to reference Dhall expressions from Haskell without having a + runtime dependency on the location of Dhall files. + + For example, given a file @".\/Some\/Type.dhall"@ containing + + > < This : Natural | Other : ../Other/Type.dhall > + + ... rather than duplicating the AST manually in a Haskell `Dhall.Type`, you + can do: + + > Dhall.Type + > (\case + > UnionLit "This" _ _ -> ... + > UnionLit "Other" _ _ -> ...) + > $(staticDhallExpression "./Some/Type.dhall") + + This would create the Dhall Expr AST from the @".\/Some\/Type.dhall"@ file + at compile time with all imports resolved, making it easy to keep your Dhall + configs and Haskell interpreters in sync. +-} +staticDhallExpression :: Text -> Q Exp +staticDhallExpression text = do + TH.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) + + (expression, status) <- TH.runIO $ do + parsed <- Dhall.parseWithSettings Dhall.defaultInputSettings text + + (resolved, status) <- Dhall.resolveAndStatusWithSettings Dhall.defaultInputSettings parsed + + _ <- Dhall.typecheckWithSettings Dhall.defaultInputSettings resolved + + let normalized = Dhall.normalizeWithSettings Dhall.defaultInputSettings resolved + + pure (normalized, status) + + forM_ (Dhall.Map.keys (view Dhall.Import.cache status)) $ \chained -> + case Dhall.Import.chainedImport chained of + Core.Import + { importHashed = Core.ImportHashed + { importType = Core.Local prefix file + } + } -> do + fp <- Dhall.Import.localToPath prefix file + TH.addDependentFile fp + _ -> return () + + dataToExpQ (fmap liftText . Typeable.cast) expression + where + -- A workaround for a problem in TemplateHaskell (see + -- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable) + liftText = fmap (AppE (VarE 'Text.pack)) . TH.lift . Text.unpack + +{-| A quasi-quoter for Dhall expressions. + + This quoter is build on top of 'staticDhallExpression'. Therefore consult the + documentation of that function for further information. + + This quoter is meant to be used in expression context only; Other contexts + like pattern contexts or declaration contexts are not supported and will + result in an error. +-} +dhall :: QuasiQuoter +dhall = QuasiQuoter + { quoteExp = staticDhallExpression . Text.pack + , quotePat = const $ error "dhall quasi-quoter: Quoting patterns is not supported!" + , quoteType = const $ error "dhall quasi-quoter: Quoting types is not supported!" + , quoteDec = const $ error "dhall quasi-quoter: Quoting declarations is not supported!" + } + +{-| Convert a Dhall type to a Haskell type that does not require any new + data declarations beyond the data declarations supplied as the first + argument +-} +toNestedHaskellType + :: (Eq a, Pretty a) + => [Var] + -> [HaskellType (Expr s a)] + -- ^ All Dhall-derived data declarations + -- + -- Used to replace complex types with references to one of these + -- data declarations when the types match + -> Expr s a + -- ^ Dhall expression to convert to a simple Haskell type + -> Q Type +toNestedHaskellType typeParams haskellTypes = loop + where + predicate dhallType haskellType = Core.judgmentallyEqual (code haskellType) dhallType + + document dhallType = + mconcat + [ "Unsupported nested type\n" + , " \n" + , "Explanation: Not all Dhall types can be nested within Haskell datatype \n" + , "declarations. Specifically, only the following simple Dhall types are supported\n" + , "as a nested type inside of a data declaration: \n" + , " \n" + , "• ❰Bool❱ \n" + , "• ❰Double❱ \n" + , "• ❰Integer❱ \n" + , "• ❰Natural❱ \n" + , "• ❰Text❱ \n" + , "• ❰Date❱ \n" + , "• ❰TimeOfDay❱ \n" + , "• ❰TimeZone❱ \n" + , "• ❰List a❱ (where ❰a❱ is also a valid nested type) \n" + , "• ❰Optional a❱ (where ❰a❱ is also a valid nested type) \n" + , "• Another matching datatype declaration \n" + , "• A bound type variable \n" + , " \n" + , "The Haskell datatype generation logic encountered the following Dhall type: \n" + , " \n" + , " " <> Dhall.Util.insert dhallType <> "\n" + , " \n" + , "... which did not fit any of the above criteria." + ] + + message dhallType = Pretty.renderString (Dhall.Pretty.layout (document dhallType)) + + loop dhallType = case dhallType of + Bool -> + return (ConT ''Bool) + + Double -> + return (ConT ''Double) + + Integer -> + return (ConT ''Integer) + + Natural -> + return (ConT ''Numeric.Natural.Natural) + + Text -> + return (ConT ''Text) + + Date -> + return (ConT ''Time.Day) + + Time -> + return (ConT ''Time.TimeOfDay) + + TimeZone -> + return (ConT ''Time.TimeZone) + + App List dhallElementType -> do + haskellElementType <- loop dhallElementType + + return (AppT (ConT ''[]) haskellElementType) + + App Optional dhallElementType -> do + haskellElementType <- loop dhallElementType + + return (AppT (ConT ''Maybe) haskellElementType) + + App dhallAppType dhallElementType -> do + haskellAppType <- loop dhallAppType + haskellElementType <- loop dhallElementType + + return (AppT haskellAppType haskellElementType) + + Var v + | Just (V param index) <- List.find (v ==) typeParams -> do + let name = TH.mkName $ (Text.unpack param) ++ (show index) + + return (VarT name) + + | otherwise -> fail $ message v + + _ | Just haskellType <- List.find (predicate dhallType) haskellTypes -> do + let name = TH.mkName (Text.unpack (typeName haskellType)) + + return (ConT name) + | otherwise -> fail $ message dhallType + +-- | A deriving clause for `Generic`. +derivingGenericClause :: DerivClause +derivingGenericClause = DerivClause (Just StockStrategy) [ ConT ''Generic ] + +-- | Generates a `FromDhall` instances. +fromDhallInstance + :: TH.Name -- ^ The name of the type the instances is for + -> Q Exp -- ^ A TH splice generating some `Dhall.InterpretOptions` + -> Q [Dec] +fromDhallInstance n interpretOptions = [d| + instance FromDhall $(pure $ ConT n) where + autoWith = Dhall.genericAutoWithInputNormalizer $(interpretOptions) + |] + +-- | Generates a `ToDhall` instances. +toDhallInstance + :: TH.Name -- ^ The name of the type the instances is for + -> Q Exp -- ^ A TH splice generating some `Dhall.InterpretOptions` + -> Q [Dec] +toDhallInstance n interpretOptions = [d| + instance ToDhall $(pure $ ConT n) where + injectWith = Dhall.genericToDhallWithInputNormalizer $(interpretOptions) + |] + +-- | Convert a Dhall type to the corresponding Haskell datatype declaration +toDeclaration + :: (Eq a, Pretty a) + => GenerateOptions + -> [HaskellType (Expr s a)] + -> HaskellType (Expr s a) + -> Q [Dec] +toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ = + case typ of + SingleConstructor{..} -> uncurry (fromSingle typeName constructorName) $ getTypeParams code + MultipleConstructors{..} -> uncurry (fromMulti typeName) $ getTypeParams code + where + getTypeParams = first numberConsecutive . getTypeParams_ [] + + getTypeParams_ acc (Lam _ (FunctionBinding _ v _ _ _) rest) = getTypeParams_ (v:acc) rest + getTypeParams_ acc rest = (acc, rest) + + derivingClauses = [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] + + interpretOptions = generateToInterpretOptions generateOptions typ + +#if MIN_VERSION_template_haskell(2,21,0) + toTypeVar (V n i) = TH.PlainTV (TH.mkName (Text.unpack n ++ show i)) TH.BndrReq +#elif MIN_VERSION_template_haskell(2,17,0) + toTypeVar (V n i) = TH.PlainTV (TH.mkName (Text.unpack n ++ show i)) () +#else + toTypeVar (V n i) = TH.PlainTV (TH.mkName (Text.unpack n ++ show i)) +#endif + + toDataD typeName typeParams constructors = do + let name = TH.mkName (Text.unpack typeName) + + let params = fmap toTypeVar typeParams + + fmap concat . sequence $ + [pure [DataD [] name params Nothing constructors derivingClauses]] <> + [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <> + [ toDhallInstance name interpretOptions | generateToDhallInstance ] + + fromSingle typeName constructorName typeParams dhallType = do + constructor <- toConstructor typeParams generateOptions haskellTypes typeName (constructorName, Just dhallType) + + toDataD typeName typeParams [constructor] + + fromMulti typeName typeParams dhallType = case dhallType of + Union kts -> do + constructors <- traverse (toConstructor typeParams generateOptions haskellTypes typeName) (Dhall.Map.toList kts) + + toDataD typeName typeParams constructors + + _ -> fail $ message dhallType + + message dhallType = Pretty.renderString (Dhall.Pretty.layout $ document dhallType) + + document dhallType = + mconcat + [ "Dhall.TH.makeHaskellTypes: Not a union type\n" + , " \n" + , "Explanation: This function expects the ❰code❱ field of ❰MultipleConstructors❱ to\n" + , "evaluate to a union type. \n" + , " \n" + , "For example, this is a valid Dhall union type that this function would accept: \n" + , " \n" + , " \n" + , " ┌──────────────────────────────────────────────────────────────────┐ \n" + , " │ Dhall.TH.makeHaskellTypes (MultipleConstructors \"T\" \"< A | B >\") │ \n" + , " └──────────────────────────────────────────────────────────────────┘ \n" + , " \n" + , " \n" + , "... which corresponds to this Haskell type declaration: \n" + , " \n" + , " \n" + , " ┌────────────────┐ \n" + , " │ data T = A | B │ \n" + , " └────────────────┘ \n" + , " \n" + , " \n" + , "... but the following Dhall type is rejected due to being a bare record type: \n" + , " \n" + , " \n" + , " ┌──────────────────────────────────────────────┐ \n" + , " │ Dhall.TH.makeHaskellTypes \"T\" \"{ x : Bool }\" │ Not valid \n" + , " └──────────────────────────────────────────────┘ \n" + , " \n" + , " \n" + , "The Haskell datatype generation logic encountered the following Dhall type: \n" + , " \n" + , " " <> Dhall.Util.insert dhallType <> "\n" + , " \n" + , "... which is not a union type." + ] + +-- | Number each variable, starting at 0 +numberConsecutive :: [Text.Text] -> [Var] +numberConsecutive = snd . List.mapAccumR go Map.empty . reverse + where + go m k = + let (i, m') = Map.updateLookupWithKey (\_ j -> Just $ j + 1) k m + in maybe ((Map.insert k 0 m'), (V k 0)) (\i' -> (m', (V k i'))) i + +-- | Convert a Dhall type to the corresponding Haskell constructor +toConstructor + :: (Eq a, Pretty a) + => [Var] + -> GenerateOptions + -> [HaskellType (Expr s a)] + -> Text + -- ^ typeName + -> (Text, Maybe (Expr s a)) + -- ^ @(constructorName, fieldType)@ + -> Q Con +toConstructor typeParams GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do + let name = TH.mkName (Text.unpack $ constructorModifier constructorName) + + let strictness = if makeStrict then SourceStrict else NoSourceStrictness + + let bang = Bang NoSourceUnpackedness strictness + + case maybeAlternativeType of + Just dhallType + | let predicate haskellType = + Core.judgmentallyEqual (code haskellType) dhallType + && typeName haskellType /= outerTypeName + , Just haskellType <- List.find predicate haskellTypes -> do + let innerName = + TH.mkName (Text.unpack (typeName haskellType)) + + return (NormalC name [ (bang, ConT innerName) ]) + + Just (Record kts) -> do + let process (key, dhallFieldType) = do + haskellFieldType <- toNestedHaskellType typeParams haskellTypes dhallFieldType + + return (TH.mkName (Text.unpack $ fieldModifier key), bang, haskellFieldType) + + varBangTypes <- traverse process (Dhall.Map.toList $ Core.recordFieldValue <$> kts) + + return (RecC name varBangTypes) + + Just dhallAlternativeType -> do + haskellAlternativeType <- toNestedHaskellType typeParams haskellTypes dhallAlternativeType + + return (NormalC name [ (bang, haskellAlternativeType) ]) + + Nothing -> + return (NormalC name []) + +-- | Generate a Haskell datatype declaration from a Dhall union type where +-- each union alternative corresponds to a Haskell constructor +-- +-- For example, this Template Haskell splice: +-- +-- > Dhall.TH.makeHaskellTypeFromUnion "T" "< A : { x : Bool } | B >" +-- +-- ... generates this Haskell code: +-- +-- > data T = A {x :: GHC.Types.Bool} | B +-- +-- This is a special case of `Dhall.TH.makeHaskellTypes`: +-- +-- > makeHaskellTypeFromUnion typeName code = +-- > makeHaskellTypes [ MultipleConstructors{..} ] +makeHaskellTypeFromUnion + :: Text + -- ^ Name of the generated Haskell type + -> Text + -- ^ Dhall code that evaluates to a union type + -> Q [Dec] +makeHaskellTypeFromUnion typeName code = + makeHaskellTypes [ MultipleConstructors{..} ] + +-- | Used by `makeHaskellTypes` and `makeHaskellTypesWith` to specify how to +-- generate Haskell types. +data HaskellType code + -- | Generate a Haskell type with more than one constructor from a Dhall + -- union type. + = MultipleConstructors + { typeName :: Text + -- ^ Name of the generated Haskell type + , code :: code + -- ^ Dhall code that evaluates to a union type + } + -- | Generate a Haskell type with one constructor from any Dhall type. + -- + -- To generate a constructor with multiple named fields, supply a Dhall + -- record type. This does not support more than one anonymous field. + | SingleConstructor + { typeName :: Text + -- ^ Name of the generated Haskell type + , constructorName :: Text + -- ^ Name of the constructor + , code :: code + -- ^ Dhall code that evaluates to a type + } + deriving (Functor, Foldable, Traversable) + +-- | This data type holds various options that let you control several aspects +-- how Haskell code is generated. In particular you can +-- +-- * disable the generation of `FromDhall`/`ToDhall` instances. +-- * modify how a Dhall union field translates to a Haskell data constructor. +data GenerateOptions = GenerateOptions + { constructorModifier :: Text -> Text + -- ^ How to map a Dhall union field name to a Haskell constructor. + -- Note: The `constructorName` of `SingleConstructor` will be passed to this function, too. + , fieldModifier :: Text -> Text + -- ^ How to map a Dhall record field names to a Haskell record field names. + , generateFromDhallInstance :: Bool + -- ^ Generate a `FromDhall` instance for the Haskell type + , generateToDhallInstance :: Bool + -- ^ Generate a `ToDhall` instance for the Haskell type + , makeStrict :: Bool + -- ^ Make all fields strict. + } + +-- | A default set of options used by `makeHaskellTypes`. That means: +-- +-- * Constructors and fields are passed unmodified. +-- * Both `FromDhall` and `ToDhall` instances are generated. +-- +-- Note: `From/ToDhall` should be `False` if importing higher-kinded types. +-- In these cases one should use a standalone declaration. +defaultGenerateOptions :: GenerateOptions +defaultGenerateOptions = GenerateOptions + { constructorModifier = id + , fieldModifier = id + , generateFromDhallInstance = True + , generateToDhallInstance = True + , makeStrict = False + } + +-- | This function generates `Dhall.InterpretOptions` that can be used for the +-- marshalling of the Haskell type generated according to the `GenerateOptions`. +-- I.e. those `Dhall.InterpretOptions` reflect the mapping done by +-- `constructorModifier` and `fieldModifier` on the value level. +generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp +generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretOptions + { Dhall.fieldModifier = \ $(pure nameP) -> + $(toCases fieldModifier $ fields haskellType) + , Dhall.constructorModifier = \ $(pure nameP) -> + $(toCases constructorModifier $ constructors haskellType) + , Dhall.singletonConstructors = Dhall.singletonConstructors Dhall.defaultInterpretOptions + }|] + where + constructors :: HaskellType (Expr s a) -> [Text] + constructors SingleConstructor{..} = [constructorName] + constructors MultipleConstructors{..} | Union kts <- code = Dhall.Map.keys kts + constructors _ = [] + + fields :: HaskellType (Expr s a) -> [Text] + fields SingleConstructor{..} | Record kts <- code = Dhall.Map.keys kts + fields MultipleConstructors{..} | Union kts <- code = Set.toList $ mconcat + [ Dhall.Map.keysSet kts' + | (_, Just (Record kts')) <- Dhall.Map.toList kts + ] + fields _ = [] + + toCases :: (Text -> Text) -> [Text] -> Q Exp + toCases f xs = do + err <- [| Core.internalError $ "Unmatched " <> Text.pack (show $(pure nameE)) |] + pure $ CaseE nameE $ map mkMatch xs <> [Match WildP (NormalB err) []] + where + mkMatch n = Match (textToPat $ f n) (NormalB $ textToExp n) [] + + nameE :: Exp + nameE = TH.VarE $ TH.mkName "n" + + nameP :: Pat + nameP = TH.VarP $ TH.mkName "n" + + textToExp :: Text -> Exp + textToExp = TH.LitE . TH.StringL . Text.unpack + + textToPat :: Text -> Pat + textToPat = TH.LitP . TH.StringL . Text.unpack + +-- | Generate a Haskell datatype declaration with one constructor from a Dhall +-- type. +-- +-- This comes in handy if you need to keep Dhall types and Haskell types in +-- sync. You make the Dhall types the source of truth and use Template Haskell +-- to generate the matching Haskell type declarations from the Dhall types. +-- +-- For example, given this Dhall code: +-- +-- > -- ./Department.dhall +-- > < Sales | Engineering | Marketing > +-- +-- > -- ./Employee.dhall +-- > { name : Text, department : ./Department.dhall } +-- +-- ... this Template Haskell splice: +-- +-- > {-# LANGUAGE DeriveAnyClass #-} +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE DerivingStrategies #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > {-# LANGUAGE TemplateHaskell #-} +-- > +-- > Dhall.TH.makeHaskellTypes +-- > [ MultipleConstructors "Department" "./tests/th/Department.dhall" +-- > , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall" +-- > ] +-- +-- ... generates this Haskell code: +-- +-- > data Department = Engineering | Marketing | Sales +-- > deriving stock (GHC.Generics.Generic) +-- > deriving anyclass (Dhall.FromDhall, Dhall.ToDhall) +-- > +-- > data Employee +-- > = MakeEmployee {department :: Department, +-- > name :: Data.Text.Internal.Text} +-- > deriving stock (GHC.Generics.Generic) +-- > deriving anyclass (Dhall.FromDhall, Dhall.ToDhall) +-- +-- Carefully note that the conversion makes a best-effort attempt to +-- auto-detect when a Dhall type (like @./Employee.dhall@) refers to another +-- Dhall type (like @./Department.dhall@) and replaces that reference with the +-- corresponding Haskell type. +-- +-- This Template Haskell splice requires you to enable the following extensions: +-- +-- * @DeriveGeneric@ +-- * @DerivingAnyClass@ +-- * @DerivingStrategies@ +-- +-- By default, the generated types only derive `GHC.Generics.Generic`, +-- `Dhall.FromDhall`, and `Dhall.ToDhall`. To add any desired instances (such +-- as `Eq`\/`Ord`\/`Show`), you can use the @StandaloneDeriving@ language +-- extension, like this: +-- +-- > {-# LANGUAGE DeriveAnyClass #-} +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE DerivingStrategies #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > {-# LANGUAGE StandaloneDeriving #-} +-- > {-# LANGUAGE TemplateHaskell #-} +-- > +-- > Dhall.TH.makeHaskellTypes +-- > [ MultipleConstructors "Department" "./tests/th/Department.dhall" +-- > , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall" +-- > ] +-- > +-- > deriving instance Eq Department +-- > deriving instance Ord Department +-- > deriving instance Show Department +-- > +-- > deriving instance Eq Employee +-- > deriving instance Ord Employee +-- > deriving instance Show Employee +makeHaskellTypes :: [HaskellType Text] -> Q [Dec] +makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions + +-- | Like `makeHaskellTypes`, but with the ability to customize the generated +-- Haskell code by passing `GenerateOptions`. +-- +-- For instance, `makeHaskellTypes` is implemented using this function: +-- +-- > makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions +makeHaskellTypesWith :: GenerateOptions -> [HaskellType Text] -> Q [Dec] +makeHaskellTypesWith generateOptions haskellTypes = do + TH.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) + + haskellTypes' <- traverse (traverse (TH.runIO . Dhall.inputExpr)) haskellTypes + + concat <$> traverse (toDeclaration generateOptions haskellTypes') haskellTypes' diff --git a/src/Dhall/Tags.hs b/src/Dhall/Tags.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Tags.hs @@ -0,0 +1,269 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | This module contains the implementation of the @dhall tags@ command + +module Dhall.Tags + ( generate + ) where + +import Control.Exception (SomeException (..), handle) +import Data.List (foldl', isSuffixOf) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Dhall.Map (foldMapWithKey) +import Dhall.Parser (exprFromText) +import Dhall.Src (Src (srcStart)) +import Dhall.Syntax (Binding (..), Expr (..), RecordField (..)) +import Dhall.Util (Input (..)) +import System.FilePath (takeFileName, ()) +import Text.Megaparsec (sourceColumn, sourceLine, unPos) + +import qualified Data.ByteString as BS (length) +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified System.Directory as SD + +{- + Documentation for the etags format is not very informative and not very correct. + You can find some documentation here: + https://en.wikipedia.org/wiki/Ctags#Etags_2 + and you can also check the source code here: + http://cvs.savannah.gnu.org/viewvc/vtags/vtags/vtags.el?view=markup +-} + +data LineColumn = LC + { _lcLine :: Int + -- ^ line number, starting from 1, where to find the tag + , _lcColumn :: Int + -- ^ column of line where tag is + } deriving (Eq, Ord, Show) + +data LineOffset = LO + { loLine :: Int + -- ^ line number, starting from 1, where to find the tag + , loOffset :: Int + -- ^ byte offset from start of file. Not sure if any editor uses it + } deriving (Eq, Ord, Show) + +newtype Tags = Tags (M.Map FilePath [(LineOffset, Tag)]) + +instance Semigroup Tags where + (Tags ts1) <> (Tags ts2) = Tags (M.unionWith (<>) ts1 ts2) + +instance Monoid Tags where + mempty = Tags M.empty + +{-| For example, for the line: @let foo = \"foo\"@ the tag is: + > Tag "let " "foo" +-} +data Tag = Tag + { tagPattern :: Text + -- ^ In vtags source code this field is named \"pattern\" and EMacs used it as + -- a regex pattern to locate line with tag. It's looking for ^. + -- Looks like vi is not using it. + , tagName :: Text + -- ^ text, that editor compare with selected text. So it's really name of entity + } deriving (Show) + +type LineNumber = Int + +type ByteOffset = Int + +{-| Generate etags for Dhall expressions +-} +generate + :: Input + -- ^ Where to look for files. This can be a directory name (@.@ for example), + -- a file name or `StandardInput`. If `StandardInput`, then this will wait for + -- file names from @STDIN@. + -- This way someone can combine tools in @bash@ to send, for example, output from + -- @find@ to the input of @dhall tags@. + -> Maybe [Text] + -- ^ List of suffixes for dhall files or Nothing to check all files + -> Bool + -- ^ Flag if `generate` should follow symlinks + -> IO Text + -- ^ Content for tags file +generate inp sxs followSyms = do + files <- inputToFiles followSyms (map T.unpack <$> sxs) inp + tags <- traverse (\f -> handle (\(SomeException _) -> return mempty) + (fileTags f <$> TIO.readFile f)) files + return (showTags . mconcat $ tags) + +{-| Find tags in Text (second argument) and generates a list of them + To make tags for filenames that works in both emacs and vi, add two initial tags. + First for @filename@ for vi and second with @/filename@ for emacs. + Other tags are working for both. +-} +fileTags :: FilePath -> Text -> Tags +fileTags f t = Tags (M.singleton f + (initialMap <> getTagsFromText t)) + where initialViTag = (LO 1 1, Tag "" (T.pack . takeFileName $ f)) + initialEmacsTag = (LO 1 1, Tag "" ("/" <> (T.pack . takeFileName) f)) + initialMap = [initialViTag, initialEmacsTag] + +getTagsFromText :: Text -> [(LineOffset, Tag)] +getTagsFromText t = case exprFromText "" t of + Right expr -> fixPosAndDefinition t (getTagsFromExpr expr) + _ -> mempty + +{-| Used to update tag position and to build tag from term. + After getTagsFromExpr line and column in line are in @LineColumn@ for each tag. + And tagPattern is not added. + Emacs use tag pattern to check if tag is on line. It compares line from start + with tag pattern and in case they are the same, relocate user. + fixPosAndDefinition change position to line and byte offset (@LineOffset@) and + add tag pattern. For example, for Dhall string: + + >>> let dhallSource = "let foo = \"bar\"\nlet baz = \"qux\"" + + Input for this function is: + + >>> foundTerms = [(LC 1 4, "foo"), (LC 2 4, "baz")] + + And: + + >>> fixPosAndDefinition dhallSource foundTerms + [(LO {loLine = 1, loOffset = 5},Tag {tagPattern = "let foo ", tagName = "foo"}),(LO {loLine = 2, loOffset = 21},Tag {tagPattern = "let baz ", tagName = "baz"})] + + where 21 is byte offset from file start. +-} +fixPosAndDefinition :: Text -> [(LineColumn, Text)] -> [(LineOffset, Tag)] +fixPosAndDefinition t = foldMap (\(LC ln c, term) -> + let (ln', offset, tPattern) = fromMaybe (fallbackInfoForText ln c) + (infoForText term ln) + in [(LO ln' offset, Tag tPattern term)]) + where mls :: M.Map Int (Text, Int) + -- ^ mls is map that for each line has length of file before this map and line content. + -- In example above, first line is 15 bytes long and '\n', mls contain: + -- (1, (16, "let foo = "bar"") + -- That allow us to get byte offset easier. + mls = M.fromList . fst . foldl' processLine ([], 0) . zip [1..] $ T.lines t + + {-| processLine is a worker for `foldl` that generates the list of lines with + byte offsets from the start of the first line from a list of lines + -} + processLine + :: ([(LineNumber, (Text, ByteOffset))], ByteOffset) + -- ^ previous result and byte offset for the start of current line + -> (LineNumber, Text) + -> ([(LineNumber, (Text, ByteOffset))], ByteOffset) + -- ^ next result, where new line was added and byte offset for next line + processLine (numberedLinesWithSizes, bytesBeforeLine) (n, line) = + ((n, (line, bytesBeforeLine)): numberedLinesWithSizes, bytesBeforeNextLine) + where bytesBeforeNextLine = bytesBeforeLine + lengthInBytes line + 1 + + lineFromMap ln = fromMaybe ("", 0) (ln `M.lookup` mls) + + lengthInBytes = BS.length . encodeUtf8 + + {-| get information about term from map of lines + In most cases, @LineColumn@ after `getTagsFromExpr` points to byte before term. + It's better to have term in term pattern, so this function finds and updates + line number and byte offset and generate pattern. + -} + infoForText + :: Text + -- ^ term to find + -> Int + -- ^ line where to start + -> Maybe (Int, Int, Text) + -- ^ (Line number, byte offset, pattern to find term in file) + infoForText term ln + | ln <= 0 = Nothing + | T.null part2 = infoForText term (ln - 1) + | otherwise = Just (ln, lsl + 1 + lengthInBytes part1, part1 <> termAndNext) + where (l, lsl) = lineFromMap ln + (part1, part2) = T.breakOn term l + termAndNext = T.take (T.length term + 1) part2 + + fallbackInfoForText ln c = (ln, lsl + 1 + lengthInBytes pat, pat) + where (l, lsl) = lineFromMap ln + pat = T.take c l + +getTagsFromExpr :: Expr Src a -> [(LineColumn, Text)] +getTagsFromExpr = go (LC 0 0) [] + where go lpos mts = \case + (Let b e) -> go lpos (mts <> parseBinding lpos b) e + (Annot e1 e2) -> go lpos (go lpos mts e1) e2 + (Record mr) -> mts <> tagsFromDhallMap lpos (recordFieldValue <$> mr) + (RecordLit mr) -> mts <> tagsFromDhallMap lpos (recordFieldValue <$> mr) + (Union mmr) -> mts <> tagsFromDhallMapMaybe lpos mmr + (Note s e) -> go (srcToLineColumn s) mts e + _ -> mts + + tagsFromDhallMap lpos = foldMapWithKey (tagsFromDhallMapElement lpos) + + tagsFromDhallMapMaybe lpos = foldMapWithKey (\k -> \case + Just e -> tagsFromDhallMapElement lpos k e + _ -> [(lpos, k)]) + + tagsFromDhallMapElement lpos k e = go pos [(pos, k)] e + where pos = firstPosFromExpr lpos e + + parseBinding :: LineColumn -> Binding Src a -> [(LineColumn, Text)] + parseBinding lpos b = go p2 [(p0, variable b)] (value b) + where p0 = posFromBinding (bindingSrc0 b) lpos + p1 = posFromBinding (bindingSrc1 b) p0 + p2 = posFromBinding (bindingSrc2 b) p1 + posFromBinding src startPos = maybe startPos srcToLineColumn src + +srcToLineColumn :: Src -> LineColumn +srcToLineColumn s = LC line column + where ssp = srcStart s + line = unPos . sourceLine $ ssp + column = unPos . sourceColumn $ ssp + +firstPosFromExpr :: LineColumn -> Expr Src a -> LineColumn +firstPosFromExpr lpos = \case + (Note s _) -> srcToLineColumn s + _ -> lpos + +showTags :: Tags -> Text +showTags (Tags ts) = T.concat . map (uncurry showFileTags) . M.toList $ ts + +showFileTags :: FilePath -> [(LineOffset, Tag)] -> T.Text +showFileTags f ts = "\x0c\n" <> T.pack f <> "," <> (showInt . T.length) cs <> "\n" <> cs + where cs = T.concat . map (uncurry showPosTag) $ ts + +showPosTag :: LineOffset -> Tag -> Text +showPosTag lo tag = def <>"\x7f" <> name <> "\x01" <> showInt line <> + "," <> showInt offset <> "\n" + where line = loLine lo + offset = loOffset lo + def = tagPattern tag + name = tagName tag + +showInt :: Int -> Text +showInt = T.pack . show + +{-| Generate list of files for a given `Input` +-} +inputToFiles + :: Bool + -- ^ If `True`, this function will follow symbolic links + -> Maybe [String] + -- ^ List of suffixes. If `Nothing`, all files will be returned. + -- This parameter only works when the `Input` is an `InputFile` and point to a directory. + -> Input + -> IO [ FilePath ] + -- List of files. +inputToFiles _ _ StandardInput = lines <$> getContents +inputToFiles followSyms suffixes (InputFile path) = go path + where go p = do + isD <- SD.doesDirectoryExist p + isSL <- isSymLink + if isD + then if isSL && not followSyms + then return [] + else do + -- filter . .. and hidden files .* + contents <- fmap (filter ((/=) '.' . head)) + (SD.getDirectoryContents p) + concat <$> mapM (go . () p) contents + else return [p | matchingSuffix || p == path] + where matchingSuffix = maybe True (any (`isSuffixOf` p)) suffixes + isSymLink = SD.pathIsSymbolicLink p diff --git a/src/Dhall/Tutorial.hs b/src/Dhall/Tutorial.hs --- a/src/Dhall/Tutorial.hs +++ b/src/Dhall/Tutorial.hs @@ -1,2721 +1,2319 @@ {-# OPTIONS_GHC -fno-warn-unused-imports #-} - -{-| Dhall is a programming language specialized for configuration files. This - module contains a tutorial explaning how to author configuration files using - this language --} -module Dhall.Tutorial ( - -- * Introduction - -- $introduction - - -- * Types - -- $types - - -- * Imports - -- $imports - - -- * Lists - -- $lists - - -- * Optional values - -- $optional0 - - -- * Records - -- $records - - -- * Functions - -- $functions - - -- * Compiler - -- $compiler - - -- * Strings - -- $strings - - -- * Combine - -- $combine - - -- * Let expressions - -- $let - - -- * Unions - -- $unions - - -- * Polymorphic functions - -- $polymorphic - - -- * Total - -- $total - - -- * Headers - -- $headers - - -- * Import integrity - -- $integrity - - -- * Raw text - -- $rawText - - -- * Formatting code - -- $format - - -- * Built-in functions - -- $builtins - - -- ** Caveats - -- $caveats - - -- ** Overview - -- $builtinOverview - - -- ** @Bool@ - -- $bool - - -- *** @(||)@ - -- $or - - -- *** @(&&)@ - -- $and - - -- *** @(==)@ - -- $equal - - -- *** @(!=)@ - -- $unequal - - -- *** @if@\/@then@\/@else@ - -- $ifthenelse - - -- ** @Natural@ - -- $natural - - -- *** @(+)@ - -- $plus - - -- *** @(*)@ - -- $times - - -- *** @Natural/even@ - -- $even - - -- *** @Natural/odd@ - -- $odd - - -- *** @Natural/isZero@ - -- $isZero - - -- *** @Natural/fold@ - -- $naturalFold - - -- *** @Natural/build@ - -- $naturalBuild - - -- ** @Integer@ - -- $integer - - -- ** @Double@ - -- $double - - -- ** @Text@ - -- $text - - -- *** @(++)@ - -- $textAppend - - -- ** @List@ - -- $list - - -- *** @(#)@ - -- $listAppend - - -- *** @List/fold@ - -- $listFold - - -- *** @List/build@ - -- $listBuild - - -- *** @List/length@ - -- $listLength - - -- *** @List/head@ - -- $listHead - - -- *** @List/last@ - -- $listLast - - -- *** @List/indexed@ - -- $listIndexed - - -- *** @List/reverse@ - -- $listReverse - - -- ** @Optional@ - -- $optional1 - - -- *** @Optional/fold@ - -- $optionalFold - - -- * Prelude - -- $prelude - - -- * Conclusion - -- $conclusion - - -- * Frequently Asked Questions (FAQ) - -- $faq - ) where - -import Data.Vector (Vector) -import Dhall - --- $introduction --- --- The simplest way to use Dhall is to ignore the programming language features --- and use it as a strongly typed configuration format. For example, suppose --- that you create the following configuration file: --- --- > $ cat ./config --- > { foo = 1 --- > , bar = [3.0, 4.0, 5.0] --- > } --- --- You can read the above configuration file into Haskell using the following --- code: --- --- > -- example.hs --- > --- > {-# LANGUAGE DeriveGeneric #-} --- > {-# LANGUAGE OverloadedStrings #-} --- > --- > import Dhall --- > --- > data Example = Example { foo :: Integer, bar :: Vector Double } --- > deriving (Generic, Show) --- > --- > instance Interpret Example --- > --- > main :: IO () --- > main = do --- > x <- input auto "./config" --- > print (x :: Example) --- --- If you compile and run the above example, the program prints the corresponding --- Haskell record: --- --- > $ ./example --- > Example {foo = 1, bar = [3.0,4.0,5.0]} --- --- You can also load some types directly into Haskell without having to define a --- record, like this: --- --- > >>> :set -XOverloadedStrings --- > >>> input auto "True" :: IO Bool --- > True --- --- The `input` function can decode any value if we specify the value's expected --- `Type`: --- --- > input --- > :: Type a -- Expected type --- > -> Text -- Dhall program --- > -> IO a -- Decoded expression --- --- ... and we can either specify an explicit type like `bool`: --- --- > bool :: Type Bool --- > --- > input bool :: Text -> IO Bool --- > --- > input bool "True" :: IO Bool --- > --- > >>> input bool "True" --- > True --- --- ... or we can use `auto` to let the compiler infer what type to decode from --- the expected return type: --- --- > auto :: Interpret a => Type a --- > --- > input auto :: Interpret a => Text -> IO a --- > --- > >>> input auto "True" :: IO Bool --- > True --- --- You can see what types `auto` supports \"out-of-the-box\" by browsing the --- instances for the `Interpret` class. For example, the following instance --- says that we can directly decode any Dhall expression that evaluates to a --- @Bool@ into a Haskell `Bool`: --- --- > instance Interpret Bool --- --- ... which is why we could directly decode the string @\"True\"@ into the --- value `True`. --- --- There is also another instance that says that if we can decode a value of --- type @a@, then we can also decode a @List@ of values as a `Vector` of @a@s: --- --- > instance Interpret a => Interpret (Vector a) --- --- Therefore, since we can decode a @Bool@, we must also be able to decode a --- @List@ of @Bool@s, like this: --- --- > >>> input auto "[True, False]" :: IO (Vector Bool) --- > [True,False] --- --- We could also specify what type to decode by providing an explicit `Type` --- instead of using `auto` with a type annotation: --- --- > >>> input (vector bool) "[True, False]" --- > [True, False] --- --- __Exercise:__ Create a @./config@ file that the following program can decode: --- --- > {-# LANGUAGE DeriveGeneric #-} --- > {-# LANGUAGE OverloadedStrings #-} --- > --- > import Dhall --- > --- > data Person = Person { age :: Integer, name :: Text } --- > deriving (Generic, Show) --- > --- > instance Interpret Person --- > --- > main :: IO () --- > main = do --- > x <- input auto "./config" --- > print (x :: Person) --- --- __Exercise:__ Create a @./config@ file that the following program can decode: --- --- > {-# LANGUAGE OverloadedStrings #-} --- > --- > import Data.Functor.Identity --- > import Dhall --- > --- > instance Interpret a => Interpret (Identity a) --- > --- > main :: IO () --- > main = do --- > x <- input auto "./config" --- > print (x :: Identity Double) - --- $types --- --- Suppose that we try to decode a value of the wrong type, like this: --- --- > >>> input auto "1" :: IO Bool --- > *** Exception: --- > Error: Expression doesn't match annotation --- > --- > 1 : Bool --- > --- > (input):1:1 --- --- The interpreter complains because the string @\"1\"@ cannot be decoded into a --- Haskell value of type `Bool`. --- --- The code excerpt from the above error message has two components: --- --- * the expression being type checked (i.e. @1@) --- * the expression's expected type (i.e. @Bool@) --- --- > Expression --- > ⇩ --- > 1 : Bool --- > ⇧ --- > Expected type --- --- The @(:)@ symbol is how Dhall annotates values with their expected types. --- This notation is equivalent to type annotations in Haskell using the @(::)@ --- symbol. Whenever you see: --- --- > x : t --- --- ... you should read that as \"we expect the expression @x@ to have type --- @t@\". However, we might be wrong and if our expected type does not match the --- expression's actual type then the type checker will complain. --- --- In this case, the expression @1@ does not have type @Bool@ so type checking --- fails with an exception. --- --- __Exercise:__ Load the Dhall library into @ghci@ and run these commands to get --- get a more detailed error message: --- --- > >>> import Dhall --- > >>> :set -XOverloadedStrings --- > >>> detailed (input auto "1") :: IO Bool --- > ... --- --- ... then read the entire error message --- --- __Exercise:__ Fix the type error, either by changing the value to decode or --- changing the expected type - --- $imports --- --- You might wonder why in some cases we can decode a configuration file: --- --- > >>> writeFile "bool" "True" --- > >>> input auto "./bool" :: IO Bool --- > True --- --- ... and in other cases we can decode a value directly: --- --- > >>> input auto "True" :: IO Bool --- > True --- --- This is because importing a configuration from a file is a special case of a --- more general language feature: Dhall expressions can reference other --- expressions by their file path. --- --- To illustrate this, let's create three files: --- --- > $ echo "True" > bool1 --- > $ echo "False" > bool2 --- > $ echo "./bool1 && ./bool2" > both --- --- ... and read in all three files in a single expression: --- --- > >>> input auto "[ ./bool1 , ./bool2 , ./both ]" :: IO (Vector Bool) --- > [True,False,False] --- --- Each file path is replaced with the Dhall expression contained within that --- file. If that file contains references to other files then those references --- are transitively resolved. --- --- In other words: configuration files can reference other configuration files, --- either by their relative or absolute paths. This means that we can split a --- configuration file into multiple files, like this: --- --- > $ cat > ./config < { foo = 1 --- > , bar = ./bar --- > } --- > EOF --- --- > $ echo "[3.0, 4.0, 5.0]" > ./bar --- --- > $ ./example --- > Example {foo = 1, bar = [3.0,4.0,5.0]} --- --- However, the Dhall language will forbid cycles in these file references. For --- example, if we create the following cycle: --- --- > $ echo './file1' > file2 --- > $ echo './file2' > file1 --- --- ... then the interpreter will reject the import: --- --- > >>> input auto "./file1" :: IO Integer --- > *** Exception: --- > ↳ ./file1 --- > ↳ ./file2 --- > --- > Cyclic import: ./file1 --- --- You can also import expressions by URL. For example, you can find a Dhall --- expression hosted at this URL using @ipfs@: --- --- --- --- > $ curl https://ipfs.io/ipfs/QmVf6hhTCXc9y2pRvhUmLk3AZYEgjeAz5PNwjt1GBYqsVB --- > True --- --- ... and you can reference that expression either directly: --- --- > >>> input auto "https://ipfs.io/ipfs/QmVf6hhTCXc9y2pRvhUmLk3AZYEgjeAz5PNwjt1GBYqsVB" :: IO Bool --- > True --- --- ... or inside of a larger expression: --- --- > >>> input auto "False == https://ipfs.io/ipfs/QmVf6hhTCXc9y2pRvhUmLk3AZYEgjeAz5PNwjt1GBYqsVB" :: IO Bool --- > False --- --- You're not limited to hosting Dhall expressions on @ipfs@. You can host a --- Dhall expression anywhere that you can host UTF8-encoded text on the web, such --- as Github, a pastebin, or your own web server. --- --- You can also import Dhall expressions from environment variables, too: --- --- > >>> System.Environment.setEnv "FOO" "1" --- > >>> input auto "env:FOO" :: IO Integer --- > 1 --- --- You can import types, too. For example, we can change our @./bar@ file to: --- --- > $ echo "[3.0, 4.0, 5.0] : List ./type" > ./bar --- --- ... then specify the @./type@ in a separate file: --- --- > $ echo "Double" > ./type --- --- ... and everything still type checks: --- --- > $ ./example --- > Example {foo = 1, bar = [3.0,4.0,5.0]} --- --- Note that all imports must be terminated by whitespace or you will get either --- an import error or a parse error, like this: --- --- > >>> writeFile "baz" "2.0" --- > >>> input auto "./baz: Double" :: IO Double --- > *** Exception: --- > ↳ ./baz: --- > --- > Error: Missing file --- --- This is because the parser thinks that @./baz:@ is a single token due to --- the missing whitespace before the colon and tries to import a file named --- @./baz:@, which does not exist. To fix the problem we have to add a space --- after @./baz@: --- --- > >>> input auto "./baz : Double" :: IO Double --- > 2.0 --- --- __Exercise:__ There is a @not@ function hosted online here: --- --- --- --- Visit that link and read the documentation. Then try to guess what this --- code returns: --- --- > >>> input auto "https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Bool/not https://ipfs.io/ipfs/QmVf6hhTCXc9y2pRvhUmLk3AZYEgjeAz5PNwjt1GBYqsVB" :: IO Bool --- > ??? --- --- Run the code to test your guess - --- $lists --- --- You can store 0 or more values of the same type in a list, like this: --- --- > [1, 2, 3] --- --- Every list can be followed by the type of the list. The type annotation is --- required for empty lists but optional for non-empty lists. You will get a --- type error if you provide an empty list without a type annotation: --- --- > >>> input auto "[]" :: IO (Vector Integer) --- > *** Exception: --- > Error: Empty lists need a type annotation --- > --- > [] --- > --- > (input):1:1 --- > >>> input auto "[] : List Integer" :: IO (Vector Integer) --- > [] --- --- Also, list elements must all have the same type. You will get an error if --- you try to store elements of different types in a list: --- --- > >>> input auto "[1, True, 3]" :: IO (Vector Integer) --- > *** Exception: --- > Error: List elements should have the same type --- > --- > [1, True, 3] --- > --- > (input):1:1 --- --- __Exercise:__ What is the shortest @./config@ file that you can decode using --- this command: --- --- > >>> input auto "./config" :: IO (Vector (Vector Integer)) - --- $optional0 --- --- @Optional@ values are exactly like lists except they can only hold 0 or 1 --- elements. They cannot hold 2 or more elements: --- --- For example, these are valid @Optional@ values: --- --- > [1] : Optional Integer --- > --- > [] : Optional Integer --- --- ... but this is /not/ valid: --- --- > [1, 2] : Optional Integer -- NOT valid --- --- An @Optional@ corresponds to Haskell's `Maybe` type for decoding purposes: --- --- > >>> input auto "[1] : Optional Integer" :: IO (Maybe Integer) --- > Just 1 --- > >>> input auto "[] : Optional Integer" :: IO (Maybe Integer) --- > Nothing --- --- You cannot omit the type annotation for @Optional@ values. The type --- annotation is mandatory --- --- __Exercise:__ What is the shortest possible @./config@ file that you can decode --- like this: --- --- > >>> input auto "./config" :: IO (Maybe (Maybe (Maybe Integer))) --- > ??? --- --- __Exercise:__ Try to decode an @Optional@ value with more than one element and --- see what happens - --- $records --- --- Record literals are delimited by curly braces and their fields are separated --- by commas. For example, this is a valid record literal: --- --- > { foo = True --- > , bar = 2 --- > , baz = 4.2 --- > } --- --- A record type is like a record literal except instead of specifying each --- field's value we specify each field's type. For example, the preceding --- record literal has the following record type: --- --- > { foo : Bool --- > , bar : Integer --- > , baz : Double --- > } --- --- If you want to specify an empty record literal, you must use @{=}@, which is --- special syntax reserved for empty records. If you want to specify the empty --- record type, then you use @{}@. If you forget which is which you can always --- ask the @dhall@ compiler to remind you of the type for each one: --- --- > $ dhall --- > {=} --- > --- > {} --- > --- > {=} --- --- > $ dhall --- > {} --- > --- > Type --- > --- > {} --- --- You can access a field of a record using the following syntax: --- --- > record.fieldName --- --- ... which means to access the value of the field named @fieldName@ from the --- @record@. For example: --- --- > >>> input auto "{ foo = True, bar = 2, baz = 4.2 }.baz" :: IO Double --- > 4.2 --- --- __Exercise__: What is the type of this record: --- --- > { foo = 1 --- > , bar = --- > { baz = 2.0 --- > , qux = True --- > } --- > } --- --- __Exercise__: Save the above code to a file named @./record@ and then try to --- access the value of the @baz@ field - --- $functions --- --- The Dhall programming language also supports user-defined anonymous --- functions. For example, we can save the following anonymous function to a --- file: --- --- > $ cat > makeBools --- > \(n : Bool) -> --- > [ n && True, n && False, n || True, n || False ] --- > --- --- ... or we can use Dhall's support for Unicode characters to use @λ@ (U+03BB) --- instead of @\\@ and @→@ (U+2192) instead of @->@ (for people who are into that --- sort of thing): --- --- > $ cat > makeBools --- > λ(n : Bool) → --- > [ n && True, n && False, n || True, n || False ] --- > --- --- You can read this as a function of one argument named @n@ that has type --- @Bool@. This function returns a @List@ of @Bool@s. Each element of the --- @List@ depends on the input argument named @n@. --- --- The (ASCII) syntax for anonymous functions resembles the syntax for anonymous --- functions in Haskell. The only difference is that Dhall requires you to --- annotate the type of the function's input. --- --- You can import this function into Haskell, too: --- --- >>> makeBools <- input auto "./makeBools" :: IO (Bool -> Vector Bool) --- >>> makeBools True --- [True,False,True,True] --- --- The reason this works is that there is an `Interpret` instance for simple --- functions: --- --- > instance (Inject a, Interpret b) => Interpret (a -> b) --- --- Thanks to currying, this instance works for functions of multiple simple --- arguments: --- --- >>> dhallAnd <- input auto "λ(x : Bool) → λ(y : Bool) → x && y" :: IO (Bool -> Bool -> Bool) --- >>> dhallAnd True False --- False --- --- However, you can't convert anything more complex than that (like a polymorphic --- or higher-order function). You will need to apply those functions to their --- arguments within Dhall before converting their result to a Haskell value. --- --- Just like `Interpret`, you can derive `Inject` for user-defined data types: --- --- > {-# LANGUAGE DeriveAnyClass #-} --- > {-# LANGUAGE DeriveGeneric #-} --- > {-# LANGUAGE OverloadedStrings #-} --- > --- > module Main where --- > --- > import Dhall --- > --- > data Example0 = Example0 { foo :: Bool, bar :: Bool } --- > deriving (Generic, Inject) --- > --- > main = do --- > f <- input auto "λ(r : { foo : Bool, bar : Bool }) → r.foo && r.bar" --- > print (f (Example0 { foo = True, bar = False }) :: Bool) --- > print (f (Example0 { foo = True, bar = True }) :: Bool) --- --- The above program prints: --- --- > False --- > True - --- $compiler --- --- We can also test our @makeBools@ function directly from the command line. --- This library comes with a command-line executable program named @dhall@ that --- you can use to both type-check files and convert them to a normal form. Our --- compiler takes a program on standard input and then prints the program's type --- to standard error followed by the program's normal form to standard output: --- --- > $ dhall --- > ./makeBools --- > --- > ∀(n : Bool) → List Bool --- > --- > λ(n : Bool) → [n && True, n && False, n || True, n || False] --- --- The first line says that @makeBools@ is a function of one argument named @n@ --- that has type @Bool@ and the function returns a @List@ of @Bool@s. The @∀@ --- (U+2200) symbol is shorthand for the ASCII @forall@ keyword: --- --- > ∀(x : a) → b -- This type ... --- > --- > forall (x : a) → b -- ... is the same as this type --- --- ... and Dhall's @forall@ keyword behaves the same way as Haskell's @forall@ --- keyword for input values that are @Type@s: --- --- > forall (x : Type) → b -- This Dhall type ... --- --- > forall x . b -- ... is the same as this Haskell type --- --- The part where Dhall differs from Haskell is that you can also use --- @∀@/@forall@ to give names to non-@Type@ arguments (such as the first --- argument to @makeBools@). --- --- The second line of Dhall's output is our program's normal form: --- --- > λ(n : Bool) → [n && True, n && False, n || True, n || False] --- --- ... which in this case happens to be identical to our original program. --- --- To apply a function to an argument you separate the function and argument by --- whitespace (just like Haskell): --- --- @f x@ --- --- You can read the above as \"apply the function @f@ to the argument @x@\". This --- means that we can \"apply\" our @./makeBools@ function to a @Bool@ argument --- like this: --- --- > $ dhall --- > ./makeBools True --- > --- > List Bool --- > --- > [True, False, True, True] --- --- Remember that file paths are synonymous with their contents, so the above --- code is exactly equivalent to: --- --- > $ dhall --- > (λ(n : Bool) → [n && True, n && False, n || True, n || False]) True --- > --- > List Bool --- > --- > [True, False, True, True] --- --- When you apply an anonymous function to an argument, you substitute the --- \"bound variable" with the function's argument: --- --- > Bound variable --- > ⇩ --- > (λ(n : Bool) → ...) True --- > ⇧ --- > Function argument --- --- So in our above example, we would replace all occurrences of @n@ with @True@, --- like this: --- --- > -- If we replace all of these `n`s with `True` ... --- > [n && True, n && False, n || True, n || False] --- > --- > -- ... then we get this: --- > [True && True, True && False, True || True, True || False] --- > --- > -- ... which reduces to the following normal form: --- > [True, False, True, True] --- --- Now that we've verified that our function type checks and works, we can use --- the same function within Haskell: --- --- > >>> input auto "./makeBools True" :: IO (Vector Bool) --- > [True,False,True,True] --- --- __Exercise__: Create a file named @getFoo@ that is a function of the following --- type: --- --- > ∀(r : { foo : Bool, bar : Text }) → Bool --- --- This function should take a single input argument named @r@ that is a record --- with two fields. The function should return the value of the @foo@ field. --- --- __Exercise__: Use the @dhall@ compiler to infer the type of the function you --- just created and verify that your function has the correct type --- --- __Exercise__: Use the @dhall@ compiler to apply your function to a sample --- record - --- $strings --- Dhall supports ordinary string literals with Haskell-style escaping rules: --- --- > dhall --- > "Hello, \"world\"!" --- > --- > Text --- > --- > "Hello, \"world\"!" --- --- ... and Dhall also supports Nix-style multi-line string literals: --- --- > dhall --- > '' --- > #!/bin/bash --- > --- > echo "Hi!" --- > '' --- > --- > Text --- > --- > "\n#!/bin/bash\n\necho \"Hi!\"\n" --- --- These \"double single quote strings\" ignore all special characters, with one --- exception: if you want to include a @''@ in the string, you will need to --- escape it with a preceding @'@ (i.e. use @'''@ to insert @''@ into the final --- string). --- --- These strings also strip leading whitespace using the same rules as Nix. --- Specifically: \"it strips from each line a number of spaces equal to the --- minimal indentation of the string as a whole (disregarding the indentation --- of empty lines).\" --- --- You can also interpolate expressions into strings using @${...}@ syntax. For --- example: --- --- > $ dhall --- > let name = "John Doe" --- > in let age = 21 --- > in "My name is ${name} and my age is ${Integer/show age}" --- > --- > Text --- > --- > "My name is John Doe and my age is 21" --- --- Note that you can only interpolate expressions of type @Text@ --- --- If you need to insert a @"${"@ into a string without interpolation then use --- @"''${"@ (same as Nix) --- --- > '' --- > for file in *; do --- > echo "Found ''${file}" --- > done --- > '' - --- $combine --- --- You can combine two records, using either the @(//)@ operator or the --- @(/\\)@ operator. --- --- The @(//)@ operator (or @(⫽)@ U+2AFD) combines the fields of both records, --- preferring fields from the right record if they share fields in common: --- --- > $ dhall --- > { foo = 1, bar = "ABC" } // { baz = True } --- > --- > { bar : Text, baz : Bool, foo : Integer } --- > --- > { bar = "ABC", baz = True, foo = 1 } --- > $ dhall --- > { foo = 1, bar = "ABC" } ⫽ { bar = True } -- Fancy unicode --- > --- > { bar : Bool, foo : Integer } --- > --- > { bar = True, foo = 1 } --- --- Note that the order of record fields does not matter. The compiler --- automatically sorts the fields. --- --- The @(/\\)@ operator (or @(∧)@ U+2227) also lets you combine records, but --- behaves differently if the records share fields in common. The operator --- combines shared fields recursively if they are both records: --- --- > $ dhall --- > { foo = { bar = True }, baz = "ABC" } /\ { foo = { qux = 1.0 } } --- > --- > { baz : Text, foo : { bar : Bool, qux : Double } } --- > --- > { baz = "ABC", foo = { bar = True, qux = 1.0 } } --- --- ... but fails with a type error if either shared field is not a record: --- --- > $ dhall --- > { foo = 1, bar = "ABC" } ∧ { foo = True } --- > --- > Use "dhall --explain" for detailed errors --- > --- > Error: Field collision --- > --- > { foo = 1, bar = "ABC" } ∧ { foo = True } --- > --- > (stdin):1:1 --- --- __Exercise__: Combine any record with the empty record. What do you expect --- to happen? - --- $let --- --- Dhall also supports @let@ expressions, which you can use to define --- intermediate values in the course of a computation, like this: --- --- > $ dhall --- > let x = "ha" in x ++ x --- > --- > Text --- > --- > "haha" --- --- You can also annotate the types of values defined within a @let@ expression, --- like this: --- --- > $ dhall --- > let x : Text = "ha" in x ++ x --- > --- > Text --- > --- > "haha" --- --- You need to nest @let@ expressions if you want to define more than one value --- in this way: --- --- > $ dhall --- > let x = "Hello, " --- > in let y = "world!" --- > in x ++ y --- > --- > Text --- > --- > "Hello, world!" --- --- Dhall is whitespace-insensitive, so feel free to format things over multiple --- lines or indent in any way that you please. --- --- If you want to define a named function, just give a name to an anonymous --- function: --- --- > $ dhall --- > let twice = λ(x : Text) → x ++ x in twice "ha" --- > --- > Text --- > --- > "haha" --- --- Unlike Haskell, Dhall does not support function arguments on the left-hand --- side of the equals sign, so this will not work: --- --- > $ dhall --- > let twice (x : Text) = x ++ x in twice "ha" --- > --- > (stdin):1:11: error: expected: ":", --- > "=" --- > let twice (x : Text) = x ++ x in twice "ha" --- > ^ --- --- The error message says that Dhall expected either a @(:)@ (i.e. the beginning --- of a type annotation) or a @(=)@ (the beginning of the assignment) and not a --- function argument. --- --- You can also use @let@ expressions to rename imports, like this: --- --- > $ dhall --- > let not = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Bool/not --- > in not True --- > --- > Bool --- > --- > False --- --- ... or to define synonyms for types: --- --- > $ dhall <<< 'let Name : Type = Text in [ "John", "Mary" ] : List Name' --- > List Text --- > --- > [ "John", "Mary" ] --- --- __Exercise:__ What do you think the following code will normalize to? --- --- > let x = 1 --- > in let x = 2 --- > in x --- --- Test your guess using the @dhall@ compiler --- --- __Exercise:__ Now try to guess what this code will normalize to: --- --- > let x = "ha" --- > in let x = x ++ "ha" --- > in x --- --- __Exercise:__ What about this code? --- --- > let x = x ++ "ha" --- > in x - --- $unions --- --- A union is a value that can be one of many alternative types of values. For --- example, the following union type: --- --- > < Left : Natural | Right : Bool > --- --- ... represents a value that can be either a @Natural@ or a @Bool@ value. If --- you are familiar with Haskell these are exactly analogous to Haskell's --- \"sum types\". --- --- Each alternative is associated with a tag that distinguishes that alternative --- from other alternatives. In the above example, the @Left@ tag is used for --- the @Natural@ alternative and the @Right@ tag is used for the @Bool@ --- alternative. --- --- A union literal specifies the value of one alternative and the types of the --- remaining alternatives. For example, both of the following union literals --- have the same type, which is the above union type: --- --- > < Left = +0 | Right : Bool > --- --- > < Right = True | Left : Natural > --- --- You can consume a union using the built-in @merge@ function. For example, --- suppose we want to convert our union to a @Bool@ but we want to behave --- differently depending on whether or not the union is a @Natural@ wrapped in --- the @Left@ alternative or a @Bool@ wrapped in the @Right@ alternative. We --- would write: --- --- > $ cat > process < λ(union : < Left : Natural | Right : Bool >) --- > → let handlers = --- > { Left = Natural/even -- Natural/even is a built-in function --- > , Right = λ(b : Bool) → b --- > } --- > in merge handlers union : Bool --- > EOF --- --- Now our @./process@ function can handle both alternatives: --- --- > $ dhall --- > ./process < Left = +3 | Right : Bool > --- > --- > Bool --- > --- > False --- --- > $ dhall --- > ./process < Right = True | Left : Natural > --- > --- > Bool --- > --- > True --- --- Every @merge@ has the following form: --- --- > merge handlers union : type --- --- ... where: --- --- * @union@ is the union you want to consume --- * @handlers@ is a record with one function per alternative of the union --- * @type@ is the declared result type of the @merge@ --- --- The @merge@ function selects which function to apply from the record based on --- which alternative the union selects: --- --- > merge { Foo = f, ... } < Foo = x | ... > : t = f x : t --- --- So, for example: --- --- > merge { Left = Natural/even, Right = λ(b : Bool) → b } < Left = +3 | Right : Bool > : Bool --- > = Natural/even +3 : Bool --- > = False --- --- ... and similarly: --- --- > merge { Left = Natural/even, Right = λ(b : Bool) → b } < Right = True | Left : Natural > : Bool --- > = (λ(b : Bool) → b) True : Bool --- > = True --- --- Notice that each handler has to return the same type of result (@Bool@ in --- this case) which must also match the declared result type of the @merge@. --- --- You can also omit the type annotation when merging a union with one or more --- alternatives, like this: --- --- > merge { Left = Natural/even, Right = λ(b : Bool) → b } < Right = True | Left : Natural > --- --- You can also store more than one value or less than one value within --- alternatives using Dhall's support for anonymous records. You can nest an --- anonymous record within a union such as in this type: --- --- > < Empty : {} | Person : { name : Text, age : Natural } > --- --- This union of records resembles following equivalent Haskell data type: --- --- > data Example = Empty | Person { name :: Text, age :: Text } --- --- You can resemble Haskell further by defining convenient constructors for each --- alternative, like this: --- --- > let Empty = < Empty = {=} | Person : { name : Text, age : Natural } > --- > in let Person = --- > λ(p : { name : Text, age : Natural }) → < Person = p | Empty : {} > --- > in [ Empty --- > , Person { name = "John", age = +23 } --- > , Person { name = "Amy" , age = +25 } --- > , Empty --- > ] --- --- ... and Dhall even provides the @constructors@ keyword to automate this --- common pattern: --- --- > let MyType = constructors < Empty : {} | Person : { name : Text, age : Natural } > --- > in [ MyType.Empty {=} --- > , MyType.Person { name = "John", age = +23 } --- > , MyType.Person { name = "Amy" , age = +25 } --- > ] --- --- The @constructors@ keyword takes a union type argument and returns a record --- with one field per union type constructor: --- --- > $ dhall --pretty --- > constructors < Empty : {} | Person : { name : Text, age : Natural } > --- > --- > --- > { Empty : --- > ∀(Empty : {}) → < Empty : {} | Person : { age : Natural, name : Text } > --- > , Person : --- > ∀(Person : { age : Natural, name : Text }) --- > → < Empty : {} | Person : { age : Natural, name : Text } > --- > } --- > --- > { Empty = --- > λ(Empty : {}) → < Empty = Empty | Person : { age : Natural, name : Text } > --- > , Person = --- > λ(Person : { age : Natural, name : Text }) --- > → < Person = Person | Empty : {} > --- > } --- --- You can also extract fields during pattern matching such as in the following --- function which renders each value to `Text`: --- --- > λ(x : < Empty : {} | Person : { name : Text, age : Natural } >) --- > → merge --- > { Empty = λ(_ : {}) → "Unknown" --- > --- > , Person = --- > λ(person : { name : Text, age : Natural }) --- > → "Name: ${person.name}, Age: ${Natural/show person.age}" --- > } --- > x --- --- __Exercise__: Create a list of the following type with at least one element --- per alternative: --- --- > List < Left : Integer | Right : Double > - --- $polymorphic --- --- The Dhall language supports defining polymorphic functions (a.k.a. --- \"generic\" functions) that work on more than one type of value. However, --- Dhall differs from Haskell by not inferring the types of these polymorphic --- functions. Instead, you must be explicit about what type of value the --- function is specialized to. --- --- Take, for example, Haskell's identity function named @id@: --- --- > id :: a -> a --- > id = \x -> x --- --- The identity function is polymorphic, meaning that `id` works on values of --- different types: --- --- > >>> id 4 --- > 4 --- > >>> id True --- > True --- --- The equivalent function in Dhall is: --- --- > λ(a : Type) → λ(x : a) → x --- --- Notice how this function takes two arguments instead of one. The first --- argument is the type of the second argument. --- --- Let's illustrate how this works by actually using the above function: --- --- > $ echo "λ(a : Type) → λ(x : a) → x" > id --- --- If we supply the function alone to the compiler we get the inferred type as --- the first line: --- --- > $ dhall --- > ./id --- > --- > ∀(a : Type) → ∀(x : a) → a --- > --- > λ(a : Type) → λ(x : a) → x --- --- You can read the type @(∀(a : Type) → ∀(x : a) → a)@ as saying: \"This is the --- type of a function whose first argument is named @a@ and is a @Type@. The --- second argument is named @x@ and has type @a@ (i.e. the value of the first --- argument). The result also has type @a@.\" --- --- This means that the type of the second argument changes depending on what --- type we provide for the first argument. When we apply @./id@ to @Integer@, we --- create a function that expects an @Integer@ argument: --- --- > $ dhall --- > ./id Integer --- > --- > ∀(x : Integer) → Integer --- > --- > λ(x : Integer) → x --- --- Similarly, when we apply @./id@ to @Bool@, we create a function that expects a --- @Bool@ argument: --- --- > $ dhall --- > ./id Bool --- > --- > ∀(x : Bool) → Bool --- > --- > λ(x : Bool) → x --- --- We can then supply the final argument to each of those functions to show --- that they both work on their respective types: --- --- > $ dhall --- > ./id Integer 4 --- > --- > Integer --- > --- > 4 --- --- > $ dhall --- > ./id Bool True --- > --- > Bool --- > --- > True --- --- Built-in functions can also be polymorphic, too. For example, we can ask --- the compiler for the type of @List/reverse@, the function that reverses a --- list: --- --- > $ dhall --- > List/reverse --- > --- > ∀(a : Type) → List a → List a --- > --- > List/reverse --- --- The first argument to @List/reverse@ is the type of the list to reverse: --- --- > $ dhall --- > List/reverse Bool --- > --- > List Bool → List Bool --- > --- > List/reverse Bool --- --- ... and the second argument is the list to reverse: --- --- > $ dhall --- > List/reverse Bool [True, False] --- > --- > List Bool --- > --- > [False, True] : List Bool --- --- Note that the second argument has no name. This type: --- --- > ∀(a : Type) → List a → List a --- --- ... is equivalent to this type: --- --- > ∀(a : Type) → ∀(_ : List a) → List a --- --- In other words, if you don't see the @∀@ symbol surrounding a function --- argument type then that means that the name of the argument is @"_"@. This --- is true even for user-defined functions: --- --- > $ dhall --- > λ(_ : Text) → 1 --- > --- > Text → Integer --- > --- > λ(_ : Text) → 1 --- --- The type @(Text → Integer)@ is the same as @(∀(_ : Text) → Integer)@ --- --- __Exercise__ : Translate Haskell's `flip` function to Dhall - --- $total --- --- Dhall is a total programming language, which means that Dhall is not --- Turing-complete and evaluation of every Dhall program is guaranteed to --- eventually halt. There is no upper bound on how long the program might take --- to evaluate, but the program is guaranteed to terminate in a finite amount of --- time and not hang forever. --- --- This guarantees that all Dhall programs can be safely reduced to a normal --- form where as many functions have been evaluated as possible. In fact, Dhall --- expressions can be evaluated even if all function arguments haven't been fully --- applied. For example, the following program is an anonymous function: --- --- > $ dhall --- > \(n : Bool) -> +10 * +10 --- > --- > ∀(n : Bool) → Natural --- > --- > λ(n : Bool) → +100 --- --- ... and even though the function is still missing the first argument named --- @n@ the compiler is smart enough to evaluate the body of the anonymous --- function ahead of time before the function has even been invoked. --- --- We can use the @map@ function from the Prelude to illustrate an even more --- complex example: --- --- > $ dhall --- > let Prelude/List/map = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/map --- > in λ(f : Integer → Integer) → Prelude/List/map Integer Integer f [1, 2, 3] --- > --- > ∀(f : Integer → Integer) → List Integer --- > --- > λ(f : Integer → Integer) → [f 1, f 2, f 3] : List Integer --- --- Dhall can apply our function to each element of the list even before we specify --- which function to apply. --- --- The language will also never crash or throw any exceptions. Every --- computation will succeed and produce something, even if the result might be --- an @Optional@ value: --- --- > $ dhall --- > List/head Integer ([] : List Integer) --- > --- > Optional Integer --- > --- > [] : Optional Integer --- --- __Exercise__: The Dhall Prelude provides a @replicate@ function which you can --- find here: --- --- --- --- Test what the following Dhall expression normalizes to: --- --- > let replicate = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/replicate --- > in replicate +10 --- --- __Exercise__: If you have a lot of spare time, try to \"break the compiler\" by --- finding an input expression that crashes or loops forever (and file a bug --- report if you succeed) - --- $headers --- --- Sometimes you would like to provide additional request headers when importing --- Dhall expressions from URLs. For example, you might want to provide an --- authorization header or specify the expected content type. --- --- Dhall URL imports let you add or modify request headers with the @using@ --- keyword: --- --- > https://example.com using ./headers --- --- ... where you can replace @./headers@ with any import that points to a Dhall --- expression of the following type: --- --- > List { header : Text, value : Text } --- --- For example, if you needed to specify the content type correctly in order to --- download the file, then your @./headers@ file might look like this: --- --- > $ cat headers --- > [ { header = "Accept", value = "application/dhall" } ] --- --- ... or if you needed to provide an authorization token to access a private --- GitHub repository, then your headers could look like this: --- --- > [ { header = "Authorization", value = "token ${env:GITHUB_TOKEN as Text}" } ] --- --- This would read your GitHub API token from the @GITHUB_TOKEN@ environment --- variable and supply that token in the authorization header. --- --- You cannot inline the headers within the same file as the URL. You must --- provide them as a separate import. That means that this is /not/ legal code: --- --- > http://example.com using [ { header = "Accept", value = "application/dhall" } ] -- NOT legal --- --- Dhall will forward imports if you import an expression from a URL that --- contains a relative import. For example, if you import an expression like --- this: --- --- > http://example.com using ./headers --- --- ... and @http:\/\/example.com@ contains a relative import of @./foo@ then --- Dhall will import @http:\/\/example.com/foo@ using the same @./headers@ file. - --- $integrity --- --- Sometimes you want to use share code while still ensuring that the imported --- value never changes and can't be corrupted by a malicious attacker. Dhall --- provides built-in support for hashing imported values to verify that their --- value never changes --- --- For example, suppose you save the following two files: --- --- > $ cat ./foo --- > ./bar sha256:6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b --- --- > $ cat ./bar --- > ./baz --- --- > $ cat ./baz --- > 1 --- --- The first file named @./foo@ contains an example of an integrity check. You --- can add @sha256:XXX@ after any import (such as after @./bar@), where @XXX@ is --- an expected 64-character @sha256@ hash of the Dhall value. To be precise, --- the hash represents a @sha256@ hash of the UTF-8 encoding of a canonical text --- representation of the fully resolved and normalized abstract syntax tree of --- the imported expression. --- --- Dhall will verify that the expected hash matches the actual hash of the --- imported Dhall value and reject the import if there is a hash mismatch: --- --- > $ dhall <<< './foo' --- > Integer --- > --- > 1 --- --- This implies that the hash only changes if the Dhall value changes. For --- example, if you add a comment to the @./bar@ file: --- --- > $ cat ./bar --- > -- This comment does not change the hash --- > ./baz --- --- ... then @./foo@ will still successfully import @./bar@ because the hash --- only depends on the normalized value and does not depend on meaningless --- changes to whitespace or comments: --- --- > $ dhall <<< './foo' # This still succeeds --- > Integer --- > --- > 1 --- --- You can compute the Hash for any import by using the @dhall-hash@ utility --- installed by this package. For example: --- --- > dhall-hash <<< './bar' --- > sha256:6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b --- --- Then you can paste that output into your code after the import --- --- Now suppose that you you change the value of the @./baz@ file: --- --- > $ cat ./baz --- > 2 --- --- ... then the @./foo@ file will fail to import @./bar@, even though the --- text of the @./bar@ file technically never changed: --- --- > dhall <<< './foo' --- > --- > Error: Import integrity check failed --- > --- > Expected hash: --- > --- > ↳ 6b86b273ff34fce19d6b804eff5a3f5747ada4eaa22f1d49c01e52ddb7875b4b --- > --- > Actual hash: --- > --- > ↳ d4735e3a265e16eee03f59718b9b5d03019c07d8b6c51f90da3a666eec13ab35 --- --- This is because the @./bar@ file now represents a new value (@2@ instead of --- @1@), even though the text of the @./bar@ is still the same. Since the value --- changed the hash must change as well. However, we could change @./baz@ to: --- --- > $ cat baz --- > if True then 1 else 2 --- --- ... and the import would succeed again because the final result is still @1@. --- --- The integrity hash ensures that your import's final meaning can never change, --- so an attacker can never compromise an imported value protected by a hash --- unless they can break SHA-256 encryption. The hash not only protects the --- file that you immediately import, but also protects every transitive import --- as well. --- --- You can also safely refactor your imported dependencies knowing that the --- refactor will not change your hash so long as your refactor is --- behavior-preserving. This provides an easy way to detect refactoring errors --- that you might accidentally introduce. The hash not only protects you --- from attackers, but also protects against human error, too! - --- $rawText --- --- Sometimes you want to import the contents of a raw text file as a Dhall --- value of type `Text`. For example, one of the fields of a record might be --- the contents of a software license: --- --- > { package = "dhall" --- > , author = "Gabriel Gonzalez" --- > , license = ./LICENSE --- > } --- --- Normally if you wanted to import a text file you would need to wrap the --- contents of the file in double single-quotes, like this: --- --- > $ cat LICENSE --- > '' --- > Copyright (c) 2017 Gabriel Gonzalez --- > All rights reserved. --- > --- > ... --- > (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --- > '' --- --- ... which does not work well if you need to reuse the same text file for --- other programs --- --- However, Dhall supports importing a raw text file by adding @as Text@ to the --- end of the import, like this: --- --- > { package = "dhall" --- > , author = "Gabriel Gonzalez" --- > , license = ./LICENSE as Text --- > } --- --- ... and then you can use the original text file unmodified: --- --- > $ cat LICENSE --- > Copyright (c) 2017 Gabriel Gonzalez --- > All rights reserved. --- > --- > ... --- > (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - --- $format --- --- This package also provides a @dhall-format@ executable that you can use to --- automatically format Dhall expressions. For example, we can take the --- following unformatted Dhall expression: --- --- > $ cat ./unformatted --- > λ(a : Type) → λ(kvss : List (List { index : Natural, value : a })) → --- > List/build { index : Natural, value : a } (λ(list : Type) → λ(cons : { --- > index : Natural, value : a } → list → list) → λ(nil : list) → --- > (List/fold (List { index : Natural, value : a }) kvss { count : Natural, diff : --- > Natural → list } (λ(kvs : List { index : Natural, value : a }) → λ(y : { --- > count : Natural, diff : Natural → list }) → { count = y.count + List/length --- > { index : Natural, value : a } kvs, diff = λ(n : Natural) → List/fold { --- > index : Natural, value : a } kvs list (λ(kvOld : { index : Natural, value : a --- > }) → λ(z : list) → cons { index = kvOld.index + n, value = kvOld.value } --- > z) (y.diff (n + List/length { index : Natural, value : a } kvs)) }) { count = --- > +0, diff = λ(_ : Natural) → nil }).diff +0) --- --- ... and run the expression through the @dhall-format@ executable: --- --- > $ dhall-format < ./unformatted --- > λ(a : Type) --- > → λ(kvss : List (List { index : Natural, value : a })) --- > → List/build --- > { index : Natural, value : a } --- > ( λ(list : Type) --- > → λ(cons : { index : Natural, value : a } → list → list) --- > → λ(nil : list) --- > → ( List/fold --- > (List { index : Natural, value : a }) --- > kvss --- > { count : Natural, diff : Natural → list } --- > ( λ(kvs : List { index : Natural, value : a }) --- > → λ(y : { count : Natural, diff : Natural → list }) --- > → { count = y.count + List/length { index : Natural, value : a } kvs --- > , diff = --- > λ(n : Natural) --- > → List/fold --- > { index : Natural, value : a } --- > kvs --- > list --- > ( λ(kvOld : { index : Natural, value : a }) --- > → λ(z : list) --- > → cons { index = kvOld.index + n, value = kvOld.value } z --- > ) --- > (y.diff (n + List/length { index : Natural, value : a } kvs)) --- > } --- > ) --- > { count = +0, diff = λ(_ : Natural) → nil } --- > ).diff --- > +0 --- > ) --- --- The executable formats expressions without resolving, type-checking, or --- normalizing them: --- --- > $ dhall-format --- > let replicate = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/replicate --- > in replicate +5 (List (List Integer)) (replicate +5 (List Integer) (replicate +5 Integer 1)) --- > --- > let replicate = --- > https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/replicate --- > --- > in replicate --- > +5 --- > (List (List Integer)) --- > (replicate +5 (List Integer) (replicate +5 Integer 1)) --- --- If you want to evaluate and format an expression then you can use the --- @--pretty@ flag of the @dhall@ executable: --- --- > $ dhall --pretty --- > let replicate = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/replicate --- > in replicate +5 (List (List Integer)) (replicate +5 (List Integer) (replicate +5 Integer 1)) --- > --- > List (List (List Integer)) --- > --- > [ [ [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > ] --- > : List (List Integer) --- > , [ [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > ] --- > : List (List Integer) --- > , [ [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > ] --- > : List (List Integer) --- > , [ [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > ] --- > : List (List Integer) --- > , [ [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > , [ 1, 1, 1, 1, 1 ] : List Integer --- > ] --- > : List (List Integer) --- > ] --- > : List (List (List Integer)) --- --- You can also use the formatter to modify files in place using the --- @--inplace@ flag: --- --- > $ dhall-format --inplace ./unformatted --- > $ cat ./unformatted --- > λ(a : Type) --- > → λ(kvss : List (List { index : Natural, value : a })) --- > → List/build --- > { index : Natural, value : a } --- > ( λ(list : Type) --- > → λ(cons : { index : Natural, value : a } → list → list) --- > → λ(nil : list) --- > → ( List/fold --- > (List { index : Natural, value : a }) --- > kvss --- > { count : Natural, diff : Natural → list } --- > ( λ(kvs : List { index : Natural, value : a }) --- > → λ(y : { count : Natural, diff : Natural → list }) --- > → { count = y.count + List/length { index : Natural, value : a } kvs --- > , diff = --- > λ(n : Natural) --- > → List/fold --- > { index : Natural, value : a } --- > kvs --- > list --- > ( λ(kvOld : { index : Natural, value : a }) --- > → λ(z : list) --- > → cons { index = kvOld.index + n, value = kvOld.value } z --- > ) --- > (y.diff (n + List/length { index : Natural, value : a } kvs)) --- > } --- > ) --- > { count = +0, diff = λ(_ : Natural) → nil } --- > ).diff --- > +0 --- > ) --- --- Carefully note that the code formatter does not preserve all comments. --- Currently, the formatter only preserves leading comments and whitespace --- up until the last newline preceding the code. In other words: --- --- > $ dhall-format --- > {- This comment will be preserved by the formatter -} --- > -- ... and this comment will be preserved, too --- > {- This comment will *NOT* be preserved -} 1 --- > -- ... and this comment will also *NOT* be preserved --- > --- > {- This comment will be preserved by the formatter -} --- > -- ... and this comment will be preserved, too --- > 1 - --- $builtins --- --- Dhall is a restricted programming language that only supports simple built-in --- functions and operators. If you want to do anything fancier you will need to --- load your data into Haskell for further processing --- --- This section covers types, functions, and operators that are built into the --- language, meaning that you do not need to import any code to use them. --- Additionally, Dhall also comes with a Prelude (covered in the next section) --- hosted online that contains functions derived from these base utilities. The --- Prelude also re-exports all built-in functions for people who prefer --- consistency. --- --- The following documentation on built-ins is provided primarily as a reference. --- You don't need to read about every single built-in and you may want to skip to --- the following Prelude section. - --- The language provides built-in support for the following primitive types: --- --- * @Bool@ values --- * @Natural@ values --- * @Integer@ values --- * @Double@ values --- * @Text@ values --- --- ... as well as support for the following derived types: --- --- * @List@s of values --- * @Optional@ values --- * Anonymous records --- * Anonymous unions - --- $caveats --- --- Dhall differs in a few important ways from other programming languages, so --- you should keep the following caveats in mind: --- --- First, Dhall only supports addition and multiplication on @Natural@ numbers --- (i.e. non-negative integers), which are not the same type of number as --- @Integer@s (which can be negative). A @Natural@ number is a number prefixed --- with the @+@ symbol. If you try to add or multiply two @Integer@s (without --- the @+@ prefix) you will get a type error: --- --- > $ dhall --- > 2 + 2 --- > --- > Use "dhall --explain" for detailed errors --- > --- > Error: ❰+❱ only works on ❰Natural❱s --- > --- > 2 + 2 --- > --- > (stdin):1:1 --- --- In fact, there are no built-in functions for @Integer@s (or @Double@s). As --- far as the language is concerned they are opaque values that can only be --- shuffled around but not used in any meaningful way until they have been --- loaded into Haskell. --- --- Second, the equality @(==)@ and inequality @(!=)@ operators only work on --- @Bool@s. You cannot test any other types of values for equality. - --- $builtinOverview --- --- Each of the following sections provides an overview of builtin functions and --- operators for each type. For each function you get: --- --- * An example use of that function --- --- * A \"type judgement\" explaining when that function or operator is well --- typed --- --- For example, for the following judgement: --- --- > Γ ⊢ x : Bool Γ ⊢ y : Bool --- > ─────────────────────────── --- > Γ ⊢ x && y : Bool --- --- ... you can read that as saying: "if @x@ has type @Bool@ and @y@ has type --- @Bool@, then @x && y@ has type @Bool@" --- --- Similarly, for the following judgement: --- --- > ───────────────────────────────── --- > Γ ⊢ Natural/even : Natural → Bool --- --- ... you can read that as saying: "@Natural/even@ always has type --- @Natural → Bool@" --- --- * Rules for how that function or operator behaves --- --- These rules are just equalities that come in handy when reasoning about code. --- For example, the section on @(&&)@ has the following rules: --- --- > (x && y) && z = x && (y && z) --- > --- > x && True = x --- > --- > True && x = x --- --- These rules are also a contract for how the compiler should behave. If you --- ever observe code that does not obey these rules you should file a bug --- report. - --- $bool --- --- There are two values that have type @Bool@ named @True@ and @False@: --- --- > ─────────────── --- > Γ ⊢ True : Bool --- --- > ──────────────── --- > Γ ⊢ False : Bool --- --- The built-in operations for values of type @Bool@ are: --- - --- $or --- --- Example: --- --- > $ dhall --- > True || False --- > --- > Bool --- > --- > True --- --- Type: --- --- > Γ ⊢ x : Bool Γ ⊢ y : Bool --- > ─────────────────────────── --- > Γ ⊢ x || y : Bool --- --- Rules: --- --- > (x || y) || z = x || (y || z) --- > --- > x || False = x --- > --- > False || x = x --- > --- > x || (y && z) = (x || y) && (x || z) --- > --- > x || True = True --- > --- > True || x = True - --- $and --- --- Example: --- --- > $ dhall --- > True && False --- > --- > Bool --- > --- > False --- --- Type: --- --- > Γ ⊢ x : Bool Γ ⊢ y : Bool --- > ─────────────────────────── --- > Γ ⊢ x && y : Bool --- --- Rules: --- --- > (x && y) && z = x && (y && z) --- > --- > x && True = x --- > --- > True && x = x --- > --- > x && (y || z) = (x && y) || (x && z) --- > --- > x && False = False --- > --- > False && x = False - --- $equal --- --- Example: --- --- > $ dhall --- > True == False --- > --- > Bool --- > --- > False --- --- Type: --- --- > Γ ⊢ x : Bool Γ ⊢ y : Bool --- > ─────────────────────────── --- > Γ ⊢ x == y : Bool --- --- Rules: --- --- > (x == y) == z = x == (y == z) --- > --- > x == True = x --- > --- > True == x = x --- > --- > x == x = True - --- $unequal --- --- Example: --- --- > $ dhall --- > True != False --- > --- > Bool --- > --- > True --- --- Type: --- --- > Γ ⊢ x : Bool Γ ⊢ y : Bool --- > ─────────────────────────── --- > Γ ⊢ x != y : Bool --- --- Rules: --- --- > (x != y) != z = x != (y != z) --- > --- > x != False = x --- > --- > False != x = x --- > --- > x != x = False - --- $ifthenelse --- --- Example: --- --- > $ dhall --- > if True then 3 else 5 --- > --- > Integer --- > --- > 3 --- --- Type: --- --- > Γ ⊢ t : Type --- > ───────────────────── --- > Γ ⊢ b : Bool Γ ⊢ l : t Γ ⊢ r : t --- > ──────────────────────────────────── --- > Γ ⊢ if b then l else r : t --- --- Rules: --- --- > if b then True else False = b --- > --- > if True then l else r = l --- > --- > if False then l else r = r - --- $natural --- --- @Natural@ literals are numbers prefixed by a @+@ sign, like this: --- --- > +4 : Natural --- --- If you omit the @+@ sign then you get an @Integer@ literal, which is a --- different type of value - --- $plus --- --- Example: --- --- > $ dhall --- > +2 + +3 --- > --- > Natural --- > --- > +5 --- --- Type: --- --- > Γ ⊢ x : Natural Γ ⊢ y : Natural --- > ───────────────────────────────── --- > Γ ⊢ x + y : Natural --- --- Rules: --- --- > (x + y) + z = x + (y + z) --- > --- > x + +0 = x --- > --- > +0 + x = x - --- $times --- --- Example: --- --- > $ dhall --- > +2 * +3 --- > --- > Natural --- > --- > +6 --- --- Type: --- --- > Γ ⊢ x : Natural Γ ⊢ y : Natural --- > ───────────────────────────────── --- > Γ ⊢ x * y : Natural --- --- Rules: --- --- > (x * y) * z = x * (y * z) --- > --- > x * +1 = x --- > --- > +1 * x = x --- > --- > (x + y) * z = (x * z) + (y * z) --- > --- > x * (y + z) = (x * y) + (x * z) --- > --- > x * +0 = +0 --- > --- > +0 * x = +0 - --- $even --- --- Example: --- --- > $ dhall --- > Natural/even +6 --- > --- > Bool --- > --- > True --- --- Type: --- --- > ───────────────────────────────── --- > Γ ⊢ Natural/even : Natural → Bool --- --- Rules: --- --- > Natural/even (x + y) = Natural/even x == Natural/even y --- > --- > Natural/even +0 = True --- > --- > Natural/even (x * y) = Natural/even x || Natural/even y --- > --- > Natural/even +1 = False - --- $odd --- --- Example: --- --- > $ dhall --- > Natural/odd +6 --- > --- > Bool --- > --- > False --- --- Type: --- --- > ──────────────────────────────── --- > Γ ⊢ Natural/odd : Natural → Bool --- --- Rules: --- --- > Natural/odd (x + y) = Natural/odd x != Natural/odd y --- > --- > Natural/odd +0 = False --- > --- > Natural/odd (x * y) = Natural/odd x && Natural/odd y --- > --- > Natural/odd +1 = True - --- $isZero --- --- Example: --- --- > $ dhall --- > Natural/isZero +6 --- > --- > Bool --- > --- > False --- --- Type: --- --- > ─────────────────────────────────── --- > Γ ⊢ Natural/isZero : Natural → Bool --- --- Rules: --- --- > Natural/isZero (x + y) = Natural/isZero x && Natural/isZero y --- > --- > Natural/isZero +0 = True --- > --- > Natural/isZero (x * y) = Natural/isZero x || Natural/isZero y --- > --- > Natural/isZero +1 = False - --- $naturalFold --- --- Example: --- --- > $ dhall --- > Natural/fold +40 Text (λ(t : Text) → t ++ "!") "You're welcome" --- > --- > Text --- > --- > "You're welcome!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" --- --- Type: --- --- > ────────────────────────────────────────────────────────────────────────────────────────────────────────── --- > Γ ⊢ Natural/fold : Natural → ∀(natural : Type) → ∀(succ : natural → natural) → ∀(zero : natural) → natural --- --- Rules: --- --- > Natural/fold (x + y) n s z = Natural/fold x n s (Natural/fold y n s z) --- > --- > Natural/fold +0 n s z = z --- > --- > Natural/fold (x * y) n s = Natural/fold x n (Natural/fold y n s) --- > --- > Natural/fold +1 n s = s - --- $naturalBuild --- --- Example: --- --- > $ dhall --- > Natural/build (λ(natural : Type) → λ(succ : natural → natural) → λ(zero : natural) → succ (succ zero)) --- > --- > Natural --- > --- > +2 --- --- Type: --- --- > ───────────────────────────────────────────────────────────────────────────────────────────────────────────── --- > Γ ⊢ Natural/build : (∀(natural : Type) → ∀(succ : natural → natural) → ∀(zero : natural) → natural) → Natural --- --- Rules: --- --- > Natural/fold (Natural/build x) = x --- > --- > Natural/build (Natural/fold x) = x - --- $integer --- --- @Integer@ literals are either prefixed with a @-@ sign (if they are negative) --- or no sign (if they are positive), like this: --- --- > 3 : Integer --- > -2 : Integer --- --- If you prefix them with a @+@ sign then they are @Natural@ literals and not --- @Integer@s --- --- There are no built-in operations on @Integer@s. For all practical purposes --- they are opaque values within the Dhall language - --- $double --- --- A @Double@ literal is a floating point value with at least one decimal --- place, such as: --- --- > -2.0 : Double --- > 3.14159 : Double --- --- There are no built-in operations on @Double@s. For all practical purposes --- they are opaque values within the Dhall language - --- $text --- --- A @Text@ literal is just a sequence of characters enclosed in double quotes, --- like: --- --- > "ABC" : Text --- --- The only thing you can do with @Text@ values is concatenate them - --- $textAppend --- --- Example: --- --- > $ dhall --- > "Hello, " ++ "world!" --- > --- > Text --- > --- > "Hello, world!" --- --- Type: --- --- > Γ ⊢ x : Text Γ ⊢ y : Text --- > ─────────────────────────── --- > Γ ⊢ x && y : Text --- --- Rules: --- --- > (x ++ y) ++ z = x ++ (y ++ z) --- > --- > x ++ "" = x --- > --- > "" ++ x = x - --- $list --- --- Dhall @List@ literals are a sequence of values inside of brackets separated by --- commas: --- --- > Γ ⊢ t : Type Γ ⊢ x : t Γ ⊢ y : t ... --- > ────────────────────────────────────────── --- > Γ ⊢ [x, y, ... ] : List t --- --- Also, every empty @List@ must end with a mandatory type annotation, for example: --- --- > [] : List Integer --- --- The built-in operations on @List@s are: - --- $listAppend --- --- Example: --- --- > $ dhall --- > [1, 2, 3] # [4, 5, 6] --- > --- > List Integer --- > --- > [1, 2, 3, 4, 5, 6] --- --- Type: --- --- > Γ ⊢ x : List a Γ ⊢ y : List a --- > ───────────────────────────────── --- > Γ ⊢ x # y : List a --- --- Rules: --- --- > ([] : List a) # xs = xs --- > --- > xs # ([] : List a) = xs --- > --- > (xs # ys) # zs = xs # (ys # zs) - --- $listFold --- --- Example: --- --- > $ dhall --- > List/fold Bool [True, False, True] Bool (λ(x : Bool) → λ(y : Bool) → x && y) True --- > --- > Bool --- > --- > False --- --- Type: --- --- > ──────────────────────────────────────────────────────────────────────────────────────────────────────── --- > Γ ⊢ List/fold : ∀(a : Type) → List a → ∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list --- --- Rules: --- --- > let Prelude/List/concat = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concat --- > --- > List/fold a (Prelude/List/concat a xss) b c --- > = List/fold (List a) xss b (λ(x : List a) → List/fold a x b c) --- > --- > List/fold a ([] : List a) b c n = n --- > --- > List/fold a ([x] : List a) b c = c x - --- $listBuild --- --- Example: --- --- > $ dhall --- > List/build Integer (λ(list : Type) → λ(cons : Integer → list → list) → λ(nil : list) → cons 1 (cons 2 (cons 3 nil))) --- > --- > List Integer --- > --- > [1, 2, 3] : List Integer --- --- Type: --- --- > ─────────────────────────────────────────────────────────────────────────────────────────────────────────── --- > Γ ⊢ List/build : ∀(a : Type) → (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) → List a --- --- Rules: --- --- > List/build t (List/fold t x) = x --- > --- > List/fold t (List/build t x) = x - --- $listLength --- --- Example: --- --- > $ dhall --- > List/length Integer [1, 2, 3] --- > --- > Natural --- > --- > +3 --- --- Type: --- --- > ──────────────────────────────────────────────── --- > Γ ⊢ List/length : ∀(a : Type) → List a → Natural --- --- Rules: --- --- > List/length t xs = List/fold t xs Natural (λ(_ : t) → λ(n : Natural) → n + +1) +0 - --- $listHead --- --- Example: --- --- > $ dhall --- > List/head Integer [1, 2, 3] --- > --- > Optional Integer --- > --- > [1] : Optional Integer --- --- Type: --- --- > ───────────────────────────────────── --- > Γ ⊢ List/head ∀(a : Type) → List a → Optional a --- --- Rules: --- --- > let Prelude/Optional/head = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Optional/head --- > let Prelude/List/concat = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concat --- > let Prelude/List/concatMap = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concatMap --- > let Prelude/List/map = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/map --- > --- > List/head a (Prelude/List/concat a xss) = --- > Prelude/Optional/head a (Prelude/List/map (List a) (Optional a) (List/head a) xss) --- > --- > List/head a ([x] : List a) = [x] : Optional a --- > --- > List/head b (Prelude/List/concatMap a b f m) --- > = Prelude/Optional/concatMap a b (λ(x : a) → List/head b (f x)) (List/head a m) - --- $listLast --- --- Example: --- --- > $ dhall --- > List/last Integer [1, 2, 3] --- > --- > Optional Integer --- > --- > [1] : Optional Integer --- --- Type: --- --- > ───────────────────────────────────── --- > Γ ⊢ List/last : ∀(a : Type) → List a → Optional a --- --- Rules: --- --- > let Prelude/Optional/last = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Optional/last --- > let Prelude/List/concat = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concat --- > let Prelude/List/concatMap = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concatMap --- > let Prelude/List/map = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/map --- > --- > List/last a (Prelude/List/concat a xss) = --- > Prelude/Optional/last a (Prelude/List/map (List a) (Optional a) (List/last a) xss) --- > --- > List/last a ([x] : List a) = [x] : Optional a --- > --- > List/last b (Prelude/List/concatMap a b f m) --- > = Prelude/Optional/concatMap a b (λ(x : a) → List/last b (f x)) (List/last a m) - --- $listIndexed --- --- Example --- --- > $ dhall --- > List/indexed Text ["ABC", "DEF", "GHI"] --- > --- > List { index : Natural, value : Text } --- > --- > [{ index = +0, value = "ABC" }, { index = +1, value = "DEF" }, { index = +2, value = "GHI" }] : List { index : Natural, value : Text } --- --- Type: --- --- > ───────────────────────────────────────────────────────────────────────────── --- > Γ ⊢ List/indexed : ∀(a : Type) → List a → List { index : Natural, value : a } --- --- Rules: --- --- > let Prelude/List/shifted = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/shifted --- > let Prelude/List/concat = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concat --- > let Prelude/List/map = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/map --- > --- > List/indexed a (Prelude/List/concat a xss) = --- > Prelude/List/shifted a (Prelude/List/map (List a) (List { index : Natural, value : a }) (List/indexed a) xss) - --- $listReverse --- --- Example: --- --- > $ dhall --- > List/reverse Integer [1, 2, 3] --- > --- > List Integer --- > --- > [3, 2, 1] : List Integer --- --- Type: --- --- > ───────────────────────────────────────────────── --- > Γ ⊢ List/reverse : ∀(a : Type) → List a → List a --- --- Rules: --- --- > let Prelude/List/map = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/map --- > let Prelude/List/concat = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concat --- > let Prelude/List/concatMap = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/List/concatMap --- > --- > List/reverse a (Prelude/List/concat a xss) --- > = Prelude/List/concat a (List/reverse (List a) (Prelude/List/map (List a) (List a) (List/reverse a) xss)) --- > --- > List/reverse a ([x] : List a) = [x] : List a --- > --- > List/reverse b (Prelude/List/concatMap a b f xs) --- > = Prelude/List/concatMap a b (λ(x : a) → List/reverse b (f x)) (List/reverse a xs) --- > --- > List/reverse a ([x, y] : List a) = [y, x] : List a - --- $optional1 --- --- Dhall @Optional@ literals are 0 or 1 values inside of brackets: --- --- > Γ ⊢ t : Type Γ ⊢ x : t --- > ──────────────────────── --- > Γ ⊢ ([x] : Optional t) : Optional t --- --- > Γ ⊢ t : Type --- > ──────────────────────── --- > Γ ⊢ ([] : Optional t) : Optional t --- --- Also, every @Optional@ literal must end with a mandatory type annotation --- --- The built-in operations on @Optional@ values are: - --- $optionalFold --- --- Example: --- --- > $ dhall --- > Optional/fold Text (["ABC"] : Optional Text) Text (λ(t : Text) → t) "" --- > --- > Text --- > --- > "ABC" --- --- Type: --- --- > ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── --- > Γ ⊢ Optional/fold : ∀(a : Type) → Optional a → ∀(optional : Type) → ∀(just : a → optional) → ∀(nothing : optional) → optional --- --- Rules: --- --- > Optional/fold a ([] : Optional a) o j n = n --- > --- > Optional/fold a ([x] : Optional a) o j n = j x - --- $prelude --- --- There is also a Prelude available at: --- --- --- --- ... which currenty redirects to: --- --- --- --- There is nothing \"official\" or \"standard\" about this Prelude other than --- the fact that it is mentioned in this tutorial. The \"Prelude\" is just a --- set of convenient utilities which didn't quite make the cut to be built into --- the language. Feel free to host your own custom Prelude if you want! --- --- If you visit the above link you can browse the Prelude, which has a few --- subdirectories. For example, the @Bool@ subdirectory has a @not@ file --- located here: --- --- --- --- The @not@ function is just a UTF8-encoded text file hosted online with the --- following contents --- --- > $ curl https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Bool/not --- > {- --- > Flip the value of a `Bool` --- > --- > Examples: --- > --- > ``` --- > ./not True = False --- > --- > ./not False = True --- > ``` --- > -} --- > let not : Bool → Bool --- > = λ(b : Bool) → b == False --- > --- > in not --- --- The file could have been much shorter, like this: --- --- > λ(b : Bool) → b == False --- --- ... but all the functions exported from the Prelude try to be as --- self-documenting as possible by including: --- --- * the name of the function --- * the type of the function --- * documentation (including a few examples) --- --- The performance penalty for adding these helpful features is negligible. --- --- You can use this @not@ function either directly: --- --- > $ dhall --- > https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Bool/not True --- > --- > Bool --- > --- > False --- --- ... or assign the URL to a shorter name: --- --- > $ dhall --- > let Bool/not = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Bool/not --- > in Bool/not True --- > --- > Bool --- > --- > False --- --- Some functions in the Prelude just re-export built-in functions for --- consistency and documentation, such as @Prelude\/Natural\/even@, which --- re-exports the built-in @Natural/even@ function: --- --- > $ curl https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/Natural/even --- > {- --- > Returns `True` if a number if even and returns `False` otherwise --- > --- > Examples: --- > --- > ``` --- > ./even +3 = False --- > --- > ./even +0 = True --- > ``` --- > -} --- > let even : Natural → Bool --- > = Natural/even --- > --- > in even --- --- You can also download the Prelude locally to your filesystem if you prefer --- using local relative paths instead of URLs. For example, you can use @wget@, --- like this: --- --- > $ wget -np -nH -r --cut-dirs=2 https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/ --- > $ tree Prelude --- > Prelude --- > ├── Bool --- > │   ├── and --- > │   ├── build --- > │   ├── even --- > │   ├── fold --- > │   ├── not --- > │   ├── odd --- > │   ├── or --- > │   └── show --- > ├── Double --- > │   └── show --- > ├── Integer --- > │   └── show --- > ├── List --- > │   ├── all --- > │   ├── any --- > │   ├── build --- > │   ├── concat --- > │   ├── filter --- > │   ├── fold --- > │   ├── generate --- > │   ├── head --- > │   ├── indexed --- > │   ├── iterate --- > │   ├── last --- > │   ├── length --- > │   ├── map --- > │   ├── null --- > │   ├── replicate --- > │   ├── reverse --- > │   ├── shifted --- > │   └── unzip --- > ├── Monoid --- > ├── Natural --- > │   ├── build --- > │   ├── enumerate --- > │   ├── even --- > │   ├── fold --- > │   ├── isZero --- > │   ├── odd --- > │   ├── product --- > │   ├── show --- > │   ├── sum --- > │   └── toInteger --- > ├── Optional --- > │   ├── build --- > │   ├── concat --- > │   ├── fold --- > │   ├── head --- > │   ├── last --- > │   ├── map --- > │   ├── toList --- > │   └── unzip --- > ├── Text --- > │   └── concat --- > └── index.html --- --- ... or if you have an @ipfs@ daemon running, you can mount the Prelude --- locally like this: --- --- > $ ipfs mount --- > $ cd /ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude --- --- Browse the Prelude online to learn more by seeing what functions are --- available and reading their inline documentation: --- --- --- --- __Exercise__: Try to use a new Prelude function that has not been covered --- previously in this tutorial --- --- You can also import the entire Prelude as a single large record for --- convenience: --- --- > $ dhall --- > let Prelude = https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/package.dhall --- > --- > in λ(x : Text) --- > → Prelude.`List`.length Text (Prelude.`List`.replicate +10 Text x) --- > --- > ∀(x : Text) → Natural --- > --- > λ(x : Text) → +10 --- --- The organization of the package mirrors the layout of the Prelude, meaning --- that every directory is stored as a record whose children are the fields of --- that record. --- --- __Exercise__: Browse the Prelude by running: --- --- > $ dhall --pretty <<< 'https://ipfs.io/ipfs/QmdtKd5Q7tebdo6rXfZed4kN6DXmErRQHJ4PsNCtca9GbB/Prelude/package.dhall' - --- $conclusion --- --- By this point you should be able to use the Dhall configuration language to --- author, import, and program configuration files. If you run into any issues --- you can report them at: --- --- --- --- You can also request features, support, or documentation improvements on the --- above issue tracker. --- --- If you would like to contribute to the Dhall project you can try to port Dhall --- to other languages besides Haskell so that Dhall configuration files can be --- read into those languages, too. - --- $faq --- --- * Why do empty lists require a type annotation? --- --- Unlike Haskell, Dhall cannot infer a polymorphic type for the empty list --- because Dhall represents polymorphic values as functions of types, like this: --- --- > λ(a : Type) → [] : List a --- --- If the compiler treated an empty list literal as syntactic short-hand for --- the above polymorphic function then you'd get the unexpected behavior where --- a list literal is a function if the list has 0 elements but not a function --- otherwise. --- --- * Does Dhall support user-defined recursive types? --- --- No, but you can translate recursive code to non-recursive code by following --- this guide: --- --- +{-# LANGUAGE CPP #-} + +{-| Dhall is a programming language specialized for configuration files. This + module contains a tutorial explaining how to author configuration files + using this language + + You might also be interested in the + , a + Haskell-agnostic tour of Dhall's language features. +-} +module Dhall.Tutorial ( + -- * Introduction + -- $introduction + + -- * Types + -- $types + + -- * Imports + -- $imports + + -- * Lists + -- $lists + + -- * Optional values + -- $optional0 + + -- * Records + -- $records + + -- * Functions + -- $functions + + -- * Compiler + -- $compiler + + -- * Strings + -- $strings + + -- * Combine + -- $combine + + -- * Let expressions + -- $let + + -- * Defaults + -- $defaults + + -- * Unions + -- $unions + + -- * Polymorphic functions + -- $polymorphic + + -- * Total + -- $total + + -- * Assertions + -- $assertions + + -- * Headers + -- $headers + + -- * Import integrity + -- $integrity + + -- * Raw text + -- $rawText + + -- * Formatting code + -- $format + + -- * Built-in functions + -- $builtins + + -- ** Caveats + -- $caveats + + -- ** Extending the language + -- $extending + + -- ** Substitutions + -- $substitutions + + -- * Prelude + -- $prelude + + -- * Limitations + -- $limitations + + -- * Conclusion + -- $conclusion + + -- * Frequently Asked Questions (FAQ) + -- $faq + ) where + +import Data.Vector (Vector) +import Dhall + +-- $setup +-- +-- >>> :set -XOverloadedStrings + +-- $introduction +-- +-- The simplest way to use Dhall is to ignore the programming language features +-- and use it as a strongly typed configuration format. For example, suppose +-- that you create the following configuration file: +-- +-- > -- ./config.dhall +-- > { foo = 1 +-- > , bar = [3.0, 4.0, 5.0] +-- > } +-- +-- You can read the above configuration file into Haskell using the following +-- code: +-- +-- > -- example.hs +-- > +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Dhall +-- > +-- > data Example = Example { foo :: Natural, bar :: Vector Double } +-- > deriving (Generic, Show) +-- > +-- > instance FromDhall Example +-- > +-- > main :: IO () +-- > main = do +-- > x <- input auto "./config.dhall" +-- > print (x :: Example) +-- +-- __WARNING__: You must not instantiate FromDhall with a recursive type. See [Limitations](#limitations). +-- +-- If you compile and run the above example, the program prints the corresponding +-- Haskell record: +-- +-- > $ ./example +-- > Example {foo = 1, bar = [3.0,4.0,5.0]} +-- +-- You can also load some types directly into Haskell without having to define a +-- record, like this: +-- +-- >>> import Dhall +-- >>> :set -XOverloadedStrings +-- >>> input auto "True" :: IO Bool +-- True +-- +-- The `Dhall.input` function can decode any value if we specify the value's +-- expected `Dhall.Type`: +-- +-- > input +-- > :: Type a -- Expected type +-- > -> Text -- Dhall program +-- > -> IO a -- Decoded expression +-- +-- ... and we can either specify an explicit type like `bool`: +-- +-- > bool :: Type Bool +-- > +-- > input bool :: Text -> IO Bool +-- > +-- > input bool "True" :: IO Bool +-- +-- >>> input bool "True" +-- True +-- +-- ... or we can use `auto` to let the compiler infer what type to decode from +-- the expected return type: +-- +-- > auto :: FromDhall a => Type a +-- > +-- > input auto :: FromDhall a => Text -> IO a +-- +-- >>> input auto "True" :: IO Bool +-- True +-- +-- You can see what types `auto` supports \"out-of-the-box\" by browsing the +-- instances for the `FromDhall` class. For example, the following instance +-- says that we can directly decode any Dhall expression that evaluates to a +-- @Bool@ into a Haskell `Prelude.Bool`: +-- +-- > instance FromDhall Bool +-- +-- ... which is why we could directly decode the string @\"True\"@ into the +-- value `True`. +-- +-- There is also another instance that says that if we can decode a value of +-- type @a@, then we can also decode a @List@ of values as a `Vector` of @a@s: +-- +-- > instance FromDhall a => FromDhall (Vector a) +-- +-- Therefore, since we can decode a @Bool@, we must also be able to decode a +-- @List@ of @Bool@s, like this: +-- +-- >>> input auto "[True, False]" :: IO (Vector Bool) +-- [True,False] +-- +-- We could also specify what type to decode by providing an explicit +-- `Dhall.Type` instead of using `auto` with a type annotation: +-- +-- >>> input (vector bool) "[True, False]" +-- [True,False] +-- +-- __Exercise:__ Create a @./config.dhall@ file that the following program can +-- decode: +-- +-- > {-# LANGUAGE DeriveAnyClass #-} +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Dhall +-- > +-- > data Person = Person { age :: Natural, name :: Text } +-- > deriving (Generic, FromDhall, Show) +-- > +-- > main :: IO () +-- > main = do +-- > x <- input auto "./config.dhall" +-- > print (x :: Person) +-- +-- __Exercise:__ Create a @./config.dhall@ file that the following program can +-- decode: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Data.Functor.Identity +-- > import Dhall +-- > +-- > instance FromDhall a => FromDhall (Identity a) +-- > +-- > main :: IO () +-- > main = do +-- > x <- input auto "./config.dhall" +-- > print (x :: Identity Double) + +-- $types +-- +-- Suppose that we try to decode a value of the wrong type, like this: +-- +-- >>> input auto "1" :: IO Bool +-- *** Exception: +-- ...Error...: Expression doesn't match annotation +-- ... +-- - Bool +-- + Natural +-- ... +-- 1│ 1 : Bool +-- ... +-- (input):1:1 +-- ... +-- +-- The interpreter complains because the string @\"1\"@ cannot be decoded into a +-- Haskell value of type `Prelude.Bool`. This part of the type error: +-- +-- > - Bool +-- > + Natural +-- +-- ... means that the expected type was @Bool@ but the inferred type of the +-- expression @1@ was @Natural@. +-- +-- The code excerpt from the above error message has two components: +-- +-- * the expression being type checked (i.e. @1@) +-- * the expression's expected type (i.e. @Bool@) +-- +-- > Expression +-- > ⇩ +-- > 1 : Bool +-- > ⇧ +-- > Expected type +-- +-- The @(:)@ symbol is how Dhall annotates values with their expected types. +-- This notation is equivalent to type annotations in Haskell using the @(::)@ +-- symbol. Whenever you see: +-- +-- > x : t +-- +-- ... you should read that as \"we expect the expression @x@ to have type +-- @t@\". However, we might be wrong and if our expected type does not match the +-- expression's actual type then the type checker will complain. +-- +-- In this case, the expression @1@ does not have type @Bool@ so type checking +-- fails with an exception. +-- +-- __Exercise:__ Load the Dhall library into @ghci@ and run these commands to get +-- get a more detailed error message: +-- +-- > >>> import Dhall +-- > >>> :set -XOverloadedStrings +-- > >>> detailed (input auto "1") :: IO Bool +-- > ... +-- +-- ... then read the entire error message +-- +-- __Exercise:__ Fix the type error, either by changing the value to decode or +-- changing the expected type + +-- $imports +-- +-- You might wonder why in some cases we can decode a configuration file: +-- +-- >>> writeFile "bool" "True" +-- >>> input auto "./bool" :: IO Bool +-- True +-- +-- ... and in other cases we can decode a value directly: +-- +-- >>> input auto "True" :: IO Bool +-- True +-- +-- This is because importing a configuration from a file is a special case of a +-- more general language feature: Dhall expressions can reference other +-- expressions by their file path. +-- +-- To illustrate this, let's create three files: +-- +-- > $ echo "True" > bool1 +-- > $ echo "False" > bool2 +-- > $ echo "./bool1 && ./bool2" > both +-- +-- ... and read in all three files in a single expression: +-- +-- >>> input auto "[ ./bool1 , ./bool2 , ./both ]" :: IO (Vector Bool) +-- [True,False,False] +-- +-- Each file path is replaced with the Dhall expression contained within that +-- file. If that file contains references to other files then those references +-- are transitively resolved. +-- +-- In other words: configuration files can reference other configuration files, +-- either by their relative or absolute paths. This means that we can split a +-- configuration file into multiple files, like this: +-- +-- > -- ./config.dhall +-- > { foo = 1 +-- > , bar = ./bar.dhall +-- > } +-- +-- > -- ./bar.dhall +-- > [3.0, 4.0, 5.0] +-- +-- ... which is equivalent to our original configuration: +-- +-- > -- ./config.dhall +-- > { foo = 1 +-- > , bar = [3.0, 4.0, 5.0] +-- > } +-- +-- However, the Dhall language will forbid cycles in these file references. For +-- example, if we create the following cycle: +-- +-- > $ echo './file1' > file2 +-- > $ echo './file2' > file1 +-- +-- ... then the interpreter will reject the import: +-- +-- >>> input auto "./file1" :: IO Natural +-- *** Exception: +-- ↳ ./file1 +-- ↳ ./file2 +-- ... +-- Cyclic import: ./file1 +-- ... +-- +-- You can also import expressions by URL. For example, you can find a Dhall +-- expression hosted at this GitHub URL: +-- +-- +-- +-- > $ curl https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True +-- > True +-- +-- ... and you can reference that expression either directly: +-- +#if defined(WITH_HTTP) && defined(USE_HTTP_CLIENT_TLS) && defined(NETWORK_TESTS) +-- >>> input auto "https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True" :: IO Bool +-- True +#else +-- > >>> input auto "https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True" :: IO Bool +-- > True +#endif +-- +-- ... or inside of a larger expression: +-- +#if defined(WITH_HTTP) && defined(USE_HTTP_CLIENT_TLS) && defined(NETWORK_TESTS) +-- >>> input auto "False == https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True" :: IO Bool +-- False +#else +-- > >>> input auto "False == https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True" :: IO Bool +-- > False +#endif +-- +-- You're not limited to hosting Dhall expressions on GitHub. You can host a +-- Dhall expression anywhere that you can host UTF8-encoded text on the web, +-- such as a pastebin, or your own web server. +-- +-- You can also import Dhall expressions from environment variables, too: +-- +-- >>> System.Environment.setEnv "FOO" "1" +-- >>> input auto "env:FOO" :: IO Natural +-- 1 +-- +-- You can import types, too. For example, we can change our @./bar@ file to: +-- +-- > -- ./bar.dhall +-- > [3.0, 4.0, 5.0] : List ./type.dhall +-- +-- ... then specify the type in a separate file: +-- +-- > -- ./type.dhall +-- > Double +-- +-- ... and everything still type checks: +-- +-- > $ ./example +-- > Example {foo = 1, bar = [3.0,4.0,5.0]} +-- +-- Note that imports should be terminated by whitespace or parentheses otherwise +-- you will get either an import error or a parse error, like this: +-- +-- >>> writeFile "baz" "2.0" +-- >>> input auto "./baz: Double" :: IO Double +-- *** Exception: +-- ↳ ./baz: +-- ... +-- ...Error...: Missing file ...baz: +-- ... +-- +-- This is because the parser thinks that @./baz:@ is a single token due to +-- the missing whitespace before the colon and tries to import a file named +-- @./baz:@, which does not exist. To fix the problem we have to add a space +-- after @./baz@: +-- +-- >>> input auto "./baz : Double" :: IO Double +-- 2.0 +-- +-- __Exercise:__ There is a @not@ function hosted online here: +-- +-- +-- +-- Visit that link and read the documentation. Then try to guess what this +-- code returns: +-- +-- > >>> input auto "https://prelude.dhall-lang.org/Bool/not https://raw.githubusercontent.com/dhall-lang/dhall-haskell/18e4e9a18dc53271146df3ccf5b4177c3552236b/examples/True" :: IO Bool +-- > ??? +-- +-- Run the code to test your guess + +-- $lists +-- +-- You can store 0 or more values of the same type in a list, like this: +-- +-- > [1, 2, 3] +-- +-- Every list can be followed by the type of the list. The type annotation is +-- required for empty lists but optional for non-empty lists. You will get a +-- parse error if you provide an empty list without a type annotation: +-- +-- >>> input auto "[]" :: IO (Vector Natural) +-- *** Exception: +-- ...Error...: Invalid input +-- ... +-- (input):1:3: +-- | +-- 1 | [] +-- | ^ +-- Empty list literal without annotation +-- ... +-- +-- Also, list elements must all have the same type. You will get an error if +-- you try to store elements of different types in a list: +-- +-- >>> input auto "[1, True, 3]" :: IO (Vector Natural) +-- *** Exception: +-- ...Error...: List elements should all have the same type +-- ... +-- - Natural +-- + Bool +-- ... +-- 1│ True +-- ... +-- (input):1:5 +-- ... +-- +-- __Exercise:__ Replace the @\"???\"@ with an expression that successfully +-- decodes to the specified type: +-- +-- > >>> input auto "???" :: IO (Vector (Vector Natural)) + +-- $optional0 +-- +-- @Optional@ values are either of the form @Some value@ or @None type@. +-- +-- For example, these are valid @Optional@ values: +-- +-- > Some 1 +-- > +-- > None Natural +-- +-- ... which both have type @Optional Natural@ +-- +-- An @Optional@ corresponds to Haskell's `Maybe` type for decoding purposes: +-- +-- >>> input auto "Some 1" :: IO (Maybe Natural) +-- Just 1 +-- >>> input auto "None Natural" :: IO (Maybe Natural) +-- Nothing +-- +-- __Exercise:__ Replace the @\"???\"@ with an expression that successfully +-- decodes to the specified type: +-- +-- > >>> input auto "???" :: IO (Maybe (Maybe (Maybe Natural))) + +-- $records +-- +-- Record literals are delimited by curly braces and their fields are separated +-- by commas. For example, this is a valid record literal: +-- +-- > { foo = True +-- > , bar = 2 +-- > , baz = 4.2 +-- > } +-- +-- A record type is like a record literal except instead of specifying each +-- field's value we specify each field's type. For example, the preceding +-- record literal has the following record type: +-- +-- > { foo : Bool +-- > , bar : Natural +-- > , baz : Double +-- > } +-- +-- If you want to specify an empty record literal, you must use @{=}@, which is +-- special syntax reserved for empty records. If you want to specify the empty +-- record type, then you use @{}@. If you forget which is which you can always +-- ask the @dhall@ compiler to remind you of the type for each one: +-- +-- > $ dhall type <<< '{=}' +-- > {} +-- +-- > $ dhall type <<< '{}' +-- > Type +-- +-- This is our first use of the @dhall@ command-line tool (provided by this +-- package), which provides a @type@ subcommand for inferring an expression's +-- type. By default the tool reads the expression on standard input and outputs +-- the type to standard output. +-- +-- Note that @<<<@ is a feature specific to the Bash shell to feed a string to +-- a command's standard input. If you are using another shell, then you can +-- instead do this: +-- +-- > $ echo '{=}' | dhall type +-- > {} +-- +-- __Exercise__: Use the @dhall type@ command to infer the type of this record: +-- +-- > -- ./nested.dhall +-- > { foo = 1 +-- > , bar = +-- > { baz = 2.0 +-- > , qux = True +-- > } +-- > } +-- +-- You can specify nested fields using dot-separated keys, like this: +-- +-- > { foo = 1, bar.baz = 2.0, bar.qux = True } +-- +-- ... which is equivalent to: +-- +-- > { foo = 1, bar = { baz = 2.0, qux = True } } +-- +-- You can also access a field of a record using the following syntax: +-- +-- > record.fieldName +-- +-- ... which means to access the value of the field named @fieldName@ from the +-- @record@. For example: +-- +-- >>> input auto "{ foo = True, bar = 2, baz = 4.2 }.baz" :: IO Double +-- 4.2 +-- +-- ... and you can project out multiple fields into a new record using this +-- syntax: +-- +-- > someRecord.{ field₀, field₁, … } +-- +-- For example: +-- +-- > $ dhall <<< '{ x = 1, y = True, z = "ABC" }.{ x, y }' +-- > { x = 1, y = True } +-- +-- This is our first example of using the @dhall@ command-line tool with no +-- subcommand (like @type@), which evaluates the provided expression. By +-- default, this reads the expression on standard input and outputs the +-- evaluated result on standard output. +-- +-- __Exercise__: Save the above @./nested.dhall@ file and then try to access the +-- value of the @baz@ field. Test that this works by interpreting your code +-- using the @dhall@ command. +-- +-- You can convert a record to a list of key-value pairs (a.k.a. a \"Map\") by +-- using the @toMap@ keyword. For example: +-- +-- > $ dhall <<< 'toMap { foo = 1, bar = 2 }' +-- > [ { mapKey = "bar", mapValue = 2 }, { mapKey = "foo", mapValue = 1 } ] +-- +-- This conversion only works if all field of the record have the same type. +-- This comes in handy when you need to convert a Dhall record to the Dhall +-- equivalent of a homogeneous map (i.e. Haskell's @"Data.Map"@). + +-- $functions +-- +-- The Dhall programming language also supports user-defined anonymous +-- functions. For example, we can save the following anonymous function to a +-- file: +-- +-- > -- ./makeBools.dhall +-- > \(n : Bool) -> +-- > [ n && True, n && False, n || True, n || False ] +-- +-- ... or we can use Dhall's support for Unicode characters to use @λ@ (U+03BB) +-- instead of @\\@ and @→@ (U+2192) instead of @->@ (for people who are into +-- that sort of thing): +-- +-- > $ -- ./makeBools.dhall +-- > λ(n : Bool) → +-- > [ n && True, n && False, n || True, n || False ] +-- > +-- +-- We'll be sticking to ASCII for the remainder of the tutorial, though, while +-- still pointing out Unicode equivalents as we go. +-- +-- You can read this as a function of one argument named @n@ that has type +-- @Bool@. This function returns a @List@ of @Bool@s. Each element of the +-- @List@ depends on the input argument named @n@. +-- +-- The (ASCII) syntax for anonymous functions resembles the syntax for anonymous +-- functions in Haskell. The only difference is that Dhall requires you to +-- annotate the type of the function's input. +-- +-- You can import this function into Haskell, too: +-- +-- >>> makeBools <- input auto "./makeBools.dhall" :: IO (Bool -> Vector Bool) +-- >>> makeBools True +-- [True,False,True,True] +-- +-- The reason this works is that there is an `FromDhall` instance for simple +-- functions: +-- +-- > instance (ToDhall a, FromDhall b) => FromDhall (a -> b) +-- +-- Thanks to currying, this instance works for functions of multiple simple +-- arguments: +-- +-- >>> dhallAnd <- input auto "\\(x : Bool) -> \\(y : Bool) -> x && y" :: IO (Bool -> Bool -> Bool) +-- >>> dhallAnd True False +-- False +-- +-- However, you can't convert anything more complex than that (like a polymorphic +-- or higher-order function). You will need to apply those functions to their +-- arguments within Dhall before converting their result to a Haskell value. +-- +-- Just like `FromDhall`, you can derive `ToDhall` for user-defined data types: +-- +-- > {-# LANGUAGE DeriveAnyClass #-} +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > module Main where +-- > +-- > import Dhall +-- > +-- > data Example0 = Example0 { foo :: Bool, bar :: Bool } +-- > deriving (Generic, ToDhall) +-- > +-- > main = do +-- > f <- input auto "\\(r : { foo : Bool, bar : Bool }) -> r.foo && r.bar" +-- > print (f (Example0 { foo = True, bar = False }) :: Bool) +-- > print (f (Example0 { foo = True, bar = True }) :: Bool) +-- +-- The above program prints: +-- +-- > False +-- > True + +-- $compiler +-- +-- We can also test our @makeBools@ function directly from the command line. +-- This library comes with a command-line executable program named @dhall@ that +-- you can use to both type-check files and convert them to a normal form. Our +-- compiler takes a program on standard input and then prints the program's type +-- to standard error followed by the program's normal form to standard output: +-- +-- > $ dhall --annotate <<< './makeBools.dhall' +-- > (λ(n : Bool) → [ n, False, True, n ]) : ∀(n : Bool) → List Bool +-- +-- The @dhall@ command emits Unicode output by default, but you can switch to +-- ASCII output using the @--ascii@ flag: +-- +-- > $ dhall --annotate --ascii <<< './makeBools.dhall' +-- > (\(n : Bool) -> [ n, False, True, n ]) : forall (n : Bool) -> List Bool +-- +-- The @--annotate@ flag adds a type signature to the output to let us know +-- what type the interpreter inferred for our expression. The type signature +-- is @∀(n : Bool) → List Bool@ which says that @makeBools@ is a function of one +-- argument named @n@ that has type @Bool@ and the function returns a @List@ of +-- @Bool@s. The @∀@ (U+2200) symbol is shorthand for the ASCII @forall@ +-- keyword: +-- +-- > ∀(x : a) → b -- This type ... +-- > +-- > forall (x : a) -> b -- ... is the same as this type +-- +-- ... and Dhall's @forall@ keyword behaves the same way as Haskell's @forall@ +-- keyword for input values that are @Type@s: +-- +-- > forall (x : Type) -> b -- This Dhall type ... +-- +-- > forall x . b -- ... is the same as this Haskell type +-- +-- The part where Dhall differs from Haskell is that you can also use +-- @∀@/@forall@ to give names to non-@Type@ arguments (such as the first +-- argument to @makeBools@). +-- +-- This expression is our program's normal form: +-- +-- > λ(n : Bool) → [ n, False, True, n ] +-- +-- ... and the interpreter was able to simplify our expression by noting that: +-- +-- * @n && True = n@ +-- * @n && False = False@ +-- * @n || True = True@ +-- * @n || False = n@ +-- +-- To apply a function to an argument you separate the function and argument by +-- whitespace (just like Haskell): +-- +-- @f x@ +-- +-- You can read the above as \"apply the function @f@ to the argument @x@\". This +-- means that we can \"apply\" our @./makeBools@ function to a @Bool@ argument +-- like this: +-- +-- > $ dhall <<< './makeBools.dhall True' +-- > [True, False, True, True] +-- +-- Remember that file paths are synonymous with their contents, so the above +-- code is exactly equivalent to: +-- +-- > $ dhall <<< '(\(n : Bool) -> [n && True, n && False, n || True, n || False]) True' +-- > [True, False, True, True] +-- +-- When you apply an anonymous function to an argument, you substitute the +-- \"bound variable" with the function's argument: +-- +-- > Bound variable +-- > ⇩ +-- > (\(n : Bool) -> ...) True +-- > ⇧ +-- > Function argument +-- +-- So in our above example, we would replace all occurrences of @n@ with @True@, +-- like this: +-- +-- > -- If we replace all of these `n`s with `True` ... +-- > [n && True, n && False, n || True, n || False] +-- > +-- > -- ... then we get this: +-- > [True && True, True && False, True || True, True || False] +-- > +-- > -- ... which reduces to the following normal form: +-- > [True, False, True, True] +-- +-- Now that we've verified that our function type checks and works, we can use +-- the same function within Haskell: +-- +-- >>> input auto "./makeBools.dhall True" :: IO (Vector Bool) +-- [True,False,True,True] +-- +-- __Exercise__: Create a file named @getFoo@ that is a function of the following +-- type: +-- +-- > forall (r : { foo : Bool, bar : Text }) -> Bool +-- +-- This function should take a single input argument named @r@ that is a record +-- with two fields. The function should return the value of the @foo@ field. +-- +-- __Exercise__: Use the @dhall@ command to infer the type of the function you +-- just created and verify that your function has the correct type +-- +-- __Exercise__: Use the @dhall@ command to apply your function to a sample +-- record + +-- $strings +-- Dhall supports ordinary string literals with Haskell-style escaping rules: +-- +-- > $ dhall +-- > "Hello, \"world\"!" +-- > +-- > "Hello, \"world\"!" +-- +-- ... and Dhall also supports Nix-style multi-line string literals: +-- +-- > $ dhall +-- > '' +-- > #!/bin/bash +-- > +-- > echo "Hi!" +-- > '' +-- > +-- > "\n#!/bin/bash\n\necho \"Hi!\"\n" +-- +-- These \"double single quote strings\" ignore all special characters, with one +-- exception: if you want to include a @''@ in the string, you will need to +-- escape it with a preceding @'@ (i.e. use @'''@ to insert @''@ into the final +-- string). +-- +-- These strings also strip leading whitespace using the same rules as Nix. +-- Specifically: \"it strips from each line a number of spaces equal to the +-- minimal indentation of the string as a whole (disregarding the indentation +-- of empty lines).\" +-- +-- You can also interpolate expressions into strings using @${...}@ syntax. For +-- example: +-- +-- > $ dhall +-- > let name = "John Doe" +-- > let age = 21 +-- > in "My name is ${name} and my age is ${Natural/show age}" +-- > +-- > "My name is John Doe and my age is 21" +-- +-- Note that you can only interpolate expressions of type @Text@ +-- +-- If you need to insert a @"${"@ into a string without interpolation then use +-- @"''${"@ (same as Nix) +-- +-- > '' +-- > for file in *; do +-- > echo "Found ''${file}" +-- > done +-- > '' + +-- $combine +-- +-- You can combine two records, using either the @(//)@ operator or the +-- @(/\\)@ operator. +-- +-- The @(//)@ operator (or @(⫽)@ U+2AFD) combines the fields of both records, +-- preferring fields from the right record if they share fields in common: +-- +-- > $ dhall +-- > { foo = 1, bar = "ABC" } // { baz = True } +-- > +-- > { bar = "ABC", baz = True, foo = 1 } +-- > $ dhall +-- > { foo = 1, bar = "ABC" } ⫽ { bar = True } -- Fancy unicode +-- > +-- > { bar = True, foo = 1 } +-- +-- Note that the order of record fields does not matter. The compiler +-- automatically sorts the fields. +-- +-- If you need to set or add a deeply nested field you can use the @with@ +-- keyword, like this: +-- +-- > $ dhall <<< '{ x.y = 1 } with x.z = True' +-- > { x = { y = 1, z = True } } +-- +-- > $ dhall <<< '{ x.y = 1 } with x.y = 2' +-- > { x.y = 2 } +-- +-- The @with@ keyword is syntactic sugar for the @//@ operator which follows +-- these rules: +-- +-- > -- Nested case +-- > record with k.ks… = value ⇒ record // { k = record.k with ks… = value } +-- > +-- > -- Base case +-- > record with k = value ⇒ record // { k = value } +-- +-- The @(/\\)@ operator (or @(∧)@ U+2227) also lets you combine records, but +-- behaves differently if the records share fields in common. The operator +-- combines shared fields recursively if they are both records: +-- +-- > $ dhall +-- > { foo = { bar = True }, baz = "ABC" } /\ { foo = { qux = 1.0 } } +-- > +-- > { baz = "ABC", foo = { bar = True, qux = 1.0 } } +-- +-- ... but fails with a type error if either shared field is not a record: +-- +-- > $ dhall +-- > { foo = 1, bar = "ABC" } /\ { foo = True } +-- > +-- > Use "dhall --explain" for detailed errors +-- > +-- > Error: Field collision +-- > +-- > { foo = 1, bar = "ABC" } ∧ { foo = True } +-- > +-- > (input):1:1 +-- +-- __Exercise__: Combine any record with the empty record. What do you expect +-- to happen? +-- +-- You can analogously combine record types using the @//\\\\@ operator (or @(⩓)@ U+2A53): +-- +-- > $ dhall +-- > { foo : Natural } //\\ { bar : Text } +-- > +-- > { foo : Natural, bar : Text } +-- +-- ... which behaves the exact same, except at the type level, meaning that the +-- operator descends recursively into record types: +-- +-- > $ dhall +-- > { foo : { bar : Text } } //\\ { foo : { baz : Bool }, qux : Natural } +-- > +-- > { foo : { bar : Text, baz : Bool }, qux : Natural } + +-- $let +-- +-- Dhall also supports @let@ expressions, which you can use to define +-- intermediate values in the course of a computation, like this: +-- +-- > $ dhall +-- > let x = "ha" in x ++ x +-- > +-- > "haha" +-- +-- You can also annotate the types of values defined within a @let@ expression, +-- like this: +-- +-- > $ dhall +-- > let x : Text = "ha" in x ++ x +-- > +-- > "haha" +-- +-- You need to nest @let@ expressions if you want to define more than one value +-- in this way: +-- +-- > $ dhall +-- > let x = "Hello, " +-- > let y = "world!" +-- > in x ++ y +-- > +-- > "Hello, world!" +-- +-- Dhall is whitespace-insensitive, so feel free to format things over multiple +-- lines or indent in any way that you please. +-- +-- If you want to define a named function, just give a name to an anonymous +-- function: +-- +-- > $ dhall +-- > let twice = \(x : Text) -> x ++ x in twice "ha" +-- > +-- > "haha" +-- +-- Unlike Haskell, Dhall does not support function arguments on the left-hand +-- side of the equals sign, so this will not work: +-- +-- > $ dhall +-- > let twice (x : Text) = x ++ x in twice "ha" +-- > +-- > Error: Invalid input +-- > +-- > (input):1:11: +-- > | +-- > 1 | let twice (x : Text) = x ++ x in twice "ha" +-- > | ^ +-- > unexpected '(' +-- > expecting ':', '=', or the rest of label +-- +-- The error message says that Dhall expected either a @(:)@ (i.e. the beginning +-- of a type annotation) or a @(=)@ (the beginning of the assignment) and not a +-- function argument. +-- +-- You can also use @let@ expressions to rename imports, like this: +-- +-- > $ dhall +-- > let not = https://prelude.dhall-lang.org/Bool/not +-- > in not True +-- > +-- > False +-- +-- ... or to define synonyms for types: +-- +-- > $ dhall <<< 'let Name : Type = Text in [ "John", "Mary" ] : List Name' +-- > List Text +-- > +-- > [ "John", "Mary" ] +-- +-- __Exercise:__ What do you think the following code will normalize to? +-- +-- > let x = 1 +-- > let x = 2 +-- > in x +-- +-- Test your guess using the @dhall@ compiler +-- +-- __Exercise:__ Now try to guess what this code will normalize to: +-- +-- > let x = "ha" +-- > let x = x ++ "ha" +-- > in x +-- +-- __Exercise:__ What about this code? +-- +-- > let x = x ++ "ha" +-- > in x + +-- $defaults +-- +-- For records with a large number of defaultable fields you can use the +-- @::@ operator to auto-complete a record. For example: +-- +-- > let greet = +-- > \(args : { greeting : Text, name : Text }) +-- > -> "${args.greeting}, ${args.name}!" +-- > +-- > let Greeting = +-- > { Type = { greeting : Text, name : Text } +-- > , default = { greeting = "Hello", name = "John" } +-- > } +-- > +-- > in '' +-- > ${greet Greeting::{=}} +-- > ${greet Greeting::{ greeting = "Hola" }} +-- > ${greet Greeting::{ name = "Jane" }} +-- > ${greet Greeting::{ greeting = "Hola", name = "Jane" }} +-- > '' +-- +-- This operator is syntactic sugar. Specifically an expression of the form: +-- +-- > T::r +-- +-- ... is equivalent to: +-- +-- > (T.default // r) : T.Type +-- +-- So, for example: +-- +-- > Greeting::{ greeting = "Hola" } +-- +-- ... is the same thing as: +-- +-- > (Greeting.default // { greeting = "Hola" }) : Greeting.Type +-- +-- ... which is the same thing as: +-- +-- > ({ greeting = "Hello", name = "John" } // { greeting = "Hola" }) : { greeting : Text, name : Text } +-- +-- ... which is the same thing as: +-- +-- > { greeting = "Hola", name = "John" } + +-- $unions +-- +-- A union is a value that can be one of many alternative types of values. For +-- example, the following union type: +-- +-- > < Left : Natural | Right : Bool > +-- +-- ... represents a value that can be either a @Natural@ or a @Bool@ value. If +-- you are familiar with Haskell these are exactly analogous to Haskell's +-- \"sum types\" and the above type is equivalent to @Either Natural Bool@. +-- +-- Each alternative is associated with a tag that distinguishes that alternative +-- from other alternatives. In the above example, the @Left@ tag is used for +-- the @Natural@ alternative and the @Right@ tag is used for the @Bool@ +-- alternative. +-- +-- You can specify the value of a union constructor like this: +-- +-- > let Union = < Left : Natural | Right : Bool> +-- > +-- > in [ Union.Left 0, Union.Right True ] +-- +-- In other words, you can access a union constructor as a field of a union +-- type and use that constructor to wrap a value of a type appropriate for +-- that alternative. In the above example, the @Left@ constructor can wrap +-- a @Natural@ value and the @Right@ constructor can wrap a @Bool@ value. We +-- can also confirm that by inspecting their type: +-- +-- > $ echo '< Left : Natural | Right : Bool>' > ./Union +-- +-- > $ dhall --annotate <<< '(./Union).Left' +-- > < Left : Natural | Right : Bool >.Left +-- > : ∀(Left : Natural) → < Left : Natural | Right : Bool > +-- +-- > $ dhall --annotate <<< '(./Union).Right' +-- > < Left : Natural | Right : Bool >.Right +-- > : ∀(Right : Bool) → < Left : Natural | Right : Bool > +-- +-- In other words, the @Left@ constructor is a function from a @Natural@ to a +-- value of our @Union@ type and the @Right@ constructor is a separate function +-- from a @Bool@ to that same @Union@ type. +-- +-- You can consume a union using the built-in @merge@ function. For example, +-- suppose we want to convert our union to a @Bool@ but we want to behave +-- differently depending on whether or not the union is a @Natural@ wrapped in +-- the @Left@ constructor or a @Bool@ wrapped in the @Right@ constructor . We +-- would write: +-- +-- > $ cat > process < \(union : < Left : Natural | Right : Bool >) -> +-- > let handlers = +-- > { Left = Natural/even -- Natural/even is a built-in function +-- > , Right = \(b : Bool) -> b +-- > } +-- > in merge handlers union +-- > EOF +-- +-- Now our @./process@ function can handle both alternatives: +-- +-- > $ dhall <<< './process ((./Union).Left 3)' +-- > False +-- +-- > $ dhall <<< './process ((./Union).Right True)' +-- > True +-- +-- Every @merge@ has the following form: +-- +-- > merge handlers union [ : type ] +-- +-- ... where: +-- +-- * @union@ is the union you want to consume +-- * @handlers@ is a record with one function per alternative of the union +-- * @type@ is an optional declared result type of the @merge@ +-- +-- The @merge@ function selects which function to apply from the record based on +-- which alternative the union selects: +-- +-- > merge { Foo = f, ... } (< … >.Foo x) = f x +-- +-- So, for example: +-- +-- > merge { Left = Natural/even, Right = \(b : Bool) -> b } (< Left : Natural | Right : Bool >.Left 3) +-- > = Natural/even 3 +-- > = False +-- +-- ... and similarly: +-- +-- > merge { Left = Natural/even, Right = \(b : Bool) -> b } (< Left : Natural | Right : Bool >.Right True) +-- > = (\(b : Bool) -> b) True +-- > = True +-- +-- Notice that each handler has to return the same type of result (@Bool@ in +-- this case). +-- +-- You can also store more than one value within alternatives using Dhall's +-- support for anonymous records. You can nest an anonymous record within a +-- union such as in this type: +-- +-- > < Empty : {} | Person : { name : Text, age : Natural } > +-- +-- You can even go a step further and omit the type of an alternative if it +-- stores no data, like this: +-- +-- > < Empty | Person : { name : Text, age : Natural } > +-- +-- The above Dhall type resembles the following equivalent Haskell data type: +-- +-- > data Example = Empty | Person { name :: Text, age :: Text } +-- +-- Empty alternatives like @Empty@ require no argument: +-- +-- > let Example = < Empty | Person : { name : Text, age : Natural } > +-- > +-- > in [ Example.Empty -- Note the absence of any argument to `Empty` +-- > , Example.Person { name = "John", age = 23 } +-- > , Example.Person { name = "Amy" , age = 25 } +-- > ] +-- +-- ... and when you @merge@ an empty alternative the correspond handler takes no +-- argument: +-- +-- > \(x : < Empty | Person : { name : Text, age : Natural } >) -> +-- > merge +-- > { Empty = "Unknown" -- Note the absence of an anonymous function +-- > +-- > , Person = +-- > \(person : { name : Text, age : Natural }) -> +-- > "Name: ${person.name}, Age: ${Natural/show person.age}" +-- > } +-- > x +-- +-- __Exercise__: Create a list of the following type with at least one element +-- per alternative: +-- +-- > List < Left : Natural | Right : Double > + +-- $polymorphic +-- +-- The Dhall language supports defining polymorphic functions (a.k.a. +-- \"generic\" functions) that work on more than one type of value. However, +-- Dhall differs from Haskell by not inferring the types of these polymorphic +-- functions. Instead, you must be explicit about what type of value the +-- function is specialized to. +-- +-- Take, for example, Haskell's identity function named @id@: +-- +-- > id :: a -> a +-- > id = \x -> x +-- +-- The identity function is polymorphic, meaning that `id` works on values of +-- different types: +-- +-- >>> id 4 +-- 4 +-- >>> id True +-- True +-- +-- The equivalent function in Dhall is: +-- +-- > \(a : Type) -> \(x : a) -> x +-- +-- Notice how this function takes two arguments instead of one. The first +-- argument is the type of the second argument. +-- +-- Let's illustrate how this works by actually using the above function: +-- +-- > $ echo "\\(a : Type) -> \\(x : a) -> x" > id +-- +-- Let's ask the interpreter for the type of this function: +-- the first line: +-- +-- > $ dhall type <<< './id' +-- > ∀(a : Type) → ∀(x : a) → a +-- +-- You can read the type @(∀(a : Type) → ∀(x : a) → a)@ as saying: \"This is the +-- type of a function whose first argument is named @a@ and is a @Type@. The +-- second argument is named @x@ and has type @a@ (i.e. the value of the first +-- argument). The result also has type @a@.\" +-- +-- This means that the type of the second argument changes depending on what +-- type we provide for the first argument. When we apply @./id@ to @Natural@, +-- we create a function that expects an @Natural@ argument: +-- +-- > $ dhall type <<< './id Natural' +-- > ∀(x : Natural) → Natural +-- +-- Similarly, when we apply @./id@ to @Bool@, we create a function that expects a +-- @Bool@ argument: +-- +-- > $ dhall type <<< './id Bool' +-- > ∀(x : Bool) → Bool +-- +-- We can then supply the final argument to each of those functions to show +-- that they both work on their respective types: +-- +-- > $ dhall <<< './id Natural 4' +-- > 4 +-- +-- > $ dhall <<< './id Bool True' +-- > True +-- +-- Built-in functions can also be polymorphic, too. For example, we can ask +-- the compiler for the type of @List/reverse@, the function that reverses a +-- list: +-- +-- > $ dhall --annotate +-- > List/reverse +-- > +-- > List/reverse : ∀(a : Type) → List a → List a +-- +-- The first argument to @List/reverse@ is the type of the list to reverse: +-- +-- > $ dhall +-- > List/reverse Bool +-- > +-- > List/reverse Bool : List Bool → List Bool +-- +-- ... and the second argument is the list to reverse: +-- +-- > $ dhall +-- > List/reverse Bool [True, False] +-- > +-- > [False, True] +-- +-- Note that the second argument has no name. This type: +-- +-- > ∀(a : Type) → List a → List a +-- +-- ... is equivalent to this type: +-- +-- > ∀(a : Type) → ∀(_ : List a) → List a +-- +-- In other words, if you don't see the @∀@ symbol surrounding a function +-- argument type then that means that the name of the argument is @"_"@. This +-- is true even for user-defined functions: +-- +-- > $ dhall type <<< '\\(_ : Text) -> 1' +-- > Text → Natural +-- +-- The type @Text → Natural@ is the same as @∀(_ : Text) → Natural@ +-- +-- __Exercise__ : Translate Haskell's `flip` function to Dhall + +-- $total +-- +-- Dhall is a total programming language, which means that Dhall is not +-- Turing-complete and evaluation of every Dhall program is guaranteed to +-- eventually halt. There is no upper bound on how long the program might take +-- to evaluate, but the program is guaranteed to terminate in a finite amount of +-- time and not hang forever. +-- +-- This guarantees that all Dhall programs can be safely reduced to a normal +-- form where as many functions have been evaluated as possible. In fact, Dhall +-- expressions can be evaluated even if all function arguments haven't been fully +-- applied. For example, the following program is an anonymous function: +-- +-- > $ dhall +-- > \(n : Bool) -> 10 * 10 +-- > +-- > λ(n : Bool) → 100 +-- +-- ... and even though the function is still missing the first argument named +-- @n@ the compiler is smart enough to evaluate the body of the anonymous +-- function ahead of time before the function has even been invoked. +-- +-- We can use the @map@ function from the Prelude to illustrate an even more +-- complex example: +-- +-- > $ dhall +-- > let List/map = https://prelude.dhall-lang.org/List/map +-- > in \(f : Natural → Natural) -> List/map Natural Natural f [1, 2, 3] +-- > +-- > λ(f : Natural → Natural) → [f 1, f 2, f 3] +-- +-- Dhall can apply our function to each element of the list even before we specify +-- which function to apply. +-- +-- The language will also never crash or throw any exceptions. Every +-- computation will succeed and produce something, even if the result might be +-- an @Optional@ value: +-- +-- > $ dhall <<< 'List/head Natural ([] : List Natural)' +-- > None Natural +-- +-- __Exercise__: The Dhall Prelude provides a @replicate@ function which you can +-- find here: +-- +-- +-- +-- Test what the following Dhall expression normalizes to: +-- +-- > let replicate = https://prelude.dhall-lang.org/List/replicate +-- > in replicate 10 +-- +-- __Exercise__: If you have a lot of spare time, try to \"break the compiler\" +-- by finding an input expression that crashes or loops forever (and file a bug +-- report if you succeed). + +-- $assertions +-- +-- You can add compile-time assertions which you can use to add tests to your +-- code. For example, we can add some tests to our @not@ function like this: +-- +-- > let not +-- > : Bool -> Bool +-- > = \(b : Bool) -> b == False +-- > +-- > let example0 = assert : not False === True +-- > +-- > let example1 = assert : not True === False +-- > +-- > in not +-- +-- The expression @assert : not False == True@ is a type-checking assertion +-- that two expressions have the same normal form. If the two expressions differ +-- then type-checking rejects the code. +-- +-- For example, suppose that we change the example to add an incorrect assertion: +-- +-- > -- ./test.dhall +-- > +-- > let not +-- > : Bool -> Bool +-- > = \(b : Bool) -> b == False +-- > +-- > let example0 = assert : not False === True +-- > +-- > let example1 = assert : not True === True -- Oops! +-- > +-- > in not +-- +-- The type-checker then rejects the assertion with the following error message: +-- +-- > $ dhall <<< './test.dhall' +-- > +-- > ↳ ./test.dhall +-- > +-- > Error: Assertion failed +-- > +-- > - False +-- > + True +-- > +-- > 7│ assert : not True === True -- Oops! +-- > 8│ +-- > +-- > ./test.dhall:7:16 +-- > +-- > 1│ ./test.dhall +-- > +-- > (input):1:1 +-- +-- You can compare expressions that contain variables, too, which is equivalent +-- to symbolic reasoning: +-- +-- > $ dhall <<< '\(n : Natural) -> assert : n === (n + 0)' +-- > λ(n : Natural) → assert : n ≡ n +-- +-- Dhall accepts this because the language has built-in support for normalizing +-- @n + 0@ to @n@, so both sides of the comparison normalize to the same value: +-- @n@. +-- +-- Note that this sort of symbolic reasoning is limited and can only detect +-- equality of normal forms. Some equivalent expressions will be rejected +-- if they don't share the same normal form, such as these: +-- +-- > $ dhall <<< '\(n : Natural) -> assert : Natural/even (n + n) === True' +-- > +-- > Use "dhall --explain" for detailed errors +-- > +-- > n : Natural +-- > +-- > Error: Assertion failed +-- > +-- > - … … +-- > + True +-- > +-- > 1│ assert : Natural/even (n + n) === True +-- > +-- > (input):1:19 +-- +-- Here the interpreter is not smart enough to simplify @Natural/even (n + n)@ +-- to @True@ so the assertion fails. +-- +-- If you prefer to use Unicode, then the Unicode equivalent of @===@ is @≡@ +-- (U+2261). + +-- $headers +-- +-- Sometimes you would like to provide additional request headers when importing +-- Dhall expressions from URLs. For example, you might want to provide an +-- authorization header or specify the expected content type. +-- +-- Dhall URL imports let you add or modify request headers with the @using@ +-- keyword: +-- +-- > https://example.com/example.dhall using ./headers +-- +-- ... where you can replace @./headers@ with any import that points to a Dhall +-- expression of the following type: +-- +-- > List { header : Text, value : Text } +-- +-- For example, if you needed to specify the content type correctly in order to +-- download the file, then your @./headers@ file might look like this: +-- +-- > $ cat headers +-- > [ { header = "Accept", value = "application/dhall" } ] +-- +-- ... or if you needed to provide an authorization token to access a private +-- GitHub repository, then your headers could look like this: +-- +-- > [ { header = "Authorization", value = "token ${env:GITHUB_TOKEN as Text}" } ] +-- +-- This would read your GitHub API token from the @GITHUB_TOKEN@ environment +-- variable and supply that token in the authorization header. +-- +-- You cannot inline the headers within the same file as the URL. You must +-- provide them as a separate import. That means that this is /not/ legal code: +-- +-- > http://example.com/example.dhall using [ { header = "Accept", value = "application/dhall" } ] -- NOT legal +-- +-- Dhall will forward imports if you import an expression from a URL that +-- contains a relative import. For example, if you import an expression like +-- this: +-- +-- > http://example.com/example.dhall using ./headers +-- +-- ... and @http:\/\/example.com/example.dhall@ contains a relative import of @./foo@ +-- then Dhall will import @http:\/\/example.com/foo@ using the same @./headers@ file. + +-- $integrity +-- +-- Sometimes you want to use share code while still ensuring that the imported +-- value never changes and can't be corrupted by a malicious attacker. Dhall +-- provides built-in support for hashing imported values to verify that their +-- value never changes +-- +-- For example, suppose you save the following two files: +-- +-- > $ cat ./foo +-- > ./bar sha256:d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 +-- +-- > $ cat ./bar +-- > ./baz +-- +-- > $ cat ./baz +-- > 1 +-- +-- The first file named @./foo@ contains an example of an integrity check. You +-- can add @sha256:XXX@ after any import (such as after @./bar@), where @XXX@ is +-- an expected 64-character @sha256@ hash of the Dhall value. To be precise, +-- the hash represents a @sha256@ hash of the UTF-8 encoding of a canonical text +-- representation of the fully resolved and normalized abstract syntax tree of +-- the imported expression. +-- +-- Dhall will verify that the expected hash matches the actual hash of the +-- imported Dhall value and reject the import if there is a hash mismatch: +-- +-- > $ dhall <<< './foo' +-- > Natural +-- > +-- > 1 +-- +-- Any import protected by a semantic integrity check is automatically cached +-- locally underneath either @~\/.cache\/dhall\/1220${HASH}@ or +-- @${XDG_CACHE_HOME}\/dhall/1220${HASH}@ if you define the @XDG_CACHE_HOME@ +-- environment variable. +-- +-- For example, after you import @./foo@ the contents of `./bar` are locally +-- cached in a fully-evaluated and binary-encoded form which you can inspect by +-- running: +-- +-- > $ dhall decode < ~/.cache/dhall/1220d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 +-- > 1 +-- +-- Subsequent attempts to resolve the same import will automatically retrieve +-- the import from the cache. This matters less for local imports, but comes in +-- handy for remote imports to avoid redownloading them. +-- +-- The local cache takes precedence when resolving imports, so changing the +-- original import afterwards will have no affect until you update the hash. +-- From Dhall's point of view, the hash is the true address and the file path +-- is just a suggestion for how to obtain the import if it's not already cached. +-- +-- You can disable the cache by setting @XDG_CACHE_HOME@ to `/var/empty` (an +-- empty and unwritable directory), like this: +-- +-- > $ XDG_CACHE_HOME=/var/empty dhall <<< './foo' +-- > Natural +-- > +-- > 1 +-- +-- We'll use this trick to test changes to the protected import in the following +-- examples. +-- +-- Now, suppose you add a comment to the @./bar@ file: +-- +-- > $ cat ./bar +-- > -- This comment does not change the hash +-- > ./baz +-- +-- ... then @./foo@ will still successfully import @./bar@ because the hash +-- only depends on the normalized value and does not depend on meaningless +-- changes to whitespace or comments: +-- +-- > $ XDG_CACHE_HOME=/var/empty dhall <<< './foo' # This still succeeds +-- > Natural +-- > +-- > 1 +-- +-- You can compute the Hash for any import by using the hash subcommand +-- of this package. For example: +-- +-- > $ dhall hash <<< './bar' +-- > sha256:d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 +-- +-- Now suppose that you actually change the value of the @./baz@ file: +-- +-- > $ cat ./baz +-- > 2 +-- +-- ... then the @./foo@ file will fail to import @./bar@, even though the +-- text of the @./bar@ file technically never changed: +-- +-- > XDG_CACHE_HOME=/var/empty dhall <<< './foo' +-- > +-- > Error: Import integrity check failed +-- > +-- > Expected hash: +-- > +-- > ↳ d60d8415e36e86dae7f42933d3b0c4fe3ca238f057fba206c7e9fbf5d784fe15 +-- > +-- > Actual hash: +-- > +-- > ↳ 4caf97e8c445d4d4b5c5b992973e098ed4ae88a355915f5a59db640a589bc9cb +-- +-- This is because the @./bar@ file now represents a new value (@2@ instead of +-- @1@), even though the text of the @./bar@ file is still the same. Since the +-- value changed the hash must change as well. However, we could change @./baz@ +-- to: +-- +-- > $ cat baz +-- > if True then 1 else 2 +-- +-- ... and the import would now succeed again because the final result is @1@. +-- +-- The integrity hash ensures that your import's final meaning can never change, +-- so an attacker can never compromise an imported value protected by a hash +-- unless they can break SHA-256 encryption. The hash not only protects the +-- file that you immediately import, but also protects every transitive import +-- as well. +-- +-- You can also safely refactor your imported dependencies knowing that the +-- refactor will not change your hash so long as your refactor is +-- behavior-preserving. This provides an easy way to detect refactoring errors +-- that you might accidentally introduce. The hash not only protects you +-- from attackers, but also protects against human error, too! +-- +-- If you have a file which either doesn't already use hashed imports, +-- or you changed some of the imports and want to update the hashes you can use the +-- freeze command to either add or update hashes: +-- +-- > $ cat foo.dhall +-- > let replicate = https://prelude.dhall-lang.org/List/replicate +-- > in replicate 5 +-- > $ +-- > $ dhall freeze ./foo.dhall +-- > $ cat ./foo.dhall +-- > let replicate = +-- > https://prelude.dhall-lang.org/List/replicate sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 +-- > +-- > in replicate 5 + +-- $rawText +-- +-- Sometimes you want to import the contents of a raw text file as a Dhall +-- value of type `Dhall.Syntax.Text`. For example, one of the fields of a +-- record might be the contents of a software license: +-- +-- > { package = "dhall" +-- > , author = "Gabriella Gonzalez" +-- > , license = ./LICENSE +-- > } +-- +-- Normally if you wanted to import a text file you would need to wrap the +-- contents of the file in double single-quotes, like this: +-- +-- > $ cat LICENSE +-- > '' +-- > Copyright (c) 2017 Gabriella Gonzalez +-- > All rights reserved. +-- > +-- > ... +-- > (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- > '' +-- +-- ... which does not work well if you need to reuse the same text file for +-- other programs +-- +-- However, Dhall supports importing a raw text file by adding @as Text@ to the +-- end of the import, like this: +-- +-- > { package = "dhall" +-- > , author = "Gabriella Gonzalez" +-- > , license = ./LICENSE as Text +-- > } +-- +-- ... and then you can use the original text file unmodified: +-- +-- > $ cat LICENSE +-- > Copyright (c) 2017 Gabriella Gonzalez +-- > All rights reserved. +-- > +-- > ... +-- > (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- > SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-- $format +-- +-- A format subcommand is also available that you can use to +-- automatically format Dhall expressions. For example, we can take the +-- following unformatted Dhall expression: +-- +-- > $ cat ./unformatted +-- > λ(a : Type) → λ(kvss : List (List { index : Natural, value : a })) → +-- > List/build { index : Natural, value : a } (λ(list : Type) → λ(cons : { +-- > index : Natural, value : a } → list → list) → λ(nil : list) → +-- > (List/fold (List { index : Natural, value : a }) kvss { count : Natural, diff : +-- > Natural → list } (λ(kvs : List { index : Natural, value : a }) → λ(y : { +-- > count : Natural, diff : Natural → list }) → { count = y.count + List/length +-- > { index : Natural, value : a } kvs, diff = λ(n : Natural) → List/fold { +-- > index : Natural, value : a } kvs list (λ(kvOld : { index : Natural, value : a +-- > }) → λ(z : list) → cons { index = kvOld.index + n, value = kvOld.value } +-- > z) (y.diff (n + List/length { index : Natural, value : a } kvs)) }) { count = +-- > 0, diff = λ(_ : Natural) → nil }).diff 0) +-- +-- ... and run the expression through the formatter: +-- +-- > $ dhall format < ./unformatted +-- > λ(a : Type) → +-- > λ(kvss : List (List { index : Natural, value : a })) → +-- > List/build +-- > { index : Natural, value : a } +-- > ( λ(list : Type) → +-- > λ(cons : { index : Natural, value : a } → list → list) → +-- > λ(nil : list) → +-- > ( List/fold +-- > (List { index : Natural, value : a }) +-- > kvss +-- > { count : Natural, diff : Natural → list } +-- > ( λ(kvs : List { index : Natural, value : a }) → +-- > λ(y : { count : Natural, diff : Natural → list }) → +-- > { count = +-- > y.count + List/length { index : Natural, value : a } kvs +-- > , diff = +-- > λ(n : Natural) → +-- > List/fold +-- > { index : Natural, value : a } +-- > kvs +-- > list +-- > ( λ(kvOld : { index : Natural, value : a }) → +-- > λ(z : list) → +-- > cons +-- > { index = kvOld.index + n, value = kvOld.value } +-- > z +-- > ) +-- > ( y.diff +-- > (n + List/length { index : Natural, value : a } kvs) +-- > ) +-- > } +-- > ) +-- > { count = 0, diff = λ(_ : Natural) → nil } +-- > ).diff +-- > 0 +-- > ) +-- +-- The executable formats expressions without resolving, type-checking, or +-- normalizing them: +-- +-- > $ dhall format +-- > let replicate = https://prelude.dhall-lang.org/List/replicate +-- > in replicate 5 (List (List Natural)) (replicate 5 (List Natural) (replicate 5 Natural 1)) +-- > +-- > let replicate = https://prelude.dhall-lang.org/List/replicate +-- > +-- > in replicate +-- > 5 +-- > (List (List Natural)) +-- > (replicate 5 (List Natural) (replicate 5 Natural 1)) +-- +-- You can also use the formatter to modify files in place: +-- +-- > $ dhall format ./unformatted +-- +-- Carefully note that the code formatter does not preserve all comments. +-- Currently, the formatter only preserves two types of comments: +-- +-- * Leading comments at the beginning of the file +-- * Comments within a @let@ binding +-- +-- For example: +-- +-- > $ dhall format +-- > {- This comment will be preserved by the formatter -} +-- > -- ... and this comment will be preserved, too +-- > {- This comment will *NOT* be preserved -} 1 +-- > -- ... and this comment will also *NOT* be preserved +-- > +-- > {- This comment will be preserved by the formatter -} +-- > -- ... and this comment will be preserved, too +-- > 1 +-- +-- Also: +-- +-- > let {- This comment will be preserved -} +-- > x {- This comment will also be preserved-} = +-- > {- ... and this one will be preserved, too -} +-- > 1 +-- > +-- > in x +-- +-- Note that you do not need to format the output of the +-- @dhall@ interpreter. The interpreter already automatically formats +-- multi-line expressions, too: +-- +-- > $ dhall +-- > let replicate = https://prelude.dhall-lang.org/List/replicate +-- > in replicate 5 (List (List Natural)) (replicate 5 (List Natural) (replicate 5 Natural 1)) +-- > +-- > [ [ [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > ] +-- > , [ [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > ] +-- > , [ [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > ] +-- > , [ [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > ] +-- > , [ [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > , [ 1, 1, 1, 1, 1 ] +-- > ] +-- > ] + +-- $builtins +-- +-- Dhall is a restricted programming language that only supports simple built-in +-- functions and operators. If you want to do anything fancier you will need to +-- load your data into Haskell for further processing +-- +-- This section covers types, functions, and operators that are built into the +-- language, meaning that you do not need to import any code to use them. +-- Additionally, Dhall also comes with a Prelude (covered in the next section) +-- hosted online that contains functions derived from these base utilities. The +-- Prelude also re-exports all built-in functions for people who prefer +-- consistency. +-- +-- The language provides built-in support for the following primitive types: +-- +-- * @Bool@ values +-- * @Natural@ values +-- * @Integer@ values +-- * @Double@ values +-- * @Text@ values +-- +-- ... as well as support for the following derived types: +-- +-- * @List@s of values +-- * @Optional@ values +-- * Anonymous records +-- * Anonymous unions +-- +-- You can find an up-to-date list of available built-in functions and operators +-- here: +-- +-- + +-- $caveats +-- +-- Dhall differs in a few important ways from other programming languages, so +-- you should keep the following caveats in mind: +-- +-- First, Dhall only supports addition and multiplication on @Natural@ numbers +-- (i.e. non-negative integers), which are not the same type of number as +-- @Integer@s (which can be negative). An @Integer@ number is a number prefixed +-- with either a @+@ or @-@ symbol whereas a @Natural@ number has no leading +-- sign. If you try to add or multiply two @Integer@s you will get a type +-- error: +-- +-- > $ dhall +-- > +2 + +2 +-- > +-- > Use "dhall --explain" for detailed errors +-- > +-- > Error: ❰+❱ only works on ❰Natural❱s +-- > +-- > +2 + +2 +-- > +-- > (input):1:1 +-- +-- There are no built-in functions for @Integer@ arithmetic; however, conversion +-- to and from @Natural@s is possible usinng @Integer/clamp@, @Integer/negate@ +-- and @Natural/toInteger@. +-- +-- For @Double@s the situation is even more extreme: there are no built-in +-- functions other than @Double/show@. As far as the language is concerned they +-- are opaque values that can only be shuffled around but not used in any +-- meaningful way until they have been loaded into Haskell. +-- +-- Second, the equality @(==)@ and inequality @(!=)@ operators only work on +-- @Bool@s. You cannot test any other types of values for equality. +-- +-- However, you can extend the language with your own built-ins using the +-- Haskell API, as described in the next section. + +-- $extending +-- +-- You can use the Haskell API to extend the Dhall configuration language with +-- new built-in functions. This section contains a simple Haskell recipe to add +-- a new @Natural/equal@ built-in function of type: +-- +-- > Natural/equal : Natural -> Natural -> Bool +-- +-- To do so, we: +-- +-- * extend the type-checking context to include the type of @Natural/equal@ +-- * extend the normalizer to evaluate all occurrences of @Natural/equal@ +-- +-- ... like this: +-- +-- > -- example.hs +-- > +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > module Main where +-- > +-- > import Dhall.Core (Expr(..), ReifiedNormalizer(..)) +-- > +-- > import qualified Data.Text.IO +-- > import qualified Dhall +-- > import qualified Dhall.Context +-- > import qualified Lens.Family as Lens +-- > +-- > main :: IO () +-- > main = do +-- > text <- Data.Text.IO.getContents +-- > +-- > let startingContext = transform Dhall.Context.empty +-- > where +-- > transform = Dhall.Context.insert "Natural/equal" naturalEqualType +-- > +-- > naturalEqualType = +-- > Pi "_" Natural (Pi "_" Natural Bool) +-- > +-- > let normalizer (App (App (Var "Natural/equal") (NaturalLit x)) (NaturalLit y)) = +-- > Just (BoolLit (x == y)) +-- > normalizer _ = +-- > Nothing +-- > +-- > let inputSettings = transform Dhall.defaultInputSettings +-- > where +-- > transform = +-- > Lens.set Dhall.normalizer (Just (ReifiedNormalizer (pure . normalizer))) +-- > . Lens.set Dhall.startingContext startingContext +-- > +-- > x <- Dhall.inputWithSettings inputSettings Dhall.auto text +-- > +-- > Data.Text.IO.putStrLn x +-- +-- Here is an example use of the above program: +-- +-- > $ ./example <<< 'if Natural/equal 2 (1 + 1) then "Equal" else "Not equal"' +-- > Equal +-- +-- Note that existing Dhall tools that type-check expressions will reject +-- expressions containing unexpected free variable such as @Natural/equal@: +-- +-- > $ dhall <<< 'Natural/equal 2 (1 + 1)' +-- > +-- > Use "dhall --explain" for detailed errors +-- > +-- > Error: Unbound variable +-- > +-- > Natural/equal +-- > +-- > (input):1:1 +-- +-- You will need to either: +-- +-- * create your own parallel versions of these tools, or: +-- * < https://github.com/dhall-lang/dhall-lang/blob/master/.github/CONTRIBUTING.md#how-do-i-change-the-language try to upstream your built-ins into the language> +-- +-- The general guidelines for adding new built-ins to the language are: +-- +-- * Keep built-ins easy to implement across language bindings +-- * Prefer general purpose built-ins or built-ins appropriate for the task of program configuration +-- * Design built-ins to catch errors as early as possible (i.e. when type-checking the configuration) + +-- $substitutions +-- +-- Substitutions are another way to extend the language. +-- +-- Suppose we have the following Haskell datatype: +-- +-- > data Result = Failure Integer | Success String +-- > deriving (Eq, Generic, Show) +-- > +-- > instance FromDhall Result +-- +-- We can use it in Dhall like that: +-- +-- > -- example.dhall +-- > +-- > let Result = < Failure : Integer | Success : Text > +-- > in Result.Failure +1 +-- +-- Right now it is quite easy to keep these two definitions (the one in Haskell source and the one in the Dhall file) synchronized: +-- If we implement a new feature in the Haskell source we update the corresponding type in the Dhall file. +-- But what happens if our application is growing and our Result type contains e.g. 10 unions with possible types embedded in it? +-- +-- We can override the interpreter's @evaluateSettings@ with a custom set of +-- substitutions, like this: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > myexample :: IO Result +-- > myexample = let +-- > evaluateSettings = Lens.over Dhall.substitutions (Dhall.Map.insert "Result" resultType) Dhall.defaultEvaluateSettings +-- > in Dhall.inputFileWithSettings evaluateSettings resultDecoder "example.dhall" +-- +-- Substitutions are a simple 'Dhall.Map.Map' mapping variables to expressions. The application of these substitutions reflect the order of the insertions in the substitution map: +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > substitute (Dhall.Core.Var "Foo") (Dhall.Map.fromList [("Foo", Dhall.Core.Var "Bar"), ("Bar", Dhall.Core.BoolLit True)]) +-- +-- results in @Dhall.Core.Var \"Baz\"@ since we first substitute \"Foo\" with \"Bar\" and then the resulting \"Bar\" with the final @True@. +-- +-- Notable differences to the other extensions of the builtin language: +-- +-- * This approach works well with the inputFile/inputFileWithSettings functions while the let-wrapping will not. +-- +-- * In contrast to the custom built-ins described above substitutions are made BEFORE the type-checking. + +-- $prelude +-- +-- There is also a Prelude available at: +-- +-- +-- +-- If you visit the above link you can browse the Prelude, which has a few +-- subdirectories. For example, the @Bool@ subdirectory has a @not@ file, which +-- you can reference using this URL: +-- +-- +-- +-- The @not@ function is just a UTF8-encoded text file hosted online with the +-- following contents +-- +-- > $ dhall <<< 'https://prelude.dhall-lang.org/Bool/not as Text' +-- > '' +-- > {- +-- > Flip the value of a Bool +-- > -} +-- > let not : Bool → Bool = λ(b : Bool) → b == False +-- > +-- > let example0 = assert : not True ≡ False +-- > +-- > let example1 = assert : not False ≡ True +-- > +-- > in not +-- > '' +-- +-- The file could have been much shorter, like this: +-- +-- > λ(b : Bool) → b == False +-- +-- ... but all the functions exported from the Prelude try to be as +-- self-documenting as possible by including: +-- +-- * the name of the function +-- * the type of the function +-- * documentation +-- * tests +-- +-- The performance penalty for adding these helpful features is negligible, +-- especially if you protect the import with a semantic integrity check because +-- then the import would be cached compactly as @λ(_ : Bool) → _ == False@. +-- +-- You can use this @not@ function either directly: +-- +-- > $ dhall +-- > https://prelude.dhall-lang.org/Bool/not True +-- > +-- > False +-- +-- ... or assign the URL to a shorter name: +-- +-- > $ dhall +-- > let Bool/not = https://prelude.dhall-lang.org/Bool/not +-- > in Bool/not True +-- > +-- > False +-- +-- Some functions in the Prelude just re-export built-in functions for +-- consistency and documentation, such as @Prelude\/Natural\/even@, which +-- re-exports the built-in @Natural/even@ function: +-- +-- > $ dhall <<< 'https://prelude.dhall-lang.org/Natural/even as Text' +-- > '' +-- > {- +-- > Returns `True` if a number if even and returns `False` otherwise +-- > -} +-- > let even : Natural → Bool = Natural/even +-- > +-- > let example0 = assert : even 3 ≡ False +-- > +-- > let example1 = assert : even 0 ≡ True +-- > +-- > in even +-- > '' +-- +-- You can also clone the Prelude locally to your filesystem if you prefer +-- using `git clone`, like this: +-- +-- > $ git clone https://github.com/dhall-lang/dhall-lang.git +-- > $ tree dhall-lang/Prelude +-- > dhall-lang/Prelude +-- > ├── Bool +-- > │   ├── and +-- > │   ├── build +-- > │   ├── even +-- > │   ├── fold +-- > │   ├── not +-- > │   ├── odd +-- > │   ├── or +-- > │   ├── package.dhall +-- > │   └── show +-- > ├── Double +-- > │   ├── package.dhall +-- > │   └── show +-- > ├── Function +-- > │   ├── compose +-- > │   └── package.dhall +-- > ├── Integer +-- > │   ├── package.dhall +-- > │   ├── show +-- > │   └── toDouble +-- > ├── JSON +-- > │   ├── Nesting +-- > │   ├── Tagged +-- > │   ├── Type +-- > │   ├── array +-- > │   ├── bool +-- > │   ├── keyText +-- > │   ├── keyValue +-- > │   ├── null +-- > │   ├── number +-- > │   ├── object +-- > │   ├── package.dhall +-- > │   ├── render +-- > │   └── string +-- > ├── List +-- > │   ├── all +-- > │   ├── any +-- > │   ├── build +-- > │   ├── concat +-- > │   ├── concatMap +-- > │   ├── default +-- > │   ├── empty +-- > │   ├── filter +-- > │   ├── fold +-- > │   ├── generate +-- > │   ├── head +-- > │   ├── indexed +-- > │   ├── iterate +-- > │   ├── last +-- > │   ├── length +-- > │   ├── map +-- > │   ├── null +-- > │   ├── package.dhall +-- > │   ├── replicate +-- > │   ├── reverse +-- > │   ├── shifted +-- > │   └── unzip +-- > ├── Location +-- > │   ├── Type +-- > │   └── package.dhall +-- > ├── Map +-- > │   ├── Entry +-- > │   ├── Type +-- > │   ├── empty +-- > │   ├── keyText +-- > │   ├── keyValue +-- > │   ├── keys +-- > │   ├── map +-- > │   ├── package.dhall +-- > │   └── values +-- > ├── Monoid +-- > ├── Natural +-- > │   ├── build +-- > │   ├── enumerate +-- > │   ├── equal +-- > │   ├── even +-- > │   ├── fold +-- > │   ├── greaterThan +-- > │   ├── greaterThanEqual +-- > │   ├── isZero +-- > │   ├── lessThan +-- > │   ├── lessThanEqual +-- > │   ├── odd +-- > │   ├── package.dhall +-- > │   ├── product +-- > │   ├── show +-- > │   ├── subtract +-- > │   ├── sum +-- > │   ├── toDouble +-- > │   └── toInteger +-- > ├── Optional +-- > │   ├── all +-- > │   ├── any +-- > │   ├── build +-- > │   ├── concat +-- > │   ├── default +-- > │   ├── filter +-- > │   ├── fold +-- > │   ├── head +-- > │   ├── last +-- > │   ├── length +-- > │   ├── map +-- > │   ├── null +-- > │   ├── package.dhall +-- > │   ├── toList +-- > │   └── unzip +-- > ├── Text +-- > │   ├── concat +-- > │   ├── concatMap +-- > │   ├── concatMapSep +-- > │   ├── concatSep +-- > │   ├── default +-- > │   ├── defaultMap +-- > │   ├── package.dhall +-- > │   └── show +-- > ├── XML +-- > │   ├── Type +-- > │   ├── attribute +-- > │   ├── element +-- > │   ├── emptyAttributes +-- > │   ├── leaf +-- > │   ├── package.dhall +-- > │   ├── render +-- > │   └── text +-- > └── package.dhall +-- +-- Browse the Prelude online to learn more by seeing what functions are +-- available and reading their inline documentation: +-- +-- +-- +-- __Exercise__: Try to use a new Prelude function that has not been covered +-- previously in this tutorial +-- +-- You can also import the entire Prelude as a single large record for +-- convenience: +-- +-- > $ dhall +-- > let Prelude = https://prelude.dhall-lang.org/package.dhall +-- > +-- > in \(x : Text) -> +-- > Prelude.List.length Text (Prelude.List.replicate 10 Text x) +-- > +-- > ∀(x : Text) → Natural +-- > +-- > λ(x : Text) → 10 +-- +-- The organization of the package mirrors the layout of the Prelude, meaning +-- that every directory is stored as a record whose children are the fields of +-- that record. +-- +-- __Exercise__: Browse the Prelude by running: +-- +-- > $ dhall <<< 'https://prelude.dhall-lang.org/package.dhall' + +-- $limitations +-- #limitations# +-- +-- `FromDhall` has a limitiation: It won't work for recursive types. +-- If you instantiate these using their Generic instance you end up with one of +-- the following two cases: +-- +-- If the type appears in it's own definition like +-- +-- > data Foo = Foo Foo +-- > deriving Generic +-- > +-- > instance FromDhall Foo +-- +-- the resulting Decoder will throw an exception /ON USAGE/. +-- However, if the recursion is indirect like +-- +-- > data Foo = Foo Bar +-- > deriving Generic +-- > +-- > instance FromDhall Foo +-- > +-- > data Bar = Bar Foo +-- > deriving Generic +-- > +-- > instance FromDhall Bar +-- +-- the resulting Decoder will __NOT TERMINATE__ /ON USAGE/. + +-- $conclusion +-- +-- By this point you should be able to use the Dhall configuration language to +-- author, import, and program configuration files. If you run into any issues +-- you can report them at: +-- +-- +-- +-- Also, you might want to check out the +-- , a +-- more comprehensive tour of Dhall which may cover features missing from this +-- Haskell tutorial. +-- +-- You can also request features, support, or documentation improvements on the +-- above issue tracker. +-- +-- If you would like to contribute to the Dhall project you can try to port +-- Dhall to languages that do not yet have Dhall integrations so that Dhall configuration files +-- can be read into those languages, too. + +-- $faq +-- +-- diff --git a/src/Dhall/TypeCheck.hs b/src/Dhall/TypeCheck.hs --- a/src/Dhall/TypeCheck.hs +++ b/src/Dhall/TypeCheck.hs @@ -1,3155 +1,4851 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wall #-} - --- | This module contains the logic for type checking Dhall code - -module Dhall.TypeCheck ( - -- * Type-checking - typeWith - , typeOf - , typeWithA - , checkContext - - -- * Types - , Typer - , X(..) - , TypeError(..) - , DetailedTypeError(..) - , TypeMessage(..) - ) where - -import Control.Exception (Exception) -import Data.Foldable (forM_, toList) -import Data.Monoid ((<>)) -import Data.Sequence (Seq, ViewL(..)) -import Data.Set (Set) -import Data.Text.Buildable (Buildable(..)) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Builder (Builder) -import Data.Text.Prettyprint.Doc (Pretty(..)) -import Data.Traversable (forM) -import Data.Typeable (Typeable) -import Dhall.Core (Const(..), Chunks(..), Expr(..), Var(..)) -import Dhall.Context (Context) - -import qualified Data.Foldable -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.Sequence -import qualified Data.Set -import qualified Data.Text.Lazy as Text -import qualified Data.Text.Lazy.Builder as Builder -import qualified Dhall.Context -import qualified Dhall.Core - -traverseWithIndex_ :: Applicative f => (Int -> a -> f b) -> Seq a -> f () -traverseWithIndex_ k xs = - Data.Foldable.sequenceA_ (Data.Sequence.mapWithIndex k xs) - -axiom :: Const -> Either (TypeError s a) Const -axiom Type = return Kind -axiom Kind = Left (TypeError Dhall.Context.empty (Const Kind) Untyped) - -rule :: Const -> Const -> Either () Const -rule Type Kind = Left () -rule Type Type = return Type -rule Kind Kind = return Kind -rule Kind Type = return Type - -{-| Type-check an expression and return the expression's type if type-checking - succeeds or an error if type-checking fails - - `typeWith` does not necessarily normalize the type since full normalization - is not necessary for just type-checking. If you actually care about the - returned type then you may want to `Dhall.Core.normalize` it afterwards. --} -typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X) -typeWith ctx expr = do - checkContext ctx - typeWithA absurd ctx expr - -{-| Function that converts the value inside an `Embed` constructor into a new - expression --} -type Typer a = forall s. a -> Expr s a - -{-| Generalization of `typeWith` that allows type-checking the `Embed` - constructor with custom logic --} -typeWithA - :: Eq a - => Typer a - -> Context (Expr s a) - -> Expr s a - -> Either (TypeError s a) (Expr s a) -typeWithA tpa = loop - where - loop _ (Const c ) = do - fmap Const (axiom c) - loop ctx e@(Var (V x n) ) = do - case Dhall.Context.lookup x n ctx of - Nothing -> Left (TypeError ctx e (UnboundVariable x)) - Just a -> do - _ <- loop ctx a - return a - loop ctx (Lam x _A b ) = do - _ <- loop ctx _A - let ctx' = fmap (Dhall.Core.shift 1 (V x 0)) (Dhall.Context.insert x (Dhall.Core.normalize _A) ctx) - _B <- loop ctx' b - let p = Pi x _A _B - _t <- loop ctx p - return p - loop ctx e@(Pi x _A _B ) = do - tA <- fmap Dhall.Core.normalize (loop ctx _A) - kA <- case tA of - Const k -> return k - _ -> Left (TypeError ctx e (InvalidInputType _A)) - - _ <- loop ctx _A - let ctx' = fmap (Dhall.Core.shift 1 (V x 0)) (Dhall.Context.insert x (Dhall.Core.normalize _A) ctx) - tB <- fmap Dhall.Core.normalize (loop ctx' _B) - kB <- case tB of - Const k -> return k - _ -> Left (TypeError ctx' e (InvalidOutputType _B)) - - case rule kA kB of - Left () -> Left (TypeError ctx e (NoDependentTypes _A _B)) - Right k -> Right (Const k) - loop ctx e@(App f a ) = do - tf <- fmap Dhall.Core.normalize (loop ctx f) - (x, _A, _B) <- case tf of - Pi x _A _B -> return (x, _A, _B) - _ -> Left (TypeError ctx e (NotAFunction f tf)) - _A' <- loop ctx a - if Dhall.Core.judgmentallyEqual _A _A' - then do - let a' = Dhall.Core.shift 1 (V x 0) a - let _B' = Dhall.Core.subst (V x 0) a' _B - let _B'' = Dhall.Core.shift (-1) (V x 0) _B' - return _B'' - else do - let nf_A = Dhall.Core.normalize _A - let nf_A' = Dhall.Core.normalize _A' - Left (TypeError ctx e (TypeMismatch f nf_A a nf_A')) - loop ctx e@(Let x mA a0 b0) = do - _A1 <- loop ctx a0 - case mA of - Just _A0 -> do - _ <- loop ctx _A0 - let nf_A0 = Dhall.Core.normalize _A0 - let nf_A1 = Dhall.Core.normalize _A1 - if Dhall.Core.judgmentallyEqual _A0 _A1 - then return () - else Left (TypeError ctx e (AnnotMismatch a0 nf_A0 nf_A1)) - Nothing -> return () - let a1 = Dhall.Core.normalize a0 - let a2 = Dhall.Core.shift 1 (V x 0) a1 - let b1 = Dhall.Core.subst (V x 0) a2 b0 - let b2 = Dhall.Core.shift (-1) (V x 0) b1 - loop ctx b2 - loop ctx e@(Annot x t ) = do - _ <- loop ctx t - - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t t' - then do - return t - else do - let nf_t = Dhall.Core.normalize t - let nf_t' = Dhall.Core.normalize t' - Left (TypeError ctx e (AnnotMismatch x nf_t nf_t')) - loop _ Bool = do - return (Const Type) - loop _ (BoolLit _ ) = do - return Bool - loop ctx e@(BoolAnd l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantAnd l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantAnd r tr)) - - return Bool - loop ctx e@(BoolOr l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantOr l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantOr r tr)) - - return Bool - loop ctx e@(BoolEQ l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantEQ l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantEQ r tr)) - - return Bool - loop ctx e@(BoolNE l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantNE l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantNE r tr)) - - return Bool - loop ctx e@(BoolIf x y z ) = do - tx <- fmap Dhall.Core.normalize (loop ctx x) - case tx of - Bool -> return () - _ -> Left (TypeError ctx e (InvalidPredicate x tx)) - ty <- fmap Dhall.Core.normalize (loop ctx y ) - tty <- fmap Dhall.Core.normalize (loop ctx ty) - case tty of - Const Type -> return () - _ -> Left (TypeError ctx e (IfBranchMustBeTerm True y ty tty)) - - tz <- fmap Dhall.Core.normalize (loop ctx z) - ttz <- fmap Dhall.Core.normalize (loop ctx tz) - case ttz of - Const Type -> return () - _ -> Left (TypeError ctx e (IfBranchMustBeTerm False z tz ttz)) - - if Dhall.Core.judgmentallyEqual ty tz - then return () - else Left (TypeError ctx e (IfBranchMismatch y z ty tz)) - return ty - loop _ Natural = do - return (Const Type) - loop _ (NaturalLit _ ) = do - return Natural - loop _ NaturalFold = do - return - (Pi "_" Natural - (Pi "natural" (Const Type) - (Pi "succ" (Pi "_" "natural" "natural") - (Pi "zero" "natural" "natural") ) ) ) - loop _ NaturalBuild = do - return - (Pi "_" - (Pi "natural" (Const Type) - (Pi "succ" (Pi "_" "natural" "natural") - (Pi "zero" "natural" "natural") ) ) - Natural ) - loop _ NaturalIsZero = do - return (Pi "_" Natural Bool) - loop _ NaturalEven = do - return (Pi "_" Natural Bool) - loop _ NaturalOdd = do - return (Pi "_" Natural Bool) - loop _ NaturalToInteger = do - return (Pi "_" Natural Integer) - loop _ NaturalShow = do - return (Pi "_" Natural Text) - loop ctx e@(NaturalPlus l r) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Natural -> return () - _ -> Left (TypeError ctx e (CantAdd l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Natural -> return () - _ -> Left (TypeError ctx e (CantAdd r tr)) - return Natural - loop ctx e@(NaturalTimes l r) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Natural -> return () - _ -> Left (TypeError ctx e (CantMultiply l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Natural -> return () - _ -> Left (TypeError ctx e (CantMultiply r tr)) - return Natural - loop _ Integer = do - return (Const Type) - loop _ (IntegerLit _ ) = do - return Integer - loop _ IntegerShow = do - return (Pi "_" Integer Text) - loop _ Double = do - return (Const Type) - loop _ (DoubleLit _ ) = do - return Double - loop _ DoubleShow = do - return (Pi "_" Double Text) - loop _ Text = do - return (Const Type) - loop ctx e@(TextLit (Chunks xys _)) = do - let process (_, y) = do - ty <- fmap Dhall.Core.normalize (loop ctx y) - case ty of - Text -> return () - _ -> Left (TypeError ctx e (CantInterpolate y ty)) - mapM_ process xys - return Text - loop ctx e@(TextAppend l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Text -> return () - _ -> Left (TypeError ctx e (CantTextAppend l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Text -> return () - _ -> Left (TypeError ctx e (CantTextAppend r tr)) - return Text - loop _ List = do - return (Pi "_" (Const Type) (Const Type)) - loop ctx e@(ListLit Nothing xs) = do - case Data.Sequence.viewl xs of - x0 :< _ -> do - t <- loop ctx x0 - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - _ -> Left (TypeError ctx e (InvalidListType t)) - flip traverseWithIndex_ xs (\i x -> do - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t t' - then return () - else do - let nf_t = Dhall.Core.normalize t - let nf_t' = Dhall.Core.normalize t' - let err = MismatchedListElements i nf_t x nf_t' - Left (TypeError ctx x err) ) - return (App List t) - _ -> Left (TypeError ctx e MissingListType) - loop ctx e@(ListLit (Just t ) xs) = do - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - _ -> Left (TypeError ctx e (InvalidListType t)) - flip traverseWithIndex_ xs (\i x -> do - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t t' - then return () - else do - let nf_t = Dhall.Core.normalize t - let nf_t' = Dhall.Core.normalize t' - Left (TypeError ctx x (InvalidListElement i nf_t x nf_t')) ) - return (App List t) - loop ctx e@(ListAppend l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - el <- case tl of - App List el -> return el - _ -> Left (TypeError ctx e (CantListAppend l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - er <- case tr of - App List er -> return er - _ -> Left (TypeError ctx e (CantListAppend r tr)) - - if Dhall.Core.judgmentallyEqual el er - then return (App List el) - else Left (TypeError ctx e (ListAppendMismatch el er)) - loop _ ListBuild = do - return - (Pi "a" (Const Type) - (Pi "_" - (Pi "list" (Const Type) - (Pi "cons" (Pi "_" "a" (Pi "_" "list" "list")) - (Pi "nil" "list" "list") ) ) - (App List "a") ) ) - loop _ ListFold = do - return - (Pi "a" (Const Type) - (Pi "_" (App List "a") - (Pi "list" (Const Type) - (Pi "cons" (Pi "_" "a" (Pi "_" "list" "list")) - (Pi "nil" "list" "list")) ) ) ) - loop _ ListLength = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") Natural)) - loop _ ListHead = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") (App Optional "a"))) - loop _ ListLast = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") (App Optional "a"))) - loop _ ListIndexed = do - let kts = [("index", Natural), ("value", "a")] - return - (Pi "a" (Const Type) - (Pi "_" (App List "a") - (App List (Record (Data.HashMap.Strict.InsOrd.fromList kts))) ) ) - loop _ ListReverse = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") (App List "a"))) - loop _ Optional = do - return (Pi "_" (Const Type) (Const Type)) - loop ctx e@(OptionalLit t xs) = do - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - _ -> Left (TypeError ctx e (InvalidOptionalType t)) - forM_ xs (\x -> do - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t t' - then return () - else do - let nf_t = Dhall.Core.normalize t - let nf_t' = Dhall.Core.normalize t' - Left (TypeError ctx e (InvalidOptionalElement nf_t x nf_t')) ) - return (App Optional t) - loop _ OptionalFold = do - return - (Pi "a" (Const Type) - (Pi "_" (App Optional "a") - (Pi "optional" (Const Type) - (Pi "just" (Pi "_" "a" "optional") - (Pi "nothing" "optional" "optional") ) ) ) ) - loop _ OptionalBuild = do - return - (Pi "a" (Const Type) - (Pi "_" f (App Optional "a") ) ) - where f = Pi "optional" (Const Type) - (Pi "just" (Pi "_" "a" "optional") - (Pi "nothing" "optional" "optional") ) - loop ctx e@(Record kts ) = do - let process (k, t) = do - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - Const Kind -> return () - _ -> Left (TypeError ctx e (InvalidFieldType k t)) - mapM_ process (Data.HashMap.Strict.InsOrd.toList kts) - return (Const Type) - loop ctx e@(RecordLit kvs ) = do - let process k v = do - t <- loop ctx v - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - Const Kind -> return () - _ -> Left (TypeError ctx e (InvalidField k v)) - return t - kts <- Data.HashMap.Strict.InsOrd.traverseWithKey process kvs - return (Record kts) - loop ctx e@(Union kts ) = do - let process (k, t) = do - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - Const Kind -> return () - _ -> Left (TypeError ctx e (InvalidAlternativeType k t)) - mapM_ process (Data.HashMap.Strict.InsOrd.toList kts) - return (Const Type) - loop ctx e@(UnionLit k v kts) = do - case Data.HashMap.Strict.InsOrd.lookup k kts of - Just _ -> Left (TypeError ctx e (DuplicateAlternative k)) - Nothing -> return () - t <- loop ctx v - let union = Union (Data.HashMap.Strict.InsOrd.insert k (Dhall.Core.normalize t) kts) - _ <- loop ctx union - return union - loop ctx e@(Combine kvsX kvsY) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '∧' kvsX tKvsX)) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - ktsY <- case tKvsY of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '∧' kvsY tKvsY)) - - let combineTypes ktsL ktsR = do - let ksL = - Data.Set.fromList (Data.HashMap.Strict.InsOrd.keys ktsL) - let ksR = - Data.Set.fromList (Data.HashMap.Strict.InsOrd.keys ktsR) - let ks = Data.Set.union ksL ksR - kts <- forM (toList ks) (\k -> do - case (Data.HashMap.Strict.InsOrd.lookup k ktsL, Data.HashMap.Strict.InsOrd.lookup k ktsR) of - (Just (Record ktsL'), Just (Record ktsR')) -> do - t <- combineTypes ktsL' ktsR' - return (k, t) - (Nothing, Just t) -> do - return (k, t) - (Just t, Nothing) -> do - return (k, t) - _ -> do - Left (TypeError ctx e (FieldCollision k)) ) - return (Record (Data.HashMap.Strict.InsOrd.fromList kts)) - - combineTypes ktsX ktsY - loop ctx e@(Prefer kvsX kvsY) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '⫽' kvsX tKvsX)) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - ktsY <- case tKvsY of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '⫽' kvsY tKvsY)) - return (Record (Data.HashMap.Strict.InsOrd.union ktsY ktsX)) - loop ctx e@(Merge kvsX kvsY (Just t)) = do - _ <- loop ctx t - - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustMergeARecord kvsX tKvsX)) - let ksX = Data.Set.fromList (Data.HashMap.Strict.InsOrd.keys ktsX) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - ktsY <- case tKvsY of - Union kts -> return kts - _ -> Left (TypeError ctx e (MustMergeUnion kvsY tKvsY)) - let ksY = Data.Set.fromList (Data.HashMap.Strict.InsOrd.keys ktsY) - - let diffX = Data.Set.difference ksX ksY - let diffY = Data.Set.difference ksY ksX - - if Data.Set.null diffX - then return () - else Left (TypeError ctx e (UnusedHandler diffX)) - - let process (kY, tY) = do - case Data.HashMap.Strict.InsOrd.lookup kY ktsX of - Nothing -> Left (TypeError ctx e (MissingHandler diffY)) - Just tX -> - case tX of - Pi _ tY' t' -> do - if Dhall.Core.judgmentallyEqual tY tY' - then return () - else Left (TypeError ctx e (HandlerInputTypeMismatch kY tY tY')) - if Dhall.Core.judgmentallyEqual t t' - then return () - else Left (TypeError ctx e (InvalidHandlerOutputType kY t t')) - _ -> Left (TypeError ctx e (HandlerNotAFunction kY tX)) - mapM_ process (Data.HashMap.Strict.InsOrd.toList ktsY) - return t - loop ctx e@(Merge kvsX kvsY Nothing) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustMergeARecord kvsX tKvsX)) - let ksX = Data.Set.fromList (Data.HashMap.Strict.InsOrd.keys ktsX) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - ktsY <- case tKvsY of - Union kts -> return kts - _ -> Left (TypeError ctx e (MustMergeUnion kvsY tKvsY)) - let ksY = Data.Set.fromList (Data.HashMap.Strict.InsOrd.keys ktsY) - - let diffX = Data.Set.difference ksX ksY - let diffY = Data.Set.difference ksY ksX - - if Data.Set.null diffX - then return () - else Left (TypeError ctx e (UnusedHandler diffX)) - - (kX, t) <- case Data.HashMap.Strict.InsOrd.toList ktsX of - [] -> Left (TypeError ctx e MissingMergeType) - (kX, Pi _ _ t):_ -> return (kX, t) - (kX, tX ):_ -> Left (TypeError ctx e (HandlerNotAFunction kX tX)) - let process (kY, tY) = do - case Data.HashMap.Strict.InsOrd.lookup kY ktsX of - Nothing -> Left (TypeError ctx e (MissingHandler diffY)) - Just tX -> - case tX of - Pi _ tY' t' -> do - if Dhall.Core.judgmentallyEqual tY tY' - then return () - else Left (TypeError ctx e (HandlerInputTypeMismatch kY tY tY')) - if Dhall.Core.judgmentallyEqual t t' - then return () - else Left (TypeError ctx e (HandlerOutputTypeMismatch kX t kY t')) - _ -> Left (TypeError ctx e (HandlerNotAFunction kY tX)) - mapM_ process (Data.HashMap.Strict.InsOrd.toList ktsY) - return t - loop ctx e@(Constructors t ) = do - _ <- loop ctx t - - kts <- case Dhall.Core.normalize t of - Union kts -> return kts - t' -> Left (TypeError ctx e (ConstructorsRequiresAUnionType t t')) - - let adapt k t_ = Pi k t_ (Union kts) - - return (Record (Data.HashMap.Strict.InsOrd.mapWithKey adapt kts)) - loop ctx e@(Field r x ) = do - t <- fmap Dhall.Core.normalize (loop ctx r) - case t of - Record kts -> do - _ <- loop ctx t - - case Data.HashMap.Strict.InsOrd.lookup x kts of - Just t' -> return t' - Nothing -> Left (TypeError ctx e (MissingField x t)) - _ -> Left (TypeError ctx e (NotARecord x r t)) - loop ctx (Note s e' ) = case loop ctx e' of - Left (TypeError ctx' (Note s' e'') m) -> Left (TypeError ctx' (Note s' e'') m) - Left (TypeError ctx' e'' m) -> Left (TypeError ctx' (Note s e'') m) - Right r -> Right r - loop _ (Embed p ) = Right $ tpa p - -{-| `typeOf` is the same as `typeWith` with an empty context, meaning that the - expression must be closed (i.e. no free variables), otherwise type-checking - will fail. --} -typeOf :: Expr s X -> Either (TypeError s X) (Expr s X) -typeOf = typeWith Dhall.Context.empty - --- | Like `Data.Void.Void`, except with a shorter inferred type -newtype X = X { absurd :: forall a . a } - -instance Show X where - show = absurd - -instance Eq X where - _ == _ = True - -instance Buildable X where - build = absurd - -instance Pretty X where - pretty = absurd - --- | The specific type error -data TypeMessage s a - = UnboundVariable Text - | InvalidInputType (Expr s a) - | InvalidOutputType (Expr s a) - | NotAFunction (Expr s a) (Expr s a) - | TypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) - | AnnotMismatch (Expr s a) (Expr s a) (Expr s a) - | Untyped - | MissingListType - | MismatchedListElements Int (Expr s a) (Expr s a) (Expr s a) - | InvalidListElement Int (Expr s a) (Expr s a) (Expr s a) - | InvalidListType (Expr s a) - | InvalidOptionalElement (Expr s a) (Expr s a) (Expr s a) - | InvalidOptionalType (Expr s a) - | InvalidPredicate (Expr s a) (Expr s a) - | IfBranchMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) - | IfBranchMustBeTerm Bool (Expr s a) (Expr s a) (Expr s a) - | InvalidField Text (Expr s a) - | InvalidFieldType Text (Expr s a) - | InvalidAlternative Text (Expr s a) - | InvalidAlternativeType Text (Expr s a) - | ListAppendMismatch (Expr s a) (Expr s a) - | DuplicateAlternative Text - | MustCombineARecord Char (Expr s a) (Expr s a) - | FieldCollision Text - | MustMergeARecord (Expr s a) (Expr s a) - | MustMergeUnion (Expr s a) (Expr s a) - | UnusedHandler (Set Text) - | MissingHandler (Set Text) - | HandlerInputTypeMismatch Text (Expr s a) (Expr s a) - | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a) - | InvalidHandlerOutputType Text (Expr s a) (Expr s a) - | MissingMergeType - | HandlerNotAFunction Text (Expr s a) - | ConstructorsRequiresAUnionType (Expr s a) (Expr s a) - | NotARecord Text (Expr s a) (Expr s a) - | MissingField Text (Expr s a) - | CantAnd (Expr s a) (Expr s a) - | CantOr (Expr s a) (Expr s a) - | CantEQ (Expr s a) (Expr s a) - | CantNE (Expr s a) (Expr s a) - | CantInterpolate (Expr s a) (Expr s a) - | CantTextAppend (Expr s a) (Expr s a) - | CantListAppend (Expr s a) (Expr s a) - | CantAdd (Expr s a) (Expr s a) - | CantMultiply (Expr s a) (Expr s a) - | NoDependentTypes (Expr s a) (Expr s a) - deriving (Show) - -shortTypeMessage :: Buildable a => TypeMessage s a -> Builder -shortTypeMessage msg = - "\ESC[1;31mError\ESC[0m: " <> build short <> "\n" - where - ErrorMessages {..} = prettyTypeMessage msg - -longTypeMessage :: Buildable a => TypeMessage s a -> Builder -longTypeMessage msg = - "\ESC[1;31mError\ESC[0m: " <> build short <> "\n" - <> "\n" - <> long - where - ErrorMessages {..} = prettyTypeMessage msg - -data ErrorMessages = ErrorMessages - { short :: Builder - -- ^ Default succinct 1-line explanation of what went wrong - , long :: Builder - -- ^ Longer and more detailed explanation of the error - } - -_NOT :: Builder -_NOT = "\ESC[1mnot\ESC[0m" - -prettyTypeMessage :: Buildable a => TypeMessage s a -> ErrorMessages -prettyTypeMessage (UnboundVariable _) = ErrorMessages {..} - -- We do not need to print variable name here. For the discussion see: - -- https://github.com/dhall-lang/dhall-haskell/pull/116 - where - short = "Unbound variable" - - long = - "Explanation: Expressions can only reference previously introduced (i.e. \"bound\")\n\ - \variables that are still \"in scope\" \n\ - \ \n\ - \For example, the following valid expressions introduce a \"bound\" variable named\n\ - \❰x❱: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ λ(x : Bool) → x │ Anonymous functions introduce \"bound\" variables \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is the bound variable \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ let x = 1 in x │ ❰let❱ expressions introduce \"bound\" variables \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is the bound variable \n\ - \ \n\ - \ \n\ - \However, the following expressions are not valid because they all reference a \n\ - \variable that has not been introduced yet (i.e. an \"unbound\" variable): \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ λ(x : Bool) → y │ The variable ❰y❱ hasn't been introduced yet \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is the unbound variable \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ (let x = True in x) && x │ ❰x❱ is undefined outside the parentheses \n\ - \ └──────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is the unbound variable \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ let x = x in x │ The definition for ❰x❱ cannot reference itself \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ This is the unbound variable \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You misspell a variable name, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────────────┐ \n\ - \ │ λ(empty : Bool) → if emty then \"Empty\" else \"Full\" │ \n\ - \ └────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Typo \n\ - \ \n\ - \ \n\ - \● You misspell a reserved identifier, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ foral (a : Type) → a → a │ \n\ - \ └──────────────────────────┘ \n\ - \ ⇧ \n\ - \ Typo \n\ - \ \n\ - \ \n\ - \● You tried to define a recursive value, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────┐ \n\ - \ │ let x = x + +1 in x │ \n\ - \ └─────────────────────┘ \n\ - \ ⇧ \n\ - \ Recursive definitions are not allowed \n\ - \ \n\ - \ \n\ - \● You accidentally forgot a ❰λ❱ or ❰∀❱/❰forall❱ \n\ - \ \n\ - \ \n\ - \ Unbound variable \n\ - \ ⇩ \n\ - \ ┌─────────────────┐ \n\ - \ │ (x : Bool) → x │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ A ❰λ❱ here would transform this into a valid anonymous function \n\ - \ \n\ - \ \n\ - \ Unbound variable \n\ - \ ⇩ \n\ - \ ┌────────────────────┐ \n\ - \ │ (x : Bool) → Bool │ \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ A ❰∀❱ or ❰forall❱ here would transform this into a valid function type \n" - -prettyTypeMessage (InvalidInputType expr) = ErrorMessages {..} - where - short = "Invalid function input" - - long = - "Explanation: A function can accept an input \"term\" that has a given \"type\", like\n\ - \this: \n\ - \ \n\ - \ \n\ - \ This is the input term that the function accepts \n\ - \ ⇩ \n\ - \ ┌───────────────────────┐ \n\ - \ │ ∀(x : Natural) → Bool │ This is the type of a function that accepts an \n\ - \ └───────────────────────┘ input term named ❰x❱ that has type ❰Natural❱ \n\ - \ ⇧ \n\ - \ This is the type of the input term \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ Bool → Integer │ This is the type of a function that accepts an anonymous\n\ - \ └────────────────┘ input term that has type ❰Bool❱ \n\ - \ ⇧ \n\ - \ This is the type of the input term \n\ - \ \n\ - \ \n\ - \... or a function can accept an input \"type\" that has a given \"kind\", like this:\n\ - \ \n\ - \ \n\ - \ This is the input type that the function accepts \n\ - \ ⇩ \n\ - \ ┌────────────────────┐ \n\ - \ │ ∀(a : Type) → Type │ This is the type of a function that accepts an input\n\ - \ └────────────────────┘ type named ❰a❱ that has kind ❰Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the input type \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────┐ \n\ - \ │ (Type → Type) → Type │ This is the type of a function that accepts an \n\ - \ └──────────────────────┘ anonymous input type that has kind ❰Type → Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the input type \n\ - \ \n\ - \ \n\ - \Other function inputs are " <> _NOT <> " valid, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────┐ \n\ - \ │ ∀(x : 1) → x │ ❰1❱ is a \"term\" and not a \"type\" nor a \"kind\" so ❰x❱\n\ - \ └──────────────┘ cannot have \"type\" ❰1❱ or \"kind\" ❰1❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ True → x │ ❰True❱ is a \"term\" and not a \"type\" nor a \"kind\" so the \n\ - \ └──────────┘ anonymous input cannot have \"type\" ❰True❱ or \"kind\" ❰True❱\n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \You annotated a function input with the following expression: \n\ - \ \n\ - \↳ " <> txt <> " \n\ - \ \n\ - \... which is neither a type nor a kind \n" - where - txt = build expr - -prettyTypeMessage (InvalidOutputType expr) = ErrorMessages {..} - where - short = "Invalid function output" - - long = - "Explanation: A function can return an output \"term\" that has a given \"type\",\n\ - \like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ ∀(x : Text) → Bool │ This is the type of a function that returns an \n\ - \ └────────────────────┘ output term that has type ❰Bool❱ \n\ - \ ⇧ \n\ - \ This is the type of the output term \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ Bool → Integer │ This is the type of a function that returns an output \n\ - \ └────────────────┘ term that has type ❰Int❱ \n\ - \ ⇧ \n\ - \ This is the type of the output term \n\ - \ \n\ - \ \n\ - \... or a function can return an output \"type\" that has a given \"kind\", like \n\ - \this: \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ ∀(a : Type) → Type │ This is the type of a function that returns an \n\ - \ └────────────────────┘ output type that has kind ❰Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the output type \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────┐ \n\ - \ │ (Type → Type) → Type │ This is the type of a function that returns an \n\ - \ └──────────────────────┘ output type that has kind ❰Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the output type \n\ - \ \n\ - \ \n\ - \Other outputs are " <> _NOT <> " valid, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ ∀(x : Bool) → x │ ❰x❱ is a \"term\" and not a \"type\" nor a \"kind\" so the\n\ - \ └─────────────────┘ output cannot have \"type\" ❰x❱ or \"kind\" ❰x❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ Text → True │ ❰True❱ is a \"term\" and not a \"type\" nor a \"kind\" so the\n\ - \ └─────────────┘ output cannot have \"type\" ❰True❱ or \"kind\" ❰True❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You use ❰∀❱ instead of ❰λ❱ by mistake, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ ∀(x: Bool) → x │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ Using ❰λ❱ here instead of ❰∀❱ would transform this into a valid function \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You specified that your function outputs a: \n\ - \ \n\ - \↳ " <> txt <> " \n\ - \ \n\ - \... which is neither a type nor a kind: \n" - where - txt = build expr - -prettyTypeMessage (NotAFunction expr0 expr1) = ErrorMessages {..} - where - short = "Not a function" - - long = - "Explanation: Expressions separated by whitespace denote function application, \n\ - \like this: \n\ - \ \n\ - \ \n\ - \ ┌─────┐ \n\ - \ │ f x │ This denotes the function ❰f❱ applied to an argument named ❰x❱ \n\ - \ └─────┘ \n\ - \ \n\ - \ \n\ - \A function is a term that has type ❰a → b❱ for some ❰a❱ or ❰b❱. For example, \n\ - \the following expressions are all functions because they have a function type: \n\ - \ \n\ - \ \n\ - \ The function's input type is ❰Bool❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(x : Bool) → x : Bool → Bool │ User-defined anonymous function \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output type is ❰Bool❱ \n\ - \ \n\ - \ \n\ - \ The function's input type is ❰Natural❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ Natural/even : Natural → Bool │ Built-in function \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output type is ❰Bool❱ \n\ - \ \n\ - \ \n\ - \ The function's input kind is ❰Type❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(a : Type) → a : Type → Type │ Type-level functions are still functions \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output kind is ❰Type❱ \n\ - \ \n\ - \ \n\ - \ The function's input kind is ❰Type❱ \n\ - \ ⇩ \n\ - \ ┌────────────────────┐ \n\ - \ │ List : Type → Type │ Built-in type-level function \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output kind is ❰Type❱ \n\ - \ \n\ - \ \n\ - \ Function's input has kind ❰Type❱ \n\ - \ ⇩ \n\ - \ ┌─────────────────────────────────────────────────┐ \n\ - \ │ List/head : ∀(a : Type) → (List a → Optional a) │ A function can return \n\ - \ └─────────────────────────────────────────────────┘ another function \n\ - \ ⇧ \n\ - \ Function's output has type ❰List a → Optional a❱\n\ - \ \n\ - \ \n\ - \ The function's input type is ❰List Text❱ \n\ - \ ⇩ \n\ - \ ┌────────────────────────────────────────────┐ \n\ - \ │ List/head Text : List Text → Optional Text │ A function applied to an \n\ - \ └────────────────────────────────────────────┘ argument can be a function \n\ - \ ⇧ \n\ - \ The function's output type is ❰Optional Text❱\n\ - \ \n\ - \ \n\ - \An expression is not a function if the expression's type is not of the form \n\ - \❰a → b❱. For example, these are " <> _NOT <> " functions: \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ 1 : Integer │ ❰1❱ is not a function because ❰Integer❱ is not the type of \n\ - \ └─────────────┘ a function \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ Natural/even +2 : Bool │ ❰Natural/even +2❱ is not a function because \n\ - \ └────────────────────────┘ ❰Bool❱ is not the type of a function \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ List Text : Type │ ❰List Text❱ is not a function because ❰Type❱ is not \n\ - \ └──────────────────┘ the type of a function \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You tried to add two ❰Integer❱s without a space around the ❰+❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────┐ \n\ - \ │ 2+2 │ \n\ - \ └─────┘ \n\ - \ \n\ - \ \n\ - \ The above code is parsed as: \n\ - \ \n\ - \ \n\ - \ ┌────────┐ \n\ - \ │ 2 (+2) │ \n\ - \ └────────┘ \n\ - \ ⇧ \n\ - \ The compiler thinks that this ❰2❱ is a function whose argument is ❰+2❱ \n\ - \ \n\ - \ \n\ - \ This is because the ❰+❱ symbol has two meanings: you use ❰+❱ to add two \n\ - \ numbers, but you also can prefix ❰Integer❱ literals with a ❰+❱ to turn them \n\ - \ into ❰Natural❱ literals (like ❰+2❱) \n\ - \ \n\ - \ To fix the code, you need to put spaces around the ❰+❱ and also prefix each \n\ - \ ❰2❱ with a ❰+❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────┐ \n\ - \ │ +2 + +2 │ \n\ - \ └─────────┘ \n\ - \ \n\ - \ \n\ - \ You can only add ❰Natural❱ numbers, which is why you must also change each \n\ - \ ❰2❱ to ❰+2❱ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to use the following expression as a function: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... but this expression's type is: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which is not a function type \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (TypeMismatch expr0 expr1 expr2 expr3) = ErrorMessages {..} - where - short = "Wrong type of function argument" - - long = - "Explanation: Every function declares what type or kind of argument to accept \n\ - \ \n\ - \For example: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(x : Bool) → x : Bool → Bool │ This anonymous function only accepts \n\ - \ └───────────────────────────────┘ arguments that have type ❰Bool❱ \n\ - \ ⇧ \n\ - \ The function's input type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ Natural/even : Natural → Bool │ This built-in function only accepts \n\ - \ └───────────────────────────────┘ arguments that have type ❰Natural❱ \n\ - \ ⇧ \n\ - \ The function's input type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(a : Type) → a : Type → Type │ This anonymous function only accepts \n\ - \ └───────────────────────────────┘ arguments that have kind ❰Type❱ \n\ - \ ⇧ \n\ - \ The function's input kind \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ List : Type → Type │ This built-in function only accepts arguments that \n\ - \ └────────────────────┘ have kind ❰Type❱ \n\ - \ ⇧ \n\ - \ The function's input kind \n\ - \ \n\ - \ \n\ - \For example, the following expressions are valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ (λ(x : Bool) → x) True │ ❰True❱ has type ❰Bool❱, which matches the type \n\ - \ └────────────────────────┘ of argument that the anonymous function accepts \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ Natural/even +2 │ ❰+2❱ has type ❰Natural❱, which matches the type of \n\ - \ └─────────────────┘ argument that the ❰Natural/even❱ function accepts, \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ (λ(a : Type) → a) Bool │ ❰Bool❱ has kind ❰Type❱, which matches the kind \n\ - \ └────────────────────────┘ of argument that the anonymous function accepts \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ List Text │ ❰Text❱ has kind ❰Type❱, which matches the kind of argument \n\ - \ └───────────┘ that that the ❰List❱ function accepts \n\ - \ \n\ - \ \n\ - \However, you can " <> _NOT <> " apply a function to the wrong type or kind of argument\n\ - \ \n\ - \For example, the following expressions are not valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ (λ(x : Bool) → x) \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the anonymous function\n\ - \ └───────────────────────┘ expects an argument that has type ❰Bool❱ \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ Natural/even \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the ❰Natural/even❱ function\n\ - \ └──────────────────┘ expects an argument that has type ❰Natural❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ (λ(a : Type) → a) True │ ❰True❱ has type ❰Bool❱, but the anonymous \n\ - \ └────────────────────────┘ function expects an argument of kind ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌────────┐ \n\ - \ │ List 1 │ ❰1❱ has type ❰Integer❱, but the ❰List❱ function expects an \n\ - \ └────────┘ argument that has kind ❰Type❱ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You omit a function argument by mistake: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ List/head [1, 2, 3] │ \n\ - \ └───────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰List/head❱ is missing the first argument, \n\ - \ which should be: ❰Integer❱ \n\ - \ \n\ - \ \n\ - \● You supply an ❰Integer❱ literal to a function that expects a ❰Natural❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ Natural/even 2 │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ This should be ❰+2❱ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to invoke the following function: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which expects an argument of type or kind: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... on the following argument: \n\ - \ \n\ - \↳ " <> txt2 <> " \n\ - \ \n\ - \... which has a different type or kind: \n\ - \ \n\ - \↳ " <> txt3 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - txt2 = build expr2 - txt3 = build expr3 - -prettyTypeMessage (AnnotMismatch expr0 expr1 expr2) = ErrorMessages {..} - where - short = "Expression doesn't match annotation" - - long = - "Explanation: You can annotate an expression with its type or kind using the \n\ - \❰:❱ symbol, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ x : t │ ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱\n\ - \ └───────┘ \n\ - \ \n\ - \The type checker verifies that the expression's type or kind matches the \n\ - \provided annotation \n\ - \ \n\ - \For example, all of the following are valid annotations that the type checker \n\ - \accepts: \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ 1 : Integer │ ❰1❱ is an expression that has type ❰Integer❱, so the type \n\ - \ └─────────────┘ checker accepts the annotation \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ Natural/even +2 : Bool │ ❰Natural/even +2❱ has type ❰Bool❱, so the type \n\ - \ └────────────────────────┘ checker accepts the annotation \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ List : Type → Type │ ❰List❱ is an expression that has kind ❰Type → Type❱,\n\ - \ └────────────────────┘ so the type checker accepts the annotation \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ List Text : Type │ ❰List Text❱ is an expression that has kind ❰Type❱, so \n\ - \ └──────────────────┘ the type checker accepts the annotation \n\ - \ \n\ - \ \n\ - \However, the following annotations are " <> _NOT <> " valid and the type checker will\n\ - \reject them: \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ 1 : Text │ The type checker rejects this because ❰1❱ does not have type \n\ - \ └──────────┘ ❰Text❱ \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ List : Type │ ❰List❱ does not have kind ❰Type❱ \n\ - \ └─────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● The Haskell Dhall interpreter implicitly inserts a top-level annotation \n\ - \ matching the expected type \n\ - \ \n\ - \ For example, if you run the following Haskell code: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ >>> input auto \"1\" :: IO Text │ \n\ - \ └───────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ... then the interpreter will actually type check the following annotated \n\ - \ expression: \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ 1 : Text │ \n\ - \ └──────────┘ \n\ - \ \n\ - \ \n\ - \ ... and then type-checking will fail \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You or the interpreter annotated this expression: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... with this type or kind: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... but the inferred type or kind of the expression is actually: \n\ - \ \n\ - \↳ " <> txt2 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - txt2 = build expr2 - -prettyTypeMessage Untyped = ErrorMessages {..} - where - short = "❰Kind❱ has no type or kind" - - long = - "Explanation: There are four levels of expressions that form a hierarchy: \n\ - \ \n\ - \● terms \n\ - \● types \n\ - \● kinds \n\ - \● sorts \n\ - \ \n\ - \The following example illustrates this hierarchy: \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ \"ABC\" : Text : Type : Kind │ \n\ - \ └────────────────────────────┘ \n\ - \ ⇧ ⇧ ⇧ ⇧ \n\ - \ term type kind sort \n\ - \ \n\ - \There is nothing above ❰Kind❱ in this hierarchy, so if you try to type check any\n\ - \expression containing ❰Kind❱ anywhere in the expression then type checking fails\n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You supplied a kind where a type was expected \n\ - \ \n\ - \ For example, the following expression will fail to type check: \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ [] : List Type │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ ❰Type❱ is a kind, not a type \n" - -prettyTypeMessage (InvalidPredicate expr0 expr1) = ErrorMessages {..} - where - short = "Invalid predicate for ❰if❱" - - long = - "Explanation: Every ❰if❱ expression begins with a predicate which must have type \n\ - \❰Bool❱ \n\ - \ \n\ - \For example, these are valid ❰if❱ expressions: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ if True then \"Yes\" else \"No\" │ \n\ - \ └──────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Predicate \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ λ(x : Bool) → if x then False else True │ \n\ - \ └─────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Predicate \n\ - \ \n\ - \ \n\ - \... but these are " <> _NOT <> " valid ❰if❱ expressions: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ if 0 then \"Yes\" else \"No\" │ ❰0❱ does not have type ❰Bool❱ \n\ - \ └───────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ if \"\" then False else True │ ❰\"\"❱ does not have type ❰Bool❱ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might be used to other programming languages that accept predicates other \n\ - \ than ❰Bool❱ \n\ - \ \n\ - \ For example, some languages permit ❰0❱ or ❰\"\"❱ as valid predicates and treat\n\ - \ them as equivalent to ❰False❱. However, the Dhall language does not permit \n\ - \ this \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \Your ❰if❱ expression begins with the following predicate: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... that has type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... but the predicate must instead have type ❰Bool❱ \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (IfBranchMustBeTerm b expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "❰if❱ branch is not a term" - - long = - "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ - \is an expression: \n\ - \ \n\ - \ \n\ - \ Expression for ❰then❱ branch \n\ - \ ⇩ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ if True then \"Hello, world!\" │ \n\ - \ │ else \"Goodbye, world!\" │ \n\ - \ └────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Expression for ❰else❱ branch \n\ - \ \n\ - \ \n\ - \These expressions must be a \"term\", where a \"term\" is defined as an expression\n\ - \that has a type thas has kind ❰Type❱ \n\ - \ \n\ - \For example, the following expressions are all valid \"terms\": \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ 1 : Integer : Type │ ❰1❱ is a term with a type (❰Integer❱) of kind ❰Type❱\n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ term \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────┐ \n\ - \ │ Natural/odd : Natural → Bool : Type │ ❰Natural/odd❱ is a term with a type\n\ - \ └─────────────────────────────────────┘ (❰Natural → Bool❱) of kind ❰Type❱ \n\ - \ ⇧ \n\ - \ term \n\ - \ \n\ - \ \n\ - \However, the following expressions are " <> _NOT <> " valid terms: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ Text : Type : Kind │ ❰Text❱ has kind (❰Type❱) of sort ❰Kind❱ and is \n\ - \ └────────────────────┘ therefore not a term \n\ - \ ⇧ \n\ - \ type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ List : Type → Type : Kind │ ❰List❱ has kind (❰Type → Type❱) of sort \n\ - \ └───────────────────────────┘ ❰Kind❱ and is therefore not a term \n\ - \ ⇧ \n\ - \ type-level function \n\ - \ \n\ - \ \n\ - \This means that you cannot define an ❰if❱ expression that returns a type. For \n\ - \example, the following ❰if❱ expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────┐ \n\ - \ │ if True then Text else Bool │ Invalid ❰if❱ expression \n\ - \ └─────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ type type \n\ - \ \n\ - \ \n\ - \Your ❰" <> txt0 <> "❱ branch of your ❰if❱ expression is: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which has kind: \n\ - \ \n\ - \↳ " <> txt2 <> " \n\ - \ \n\ - \... of sort: \n\ - \ \n\ - \↳ " <> txt3 <> " \n\ - \ \n\ - \... and is not a term. Therefore your ❰if❱ expression is not valid \n" - where - txt0 = if b then "then" else "else" - txt1 = build expr0 - txt2 = build expr1 - txt3 = build expr2 - -prettyTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) = - ErrorMessages {..} - where - short = "❰if❱ branches must have matching types" - - long = - "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ - \is an expression: \n\ - \ \n\ - \ \n\ - \ Expression for ❰then❱ branch \n\ - \ ⇩ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ if True then \"Hello, world!\" │ \n\ - \ │ else \"Goodbye, world!\" │ \n\ - \ └────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Expression for ❰else❱ branch \n\ - \ \n\ - \ \n\ - \These two expressions must have the same type. For example, the following ❰if❱ \n\ - \expressions are all valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ λ(b : Bool) → if b then 0 else 1 │ Both branches have type ❰Integer❱ \n\ - \ └──────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ λ(b : Bool) → │ \n\ - \ │ if b then Natural/even │ Both branches have type ❰Natural → Bool❱ \n\ - \ │ else Natural/odd │ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ This branch has type ❰Integer❱ \n\ - \ ⇩ \n\ - \ ┌────────────────────────┐ \n\ - \ │ if True then 0 │ \n\ - \ │ else \"ABC\" │ \n\ - \ └────────────────────────┘ \n\ - \ ⇧ \n\ - \ This branch has type ❰Text❱ \n\ - \ \n\ - \ \n\ - \The ❰then❱ and ❰else❱ branches must have matching types, even if the predicate \n\ - \is always ❰True❱ or ❰False❱ \n\ - \ \n\ - \Your ❰if❱ expression has the following ❰then❱ branch: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which has type: \n\ - \ \n\ - \↳ " <> txt2 <> " \n\ - \ \n\ - \... and the following ❰else❱ branch: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which has a different type: \n\ - \ \n\ - \↳ " <> txt3 <> " \n\ - \ \n\ - \Fix your ❰then❱ and ❰else❱ branches to have matching types \n" - where - txt0 = build expr0 - txt1 = build expr1 - txt2 = build expr2 - txt3 = build expr3 - -prettyTypeMessage (InvalidListType expr0) = ErrorMessages {..} - where - short = "Invalid type for ❰List❱ elements" - - long = - "Explanation: ❰List❱s can optionally document the type of their elements with a \n\ - \type annotation, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ [1, 2, 3] : List Integer │ A ❰List❱ of three ❰Integer❱s \n\ - \ └──────────────────────────┘ \n\ - \ ⇧ \n\ - \ The type of the ❰List❱'s elements, which are ❰Integer❱s \n\ - \ \n\ - \ \n\ - \ ┌───────────────────┐ \n\ - \ │ [] : List Integer │ An empty ❰List❱ \n\ - \ └───────────────────┘ \n\ - \ ⇧ \n\ - \ You must specify the type when the ❰List❱ is empty \n\ - \ \n\ - \ \n\ - \The element type must be a type and not something else. For example, the \n\ - \following element types are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────┐ \n\ - \ │ ... : List 1 │ \n\ - \ └──────────────┘ \n\ - \ ⇧ \n\ - \ This is an ❰Integer❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ ... : List Type │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is a ❰Kind❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \You declared that the ❰List❱'s elements should have type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not a ❰Type❱ \n" - where - txt0 = build expr0 - -prettyTypeMessage MissingListType = do - ErrorMessages {..} - where - short = "An empty list requires a type annotation" - - long = - "Explanation: Lists do not require a type annotation if they have at least one \n\ - \element: \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ [1, 2, 3] │ The compiler can infer that this list has type ❰List Integer❱\n\ - \ └───────────┘ \n\ - \ \n\ - \ \n\ - \However, empty lists still require a type annotation: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────┐ \n\ - \ │ [] : List Integer │ This type annotation is mandatory \n\ - \ └───────────────────┘ \n\ - \ \n\ - \ \n\ - \You cannot supply an empty list without a type annotation \n" - -prettyTypeMessage (MismatchedListElements i expr0 _expr1 expr2) = - ErrorMessages {..} - where - short = "List elements should all have the same type" - - long = - "Explanation: Every element in a list must have the same type \n\ - \ \n\ - \For example, this is a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ [1, 2, 3] │ Every element in this ❰List❱ is an ❰Integer❱ \n\ - \ └───────────┘ \n\ - \ \n\ - \ \n\ - \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────┐ \n\ - \ │ [1, \"ABC\", 3] │ The first and second element have different types \n\ - \ └───────────────┘ \n\ - \ \n\ - \ \n\ - \Your first ❰List❱ element has this type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... but the element at index #" <> txt1 <> " has this type instead: \n\ - \ \n\ - \↳ " <> txt3 <> " \n" - where - txt0 = build expr0 - txt1 = build i - txt3 = build expr2 - -prettyTypeMessage (InvalidListElement i expr0 _expr1 expr2) = - ErrorMessages {..} - where - short = "List element has the wrong type" - - long = - "Explanation: Every element in the list must have a type matching the type \n\ - \annotation at the end of the list \n\ - \ \n\ - \For example, this is a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ [1, 2, 3] : List Integer │ Every element in this ❰List❱ is an ❰Integer❱ \n\ - \ └──────────────────────────┘ \n\ - \ \n\ - \ \n\ - \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ [1, \"ABC\", 3] : List Integer │ The second element is not an ❰Integer❱ \n\ - \ └──────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Your ❰List❱ elements should have this type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... but the element at index #" <> txt1 <> " has this type instead: \n\ - \ \n\ - \↳ " <> txt3 <> " \n" - where - txt0 = build expr0 - txt1 = build i - txt3 = build expr2 - -prettyTypeMessage (InvalidOptionalType expr0) = ErrorMessages {..} - where - short = "Invalid type for ❰Optional❱ element" - - long = - "Explanation: Every optional element ends with a type annotation for the element \n\ - \that might be present, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ [1] : Optional Integer │ An optional element that's present \n\ - \ └────────────────────────┘ \n\ - \ ⇧ \n\ - \ The type of the ❰Optional❱ element, which is an ❰Integer❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ [] : Optional Integer │ An optional element that's absent \n\ - \ └────────────────────────┘ \n\ - \ ⇧ \n\ - \ You still specify the type even when the element is absent \n\ - \ \n\ - \ \n\ - \The element type must be a type and not something else. For example, the \n\ - \following element types are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ ... : Optional 1 │ \n\ - \ └──────────────────┘ \n\ - \ ⇧ \n\ - \ This is an ❰Integer❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────┐ \n\ - \ │ ... : Optional Type │ \n\ - \ └─────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a ❰Kind❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \Even if the element is absent you still must specify a valid type \n\ - \ \n\ - \You declared that the ❰Optional❱ element should have type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not a ❰Type❱ \n" - where - txt0 = build expr0 - -prettyTypeMessage (InvalidOptionalElement expr0 expr1 expr2) = ErrorMessages {..} - where - short = "❰Optional❱ element has the wrong type" - - long = - "Explanation: An ❰Optional❱ element must have a type matching the type annotation\n\ - \ \n\ - \For example, this is a valid ❰Optional❱ value: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ [1] : Optional Integer │ ❰1❱ is an ❰Integer❱, which matches the type \n\ - \ └────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but this is " <> _NOT <> " a valid ❰Optional❱ value: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ [\"ABC\"] : Optional Integer │ ❰\"ABC\"❱ is not an ❰Integer❱ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Your ❰Optional❱ element should have this type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... but the element you provided: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... has this type instead: \n\ - \ \n\ - \↳ " <> txt2 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - txt2 = build expr2 - -prettyTypeMessage (InvalidFieldType k expr0) = ErrorMessages {..} - where - short = "Invalid field type" - - long = - "Explanation: Every record type documents the type of each field, like this: \n\ - \ \n\ - \ ┌──────────────────────────────────────────────┐ \n\ - \ │ { foo : Integer, bar : Integer, baz : Text } │ \n\ - \ └──────────────────────────────────────────────┘ \n\ - \ \n\ - \However, fields cannot be annotated with expressions other than types \n\ - \ \n\ - \For example, these record types are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ { foo : Integer, bar : 1 } │ \n\ - \ └────────────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰1❱ is an ❰Integer❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ { foo : Integer, bar : Type } │ \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰Type❱ is a ❰Kind❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \You provided a record type with a key named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... annotated with the following expression: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which is not a type \n" - where - txt0 = build k - txt1 = build expr0 - -prettyTypeMessage (InvalidField k expr0) = ErrorMessages {..} - where - short = "Invalid field" - - long = - "Explanation: Every record literal is a set of fields assigned to values, like \n\ - \this: \n\ - \ \n\ - \ ┌────────────────────────────────────────┐ \n\ - \ │ { foo = 100, bar = True, baz = \"ABC\" } │ \n\ - \ └────────────────────────────────────────┘ \n\ - \ \n\ - \However, fields can only be terms and cannot be types or kinds \n\ - \ \n\ - \For example, these record literals are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ { foo = 100, bar = Text } │ \n\ - \ └───────────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰Text❱ is a type and not a term \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ { foo = 100, bar = Type } │ \n\ - \ └───────────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰Type❱ is a kind and not a term \n\ - \ \n\ - \ \n\ - \You provided a record literal with a key named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... whose value is: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which is not a term \n" - where - txt0 = build k - txt1 = build expr0 - -prettyTypeMessage (InvalidAlternativeType k expr0) = ErrorMessages {..} - where - short = "Invalid alternative" - - long = - "Explanation: Every union literal begins by selecting one alternative and \n\ - \specifying the value for that alternative, like this: \n\ - \ \n\ - \ \n\ - \ Select the ❰Left❱ alternative, whose value is ❰True❱ \n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ < Left = True, Right : Natural > │ A union literal with two alternatives \n\ - \ └──────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, this value must be a term and not a type. For example, the following \n\ - \values are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ < Left = Text, Right : Natural > │ Invalid union literal \n\ - \ └──────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a type and not a term \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ < Left = Type, Right : Type > │ Invalid union type \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a kind and not a term \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally typed ❰=❱ instead of ❰:❱ for a union literal with one \n\ - \ alternative: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ < Example = Text > │ \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ This could be ❰:❱ instead \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided a union literal with an alternative named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... whose value is: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which is not a term \n" - where - txt0 = build k - txt1 = build expr0 - -prettyTypeMessage (InvalidAlternative k expr0) = ErrorMessages {..} - where - short = "Invalid alternative" - - long = - "Explanation: Every union type specifies the type of each alternative, like this:\n\ - \ \n\ - \ \n\ - \ The type of the first alternative is ❰Bool❱ \n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ < Left : Bool, Right : Natural > │ A union type with two alternatives \n\ - \ └──────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The type of the second alternative is ❰Natural❱ \n\ - \ \n\ - \ \n\ - \However, these alternatives can only be annotated with types. For example, the \n\ - \following union types are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ < Left : Bool, Right : 1 > │ Invalid union type \n\ - \ └────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a term and not a type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ < Left : Bool, Right : Type > │ Invalid union type \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a kind and not a type \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally typed ❰:❱ instead of ❰=❱ for a union literal with one \n\ - \ alternative: \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ < Example : 1 > │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This could be ❰=❱ instead \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided a union type with an alternative named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... annotated with the following expression which is not a type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build k - txt1 = build expr0 - -prettyTypeMessage (ListAppendMismatch expr0 expr1) = ErrorMessages {..} - where - short = "You can only append ❰List❱s with matching element types" - - long = - "Explanation: You can append two ❰List❱s using the ❰#❱ operator, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ [1, 2, 3] # [4, 5] │ \n\ - \ └────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot append two ❰List❱s if they have different element types. \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ These elements have type ❰Integer❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ [1, 2, 3] # [True, False] │ Invalid: the element types don't match \n\ - \ └───────────────────────────┘ \n\ - \ ⇧ \n\ - \ These elements have type ❰Bool❱ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to append a ❰List❱ thas has elements of type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... with another ❰List❱ that has elements of type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... and those two types do not match \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (DuplicateAlternative k) = ErrorMessages {..} - where - short = "Duplicate union alternative" - - long = - "Explanation: Unions may not have two alternatives that share the same name \n\ - \ \n\ - \For example, the following expressions are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────┐ \n\ - \ │ < foo = True | foo : Text > │ Invalid: ❰foo❱ appears twice \n\ - \ └─────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────┐ \n\ - \ │ < foo = 1 | bar : Bool | bar : Text > │ Invalid: ❰bar❱ appears twice \n\ - \ └───────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \You have more than one alternative named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n" - where - txt0 = build k - -prettyTypeMessage (MustCombineARecord c expr0 expr1) = ErrorMessages {..} - where - short = "You can only combine records" - - long = - "Explanation: You can combine records using the ❰" <> op <> "❱ operator, like this:\n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz = True } │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool }) → r " <> op <> " { bar = \"ABC\" } │ \n\ - \ └─────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot combine values that are not records. \n\ - \ \n\ - \For example, the following expressions are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " 1 │ \n\ - \ └──────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz : Bool } │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: This is a record type and not a record\n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " < baz = True > │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: This is a union and not a record \n\ - \ \n\ - \ \n\ - \You tried to combine the following value: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not a record, but is actually a: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - op = build c - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (FieldCollision k) = ErrorMessages {..} - where - short = "Field collision" - - long = - "Explanation: You can combine records if they don't share any fields in common, \n\ - \like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } ∧ { baz = True } │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────┐ \n\ - \ │ λ(r : { baz : Bool}) → { foo = 1 } ∧ r │ \n\ - \ └────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot merge two records that share the same field \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = True } │ Invalid: Colliding ❰foo❱ fields\n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You tried to use ❰∧❱ to update a field's value, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = 2 } │ \n\ - \ └────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid attempt to update ❰foo❱'s value to ❰2❱\n\ - \ \n\ - \ Field updates are intentionally not allowed as the Dhall language discourages \n\ - \ patch-oriented programming \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You combined two records that share the following field: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not allowed \n" - where - txt0 = build k - -prettyTypeMessage (MustMergeARecord expr0 expr1) = ErrorMessages {..} - where - short = "❰merge❱ expects a record of handlers" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the first argument to ❰merge❱ must be a record and not some other type. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ let handler = λ(x : Bool) → x │ \n\ - \ │ in merge handler < Foo = True > : True │ \n\ - \ └─────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: ❰handler❱ isn't a record \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally provide an empty record type instead of an empty record when \n\ - \ you ❰merge❱ an empty union: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ λ(x : <>) → λ(a : Type) → merge {} x : a │ \n\ - \ └──────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This should be ❰{=}❱ instead \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided the following handler: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not a record, but is actually a value of type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (MustMergeUnion expr0 expr1) = ErrorMessages {..} - where - short = "❰merge❱ expects a union" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the second argument to ❰merge❱ must be a union and not some other type. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ let handlers = { Foo = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers True : True │ \n\ - \ └──────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: ❰True❱ isn't a union \n\ - \ \n\ - \ \n\ - \You tried to ❰merge❱ this expression: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not a union, but is actually a value of type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (UnusedHandler ks) = ErrorMessages {..} - where - short = "Unused handler" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you must provide exactly one handler per alternative in the union. You \n\ - \cannot supply extra handlers \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 > │ The ❰Right❱ alternative is missing\n\ - \ │ in let handlers = │ \n\ - \ │ { Left = Natural/even │ \n\ - \ │ , Right = λ(x : Bool) → x │ Invalid: ❰Right❱ handler isn't used\n\ - \ │ } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └───────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \You provided the following handlers: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which had no matching alternatives in the union you tried to ❰merge❱ \n" - where - txt0 = build (Text.intercalate ", " (Data.Set.toList ks)) - -prettyTypeMessage (MissingHandler ks) = ErrorMessages {..} - where - short = "Missing handler" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you must provide exactly one handler per alternative in the union. You \n\ - \cannot omit any handlers \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ Invalid: Missing ❰Right❱ handler \n\ - \ ⇩ \n\ - \ ┌─────────────────────────────────────────────────┐ \n\ - \ │ let handlers = { Left = Natural/even } │ \n\ - \ │ in let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Note that you need to provide handlers for other alternatives even if those \n\ - \alternatives are never used \n\ - \ \n\ - \You need to supply the following handlers: \n\ - \ \n\ - \↳ " <> txt0 <> " \n" - where - txt0 = build (Text.intercalate ", " (Data.Set.toList ks)) - -prettyTypeMessage MissingMergeType = - ErrorMessages {..} - where - short = "An empty ❰merge❱ requires a type annotation" - - long = - "Explanation: A ❰merge❱ does not require a type annotation if the union has at \n\ - \least one alternative, like this \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, you must provide a type annotation when merging an empty union: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ λ(a : <>) → merge {=} a : Bool │ \n\ - \ └────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This can be any type \n\ - \ \n\ - \ \n\ - \You can provide any type at all as the annotation, since merging an empty \n\ - \union can produce any type of output \n" - -prettyTypeMessage (HandlerInputTypeMismatch expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "Wrong handler input type" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the input type of each handler function matches the type of the \n\ - \corresponding alternative: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ union : < Left : Natural | Right : Bool > │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These must match These must match \n\ - \ ⇩ ⇩ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ Invalid: Doesn't match the type of the ❰Right❱ alternative \n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let handlers = { Left = Natural/even | Right = λ(x : Text) → x } │ \n\ - \ │ in let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └──────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Your handler for the following alternative: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... needs to accept an input value of type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... but actually accepts an input value of a different type: \n\ - \ \n\ - \↳ " <> txt2 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - txt2 = build expr2 - -prettyTypeMessage (InvalidHandlerOutputType expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "Wrong handler output type" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the output type of each handler function matches the declared type\n\ - \of the result: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These output types ... \n\ - \ \n\ - \ ... must match the declared type of the ❰merge❱ \n\ - \ ⇩ \n\ - \ ┌─────────────────────────────┐ \n\ - \ │ merge handlers union : Bool │ \n\ - \ └─────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Text │ \n\ - \ └──────────────────────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Doesn't match output of either handler\n\ - \ \n\ - \ \n\ - \Your handler for the following alternative: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... needs to return an output value of type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... but actually returns an output value of a different type: \n\ - \ \n\ - \↳ " <> txt2 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - txt2 = build expr2 - -prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) = - ErrorMessages {..} - where - short = "Handlers should have the same output type" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the output type of each handler function is the same: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These output types both match \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = │ \n\ - \ │ { Left = λ(x : Natural) → x │ This outputs ❰Natural❱ \n\ - \ │ , Right = λ(x : Bool ) → x │ This outputs ❰Bool❱ \n\ - \ │ } │ \n\ - \ │ in merge handlers union │ \n\ - \ └─────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: The handlers in this record don't have matching outputs\n\ - \ \n\ - \ \n\ - \The handler for the ❰" <> txt0 <> "❱ alternative has this output type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... but the handler for the ❰" <> txt2 <> "❱ alternative has this output type instead:\n\ - \ \n\ - \↳ " <> txt3 <> " \n" - where - txt0 = build key0 - txt1 = build expr0 - txt2 = build key1 - txt3 = build expr1 - -prettyTypeMessage (HandlerNotAFunction k expr0) = ErrorMessages {..} - where - short = "Handler is not a function" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left = +2 | Right : Bool > │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as each handler is a function \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ merge { Foo = True } < Foo = 1 > : Bool │ \n\ - \ └─────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a function \n\ - \ \n\ - \ \n\ - \Your handler for this alternative: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... has the following type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which is not the type of a function \n" - where - txt0 = build k - txt1 = build expr0 - -prettyTypeMessage (ConstructorsRequiresAUnionType expr0 expr1) = ErrorMessages {..} - where - short = "❰constructors❱ requires a union type" - - long = - "Explanation: You can only use the ❰constructors❱ keyword on an argument that is \n\ - \a union type literal, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────┐ \n\ - \ │ constructors < Left : Natural, Right : Bool > │ \n\ - \ └───────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot use the ❰constructors❱ keyword on any other type of argument.\n\ - \For example, you cannot use a variable argument: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ λ(t : Type) → constructors t │ Invalid: ❰t❱ might not be a union type \n\ - \ └──────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────┐ \n\ - \ │ let t : Type = < Left : Natural, Right : Bool > │ Invalid: Type-checking \n\ - \ │ in constructors t │ precedes normalization \n\ - \ └─────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, you can import the union type argument: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ constructors ./unionType.dhall │ Valid: Import resolution precedes \n\ - \ └────────────────────────────────┘ type-checking \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to supply the following argument: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which normalized to: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which is not a union type literal \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (NotARecord k expr0 expr1) = ErrorMessages {..} - where - short = "Not a record" - - long = - "Explanation: You can only access fields on records, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot access fields on non-record expressions \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ 1.foo │ \n\ - \ └───────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally try to access a field of a union instead of a record, like \n\ - \ this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ < foo : a >.foo │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is a union, not a record \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to access a field named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... on the following expression which is not a record: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... but is actually an expression of type: \n\ - \ \n\ - \↳ " <> txt2 <> " \n" - where - txt0 = build k - txt1 = build expr0 - txt2 = build expr1 - -prettyTypeMessage (MissingField k expr0) = ErrorMessages {..} - where - short = "Missing record field" - - long = - "Explanation: You can only access fields on records, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you can only access fields if they are present \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\" }.qux │ \n\ - \ └─────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: the record has no ❰qux❱ field \n\ - \ \n\ - \You tried to access a field named: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... but the field is missing because the record only defines the following fields:\n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build k - txt1 = build expr0 - -prettyTypeMessage (CantAnd expr0 expr1) = - buildBooleanOperator "&&" expr0 expr1 - -prettyTypeMessage (CantOr expr0 expr1) = - buildBooleanOperator "||" expr0 expr1 - -prettyTypeMessage (CantEQ expr0 expr1) = - buildBooleanOperator "==" expr0 expr1 - -prettyTypeMessage (CantNE expr0 expr1) = - buildBooleanOperator "/=" expr0 expr1 - -prettyTypeMessage (CantInterpolate expr0 expr1) = ErrorMessages {..} - where - short = "You can only interpolate ❰Text❱" - - long = - "Explanation: Text interpolation only works on expressions of type ❰Text❱ \n\ - \ \n\ - \For example, these are all valid uses of string interpolation: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ \"ABC${\"DEF\"}GHI\" │ \n\ - \ └──────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ λ(x : Text) → \"ABC${x}GHI\" │ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────────────┐ \n\ - \ │ λ(age : Natural) → \"Age: ${Integer/show (Natural/toInteger age)}\" │ \n\ - \ └───────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have thought that string interpolation automatically converts the \n\ - \ interpolated value to a ❰Text❱ representation of that value: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ λ(age : Natural) → \"Age: ${age}\" │ \n\ - \ └──────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: ❰age❱ has type ❰Natural❱ \n\ - \ \n\ - \ \n\ - \● You might have forgotten to escape a string interpolation that you wanted \n\ - \ Dhall to ignore and pass through: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ \"echo ${HOME}\" │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ ❰HOME❱ is not in scope and this might have meant to use ❰\\${HOME}❱\n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You interpolated this expression: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which does not have type ❰Text❱ but instead has type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - - - -prettyTypeMessage (CantTextAppend expr0 expr1) = ErrorMessages {..} - where - short = "❰++❱ only works on ❰Text❱" - - long = - "Explanation: The ❰++❱ operator expects two arguments that have type ❰Text❱ \n\ - \ \n\ - \For example, this is a valid use of ❰++❱: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ \"ABC\" ++ \"DEF\" │ \n\ - \ └────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have thought that ❰++❱ was the operator to combine two lists: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ [1, 2, 3] ++ [4, 5, 6] │ Not valid \n\ - \ └────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ... but the list concatenation operator is actually ❰#❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ [1, 2, 3] # [4, 5, 6] │ Valid \n\ - \ └───────────────────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which does not have type ❰Text❱ but instead has type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (CantListAppend expr0 expr1) = ErrorMessages {..} - where - short = "❰#❱ only works on ❰List❱s" - - long = - "Explanation: The ❰#❱ operator expects two arguments that are both ❰List❱s \n\ - \ \n\ - \For example, this is a valid use of ❰#❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ [1, 2, 3] # [4, 5, 6] │ \n\ - \ └───────────────────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which is not a ❰List❱ but instead has type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - -prettyTypeMessage (CantAdd expr0 expr1) = - buildNaturalOperator "+" expr0 expr1 - -prettyTypeMessage (CantMultiply expr0 expr1) = - buildNaturalOperator "*" expr0 expr1 - -prettyTypeMessage (NoDependentTypes expr0 expr1) = ErrorMessages {..} - where - short = "No dependent types" - - long = - "Explanation: The Dhall programming language does not allow functions from terms \n\ - \to types. These function types are also known as \"dependent function types\" \n\ - \because you have a type whose value \"depends\" on the value of a term. \n\ - \ \n\ - \For example, this is " <> _NOT <> " a legal function type: \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ Bool → Type │ \n\ - \ └─────────────┘ \n\ - \ \n\ - \ \n\ - \Similarly, this is " <> _NOT <> " legal code: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────────────┐ \n\ - \ │ λ(Vector : Natural → Type → Type) → Vector +0 Text │ \n\ - \ └────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid dependent type \n\ - \ \n\ - \ \n\ - \Your function type is invalid because the input has type: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... and the output has kind: \n\ - \ \n\ - \↳ " <> txt1 <> " \n\ - \ \n\ - \... which makes this a forbidden dependent function type \n" - where - txt0 = build expr0 - txt1 = build expr1 - -buildBooleanOperator :: Buildable a => Text -> Expr s a -> Expr s a -> ErrorMessages -buildBooleanOperator operator expr0 expr1 = ErrorMessages {..} - where - short = "❰" <> txt2 <> "❱ only works on ❰Bool❱s" - - long = - "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Bool❱\n\ - \ \n\ - \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────┐ \n\ - \ │ True " <> txt2 <> " False │ \n\ - \ └───────────────┘ \n\ - \ \n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which does not have type ❰Bool❱ but instead has type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - - txt2 = build operator - -buildNaturalOperator :: Buildable a => Text -> Expr s a -> Expr s a -> ErrorMessages -buildNaturalOperator operator expr0 expr1 = ErrorMessages {..} - where - short = "❰" <> txt2 <> "❱ only works on ❰Natural❱s" - - long = - "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Natural❱\n\ - \ \n\ - \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ - \ \n\ - \ \n\ - \ ┌─────────┐ \n\ - \ │ +3 " <> txt2 <> " +5 │ \n\ - \ └─────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have tried to use an ❰Integer❱, which is " <> _NOT <> " allowed: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ λ(x : Integer) → λ(y : Integer) → x " <> txt2 <> " y │ Not valid \n\ - \ └─────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ You can only use ❰Natural❱ numbers \n\ - \ \n\ - \ \n\ - \● You might have mistakenly used an ❰Integer❱ literal, which is " <> _NOT <> " allowed:\n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ 2 " <> txt2 <> " 2 │ Not valid \n\ - \ └───────┘ \n\ - \ \n\ - \ \n\ - \ You need to prefix each literal with a ❰+❱ to transform them into ❰Natural❱ \n\ - \ literals, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────┐ \n\ - \ │ +2 " <> txt2 <> " +2 │ Valid \n\ - \ └─────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \↳ " <> txt0 <> " \n\ - \ \n\ - \... which does not have type ❰Natural❱ but instead has type: \n\ - \ \n\ - \↳ " <> txt1 <> " \n" - where - txt0 = build expr0 - txt1 = build expr1 - - txt2 = build operator - --- | A structured type error that includes context -data TypeError s a = TypeError - { context :: Context (Expr s a) - , current :: Expr s a - , typeMessage :: TypeMessage s a - } deriving (Typeable) - -instance (Buildable a, Buildable s) => Show (TypeError s a) where - show = Text.unpack . Builder.toLazyText . build - -instance (Buildable a, Buildable s, Typeable a, Typeable s) => Exception (TypeError s a) - -instance (Buildable a, Buildable s) => Buildable (TypeError s a) where - build (TypeError ctx expr msg) - = "\n" - <> ( if Text.null (Builder.toLazyText (buildContext ctx)) - then "" - else buildContext ctx <> "\n" - ) - <> shortTypeMessage msg <> "\n" - <> source - where - buildKV (key, val) = build key <> " : " <> build val - - buildContext = - build - . Text.unlines - . map (Builder.toLazyText . buildKV) - . reverse - . Dhall.Context.toList - - source = case expr of - Note s _ -> build s - _ -> mempty - -{-| Newtype used to wrap error messages so that they render with a more - detailed explanation of what went wrong --} -newtype DetailedTypeError s a = DetailedTypeError (TypeError s a) - deriving (Typeable) - -instance (Buildable a, Buildable s) => Show (DetailedTypeError s a) where - show = Text.unpack . Builder.toLazyText . build - -instance (Buildable a, Buildable s, Typeable a, Typeable s) => Exception (DetailedTypeError s a) - -instance (Buildable a, Buildable s) => Buildable (DetailedTypeError s a) where - build (DetailedTypeError (TypeError ctx expr msg)) - = "\n" - <> ( if Text.null (Builder.toLazyText (buildContext ctx)) - then "" - else buildContext ctx <> "\n" - ) - <> longTypeMessage msg <> "\n" - <> "────────────────────────────────────────────────────────────────────────────────\n" - <> "\n" - <> source - where - buildKV (key, val) = build key <> " : " <> build val - - buildContext = - build - . Text.unlines - . map (Builder.toLazyText . buildKV) - . reverse - . Dhall.Context.toList - - source = case expr of - Note s _ -> build s - _ -> mempty - -{-| This function verifies that a custom context is well-formed so that - type-checking will not loop - - Note that `typeWith` already calls `checkContext` for you on the `Context` - that you supply --} -checkContext :: Context (Expr s X) -> Either (TypeError s X) () -checkContext context = - case Dhall.Context.match context of - Nothing -> do - return () - Just (x, v, context') -> do - let shiftedV = Dhall.Core.shift (-1) (V x 0) v - let shiftedContext = fmap (Dhall.Core.shift (-1) (V x 0)) context' - _ <- typeWith shiftedContext shiftedV - return () +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wall #-} + +-- | This module contains the logic for type checking Dhall code + +module Dhall.TypeCheck ( + -- * Type-checking + typeWith + , typeOf + , typeWithA + , checkContext + , messageExpressions + + -- * Types + , Typer + , X + , absurd + , TypeError(..) + , DetailedTypeError(..) + , Censored(..) + , TypeMessage(..) + , prettyTypeMessage + , ErrorMessages(..) + ) where + +import Control.Exception (Exception) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Writer.Strict (execWriterT, tell) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Monoid (Endo (..)) +import Data.Semigroup (Max (..)) +import Data.Sequence (ViewL (..)) +import Data.Set (Set) +import Data.Text (Text) +import Data.Typeable (Typeable) +import Data.Void (Void, absurd) +import Dhall.Context (Context) +import Dhall.Eval + ( Environment (..) + , Names (..) + , Val (..) + , (~>) + ) +import Dhall.Pretty (Ann, UnescapedLabel (..)) +import Dhall.Src (Src) +import Lens.Micro (anyOf, over) +import Prettyprinter (Doc, Pretty (..), vsep) + +import Dhall.Syntax + ( Binding (..) + , Chunks (..) + , Const (..) + , Expr (..) + , FunctionBinding (..) + , PreferAnnotation (..) + , RecordField (..) + , Var (..) + , WithComponent (..) + ) + +import qualified Data.Foldable as Foldable +import qualified Data.Foldable.WithIndex as Foldable.WithIndex +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Map +import qualified Data.Sequence +import qualified Data.Set +import qualified Data.Text as Text +import qualified Data.Traversable +import qualified Dhall.Context +import qualified Dhall.Core +import qualified Dhall.Diff +import qualified Dhall.Eval as Eval +import qualified Dhall.Map +import qualified Dhall.Pretty +import qualified Dhall.Pretty.Internal +import qualified Dhall.Syntax as Syntax +import qualified Dhall.Util +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.String as Pretty + +{-| A type synonym for `Void` + + This is provided for backwards compatibility, since Dhall used to use its + own `X` type instead of @"Data.Void".`Void`@. You should use `Void` instead + of `X` now +-} +type X = Void +{-# DEPRECATED X "Use Data.Void.Void instead" #-} + +axiom :: Const -> Either (TypeError s a) Const +axiom Type = return Kind +axiom Kind = return Sort +axiom Sort = Left (TypeError Dhall.Context.empty (Const Sort) Untyped) + +rule :: Const -> Const -> Const +rule Type Type = Type +rule Kind Type = Type +rule Sort Type = Type +rule Type Kind = Kind +rule Kind Kind = Kind +rule Sort Kind = Sort +rule Type Sort = Sort +rule Kind Sort = Sort +rule Sort Sort = Sort + +{-| Type-check an expression and return the expression's type if type-checking + succeeds or an error if type-checking fails + + `typeWith` does not necessarily normalize the type since full normalization + is not necessary for just type-checking. If you actually care about the + returned type then you may want to `Dhall.Core.normalize` it afterwards. + + The supplied `Context` records the types of the names in scope. If + these are ill-typed, the return value may be ill-typed. +-} +typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X) +typeWith ctx expr = do + checkContext ctx + typeWithA absurd ctx expr + +{-| Function that converts the value inside an `Embed` constructor into a new + expression +-} +type Typer a = forall s. a -> Expr s a + +{-| Generalization of `typeWith` that allows type-checking the `Embed` + constructor with custom logic +-} +typeWithA + :: (Eq a, Pretty a) + => Typer a + -> Context (Expr s a) + -> Expr s a + -> Either (TypeError s a) (Expr s a) +typeWithA tpa context expression = + fmap (Dhall.Core.renote . Eval.quote EmptyNames) (infer tpa ctx expression) + where + ctx = contextToCtx context + +contextToCtx :: Eq a => Context (Expr s a) -> Ctx a +contextToCtx context = loop (Dhall.Context.toList context) + where + loop [] = + Ctx Empty TypesEmpty + + loop ((x, t):rest) = + Ctx (Skip vs x) (TypesBind ts x (Eval.eval vs (Dhall.Core.denote t))) + where + Ctx vs ts = loop rest + +ctxToContext :: Eq a => Ctx a -> Context (Expr s a) +ctxToContext (Ctx {..}) = loop types + where + loop (TypesBind ts x t) = Dhall.Context.insert x t' (loop ts) + where + ns = typesToNames ts + + t' = Dhall.Core.renote (Eval.quote ns t) + loop TypesEmpty = Dhall.Context.empty + +typesToNames :: Types a -> Names +typesToNames (TypesBind ts x _) = Bind ns x + where + ns = typesToNames ts +typesToNames TypesEmpty = EmptyNames + +data Types a = TypesEmpty | TypesBind !(Types a) {-# UNPACK #-} !Text (Val a) + +data Ctx a = Ctx { values :: !(Environment a), types :: !(Types a) } + +addType :: Text -> Val a -> Ctx a -> Ctx a +addType x t (Ctx vs ts) = Ctx (Skip vs x) (TypesBind ts x t) + +addTypeValue :: Text -> Val a -> Val a -> Ctx a -> Ctx a +addTypeValue x t v (Ctx vs ts) = Ctx (Extend vs x v) (TypesBind ts x t) + +fresh :: Ctx a -> Text -> Val a +fresh Ctx{..} x = VVar x (Eval.countNames x (Eval.envNames values)) + +{-| `typeWithA` is implemented internally in terms of @infer@ in order to speed + up equivalence checking. + + Specifically, we extend the `Context` to become a @Ctx@, which can store + the entire contents of a `let` expression (i.e. the type *and* the value + of the bound variable). By storing this extra information in the @Ctx@ we + no longer need to substitute `let` expressions at all (which is very + expensive!). + + However, this means that we need to use `Dhall.Eval.conv` to perform + equivalence checking instead of `Dhall.Core.judgmentallyEqual` since + only `Dhall.Core.judgmentallyEqual` is unable to use the information stored + in the extended context for accurate equivalence checking. +-} +infer + :: forall a s + . (Eq a, Pretty a) + => Typer a + -> Ctx a + -> Expr s a + -> Either (TypeError s a) (Val a) +infer typer = loop + where + {- The convention for primes (i.e. `'`s) is: + + * No primes (`x` ): An `Expr` that has not been `eval`ed yet + * One prime (`x'` ): A `Val` + * Two primes (`x''`): An `Expr` generated from `quote`ing a `Val` + -} + loop :: Ctx a -> Expr s a -> Either (TypeError s a) (Val a) + loop ctx@Ctx{..} expression = case expression of + Const c -> + fmap VConst (axiom c) + + Var (V x0 n0) -> do + let go TypesEmpty _ = + die (UnboundVariable x0) + go (TypesBind ts x t) n + | x == x0 = if n == 0 then return t else go ts (n - 1) + | otherwise = go ts n + + go types n0 + + Lam _ (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A}) b -> do + tA' <- loop ctx _A + + case tA' of + VConst _ -> return () + _ -> die (InvalidInputType _A) + + let _A' = eval values _A + + let ctx' = addType x _A' ctx + + _B' <- loop ctx' b + + let _B'' = quote (Bind (Eval.envNames values) x) _B' + + tB' <- loop ctx' (Dhall.Core.renote _B'') + + case tB' of + VConst _ -> return () + _ -> die (InvalidOutputType _B'') + + return (VHPi x _A' (\u -> Eval.eval (Extend values x u) _B'')) + + Pi _ x _A _B -> do + tA' <- loop ctx _A + + kA <- case tA' of + VConst kA -> return kA + _ -> die (InvalidInputType _A) + + let _A' = eval values _A + + let ctx' = addType x _A' ctx + + tB' <- loop ctx' _B + + kB <- case tB' of + VConst kB -> return kB + _ -> die (InvalidOutputType _B) + + return (VConst (rule kA kB)) + + App f a -> do + tf' <- loop ctx f + + case Eval.toVHPi tf' of + Just (_x, _A₀', _B') -> do + _A₁' <- loop ctx a + + if Eval.conv values _A₀' _A₁' + then do + let a' = eval values a + + return (_B' a') + + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + die (TypeMismatch f _A₀'' a _A₁'') + Nothing -> + die (NotAFunction f (quote names tf')) + + Let (Binding { value = a₀, variable = x, ..}) body -> do + let a₀' = eval values a₀ + + ctxNew <- case annotation of + Nothing -> do + _A' <- loop ctx a₀ + + return (addTypeValue x _A' a₀' ctx) + Just (_, _A₀) -> do + _ <- loop ctx _A₀ + + let _A₀' = eval values _A₀ + + _A₁' <- loop ctx a₀ + + if Eval.conv values _A₀' _A₁' + then + return () + + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + Left (TypeError context a₀ (AnnotMismatch a₀ _A₀'' _A₁'')) + + return (addTypeValue x _A₀' a₀' ctx) + + loop ctxNew body + + Annot t _T₀ -> do + case Dhall.Core.denote _T₀ of + Const _ -> return () + _ -> do + _ <- loop ctx _T₀ + + return () + + let _T₀' = eval values _T₀ + + _T₁' <- loop ctx t + + if Eval.conv values _T₀' _T₁' + then + return _T₁' + + else do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + die (AnnotMismatch t _T₀'' _T₁'') + + Bool -> + return (VConst Type) + + BoolLit _ -> + return VBool + + BoolAnd l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantAnd l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantAnd r (quote names tr')) + + return VBool + + BoolOr l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantOr l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantOr r (quote names tr')) + + return VBool + + BoolEQ l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantEQ l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantEQ r (quote names tr')) + + return VBool + + BoolNE l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantNE l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantNE r (quote names tr')) + + return VBool + + BoolIf t l r -> do + tt' <- loop ctx t + + case tt' of + VBool -> return () + _ -> die (InvalidPredicate t (quote names tt')) + + _L' <- loop ctx l + + _R' <- loop ctx r + + _ <- loop ctx (quote names _L') + + let _L'' = quote names _L' + + _ <- loop ctx (quote names _R') + + let _R'' = quote names _R' + + if Eval.conv values _L' _R' + then return () + else die (IfBranchMismatch l r _L'' _R'') + + return _L' + + Bytes -> + return (VConst Type) + + BytesLit _ -> + return VBytes + + Natural -> + return (VConst Type) + + NaturalLit _ -> + return VNatural + + NaturalFold -> + return + ( VNatural + ~> VHPi "natural" (VConst Type) (\natural -> + VHPi "succ" (natural ~> natural) (\_succ -> + VHPi "zero" natural (\_zero -> + natural + ) + ) + ) + ) + + NaturalBuild -> + return + ( VHPi "natural" (VConst Type) (\natural -> + VHPi "succ" (natural ~> natural) (\_succ -> + VHPi "zero" natural (\_zero -> + natural + ) + ) + ) + ~> VNatural + ) + + NaturalIsZero -> + return (VNatural ~> VBool) + + NaturalEven -> + return (VNatural ~> VBool) + + NaturalOdd -> + return (VNatural ~> VBool) + + NaturalToInteger -> + return (VNatural ~> VInteger) + + NaturalShow -> + return (VNatural ~> VText) + + NaturalSubtract -> + return (VNatural ~> VNatural ~> VNatural) + + NaturalPlus l r -> do + tl' <- loop ctx l + + case tl' of + VNatural -> return () + _ -> die (CantAdd l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VNatural -> return () + _ -> die (CantAdd r (quote names tr')) + + return VNatural + + NaturalTimes l r -> do + tl' <- loop ctx l + + case tl' of + VNatural -> return () + _ -> die (CantMultiply l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VNatural -> return () + _ -> die (CantMultiply r (quote names tr')) + + return VNatural + + Integer -> + return (VConst Type) + + IntegerLit _ -> + return VInteger + + IntegerClamp -> + return (VInteger ~> VNatural) + + IntegerNegate -> + return (VInteger ~> VInteger) + + IntegerShow -> + return (VInteger ~> VText) + + IntegerToDouble -> + return (VInteger ~> VDouble) + + Double -> + return (VConst Type) + + DoubleLit _ -> + return VDouble + + DoubleShow -> + return (VDouble ~> VText) + + Text -> + return (VConst Type) + + TextLit (Chunks xys _) -> do + let process (_, y) = do + _Y' <- loop ctx y + + case _Y' of + VText -> return () + _ -> die (CantInterpolate y (quote names _Y')) + + mapM_ process xys + + return VText + + TextAppend l r -> do + tl' <- loop ctx l + + case tl' of + VText -> return () + _ -> die (CantTextAppend l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VText -> return () + _ -> die (CantTextAppend r (quote names tr')) + + return VText + + TextReplace -> + return + ( VHPi "needle" VText (\_needle -> + VHPi "replacement" VText (\_replacement -> + VHPi "haystack" VText (\_haystack -> + VText + ) + ) + ) + ) + TextShow -> + return (VText ~> VText) + + Date -> + return (VConst Type) + + DateLiteral _ -> + return VDate + + DateShow -> + return (VDate ~> VText) + + Time -> + return (VConst Type) + + TimeLiteral _ _ -> + return VTime + + TimeShow -> + return (VTime ~> VText) + + TimeZone -> + return (VConst Type) + + TimeZoneLiteral _ -> + return VTimeZone + + TimeZoneShow -> + return (VTimeZone ~> VText) + + List -> + return (VConst Type ~> VConst Type) + + ListLit Nothing ts₀ -> + case Data.Sequence.viewl ts₀ of + t₀ :< ts₁ -> do + _T₀' <- loop ctx t₀ + + let _T₀'' = quote names _T₀' + + tT₀' <- loop ctx _T₀'' + + case tT₀' of + VConst Type -> return () + _ -> die (InvalidListType (App List _T₀'')) + + let process i t₁ = do + _T₁' <- loop ctx t₁ + + if Eval.conv values _T₀' _T₁' + then + return () + + else do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + + -- Carefully note that we don't use `die` + -- here so that the source span is narrowed + -- to just the offending element + let err = MismatchedListElements (i+1) _T₀'' t₁ _T₁'' + + Left (TypeError context t₁ err) + + Foldable.WithIndex.itraverse_ process ts₁ + + return (VList _T₀') + + _ -> + die MissingListType + + ListLit (Just _T₀) ts -> + if Data.Sequence.null ts + then do + _ <- loop ctx _T₀ + + let _T₀' = eval values _T₀ + + let _T₀'' = quote names _T₀' + + case _T₀' of + VList _ -> return _T₀' + _ -> die (InvalidListType _T₀'') + + -- See https://github.com/dhall-lang/dhall-haskell/issues/1359. + else die ListLitInvariant + + ListAppend x y -> do + tx' <- loop ctx x + + _A₀' <- case tx' of + VList _A₀' -> return _A₀' + _ -> die (CantListAppend x (quote names tx')) + + ty' <- loop ctx y + + _A₁' <- case ty' of + VList _A₁' -> return _A₁' + _ -> die (CantListAppend y (quote names ty')) + + if Eval.conv values _A₀' _A₁' + then return () + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + die (ListAppendMismatch _A₀'' _A₁'') + + return (VList _A₀') + + ListBuild -> + return + ( VHPi "a" (VConst Type) (\a -> + VHPi "list" (VConst Type) (\list -> + VHPi "cons" (a ~> list ~> list) (\_cons -> + (VHPi "nil" list (\_nil -> list)) + ) + ) + ~> VList a + ) + ) + + ListFold -> + return + ( VHPi "a" (VConst Type) (\a -> + VList a + ~> VHPi "list" (VConst Type) (\list -> + VHPi "cons" (a ~> list ~> list) (\_cons -> + (VHPi "nil" list (\_nil -> list)) + ) + ) + ) + ) + + ListLength -> + return (VHPi "a" (VConst Type) (\a -> VList a ~> VNatural)) + + ListHead -> + return (VHPi "a" (VConst Type) (\a -> VList a ~> VOptional a)) + + ListLast -> + return (VHPi "a" (VConst Type) (\a -> VList a ~> VOptional a)) + + ListIndexed -> + return + ( VHPi "a" (VConst Type) (\a -> + VList a + ~> VList + (VRecord + (Dhall.Map.unorderedFromList + [ ("index", VNatural) + , ("value", a ) + ] + ) + ) + ) + ) + ListReverse -> + return (VHPi "a" (VConst Type) (\a -> VList a ~> VList a)) + + Optional -> + return (VConst Type ~> VConst Type) + + None -> + return (VHPi "A" (VConst Type) (\_A -> VOptional _A)) + + Some a -> do + _A' <- loop ctx a + + tA' <- loop ctx (quote names _A') + + case tA' of + VConst Type -> return () + _ -> do + let _A'' = quote names _A' + let tA'' = quote names tA' + + die (InvalidSome a _A'' tA'') + + return (VOptional _A') + + Record xTs -> do + let process x (RecordField {recordFieldValue = _T}) = do + tT' <- lift (loop ctx _T) + + case tT' of + VConst c -> tell (Max c) + _ -> lift (die (InvalidFieldType x _T)) + + Max c <- execWriterT (Dhall.Map.unorderedTraverseWithKey_ process xTs) + + return (VConst c) + + RecordLit xts -> do + let process t = do + _T' <- loop ctx $ recordFieldValue t + + let _T'' = quote names _T' + + _ <- loop ctx _T'' + + return _T' + + xTs <- traverse process (Dhall.Map.sort xts) + + return (VRecord xTs) + + Union xTs -> do + let process _ Nothing = + return mempty + + process x₁ (Just _T₁) = do + tT₁' <- loop ctx _T₁ + + case tT₁' of + VConst c -> return (Max c) + _ -> die (InvalidAlternativeType x₁ _T₁) + + Max c <- fmap Foldable.fold (Dhall.Map.unorderedTraverseWithKey process xTs) + return (VConst c) + Combine _ mk l r -> do + _L' <- loop ctx l + + let l'' = quote names (eval values l) + + _R' <- loop ctx r + + let r'' = quote names (eval values r) + + xLs' <- case _L' of + VRecord xLs' -> + return xLs' + + _ -> do + let _L'' = quote names _L' + + case mk of + Nothing -> die (MustCombineARecord '∧' l'' _L'') + Just t -> die (InvalidDuplicateField t l _L'') + + xRs' <- case _R' of + VRecord xRs' -> + return xRs' + + _ -> do + let _R'' = quote names _R' + + case mk of + Nothing -> die (MustCombineARecord '∧' r'' _R'') + Just t -> die (InvalidDuplicateField t r _R'') + + let combineTypes xs xLs₀' xRs₀' = do + let combine x (VRecord xLs₁') (VRecord xRs₁') = + combineTypes (x : xs) xLs₁' xRs₁' + + combine x _ _ = + case mk of + Nothing -> die (FieldCollision (NonEmpty.reverse (x :| xs))) + Just t -> die (DuplicateFieldCannotBeMerged (t :| reverse (x : xs))) + + let xEs = + Dhall.Map.outerJoin Right Right combine xLs₀' xRs₀' + + xTs <- Dhall.Map.unorderedTraverseWithKey (\_x _E -> _E) xEs + + return (VRecord xTs) + + combineTypes [] xLs' xRs' + + CombineTypes _ l r -> do + _L' <- loop ctx l + + let l' = eval values l + + let l'' = quote names l' + + cL <- case _L' of + VConst cL -> return cL + _ -> die (CombineTypesRequiresRecordType l l'') + + _R' <- loop ctx r + + let r' = eval values r + + let r'' = quote names r' + + cR <- case _R' of + VConst cR -> return cR + _ -> die (CombineTypesRequiresRecordType r r'') + + let c = max cL cR + + xLs' <- case l' of + VRecord xLs' -> return xLs' + _ -> die (CombineTypesRequiresRecordType l l'') + + xRs' <- case r' of + VRecord xRs' -> return xRs' + _ -> die (CombineTypesRequiresRecordType r r'') + + let combineTypes xs xLs₀' xRs₀' = do + let combine x (VRecord xLs₁') (VRecord xRs₁') = + combineTypes (x : xs) xLs₁' xRs₁' + + combine x _ _ = + die (FieldTypeCollision (NonEmpty.reverse (x :| xs))) + + let mL = Dhall.Map.toMap xLs₀' + let mR = Dhall.Map.toMap xRs₀' + + Foldable.sequence_ (Data.Map.intersectionWithKey combine mL mR) + + combineTypes [] xLs' xRs' + + return (VConst c) + + Prefer _ _ l r -> do + _L' <- loop ctx l + + _R' <- loop ctx r + + xLs' <- case _L' of + VRecord xLs' -> return xLs' + + _ -> do + let _L'' = quote names _L' + + let l'' = quote names (eval values l) + + die (MustCombineARecord '⫽' l'' _L'') + + xRs' <- case _R' of + VRecord xRs' -> return xRs' + + _ -> do + let _R'' = quote names _R' + + let r'' = quote names (eval values r) + + die (MustCombineARecord '⫽' r'' _R'') + + return (VRecord (Dhall.Map.union xRs' xLs')) + + RecordCompletion l r -> do + _L' <- loop ctx l + + case _L' of + VRecord xLs' + | not (Dhall.Map.member "default" xLs') + -> die (InvalidRecordCompletion "default" l) + | not (Dhall.Map.member "Type" xLs') + -> die (InvalidRecordCompletion "Type" l) + | otherwise + -> loop ctx (Annot (Prefer mempty PreferFromCompletion (Field l def) r) (Field l typ)) + _ -> die (CompletionSchemaMustBeARecord l (quote names _L')) + + where + def = Syntax.makeFieldSelection "default" + typ = Syntax.makeFieldSelection "Type" + Merge t u mT₁ -> do + _T' <- loop ctx t + + yTs' <- case _T' of + VRecord yTs' -> + return yTs' + + _ -> do + let _T'' = quote names _T' + + die (MustMergeARecord t _T'') + + _U' <- loop ctx u + + yUs' <- case _U' of + VUnion yUs' -> + return yUs' + + VOptional _O' -> + -- This is a bit of hack, but it allows us to reuse the + -- rather complex type-matching logic for Optionals. + return (Dhall.Map.unorderedFromList [("None", Nothing), ("Some", Just _O')]) + + _ -> do + let _U'' = quote names _U' + + die (MustMergeUnionOrOptional u _U'') + + let ysT = Dhall.Map.keysSet yTs' + let ysU = Dhall.Map.keysSet yUs' + + let diffT = Data.Set.difference ysT ysU + let diffU = Data.Set.difference ysU ysT + + if Data.Set.null diffT + then return () + else die (UnusedHandler diffT) + + if Data.Set.null diffU + then return () + else let (exemplar,rest) = Data.Set.deleteFindMin diffU + in die (MissingHandler exemplar rest) + + let match _y _T₀' Nothing = + return _T₀' + + match y handler' (Just _A₁') = + case Eval.toVHPi handler' of + Just (x, _A₀', _T₀') -> + if Eval.conv values _A₀' _A₁' + then do + let _T₁' = _T₀' (fresh ctx x) + + let _T₁'' = quote names _T₁' + + -- x appearing in _T₁'' would indicate a disallowed + -- handler type (see + -- https://github.com/dhall-lang/dhall-lang/issues/749). + -- + -- If x appears in _T₁'', quote will have given it index + -- -1. Any well-typed variable has a non-negative index, + -- so we can simply look for negative indices to detect x. + let containsBadVar (Var (V _ n)) = + n < 0 + + containsBadVar e = + anyOf + Dhall.Core.subExpressions + containsBadVar + e + + if containsBadVar _T₁'' + then do + let handler'' = quote names handler' + + let outputType = Dhall.Core.shift 1 (V x (-1)) _T₁'' + + die (DisallowedHandlerType y handler'' outputType x) + + else return _T₁' + + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + + die (HandlerInputTypeMismatch y _A₁'' _A₀'') + + Nothing -> do + let handler'' = quote names handler' + + die (HandlerNotAFunction y handler'') + + matched <- + sequence + (Data.Map.intersectionWithKey match (Dhall.Map.toMap yTs') (Dhall.Map.toMap yUs')) + + let checkMatched :: Data.Map.Map Text (Val a) -> Either (TypeError s a) (Maybe (Val a)) + checkMatched = fmap (fmap snd) . Foldable.foldlM go Nothing . Data.Map.toList + where + go Nothing (y₁, _T₁') = + return (Just (y₁, _T₁')) + + go yT₀'@(Just (y₀, _T₀')) (y₁, _T₁') = + if Eval.conv values _T₀' _T₁' + then return yT₀' + + else do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + die (HandlerOutputTypeMismatch y₀ _T₀'' y₁ _T₁'') + + mT₀' <- checkMatched matched + + mT₁' <- Data.Traversable.for mT₁ $ \_T₁ -> do + _ <- loop ctx _T₁ + + return (eval values _T₁) + + case (mT₀', mT₁') of + (Nothing, Nothing) -> + die MissingMergeType + (Nothing, Just _T₁') -> + return _T₁' + (Just _T₀', Nothing) -> + return _T₀' + (Just _T₀', Just _T₁') -> + if Eval.conv values _T₀' _T₁' + then return _T₀' + + else do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + die (AnnotMismatch (Merge t u Nothing) _T₁'' _T₀'') + + ToMap e mT₁ -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + xTs' <- case _E' of + VRecord xTs' -> return xTs' + _ -> die (MustMapARecord e _E'') + + tE' <- loop ctx _E'' + + let tE'' = quote names tE' + + case tE' of + VConst Type -> return () + _ -> die (InvalidToMapRecordKind _E'' tE'') + + Foldable.traverse_ (loop ctx) mT₁ + + let compareFieldTypes _T₀' Nothing = + Just (Right _T₀') + + compareFieldTypes _T₀' r@(Just (Right _T₁')) + | Eval.conv values _T₀' _T₁' = r + | otherwise = do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + + Just (die (HeterogenousRecordToMap _E'' _T₀'' _T₁'')) + + compareFieldTypes _T₀' r@(Just (Left _)) = + r + + let r = appEndo (foldMap (Endo . compareFieldTypes) xTs') Nothing + + let mT₁' = fmap (eval values) mT₁ + + let mapType _T' = + VList + (VRecord + (Dhall.Map.unorderedFromList + [("mapKey", VText), ("mapValue", _T')] + ) + ) + + case (r, mT₁') of + (Nothing, Nothing) -> + die MissingToMapType + (Just err@(Left _), _) -> + err + (Just (Right _T'), Nothing) -> + pure (mapType _T') + (Nothing, Just _T₁'@(VList (VRecord itemTypes))) + | Just _T' <- Dhall.Map.lookup "mapValue" itemTypes + , Eval.conv values (mapType _T') _T₁' -> + pure _T₁' + (Nothing, Just _T₁') -> do + let _T₁'' = quote names _T₁' + + die (InvalidToMapType _T₁'') + (Just (Right _T'), Just _T₁') + | Eval.conv values (mapType _T') _T₁' -> + pure (mapType _T') + | otherwise -> do + let _T₁'' = quote names _T₁' + + die (MapTypeMismatch (quote names (mapType _T')) _T₁'') + + ShowConstructor e -> do + _E' <- loop ctx e + case _E' of + VUnion _ -> pure VText + VOptional _ -> pure VText + + _ -> die ShowConstructorNotOnUnion + + Field e (Syntax.fieldSelectionLabel -> x) -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + case _E' of + VRecord xTs' -> + case Dhall.Map.lookup x xTs' of + Just _T' -> return _T' + Nothing -> die (MissingField x _E'') + _ -> do + let e' = eval values e + + let e'' = quote names e' + + case e' of + VUnion xTs' -> + case Dhall.Map.lookup x xTs' of + Just (Just _T') -> return (VHPi x _T' (\_ -> e')) + Just Nothing -> return e' + Nothing -> die (MissingConstructor x e) + + _ -> do + let text = Dhall.Pretty.Internal.docToStrictText (Dhall.Pretty.Internal.prettyLabel x) + + die (CantAccess text e'' _E'') + Project e (Left xs) -> do + case duplicateElement xs of + Just x -> do + die (DuplicateProjectionLabel x) + Nothing -> do + return () + + _E' <- loop ctx e + + let _E'' = quote names _E' + + case _E' of + VRecord xTs' -> do + let process x = + case Dhall.Map.lookup x xTs' of + Just _T' -> return (x, _T') + Nothing -> die (MissingField x _E'') + + let adapt = VRecord . Dhall.Map.unorderedFromList + + fmap adapt (traverse process xs) + + _ -> do + let text = + Dhall.Pretty.Internal.docToStrictText (Dhall.Pretty.Internal.prettyLabels xs) + + die (CantProject text e _E'') + + Project e (Right s) -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + case _E' of + VRecord xEs' -> do + _ <- loop ctx s + + let s' = eval values s + + case s' of + VRecord xSs' -> do + let actualSubset = + quote names (VRecord (Dhall.Map.intersection xEs' xSs')) + + let expectedSubset = s + + let process x _S' = do + let _S'' = quote names _S' + + case Dhall.Map.lookup x xEs' of + Nothing -> + die (MissingField x _E'') + + Just _E' -> + if Eval.conv values _E' _S' + then return () + else die (ProjectionTypeMismatch x _E'' _S'' expectedSubset actualSubset) + + Dhall.Map.unorderedTraverseWithKey_ process xSs' + + return s' + + _ -> + die (CantProjectByExpression s) + + _ -> do + let text = Dhall.Core.pretty s + + die (CantProject text e s) + + Assert _T -> do + _ <- loop ctx _T + + let _T' = eval values _T + + case _T' of + VEquivalent x' y' -> do + let x'' = quote names x' + let y'' = quote names y' + + if Eval.conv values x' y' + then return _T' + else die (AssertionFailed x'' y'') + + _ -> + die (NotAnEquivalence _T) + + Equivalent _ x y -> do + _A₀' <- loop ctx x + + let _A₀'' = quote names _A₀' + + tA₀' <- loop ctx _A₀'' + + case tA₀' of + VConst Type -> return () + _ -> die (IncomparableExpression x) + + _A₁' <- loop ctx y + + let _A₁'' = quote names _A₁' + + tA₁' <- loop ctx _A₁'' + + case tA₁' of + VConst Type -> return () + _ -> die (IncomparableExpression y) + + if Eval.conv values _A₀' _A₁' + then return () + else die (EquivalenceTypeMismatch x _A₀'' y _A₁'') + + return (VConst Type) + + With e₀ ks₀ v₀ -> do + tE₀' <- loop ctx e₀ + + -- The purpose of this inner loop is to ensure that we only need to + -- typecheck the record once + + let with tE' ks v = case tE' of + VRecord kTs' -> + case ks of + WithLabel k :| [] -> do + tV' <- loop ctx v + + return (VRecord (Dhall.Map.insert k tV' kTs')) + WithLabel k₀ :| k₁ : ks' -> do + let _T = + case Dhall.Map.lookup k₀ kTs' of + Just _T' -> _T' + Nothing -> VRecord mempty + + tV' <- with _T (k₁ :| ks') v + + return (VRecord (Dhall.Map.insert k₀ tV' kTs')) + WithQuestion :| _ -> do + die NotALabelPath + + VOptional _O' -> do + case ks of + + -- (Some x) with ? = v is valid iff the type of x is the same as the type of v. + WithQuestion :| [] -> do + tV' <- loop ctx v + if Eval.conv values _O' tV' + then return (VOptional _O') + else die OptionalWithTypeMismatch + + -- (Some x) with ?.a.b = v is valid iff the type of x.a.b is the same as the type of v. + WithQuestion :| k₁ : ks' -> do + tV' <- with _O' (k₁ :| ks') v + if Eval.conv values _O' tV' + then return (VOptional _O') + else die OptionalWithTypeMismatch + + WithLabel k :| _ -> die (NotAQuestionPath k) + + _ -> die (NotWithARecord e₀ (quote names tE')) -- TODO: NotWithARecordOrOptional + + with tE₀' ks₀ v₀ + + Note s e -> + case loop ctx e of + Left (TypeError ctx' (Note s' e') m) -> + Left (TypeError ctx' (Note s' e') m) + Left (TypeError ctx' e' m) -> + Left (TypeError ctx' (Note s e') m) + Right r -> + Right r + + ImportAlt l _r -> + loop ctx l + + Embed p -> + return (eval values (typer p)) + where + die err = Left (TypeError context expression err) + + context = ctxToContext ctx + + names = typesToNames types + + eval vs e = Eval.eval vs (Dhall.Core.denote e) + + quote ns value = Dhall.Core.renote (Eval.quote ns value) + +{-| `typeOf` is the same as `typeWith` with an empty context, meaning that the + expression must be closed (i.e. no free variables), otherwise type-checking + will fail. +-} +typeOf :: Expr s X -> Either (TypeError s X) (Expr s X) +typeOf = typeWith Dhall.Context.empty + +-- | The specific type error +data TypeMessage s a + = UnboundVariable Text + | InvalidInputType (Expr s a) + | InvalidOutputType (Expr s a) + | NotAFunction (Expr s a) (Expr s a) + | TypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | AnnotMismatch (Expr s a) (Expr s a) (Expr s a) + | Untyped + | MissingListType + | MismatchedListElements Int (Expr s a) (Expr s a) (Expr s a) + | InvalidListType (Expr s a) + | ListLitInvariant + | InvalidSome (Expr s a) (Expr s a) (Expr s a) + | InvalidPredicate (Expr s a) (Expr s a) + | IfBranchMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | InvalidFieldType Text (Expr s a) + | InvalidAlternativeType Text (Expr s a) + | ListAppendMismatch (Expr s a) (Expr s a) + | MustCombineARecord Char (Expr s a) (Expr s a) + | InvalidDuplicateField Text (Expr s a) (Expr s a) + | InvalidRecordCompletion Text (Expr s a) + | CompletionSchemaMustBeARecord (Expr s a) (Expr s a) + | CombineTypesRequiresRecordType (Expr s a) (Expr s a) + | DuplicateFieldCannotBeMerged (NonEmpty Text) + | FieldCollision (NonEmpty Text) + | FieldTypeCollision (NonEmpty Text) + | MustMergeARecord (Expr s a) (Expr s a) + | MustMergeUnionOrOptional (Expr s a) (Expr s a) + | MustMapARecord (Expr s a) (Expr s a) + | InvalidToMapRecordKind (Expr s a) (Expr s a) + | HeterogenousRecordToMap (Expr s a) (Expr s a) (Expr s a) + | InvalidToMapType (Expr s a) + | MapTypeMismatch (Expr s a) (Expr s a) + | MissingToMapType + | UnusedHandler (Set Text) + | MissingHandler Text (Set Text) + | HandlerInputTypeMismatch Text (Expr s a) (Expr s a) + | DisallowedHandlerType Text (Expr s a) (Expr s a) Text + | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a) + | MissingMergeType + | HandlerNotAFunction Text (Expr s a) + | CantAccess Text (Expr s a) (Expr s a) + | CantProject Text (Expr s a) (Expr s a) + | CantProjectByExpression (Expr s a) + | DuplicateProjectionLabel Text + | MissingField Text (Expr s a) + | MissingConstructor Text (Expr s a) + | ProjectionTypeMismatch Text (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | AssertionFailed (Expr s a) (Expr s a) + | NotAnEquivalence (Expr s a) + | IncomparableExpression (Expr s a) + | EquivalenceTypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | NotWithARecord (Expr s a) (Expr s a) + | CantAnd (Expr s a) (Expr s a) + | CantOr (Expr s a) (Expr s a) + | CantEQ (Expr s a) (Expr s a) + | CantNE (Expr s a) (Expr s a) + | CantInterpolate (Expr s a) (Expr s a) + | CantTextAppend (Expr s a) (Expr s a) + | CantListAppend (Expr s a) (Expr s a) + | CantAdd (Expr s a) (Expr s a) + | CantMultiply (Expr s a) (Expr s a) + | OptionalWithTypeMismatch + | NotALabelPath + | NotAQuestionPath Text + | ShowConstructorNotOnUnion + deriving (Show) + +formatHints :: [Doc Ann] -> Doc Ann +formatHints hints = vsep (map format hints) + where + format hint = "\n\n\ESC[1;33mHint\ESC[0m: " <> hint + +shortTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann +shortTypeMessage msg = + "\ESC[1;31mError\ESC[0m: " <> short <> formatHints hints <> "\n" + where + ErrorMessages {..} = prettyTypeMessage msg + +longTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann +longTypeMessage msg = + "\ESC[1;31mError\ESC[0m: " <> short <> formatHints hints <> "\n" + <> "\n" + <> long + where + ErrorMessages {..} = prettyTypeMessage msg + +{-| Output of `prettyTypeMessage`, containing short- and long-form error + messages +-} +data ErrorMessages = ErrorMessages + { short :: Doc Ann + -- ^ Default succinct 1-line explanation of what went wrong + , hints :: [Doc Ann] + -- ^ Possibly-empty hints based on specific types involved in the error + , long :: Doc Ann + -- ^ Longer and more detailed explanation of the error + } + +_NOT :: Doc ann +_NOT = "\ESC[1mnot\ESC[0m" + +insert :: Pretty a => a -> Doc Ann +insert = Dhall.Util.insert + +emptyRecordTypeHint :: (Eq a, Pretty a) => Expr s a -> [Doc Ann] +emptyRecordTypeHint expr = + if Eval.judgmentallyEqual expr (Record mempty) then + ["{} is the empty record type, use {=} for the empty record value"] + else [] + +-- | Convert a `TypeMessage` to short- and long-form `ErrorMessages` +prettyTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages +prettyTypeMessage (UnboundVariable x) = ErrorMessages {..} + -- We do not need to print variable name here. For the discussion see: + -- https://github.com/dhall-lang/dhall-haskell/pull/116 + where + short = "Unbound variable: " <> Pretty.pretty x + + hints = [] + + long = + "Explanation: Expressions can only reference previously introduced (i.e. “bound”)\n\ + \variables that are still “in scope” \n\ + \ \n\ + \For example, the following valid expressions introduce a “bound” variable named \n\ + \❰x❱: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ λ(x : Bool) → x │ Anonymous functions introduce “bound” variables \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is the bound variable \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ let x = 1 in x │ ❰let❱ expressions introduce “bound” variables \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is the bound variable \n\ + \ \n\ + \ \n\ + \However, the following expressions are not valid because they all reference a \n\ + \variable that has not been introduced yet (i.e. an “unbound” variable): \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ λ(x : Bool) → y │ The variable ❰y❱ hasn't been introduced yet \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is the unbound variable \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ (let x = True in x) && x │ ❰x❱ is undefined outside the parentheses \n\ + \ └──────────────────────────┘ \n\ + \ ⇧ \n\ + \ This is the unbound variable \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ let x = x in x │ The definition for ❰x❱ cannot reference itself \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ This is the unbound variable \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You misspell a variable name, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────────┐ \n\ + \ │ λ(empty : Bool) → if emty then \"Empty\" else \"Full\" │ \n\ + \ └────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Typo \n\ + \ \n\ + \ \n\ + \● You misspell a reserved identifier, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ foral (a : Type) → a → a │ \n\ + \ └──────────────────────────┘ \n\ + \ ⇧ \n\ + \ Typo \n\ + \ \n\ + \ \n\ + \● You tried to define a recursive value, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ let x = x + 1 in x │ \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ Recursive definitions are not allowed \n\ + \ \n\ + \ \n\ + \● You accidentally forgot a ❰λ❱ or ❰∀❱/❰forall❱ \n\ + \ \n\ + \ \n\ + \ Unbound variable \n\ + \ ⇩ \n\ + \ ┌─────────────────┐ \n\ + \ │ (x : Bool) → x │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ A ❰λ❱ here would transform this into a valid anonymous function \n\ + \ \n\ + \ \n\ + \ Unbound variable \n\ + \ ⇩ \n\ + \ ┌────────────────────┐ \n\ + \ │ (x : Bool) → Bool │ \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ A ❰∀❱ or ❰forall❱ here would transform this into a valid function type \n\ + \ \n\ + \ \n\ + \● You forgot to prefix a file path with ❰./❱: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ path/to/file.dhall │ \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰./path/to/file.dhall❱ \n" + +prettyTypeMessage (InvalidInputType expr) = ErrorMessages {..} + where + short = "Invalid function input" + + hints = [] + + long = + "Explanation: A function can accept an input “term” that has a given “type”, like\n\ + \this: \n\ + \ \n\ + \ \n\ + \ This is the input term that the function accepts \n\ + \ ⇩ \n\ + \ ┌───────────────────────┐ \n\ + \ │ ∀(x : Natural) → Bool │ This is the type of a function that accepts an \n\ + \ └───────────────────────┘ input term named ❰x❱ that has type ❰Natural❱ \n\ + \ ⇧ \n\ + \ This is the type of the input term \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ Bool → Natural │ This is the type of a function that accepts an anonymous\n\ + \ └────────────────┘ input term that has type ❰Bool❱ \n\ + \ ⇧ \n\ + \ This is the type of the input term \n\ + \ \n\ + \ \n\ + \... or a function can accept an input “type” that has a given “kind”, like this:\n\ + \ \n\ + \ \n\ + \ This is the input type that the function accepts \n\ + \ ⇩ \n\ + \ ┌────────────────────┐ \n\ + \ │ ∀(a : Type) → Type │ This is the type of a function that accepts an input\n\ + \ └────────────────────┘ type named ❰a❱ that has kind ❰Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the input type \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ (Type → Type) → Type │ This is the type of a function that accepts an \n\ + \ └──────────────────────┘ anonymous input type that has kind ❰Type → Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the input type \n\ + \ \n\ + \ \n\ + \Other function inputs are " <> _NOT <> " valid, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────┐ \n\ + \ │ ∀(x : 1) → x │ ❰1❱ is a “term” and not a “type” nor a “kind” so ❰x❱ \n\ + \ └──────────────┘ cannot have “type” ❰1❱ or “kind” ❰1❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ True → x │ ❰True❱ is a “term” and not a “type” nor a “kind” so the \n\ + \ └──────────┘ anonymous input cannot have “type” ❰True❱ or “kind” ❰True❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \You annotated a function input with the following expression: \n\ + \ \n\ + \" <> txt <> "\n\ + \ \n\ + \... which is neither a type nor a kind \n" + where + txt = insert expr + +prettyTypeMessage (InvalidOutputType expr) = ErrorMessages {..} + where + short = "Invalid function output" + + hints = [] + + long = + "Explanation: A function can return an output “term” that has a given “type”, \n\ + \like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ ∀(x : Text) → Bool │ This is the type of a function that returns an \n\ + \ └────────────────────┘ output term that has type ❰Bool❱ \n\ + \ ⇧ \n\ + \ This is the type of the output term \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ Bool → Natural │ This is the type of a function that returns an output \n\ + \ └────────────────┘ term that has type ❰Natural❱ \n\ + \ ⇧ \n\ + \ This is the type of the output term \n\ + \ \n\ + \ \n\ + \... or a function can return an output “type” that has a given “kind”, like \n\ + \this: \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ ∀(a : Type) → Type │ This is the type of a function that returns an \n\ + \ └────────────────────┘ output type that has kind ❰Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the output type \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ (Type → Type) → Type │ This is the type of a function that returns an \n\ + \ └──────────────────────┘ output type that has kind ❰Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the output type \n\ + \ \n\ + \ \n\ + \Other outputs are " <> _NOT <> " valid, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ ∀(x : Bool) → x │ ❰x❱ is a “term” and not a “type” nor a “kind” so the \n\ + \ └─────────────────┘ output cannot have “type” ❰x❱ or “kind” ❰x❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ Text → True │ ❰True❱ is a “term” and not a “type” nor a “kind” so the \n\ + \ └─────────────┘ output cannot have “type” ❰True❱ or “kind” ❰True❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You use ❰∀❱ instead of ❰λ❱ by mistake, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ ∀(x: Bool) → x │ \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ Using ❰λ❱ here instead of ❰∀❱ would transform this into a valid function \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You specified that your function outputs a: \n\ + \ \n\ + \" <> txt <> "\n\ + \ \n\ + \... which is neither a type nor a kind: \n" + where + txt = insert expr + +prettyTypeMessage (NotAFunction expr0 expr1) = ErrorMessages {..} + where + short = "Not a function" + + hints = [] + + long = + "Explanation: Expressions separated by whitespace denote function application, \n\ + \like this: \n\ + \ \n\ + \ \n\ + \ ┌─────┐ \n\ + \ │ f x │ This denotes the function ❰f❱ applied to an argument named ❰x❱ \n\ + \ └─────┘ \n\ + \ \n\ + \ \n\ + \A function is a term that has type ❰a → b❱ for some ❰a❱ or ❰b❱. For example, \n\ + \the following expressions are all functions because they have a function type: \n\ + \ \n\ + \ \n\ + \ The function's input type is ❰Bool❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(x : Bool) → x : Bool → Bool │ User-defined anonymous function \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output type is ❰Bool❱ \n\ + \ \n\ + \ \n\ + \ The function's input type is ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ Natural/even : Natural → Bool │ Built-in function \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output type is ❰Bool❱ \n\ + \ \n\ + \ \n\ + \ The function's input kind is ❰Type❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(a : Type) → a : Type → Type │ Type-level functions are still functions \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output kind is ❰Type❱ \n\ + \ \n\ + \ \n\ + \ The function's input kind is ❰Type❱ \n\ + \ ⇩ \n\ + \ ┌────────────────────┐ \n\ + \ │ List : Type → Type │ Built-in type-level function \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output kind is ❰Type❱ \n\ + \ \n\ + \ \n\ + \ Function's input has kind ❰Type❱ \n\ + \ ⇩ \n\ + \ ┌─────────────────────────────────────────────────┐ \n\ + \ │ List/head : ∀(a : Type) → (List a → Optional a) │ A function can return \n\ + \ └─────────────────────────────────────────────────┘ another function \n\ + \ ⇧ \n\ + \ Function's output has type ❰List a → Optional a❱\n\ + \ \n\ + \ \n\ + \ The function's input type is ❰List Text❱ \n\ + \ ⇩ \n\ + \ ┌────────────────────────────────────────────┐ \n\ + \ │ List/head Text : List Text → Optional Text │ A function applied to an \n\ + \ └────────────────────────────────────────────┘ argument can be a function \n\ + \ ⇧ \n\ + \ The function's output type is ❰Optional Text❱\n\ + \ \n\ + \ \n\ + \An expression is not a function if the expression's type is not of the form \n\ + \❰a → b❱. For example, these are " <> _NOT <> " functions: \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ 1 : Natural │ ❰1❱ is not a function because ❰Natural❱ is not the type of \n\ + \ └─────────────┘ a function \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ Natural/even 2 : Bool │ ❰Natural/even 2❱ is not a function because \n\ + \ └───────────────────────┘ ❰Bool❱ is not the type of a function \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ List Text : Type │ ❰List Text❱ is not a function because ❰Type❱ is not \n\ + \ └──────────────────┘ the type of a function \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You tried to add two ❰Natural❱s without a space around the ❰+❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────┐ \n\ + \ │ 2+2 │ \n\ + \ └─────┘ \n\ + \ \n\ + \ \n\ + \ The above code is parsed as: \n\ + \ \n\ + \ \n\ + \ ┌────────┐ \n\ + \ │ 2 (+2) │ \n\ + \ └────────┘ \n\ + \ ⇧ \n\ + \ The compiler thinks that this ❰2❱ is a function whose argument is ❰+2❱ \n\ + \ \n\ + \ \n\ + \ This is because the ❰+❱ symbol has two meanings: you use ❰+❱ to add two \n\ + \ numbers, but you also can prefix ❰Natural❱ literals with a ❰+❱ to turn them \n\ + \ into ❰Integer❱ literals (like ❰+2❱) \n\ + \ \n\ + \ To fix the code, you need to put spaces around the ❰+❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 2 + 2 │ \n\ + \ └───────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to use the following expression as a function: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but this expression's type is: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not a function type \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (TypeMismatch expr0 expr1 expr2 expr3) = ErrorMessages {..} + where + short = "Wrong type of function argument\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr3) + + hints = emptyRecordTypeHint expr2 + + long = + "Explanation: Every function declares what type or kind of argument to accept \n\ + \ \n\ + \For example: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(x : Bool) → x : Bool → Bool │ This anonymous function only accepts \n\ + \ └───────────────────────────────┘ arguments that have type ❰Bool❱ \n\ + \ ⇧ \n\ + \ The function's input type \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ Natural/even : Natural → Bool │ This built-in function only accepts \n\ + \ └───────────────────────────────┘ arguments that have type ❰Natural❱ \n\ + \ ⇧ \n\ + \ The function's input type \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(a : Type) → a : Type → Type │ This anonymous function only accepts \n\ + \ └───────────────────────────────┘ arguments that have kind ❰Type❱ \n\ + \ ⇧ \n\ + \ The function's input kind \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ List : Type → Type │ This built-in function only accepts arguments that \n\ + \ └────────────────────┘ have kind ❰Type❱ \n\ + \ ⇧ \n\ + \ The function's input kind \n\ + \ \n\ + \ \n\ + \For example, the following expressions are valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ (λ(x : Bool) → x) True │ ❰True❱ has type ❰Bool❱, which matches the type \n\ + \ └────────────────────────┘ of argument that the anonymous function accepts \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ Natural/even 2 │ ❰2❱ has type ❰Natural❱, which matches the type of \n\ + \ └────────────────┘ argument that the ❰Natural/even❱ function accepts, \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ (λ(a : Type) → a) Bool │ ❰Bool❱ has kind ❰Type❱, which matches the kind \n\ + \ └────────────────────────┘ of argument that the anonymous function accepts \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ List Text │ ❰Text❱ has kind ❰Type❱, which matches the kind of argument \n\ + \ └───────────┘ that that the ❰List❱ function accepts \n\ + \ \n\ + \ \n\ + \However, you can " <> _NOT <> " apply a function to the wrong type or kind of argument\n\ + \ \n\ + \For example, the following expressions are not valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ (λ(x : Bool) → x) \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the anonymous function\n\ + \ └───────────────────────┘ expects an argument that has type ❰Bool❱ \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ Natural/even \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the ❰Natural/even❱ function\n\ + \ └──────────────────┘ expects an argument that has type ❰Natural❱ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ (λ(a : Type) → a) True │ ❰True❱ has type ❰Bool❱, but the anonymous \n\ + \ └────────────────────────┘ function expects an argument of kind ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌────────┐ \n\ + \ │ List 1 │ ❰1❱ has type ❰Natural❱, but the ❰List❱ function expects an \n\ + \ └────────┘ argument that has kind ❰Type❱ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You omit a function argument by mistake: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ List/head [1, 2, 3] │ \n\ + \ └───────────────────────┘ \n\ + \ ⇧ \n\ + \ ❰List/head❱ is missing the first argument, \n\ + \ which should be: ❰Natural❱ \n\ + \ \n\ + \ \n\ + \● You supply an ❰Integer❱ literal to a function that expects a ❰Natural❱ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ Natural/even +2 │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰2❱ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to invoke the following function: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which expects an argument of type or kind: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... on the following argument: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... which has a different type or kind: \n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + txt3 = insert expr3 + +prettyTypeMessage (AnnotMismatch expr0 expr1 expr2) = ErrorMessages {..} + where + short = "Expression doesn't match annotation\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) + + hints = [] + + long = + "Explanation: You can annotate an expression with its type or kind using the \n\ + \❰:❱ symbol, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ x : t │ ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱\n\ + \ └───────┘ \n\ + \ \n\ + \The type checker verifies that the expression's type or kind matches the \n\ + \provided annotation \n\ + \ \n\ + \For example, all of the following are valid annotations that the type checker \n\ + \accepts: \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ 1 : Natural │ ❰1❱ is an expression that has type ❰Natural❱, so the type \n\ + \ └─────────────┘ checker accepts the annotation \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ Natural/even 2 : Bool │ ❰Natural/even 2❱ has type ❰Bool❱, so the type \n\ + \ └───────────────────────┘ checker accepts the annotation \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ List : Type → Type │ ❰List❱ is an expression that has kind ❰Type → Type❱,\n\ + \ └────────────────────┘ so the type checker accepts the annotation \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ List Text : Type │ ❰List Text❱ is an expression that has kind ❰Type❱, so \n\ + \ └──────────────────┘ the type checker accepts the annotation \n\ + \ \n\ + \ \n\ + \However, the following annotations are " <> _NOT <> " valid and the type checker will\n\ + \reject them: \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ 1 : Text │ The type checker rejects this because ❰1❱ does not have type \n\ + \ └──────────┘ ❰Text❱ \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ List : Type │ ❰List❱ does not have kind ❰Type❱ \n\ + \ └─────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● The Haskell Dhall interpreter implicitly inserts a top-level annotation \n\ + \ matching the expected type \n\ + \ \n\ + \ For example, if you run the following Haskell code: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ >>> input auto \"1\" :: IO Text │ \n\ + \ └───────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ... then the interpreter will actually type check the following annotated \n\ + \ expression: \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ 1 : Text │ \n\ + \ └──────────┘ \n\ + \ \n\ + \ \n\ + \ ... and then type-checking will fail \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You or the interpreter annotated this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... with this type or kind: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the inferred type or kind of the expression is actually: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage Untyped = ErrorMessages {..} + where + short = "❰Sort❱ has no type, kind, or sort" + + hints = [] + + long = + "Explanation: There are five levels of expressions that form a hierarchy: \n\ + \ \n\ + \● terms \n\ + \● types \n\ + \● kinds \n\ + \● sorts \n\ + \● orders \n\ + \ \n\ + \The following example illustrates this hierarchy: \n\ + \ \n\ + \ ┌───────────────────────────────────┐ \n\ + \ │ \"ABC\" : Text : Type : Kind : Sort │ \n\ + \ └───────────────────────────────────┘ \n\ + \ ⇧ ⇧ ⇧ ⇧ ⇧ \n\ + \ term type kind sort order \n\ + \ \n\ + \There is nothing above ❰Sort❱ in this hierarchy, so if you try to type check any\n\ + \expression containing ❰Sort❱ anywhere in the expression then type checking fails\n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You supplied a sort where a kind was expected \n\ + \ \n\ + \ For example, the following expression will fail to type check: \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ f : Type -> Kind │ \n\ + \ └──────────────────┘ \n\ + \ ⇧ \n\ + \ ❰Kind❱ is a sort, not a kind \n" + +prettyTypeMessage (InvalidPredicate expr0 expr1) = ErrorMessages {..} + where + short = "Invalid predicate for ❰if❱: " + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized Bool expr1) + + hints = [] + + long = + "Explanation: Every ❰if❱ expression begins with a predicate which must have type \n\ + \❰Bool❱ \n\ + \ \n\ + \For example, these are valid ❰if❱ expressions: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────┐ \n\ + \ │ if True then \"Yes\" else \"No\" │ \n\ + \ └──────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Predicate \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ λ(x : Bool) → if x then False else True │ \n\ + \ └─────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Predicate \n\ + \ \n\ + \ \n\ + \... but these are " <> _NOT <> " valid ❰if❱ expressions: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ if 0 then \"Yes\" else \"No\" │ ❰0❱ does not have type ❰Bool❱ \n\ + \ └───────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ if \"\" then False else True │ ❰\"\"❱ does not have type ❰Bool❱ \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might be used to other programming languages that accept predicates other \n\ + \ than ❰Bool❱ \n\ + \ \n\ + \ For example, some languages permit ❰0❱ or ❰\"\"❱ as valid predicates and treat\n\ + \ them as equivalent to ❰False❱. However, the Dhall language does not permit \n\ + \ this \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \Your ❰if❱ expression begins with the following predicate: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... that has type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the predicate must instead have type ❰Bool❱ \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) = + ErrorMessages {..} + where + short = "❰if❱ branches must have matching types\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr3) + + hints = [] + + long = + "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ + \is an expression: \n\ + \ \n\ + \ \n\ + \ Expression for ❰then❱ branch \n\ + \ ⇩ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ if True then \"Hello, world!\" │ \n\ + \ │ else \"Goodbye, world!\" │ \n\ + \ └────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Expression for ❰else❱ branch \n\ + \ \n\ + \ \n\ + \These two expressions must have the same type. For example, the following ❰if❱ \n\ + \expressions are all valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ λ(b : Bool) → if b then 0 else 1 │ Both branches have type ❰Natural❱ \n\ + \ └──────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ λ(b : Bool) → │ \n\ + \ │ if b then Natural/even │ Both branches have type ❰Natural → Bool❱ \n\ + \ │ else Natural/odd │ \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ This branch has type ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌────────────────────────┐ \n\ + \ │ if True then 0 │ \n\ + \ │ else \"ABC\" │ \n\ + \ └────────────────────────┘ \n\ + \ ⇧ \n\ + \ This branch has type ❰Text❱ \n\ + \ \n\ + \ \n\ + \The ❰then❱ and ❰else❱ branches must have matching types, even if the predicate \n\ + \is always ❰True❱ or ❰False❱ \n\ + \ \n\ + \Your ❰if❱ expression has the following ❰then❱ branch: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which has type: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... and the following ❰else❱ branch: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which has a different type: \n\ + \ \n\ + \" <> txt3 <> "\n\ + \ \n\ + \Fix your ❰then❱ and ❰else❱ branches to have matching types \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + txt3 = insert expr3 + +prettyTypeMessage (ListLitInvariant) = ErrorMessages {..} + where + short = "Internal error: A non-empty list literal violated an internal invariant" + + hints = [] + + long = + "Explanation: Internal error: A non-empty list literal violated an internal \n\ + \invariant. \n\ + \ \n\ + \A non-empty list literal must always be represented as \n\ + \ \n\ + \ ListLit Nothing [x, y, ...] \n\ + \ \n\ + \Please file a bug report at https://github.com/dhall-lang/dhall-haskell/issues, \n\ + \ideally including the offending source code. \n" + +prettyTypeMessage (InvalidListType expr0) = ErrorMessages {..} + where + short = "Invalid type for ❰List❱" + + hints = [] + + long = + "Explanation: ❰List❱s can optionally document their type with a type annotation, \n\ + \like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ [1, 2, 3] : List Natural │ A ❰List❱ of three ❰Natural❱ numbers \n\ + \ └──────────────────────────┘ \n\ + \ ⇧ \n\ + \ The type of the ❰List❱'s elements, which are ❰Natural❱ \n\ + \ numbers \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ [] : List Natural │ An empty ❰List❱ \n\ + \ └───────────────────┘ \n\ + \ ⇧ \n\ + \ You must specify the type when the ❰List❱ is empty \n\ + \ \n\ + \ \n\ + \The type must be of the form ❰List ...❱ and not something else. For example, \n\ + \the following type annotation is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────┐ \n\ + \ │ ... : Bool │ \n\ + \ └────────────┘ \n\ + \ ⇧ \n\ + \ This type does not have the form ❰List ...❱ \n\ + \ \n\ + \ \n\ + \The element type must be a type and not something else. For example, the \n\ + \following element types are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────┐ \n\ + \ │ ... : List 1 │ \n\ + \ └──────────────┘ \n\ + \ ⇧ \n\ + \ This is a ❰Natural❱ number and not a ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ ... : List Type │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is a ❰Kind❱ and not a ❰Type❱ \n\ + \ \n\ + \ \n\ + \You declared that the ❰List❱ should have type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a valid list type \n" + where + txt0 = insert expr0 + +prettyTypeMessage MissingListType = + ErrorMessages {..} + where + short = "An empty list requires a type annotation" + + hints = [] + + long = + "Explanation: Lists do not require a type annotation if they have at least one \n\ + \element: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ [1, 2, 3] │ The compiler can infer that this list has type ❰List Natural❱\n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \However, empty lists still require a type annotation: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ [] : List Natural │ This type annotation is mandatory \n\ + \ └───────────────────┘ \n\ + \ \n\ + \ \n\ + \You cannot supply an empty list without a type annotation \n" + +prettyTypeMessage (MismatchedListElements i expr0 _expr1 expr2) = + ErrorMessages {..} + where + short = "List elements should all have the same type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2) + + hints = [] + + long = + "Explanation: Every element in a list must have the same type \n\ + \ \n\ + \For example, this is a valid ❰List❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ [1, 2, 3] │ Every element in this ❰List❱ is a ❰Natural❱ number \n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ [1, \"ABC\", 3] │ The first and second element have different types \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \Your first ❰List❱ element has this type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the element at index #" <> txt1 <> " has this type instead: \n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = insert expr0 + txt1 = pretty i + txt3 = insert expr2 + +prettyTypeMessage (InvalidSome expr0 expr1 expr2) = ErrorMessages {..} + where + short = "❰Some❱ argument has the wrong type" + + hints = [] + + long = + "Explanation: The ❰Some❱ constructor expects an argument that is a term, where \n\ + \the type of the type of a term must be ❰Type❱ \n\ + \ \n\ + \For example, this is a valid use of ❰Some❱: \n\ + \ \n\ + \ \n\ + \ ┌────────┐ \n\ + \ │ Some 1 │ ❰1❱ is a valid term because ❰1 : Natural : Type❱ \n\ + \ └────────┘ \n\ + \ \n\ + \ \n\ + \... but this is " <> _NOT <> " a valid ❰Optional❱ value: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ Some Text │ ❰Text❱ is not a valid term because ❰Text : Type : Kind ❱ \n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \The ❰Some❱ argument you provided: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... has this type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the type of that type is: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... which is not ❰Type❱ \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage (InvalidFieldType k expr0) = ErrorMessages {..} + where + short = "Invalid field type" + + hints = [] + + long = + "Explanation: Every record type annotates each field with a ❰Type❱, a ❰Kind❱, or \n\ + \a ❰Sort❱ like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────┐ \n\ + \ │ { foo : Natural, bar : Integer, baz : Text } │ Every field is annotated \n\ + \ └──────────────────────────────────────────────┘ with a ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ { foo : Type, bar : Type } │ Every field is annotated \n\ + \ └────────────────────────────┘ with a ❰Kind❱ \n\ + \ \n\ + \ \n\ + \However, the types of fields may " <> _NOT <> " be term-level values: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ { foo : Natural, bar : 1 } │ Invalid record type \n\ + \ └────────────────────────────┘ \n\ + \ ⇧ \n\ + \ ❰1❱ is a ❰Natural❱ number and not a ❰Type❱, \n\ + \ ❰Kind❱, or ❰Sort❱ \n\ + \ \n\ + \ \n\ + \You provided a record type with a field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... annotated with the following expression: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is neither a ❰Type❱, a ❰Kind❱, nor a ❰Sort❱ \n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (InvalidAlternativeType k expr0) = ErrorMessages {..} + where + short = "Invalid alternative type" + + hints = [] + + long = + "Explanation: Every union type specifies the type of each alternative, like this:\n\ + \ \n\ + \ \n\ + \ The type of the first alternative is ❰Bool❱ \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ < Left : Bool, Right : Natural > │ A union type with two alternatives \n\ + \ └──────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The type of the second alternative is ❰Natural❱ \n\ + \ \n\ + \ \n\ + \However, these alternatives can only be annotated with ❰Type❱s, ❰Kind❱s, or \n\ + \❰Sort❱s. For example, the following union types are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ < Left : Bool, Right : 1 > │ Invalid union type \n\ + \ └────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This is a ❰Natural❱ and not a ❰Type❱, ❰Kind❱, or \n\ + \ ❰Sort❱ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally typed ❰:❱ instead of ❰=❱ for a union literal with one \n\ + \ alternative: \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ < Example : 1 > │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This could be ❰=❱ instead \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided a union type with an alternative named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... annotated with the following expression which is not a ❰Type❱, ❰Kind❱, or \n\ + \❰Sort❱: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (ListAppendMismatch expr0 expr1) = ErrorMessages {..} + where + short = "You can only append ❰List❱s with matching element types\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + hints = [] + + long = + "Explanation: You can append two ❰List❱s using the ❰#❱ operator, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ [1, 2, 3] # [4, 5] │ \n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot append two ❰List❱s if they have different element types. \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ These elements have type ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ [1, 2, 3] # [True, False] │ Invalid: the element types don't match \n\ + \ └───────────────────────────┘ \n\ + \ ⇧ \n\ + \ These elements have type ❰Bool❱ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to append a ❰List❱ thas has elements of type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... with another ❰List❱ that has elements of type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... and those two types do not match \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CompletionSchemaMustBeARecord expr0 expr1) = ErrorMessages {..} + where + short = "The completion schema must be a record" + + hints = [] + + long = + "Explanation: You can complete records using the ❰::❱ operator: \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────────┐ \n\ + \ │ {Type = {foo : Bool, bar : Natural}, default = {bar = 2}::{foo = True}} │ \n\ + \ └─────────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \... The left-hand side of :: must be a record with 'Type' and 'default' keys \n\ + \ \n\ + \You tried to record complete the following value: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a record. It is: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (InvalidRecordCompletion fieldName expr0) = ErrorMessages {..} + where + short = "Completion schema is missing a field: " <> pretty fieldName + + hints = [] + + long = + "Explanation: You can complete records using the ❰::❱ operator like this:\n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────────┐ \n\ + \ │ {Type = {foo : Bool, bar : Natural}, default = {bar = 2}::{foo = True}} │ \n\ + \ └─────────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \... but you need to have both Type and default fields in the completion schema \n\ + \ (the record on the left of the the ::). \n\ + \ \n\ + \You tried to do record completion using the schema: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is missing the key: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = pretty fieldName + +prettyTypeMessage (MustCombineARecord c expression typeExpression) = + ErrorMessages {..} + where + action = case c of + '∧' -> "combine" + _ -> "override" + + short = "You can only " <> action <> " records" + + hints = emptyRecordTypeHint expression + + long = + "Explanation: You can " <> action <> " records using the ❰" <> op <> "❱ operator, like this:\n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz = True } │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool }) → r " <> op <> " { bar = \"ABC\" } │ \n\ + \ └─────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot " <> action <> " values that are not records. \n\ + \ \n\ + \For example, the following expressions are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " 1 │ \n\ + \ └──────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz : Bool } │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: This is a record type and not a record\n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " < baz : Bool > │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: This is a union type and not a record \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You supplied this expression as one of the arguments: \n\ + \ \n\ + \" <> insert expression <> "\n\ + \ \n\ + \... which is not a record, but is actually a: \n\ + \ \n\ + \" <> insert typeExpression <> "\n" + where + op = pretty c + +prettyTypeMessage (InvalidDuplicateField k expr0 expr1) = + ErrorMessages {..} + where + short = "Invalid duplicate field: " <> Dhall.Pretty.Internal.prettyLabel k + + hints = [] + + long = + "Explanation: You can specify a field twice if both fields are themselves \n\ + \records, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────────────┐ \n\ + \ │ { ssh = { enable = True }, ssh = { forwardX11 = True } } │ \n\ + \ └──────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... because the language automatically merges two occurrences of a field using \n\ + \the ❰∧❱ operator, and the above example is equivalent to: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────┐ \n\ + \ │ { ssh = { enable = True } ∧ { forwardX11 = True } } │ \n\ + \ └─────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... which is in turn equivalent to: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────┐ \n\ + \ │ { ssh = { enable = True, forwardX11 = True } } │ \n\ + \ └────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, this implies that both fields must be records since the ❰∧❱ operator \n\ + \cannot merge non-record values. For example, these expressions are not valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ { x = 0, x = 0 } │ Invalid: Neither field is a record \n\ + \ └──────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ { x = 0, x = { y = 0 } } │ Invalid: The first ❰x❱ field is not a record \n\ + \ └──────────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You specified more than one field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but one of the fields had this value: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... with this type: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... which is not a record type \n" + where + txt0 = insert (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome k) + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (CombineTypesRequiresRecordType expr0 expr1) = + ErrorMessages {..} + where + short = "❰⩓❱ requires arguments that are record types" + + hints = [] + + long = + "Explanation: You can only use the ❰⩓❱ operator on arguments that are record type\n\ + \literals, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────┐ \n\ + \ │ { age : Natural } ⩓ { name : Text } │ \n\ + \ └─────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot use the ❰⩓❱ operator on any other type of arguments. For \n\ + \example, you cannot use variable arguments: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────┐ \n\ + \ │ λ(t : Type) → t ⩓ { name : Text } │ Invalid: ❰t❱ might not be a record \n\ + \ └───────────────────────────────────┘ type \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to supply the following argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which normalized to: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not a record type literal \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (DuplicateFieldCannotBeMerged ks) = ErrorMessages {..} + where + short = "Duplicate field cannot be merged: " <> pretty (toPath ks) + + hints = [] + + long = + "Explanation: Duplicate fields are only allowed if they are both records and if \n\ + \the two records can be recursively merged without collisions. \n\ + \ \n\ + \Specifically, an expression like: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ { x = a, x = b } │ \n\ + \ └──────────────────┘ \n\ + \ \n\ + \ \n\ + \... is syntactic sugar for: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ { x = a ∧ b } │ \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \... which is rejected if ❰a ∧ b❱ does not type-check. One way this can happen \n\ + \is if ❰a❱ and ❰b❱ share a field in common that is not a record, which is known \n\ + \as a \"collision\". \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ { x = { y = 0 }, x = { y = 1 } } │ Invalid: The two ❰x.y❱ fields \"collide\"\n\ + \ └──────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... whereas the following expression is valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ { x = { y = 0 }, x = { z = 1 } } │ Valid: the two ❰x❱ fields don't collide\n\ + \ └──────────────────────────────────┘ because they can be recursively merged \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You specified the same field twice by mistake \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You specified the following field twice: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which collided on the following path: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome (NonEmpty.head ks)) + + txt1 = insert (toPath ks) + +prettyTypeMessage (FieldCollision ks) = ErrorMessages {..} + where + short = "Field collision on: " <> pretty (toPath ks) + + hints = [] + + long = + "Explanation: You can recursively merge records using the ❰∧❱ operator: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ { x = a } ∧ { y = b } │ \n\ + \ └───────────────────────┘ \n\ + \ \n\ + \... but two records cannot be merged in this way if they share a field that is \n\ + \not a record. \n\ + \ \n\ + \For example, the following expressions are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ { x = 1 } ∧ { x = True } │ Invalid: The ❰x❱ fields \"collide\" because they\n\ + \ └──────────────────────────┘ are not records that can be merged \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ { x = 1 } ∧ { x = { y = True } } │ Invalid: One of the two ❰x❱ fields is \n\ + \ └──────────────────────────────────┘ still not a record \n\ + \ \n\ + \ \n\ + \... but the following expression is valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ Valid: The two ❰x❱ fields \n\ + \ │ { x = { y = True } } ∧ { x = { z = 1 } } │ don't collide because they can\n\ + \ └──────────────────────────────────────────┘ be recursively merged \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You tried to use ❰∧❱ to update a field's value, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = 2 } │ \n\ + \ └────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid attempt to update ❰foo❱'s value to ❰2❱\n\ + \ \n\ + \ \n\ + \ You probably meant to use ❰⫽❱ / ❰//❱ instead: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } ⫽ { foo = 2 } │ \n\ + \ └────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to merge two records which collided on the following path: \n\ + \ \n\ + \" <> txt0 <> "\n" + where + txt0 = insert (toPath ks) + +prettyTypeMessage (FieldTypeCollision ks) = ErrorMessages {..} + where + short = "Field type collision on: " <> pretty (toPath ks) + + hints = [] + + long = + "Explanation: You can recursively merge record types using the ❰⩓❱ operator, like\n\ + \this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ { x : A } ⩓ { y : B } │ \n\ + \ └───────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot merge record types if two field types collide that are not \n\ + \both record types. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ { x : Natural } ⩓ { x : Bool } │ Invalid: The ❰x❱ fields \"collide\" \n\ + \ └────────────────────────────────┘ because they cannot be merged \n\ + \ \n\ + \ \n\ + \... but the following expression is valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────┐ Valid: The ❰x❱ field \n\ + \ │ { x : { y : Bool } } ⩓ { x : { z : Natural } } │ types don't collide and \n\ + \ └────────────────────────────────────────────────┘ can be merged \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to merge two record types which collided on the following path: \n\ + \ \n\ + \" <> txt0 <> "\n" + where + txt0 = insert (toPath ks) + +prettyTypeMessage (MustMergeARecord expr0 expr1) = ErrorMessages {..} + where + short = "❰merge❱ expects a record of handlers" + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the first argument to ❰merge❱ must be a record and not some other type. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────┐ \n\ + \ │ let handler = λ(x : Bool) → x │ \n\ + \ │ in merge handler (< Foo : Bool >.Foo True) │ \n\ + \ └─────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: ❰handler❱ isn't a record \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally provide an empty record type instead of an empty record when \n\ + \ you ❰merge❱ an empty union: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ λ(x : <>) → λ(a : Type) → merge {} x : a │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰{=}❱ instead \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided the following handler: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a record, but is actually a value of type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (MustMergeUnionOrOptional expr0 expr1) = ErrorMessages {..} + where + short = "❰merge❱ expects a union or an ❰Optional❱" + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... or this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────┐ \n\ + \ │ let optional = None Bool │ \n\ + \ │ let handlers = { None = False, Some = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers optional │ \n\ + \ └─────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the second argument to ❰merge❱ must not be some other type. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ let handlers = { Foo = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers True │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: ❰True❱ isn't a union or an ❰Optional❱ \n\ + \ \n\ + \ \n\ + \You tried to ❰merge❱ this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a union or an ❰Optional❱, but is actually a value of type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (UnusedHandler ks) = ErrorMessages {..} + where + short = "Unused handler" + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you must provide exactly one handler per alternative in the union. You \n\ + \cannot supply extra handlers \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural >.Left 2 │ The ❰Right❱ alternative is \n\ + \ │ let handlers = │ missing \n\ + \ │ { Left = Natural/even │ \n\ + \ │ , Right = λ(x : Bool) → x │ Invalid: ❰Right❱ handler isn't\n\ + \ │ } │ used \n\ + \ │ in merge handlers union │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \You provided the following handlers: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which had no matching alternatives in the union you tried to ❰merge❱ \n" + where + txt0 = insert (Text.intercalate ", " (Data.Set.toList ks)) + +prettyTypeMessage (MissingHandler exemplar ks) = ErrorMessages {..} + where + short = case Data.Set.toList ks of + [] -> "Missing handler: " <> Dhall.Pretty.Internal.prettyLabel exemplar + xs@(_:_) -> "Missing handlers: " <> (Pretty.hsep . Pretty.punctuate Pretty.comma + . map Dhall.Pretty.Internal.prettyLabel $ exemplar:xs) + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you must provide exactly one handler per alternative in the union. You \n\ + \cannot omit any handlers \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ Invalid: Missing ❰Right❱ handler \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────────────────────────┐ \n\ + \ │ let handlers = { Left = Natural/even } │ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ in merge handlers union │ \n\ + \ └──────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Note that you need to provide handlers for other alternatives even if those \n\ + \alternatives are never used \n\ + \ \n\ + \You need to supply the following handlers: \n\ + \ \n\ + \" <> txt0 <> "\n" + where + txt0 = insert (Text.intercalate ", " (exemplar : Data.Set.toList ks)) + +prettyTypeMessage MissingMergeType = + ErrorMessages {..} + where + short = "An empty ❰merge❱ requires a type annotation" + + hints = [] + + long = + "Explanation: A ❰merge❱ does not require a type annotation if the union has at \n\ + \least one alternative, like this \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, you must provide a type annotation when merging an empty union: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ λ(a : <>) → merge {=} a : Bool │ \n\ + \ └────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This can be any type \n\ + \ \n\ + \ \n\ + \You can provide any type at all as the annotation, since merging an empty \n\ + \union can produce any type of output \n" + +prettyTypeMessage (HandlerInputTypeMismatch expr0 expr1 expr2) = + ErrorMessages {..} + where + short = "Wrong handler input type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as the input type of each handler function matches the type of the \n\ + \corresponding alternative: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ union : < Left : Natural | Right : Bool > │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ These must match These must match \n\ + \ ⇩ ⇩ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ Invalid: Doesn't match the type of the ❰Right❱ alternative \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────────────────────────────┐ \n\ + \ │ let handlers = { Left = Natural/even | Right = λ(x : Text) → x } │ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ in merge handlers union │ \n\ + \ └──────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Your handler for the following alternative: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... needs to accept an input value of type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but actually accepts an input value of a different type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage (DisallowedHandlerType label handlerType handlerOutputType variable) = + ErrorMessages {..} + where + short = "Disallowed handler type" + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the output type of a handler may not depend on the input value. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ Invalid: The output type is ❰Optional A❱, which references the input \n\ + \ value ❰A❱. \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ merge { x = None } (< x : Type >.x Bool) │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Your handler for the following alternative: \n\ + \ \n\ + \" <> insert label <> "\n\ + \ \n\ + \... has type: \n\ + \ \n\ + \" <> insert handlerType <> "\n\ + \ \n\ + \... where the output type: \n\ + \ \n\ + \" <> insert handlerOutputType <> "\n\ + \ \n\ + \... references the handler's input value: \n\ + \ \n\ + \" <> insert variable <> "\n" + +prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) = + ErrorMessages {..} + where + short = "Handlers should have the same output type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as the output type of each handler function is the same: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ These output types both match \n\ + \ \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────┐ \n\ + \ │ let Union = < Left : Natural | Right : Bool > │ \n\ + \ │ let handlers = │ \n\ + \ │ { Left = λ(x : Natural) → x │ This outputs ❰Natural❱ \n\ + \ │ , Right = λ(x : Bool ) → x │ This outputs ❰Bool❱ \n\ + \ │ } │ \n\ + \ │ in merge handlers (Union.Left 2) │ \n\ + \ └─────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: The handlers in this record don't have matching outputs\n\ + \ \n\ + \ \n\ + \The handler for the ❰" <> txt0 <> "❱ alternative has this output type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the handler for the ❰" <> txt2 <> "❱ alternative has this output type instead:\n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = pretty key0 + txt1 = insert expr0 + txt2 = pretty key1 + txt3 = insert expr1 + +prettyTypeMessage (HandlerNotAFunction k expr0) = ErrorMessages {..} + where + short = "Handler for "<> Dhall.Pretty.Internal.prettyLabel k <> " is not a function" + + hints = [] + + long = + "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\ + \a record with one handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as each handler is a function -- FIXME \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────┐ \n\ + \ │ merge { Foo = True } (< Foo : Natural >.Foo 1) │ \n\ + \ └────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a function \n\ + \ \n\ + \ \n\ + \Your handler for this alternative: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... has the following type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not the type of a function \n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (MustMapARecord provided _providedType) = ErrorMessages {..} + where + short = "❰toMap❱ expects a record value" + + hints = emptyRecordTypeHint provided + + long = + "Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the argument to ❰toMap❱ must be a record and not some other type. \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally provide an empty record type instead of an empty record when \n\ + \ using ❰toMap❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────┐ \n\ + \ │ toMap {} : List { mapKey : Text, mapValue : Natural } │ \n\ + \ └───────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰{=}❱ instead \n" + +prettyTypeMessage (InvalidToMapRecordKind type_ kind) = ErrorMessages {..} + where + short = "❰toMap❱ expects a record of kind ❰Type❱" + + hints = [] + + long = + "Explanation: You can apply ❰toMap❱ to any homogenous record of kind ❰Type❱, like\n\ + \ this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but records of kind ❰Kind❱ or ❰Sort❱ cannot be turned into ❰List❱s. \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You applied ❰toMap❱ to a record of the following type: \n\ + \ \n\ + \" <> insert type_ <> "\n\ + \ \n\ + \... which has kind \n\ + \ \n\ + \" <> insert kind <> "\n" + +prettyTypeMessage (HeterogenousRecordToMap _expr0 _expr1 _expr2) = ErrorMessages {..} + where + short = "❰toMap❱ expects a homogenous record" + + hints = [] + + long = + "Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but every field of the record must have the same type. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ toMap { Foo = True, Bar = 0 } │ \n\ + \ └─────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ Bool Natural \n" + +prettyTypeMessage (MapTypeMismatch expr0 expr1) = ErrorMessages {..} + where + short = "❰toMap❱ result type doesn't match annotation" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + hints = [] + + long = + "Explanation: a ❰toMap❱ application has been annotated with a type that doesn't \n\ + \match its inferred type. \n" + +prettyTypeMessage (InvalidToMapType expr) = + ErrorMessages {..} + where + short = "An empty ❰toMap❱ was annotated with an invalid type" + <> "\n" + <> insert expr + + hints = [] + + long = + "Explanation: A ❰toMap❱ applied to an empty record must have a type annotation: \n\ + \that matches a list of key-value pairs, like this \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ toMap {=} : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \The type you have provided doesn't match the expected form. \n\ + \ \n" + +prettyTypeMessage MissingToMapType = + ErrorMessages {..} + where + short = "An empty ❰toMap❱ requires a type annotation" + + hints = [] + + long = + "Explanation: A ❰toMap❱ does not require a type annotation if the record has at \n\ + \least one field, like this \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, you must provide a type annotation with an empty record: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ toMap {=} : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n" + +prettyTypeMessage (CantAccess lazyText0 expr0 expr1) = ErrorMessages {..} + where + short = "Not a record or a union" + + hints = [] + + long = + "Explanation: You can only access fields on records or unions, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ < foo : Bool | bar : Text >.foo │ ... and so is this \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────┐ \n\ + \ │ λ(r : < foo : Bool | bar : Text >) → r.foo │ ... and so is this \n\ + \ └────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot access fields on non-record expressions \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 1.foo │ \n\ + \ └───────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to access the field: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... on the following expression which is not a record nor a union type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but is actually an expression of type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert lazyText0 + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (CantProject lazyText0 expr0 expr1) = ErrorMessages {..} + where + short = "Not a record" + + hints = [] + + long = + "Explanation: You can only project fields on records, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\", baz = 1 }.{ foo, bar } │ This is valid ... \n\ + \ └─────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool, bar : Text , baz : Natural }) → r.{ foo, bar } │ ... and so is this \n\ + \ └────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot project fields on non-record expressions \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ 1.{ foo, bar } │ \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally try to project fields of a union instead of a record, like \n\ + \ this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────┐ \n\ + \ │ < foo : a | bar : b >.{ foo, bar } │ \n\ + \ └────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This is a union, not a record \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to access the fields: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... on the following expression which is not a record: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but is actually an expression of type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert lazyText0 + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (CantProjectByExpression expr) = ErrorMessages {..} + where + short = "Selector is not a record type" + + hints = [] + + long = + "Explanation: You can project by an expression if that expression is a record \n\ + \type: \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True }.({ foo : Bool }) │ This is valid ... \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool }) → r.{ foo : Bool } │ ... and so is this \n\ + \ └──────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot project by any other type of expression: \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ { foo = True }.(True) │ \n\ + \ └───────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record type \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally try to project by a record value instead of a record type, \n\ + \ like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ let T = { foo : Bool } │ \n\ + \ │ │ \n\ + \ │ let x = { foo = True , bar = 1} │ \n\ + \ │ │ \n\ + \ │ let y = { foo = False, bar = 2} │ \n\ + \ │ │ \n\ + \ │ in x.(y) │ \n\ + \ └─────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The user might have meant ❰T❱ here \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to project out the following type: \n\ + \ \n\ + \" <> txt <> "\n\ + \ \n\ + \... which is not a record type \n" + where + txt = insert expr + +prettyTypeMessage (DuplicateProjectionLabel k) = ErrorMessages {..} + where + short = "Duplicate projection label: " <> Dhall.Pretty.Internal.prettyLabel k + + hints = [] + + long = + "Explanation: You can only specify a label once when projecting a record's fields\n\ + \by label. For example, this is valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ { x = 1.1, y = 2.4, z = -0.3 }.{ x, y } │ \n\ + \ └─────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but this is not valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ { x = 1.1, y = 2.4, z = -0.3 }.{ y, y } │ \n\ + \ └─────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: the label ❰y❱ appears twice \n\ + \ \n\ + \ \n\ + \You tried to project the following field twice: \n\ + \ \n\ + \" <> txt0 <> "\n" + where + txt0 = insert k + +prettyTypeMessage (MissingField k expr0) = ErrorMessages {..} + where + short = "Missing record field: " <> Dhall.Pretty.Internal.prettyLabel k + + hints = [] + + long = + "Explanation: You can only access fields on records, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you can only access fields if they are present \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\" }.qux │ \n\ + \ └─────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: the record has no ❰qux❱ field \n\ + \ \n\ + \ \n\ + \You tried to access a field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the field is missing because the record only defines the following \n\ + \fields: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (MissingConstructor k expr0) = ErrorMessages {..} + where + short = "Missing constructor: " <> Dhall.Pretty.Internal.prettyLabel k + + hints = [] + + long = + "Explanation: You can access constructors from unions, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ < Foo | Bar >.Foo │ This is valid ... \n\ + \ └───────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you can only access constructors if they match an union alternative of \n\ + \the same name. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ < Foo | Bar >.Baz │ \n\ + \ └───────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: the union has no ❰Baz❱ alternative \n\ + \ \n\ + \ \n\ + \You tried to access a constructor named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the constructor is missing because the union only defines the following \n\ + \alternatives: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (ProjectionTypeMismatch k expr0 expr1 expr2 expr3) = ErrorMessages {..} + where + short = "Projection type mismatch\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr2 expr3) + + hints = [] + + long = + "Explanation: You can project a subset of fields from a record by specifying the \n\ + \desired type of the final record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = True }.({ foo : Natural }) │ This is valid \n\ + \ └─────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the expected type for each desired field must match the actual type of \n\ + \the corresponding field in the original record. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ Invalid: The ❰foo❱ field contains ❰1❱, which has type ❰Natural❱...\n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = True }.({ foo : Text }) │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ ... but we requested that the ❰foo❱ field\n\ + \ must contain a value of type ❰Text❱ \n\ + \ \n\ + \ \n\ + \You tried to project out a field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... that should have type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but that field instead had a value of type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (AssertionFailed expr0 expr1) = ErrorMessages {..} + where + short = "Assertion failed\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + hints = [] + + long = + "Explanation: You can assert at type-checking time that two terms are equal if \n\ + \they have the same normal form, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ assert : 2 + 2 ≡ 4 │ This is valid \n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... and an assertion still succeeds if the normal forms only differ by renaming \n\ + \bound variables, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────────┐ \n\ + \ │ assert : λ(n : Natural) → n + 0 ≡ λ(m : Natural) → m │ This is also valid\n\ + \ └──────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, an assertion fails if the normal forms differ in any other way. For \n\ + \example, the following assertion is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ assert : 0 ≡ 1 │ Invalid: ❰0❱ does not equal ❰1❱ \n\ + \ └────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have tried to ❰assert❱ a precondition on a function's input, like \n\ + \ this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────────────────────┐ \n\ + \ │ λ(n : Natural) → let _ = assert : Natural/isZero n ≡ False in n │ \n\ + \ └──────────────────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: This assertion will always fail\n\ + \ \n\ + \ \n\ + \ This will not work. Such an assertion is checking all possible inputs to the \n\ + \ function, before you've even used the function at all. \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to assert that this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... is the same as this other expression: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but they differ\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (NotAnEquivalence expr) = ErrorMessages {..} + where + short = "Not an equivalence\n" + + hints = [] + + long = + "Explanation: The type annotation for an ❰assert❱ must evaluate to an equivalence\n\ + \of the form ❰x ≡ y❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ assert : 2 + 2 ≡ 4 │ This is valid \n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but any other type is not a valid annotation. For example, the following \n\ + \assertion is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ assert : True │ Invalid: ❰True❱ is not an equivalence \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You tried to supply an expression of type ❰Bool❱ to the assertion, rather than\n\ + \ two separate expressions to compare, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ assert : Natural/isZero 0 │ Invalid: A boolean expression is not the \n\ + \ └───────────────────────────┘ same thing as a type-level equivalence \n\ + \ \n\ + \ \n\ + \ You have to explicitly compare two expressions, even if that just means \n\ + \ comparing the expression to ❰True❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ assert : Natural/isZero 0 ≡ True │ Valid: You can assert that two boolean\n\ + \ └──────────────────────────────────┘ expressions are equivalent \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided the following type annotation for an ❰assert❱: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not an equivalence\n" + where + txt0 = insert expr + +prettyTypeMessage (IncomparableExpression expr) = ErrorMessages {..} + where + short = "Incomparable expression\n" + + hints = [] + + long = + "Explanation: You can use an ❰assert❱ to compare two terms for equivalence, like \n\ + \this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ assert : 2 + 2 ≡ 4 │ This is valid because ❰2 + 2❱ and ❰4❱ are both terms\n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot compare expressions, that are not terms, such as types. For \n\ + \example, the following equivalence is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ assert : Natural ≡ Natural │ Invalid: ❰Natural❱ is a type, not a term \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \You tried to compare the following expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a term\n" + where + txt0 = insert expr + +prettyTypeMessage (EquivalenceTypeMismatch l _L r _R) = ErrorMessages {..} + where + short = "The two sides of the equivalence have different types" + + hints = [] + + long = + "Explanation: You can use ❰≡❱ to compare two terms of the same type for \n\ + \equivalence, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ 2 + 2 ≡ 4 │ This is valid because ❰2 + 2❱ and ❰4❱ have the same type \n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot compare expressions, that have different types. For example,\n\ + \the following assertion is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ 1 ≡ True │ Invalid: ❰1❱ has type ❰Natural❱, ❰True❱ has type ❰Bool❱ \n\ + \ └──────────┘ \n\ + \ \n\ + \ \n\ + \You tried to compare the following expressions: \n\ + \ \n\ + \" <> insert l <> "\n\ + \ \n\ + \... which has type\n\ + \ \n\ + \" <> insert _L <> "\n\ + \ \n\ + \... and\n\ + \ \n\ + \" <> insert r <> "\n\ + \ \n\ + \... which has type\n\ + \ \n\ + \" <> insert _R <> "\n" + +prettyTypeMessage (NotWithARecord expr0 expr1) = ErrorMessages {..} + where + short = "❰with❱ only works on records" + + hints = [] + + long = + "Explanation: You can use ❰with❱ to update a record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────┐ \n\ + \ │ { a = 5 } with b = 10 │ This is valid because ❰{ a = 5}❱ is a record \n\ + \ └────────────────────────┘ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ λ(r : { a : Natural }) → r with b = 10 │ This is also valid because \n\ + \ └──────────────────────────────────────────┘ ❰r❱ is a record \n\ + \ \n\ + \ \n\ + \... but you cannot use ❰with❱ to update an expression that is not a record. For\n\ + \example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ 1 with b = 10 │ Invalid: ❰1❱ is not a record \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \You tried to update the following expressions: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which has type\n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not a record type\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantAnd expr0 expr1) = + buildBooleanOperator "&&" expr0 expr1 + +prettyTypeMessage (CantOr expr0 expr1) = + buildBooleanOperator "||" expr0 expr1 + +prettyTypeMessage (CantEQ expr0 expr1) = + buildBooleanOperator "==" expr0 expr1 + +prettyTypeMessage (CantNE expr0 expr1) = + buildBooleanOperator "!=" expr0 expr1 + +prettyTypeMessage (CantInterpolate expr0 expr1) = ErrorMessages {..} + where + short = "You can only interpolate ❰Text❱" + + hints = [] + + long = + "Explanation: Text interpolation only works on expressions of type ❰Text❱ \n\ + \ \n\ + \For example, these are all valid uses of string interpolation: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ \"ABC${\"DEF\"}GHI\" │ \n\ + \ └──────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ λ(x : Text) → \"ABC${x}GHI\" │ \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────┐ \n\ + \ │ λ(age : Natural) → \"Age: ${Natural/show age}\" │ \n\ + \ └───────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have thought that string interpolation automatically converts the \n\ + \ interpolated value to a ❰Text❱ representation of that value: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ λ(age : Natural) → \"Age: ${age}\" │ \n\ + \ └──────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: ❰age❱ has type ❰Natural❱ \n\ + \ \n\ + \ \n\ + \● You might have forgotten to escape a string interpolation that you wanted \n\ + \ Dhall to ignore and pass through: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ \"echo ${HOME}\" │ \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ ❰HOME❱ is not in scope and this might have meant to use ❰\\${HOME}❱\n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You interpolated this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Text❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantTextAppend expr0 expr1) = ErrorMessages {..} + where + short = "❰++❱ only works on ❰Text❱" + + hints = [] + + long = + "Explanation: The ❰++❱ operator expects two arguments that have type ❰Text❱ \n\ + \ \n\ + \For example, this is a valid use of ❰++❱: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ \"ABC\" ++ \"DEF\" │ \n\ + \ └────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have thought that ❰++❱ was the operator to combine two lists: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ [1, 2, 3] ++ [4, 5, 6] │ Not valid \n\ + \ └────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ... but the list concatenation operator is actually ❰#❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ [1, 2, 3] # [4, 5, 6] │ Valid \n\ + \ └───────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Text❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantListAppend expr0 expr1) = ErrorMessages {..} + where + short = "❰#❱ only works on ❰List❱s" + + hints = [] + + long = + "Explanation: The ❰#❱ operator expects two arguments that are both ❰List❱s \n\ + \ \n\ + \For example, this is a valid use of ❰#❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ [1, 2, 3] # [4, 5, 6] │ \n\ + \ └───────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a ❰List❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantAdd expr0 expr1) = + buildNaturalOperator "+" expr0 expr1 + +prettyTypeMessage (CantMultiply expr0 expr1) = + buildNaturalOperator "*" expr0 expr1 + +prettyTypeMessage OptionalWithTypeMismatch = ErrorMessages {..} + where + short = "❰with❱ cannot change the type of an ❰Optional❱ value" + hints = [] + long = + "Explanation: The ❰with❱ keyword cannot change the type of a value stored inside \n\ + \of a ❰Some❱ constructor \n\ + \ \n\ + \For example, this is a valid use of ❰with❱: \n\ + \ \n\ + \ \n\ + \ The old value has type ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────┐ \n\ + \ │ Some 1 with ? = 2 │ \n\ + \ └───────────────────┘ \n\ + \ ⇧ \n\ + \ ... which matches the type of the new value, which is also\n\ + \ ❰Natural❱ \n\ + \ \n\ + \ \n\ + \... but the following example is not valid: \n\ + \ \n\ + \ \n\ + \ The old value has type ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌──────────────────────┐ \n\ + \ │ Some 1 with ? = True │ \n\ + \ └──────────────────────┘ \n\ + \ ⇧ \n\ + \ ... but the new value has type ❰Bool❱, which does not \n\ + \ match \n" + +prettyTypeMessage NotALabelPath = ErrorMessages {..} + where + short = "Use a label to update a record" + hints = [] + long = + "Explanation: The ❰with❱ keyword supports updating records by naming the field(s)\n\ + \to update, but you provided a path component of ❰?❱, which only works on \n\ + \❰Optional❱ values and not records. \n\ + \ \n\ + \For example, these are valid uses of ❰with❱ to update a record: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ { x = 1 } with x = 2 │ \n\ + \ └──────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ { x = { y = 1 } } with x.y = 2 │ \n\ + \ └────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the following example is not valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ { x = 1 } with ? = 2 │ \n\ + \ └──────────────────────┘ \n\ + \ ⇧ \n\ + \ This path component is reserved for updating ❰Optional❱ \n\ + \ values and not records \n\ + \ \n\ + \Note that you can update a field named ❰?❱ if you escape the path component, \n\ + \though: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ { ? = 1 } with `?` = 2 │ \n\ + \ └────────────────────────┘ \n" + +prettyTypeMessage (NotAQuestionPath k) = ErrorMessages {..} + where + short = "Use ❰?❱ to update an ❰Optional❱ value" + hints = [] + long = + "Explanation: The ❰with❱ keyword supports updating ❰Optional❱ values using a path\n\ + \component of ❰?❱, but you provided a path component other than ❰?❱. \n\ + \ \n\ + \For example, these are valid uses of ❰with❱ to update an ❰Optional❱ value: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ Some 1 with ? = 2 │ \n\ + \ └───────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────┐ \n\ + \ │ { x = Some 1 } with x.? = 2 │ \n\ + \ └─────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the following example is not valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ Some 1 with x = True │ \n\ + \ └──────────────────────┘ \n\ + \ ⇧ \n\ + \ This path component should have been ❰?❱ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this path component: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which perhaps should have been ❰?❱. \n" + where + txt0 = insert k + +prettyTypeMessage ShowConstructorNotOnUnion = ErrorMessages {..} + where + short = "ShowConstructorNotOnUnion" + hints = [] + long = "" + +buildBooleanOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages +buildBooleanOperator operator expr0 expr1 = ErrorMessages {..} + where + short = "❰" <> txt2 <> "❱ only works on ❰Bool❱s" + + hints = [] + + long = + "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Bool❱\n\ + \ \n\ + \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ True " <> txt2 <> " False │ \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Bool❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + + txt2 = pretty operator + +buildNaturalOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages +buildNaturalOperator operator expr0 expr1 = ErrorMessages {..} + where + short = "❰" <> txt2 <> "❱ only works on ❰Natural❱s" + + hints = [] + + long = + "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Natural❱\n\ + \ \n\ + \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 3 " <> txt2 <> " 5 │ \n\ + \ └───────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have tried to use an ❰Integer❱, which is " <> _NOT <> " allowed: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ λ(x : Integer) → λ(y : Integer) → x " <> txt2 <> " y │ Not valid \n\ + \ └─────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ You can only use ❰Natural❱ numbers \n\ + \ \n\ + \ \n\ + \● You might have mistakenly used an ❰Integer❱ literal, which is " <> _NOT <> " allowed:\n\ + \ \n\ + \ \n\ + \ ┌─────────┐ \n\ + \ │ +2 " <> txt2 <> " +2 │ Not valid \n\ + \ └─────────┘ \n\ + \ \n\ + \ \n\ + \ You need to remove the leading ❰+❱ to transform them into ❰Natural❱ literals, \n\ + \ like this: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 2 " <> txt2 <> " 2 │ Valid \n\ + \ └───────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Natural❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + + txt2 = pretty operator + +-- | A structured type error that includes context +data TypeError s a = TypeError + { context :: Context (Expr s a) + , current :: Expr s a + , typeMessage :: TypeMessage s a + } + +instance (Eq a, Pretty s, Pretty a) => Show (TypeError s a) where + show = Pretty.renderString . Dhall.Pretty.layout . prettyTypeError + +instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (TypeError s a) + +instance (Eq a, Pretty s, Pretty a) => Pretty (TypeError s a) where + pretty = Pretty.unAnnotate . prettyTypeError + +prettyTypeError :: (Eq a, Pretty s, Pretty a) => TypeError s a -> Doc Ann +prettyTypeError (TypeError _ expr msg) = + ( "\n" + <> shortTypeMessage msg <> "\n" + <> source + ) + where + source = case expr of + Note s _ -> pretty s + _ -> mempty + +{-| Wrap a type error in this exception type to censor source code and + `Dhall.Syntax.Text` literals from the error message +-} +data Censored + = CensoredDetailed (DetailedTypeError Src X) + | Censored (TypeError Src X) + +instance Show Censored where + show = Pretty.renderString . Dhall.Pretty.layout . Pretty.pretty + +instance Exception Censored + +instance Pretty Censored where + pretty (CensoredDetailed (DetailedTypeError e)) = + pretty (DetailedTypeError (censorTypeError e)) + pretty (Censored e) = pretty (censorTypeError e) + +censorTypeError :: TypeError Src a -> TypeError Src a +censorTypeError (TypeError c e m) = TypeError c' e' m' + where + c' = fmap Dhall.Core.censorExpression c + + e' = Dhall.Core.censorExpression e + + m' = over messageExpressions Dhall.Core.censorExpression m + +-- | @Traversal@ that traverses every `Expr` in a `TypeMessage` +messageExpressions + :: Applicative f + => (Expr s a -> f (Expr t b)) -> TypeMessage s a -> f (TypeMessage t b) +messageExpressions f m = case m of + UnboundVariable a -> + UnboundVariable <$> pure a + InvalidInputType a -> + InvalidInputType <$> f a + InvalidOutputType a -> + InvalidOutputType <$> f a + NotAFunction a b -> + NotAFunction <$> f a <*> f b + TypeMismatch a b c d -> + TypeMismatch <$> f a <*> f b <*> f c <*> f d + AnnotMismatch a b c -> + AnnotMismatch <$> f a <*> f b <*> f c + Untyped -> + pure Untyped + MissingListType -> + pure MissingListType + MismatchedListElements a b c d -> + MismatchedListElements <$> pure a <*> f b <*> f c <*> f d + InvalidListType a -> + InvalidListType <$> f a + ListLitInvariant -> + pure ListLitInvariant + InvalidSome a b c -> + InvalidSome <$> f a <*> f b <*> f c + InvalidPredicate a b -> + InvalidPredicate <$> f a <*> f b + IfBranchMismatch a b c d -> + IfBranchMismatch <$> f a <*> f b <*> f c <*> f d + InvalidFieldType a b -> + InvalidFieldType <$> pure a <*> f b + InvalidAlternativeType a b -> + InvalidAlternativeType <$> pure a <*> f b + ListAppendMismatch a b -> + ListAppendMismatch <$> f a <*> f b + InvalidDuplicateField a b c -> + InvalidDuplicateField a <$> f b <*> f c + MustCombineARecord a b c -> + MustCombineARecord <$> pure a <*> f b <*> f c + InvalidRecordCompletion a l -> + InvalidRecordCompletion a <$> f l + CompletionSchemaMustBeARecord l r -> + CompletionSchemaMustBeARecord <$> f l <*> f r + CombineTypesRequiresRecordType a b -> + CombineTypesRequiresRecordType <$> f a <*> f b + DuplicateFieldCannotBeMerged a -> + pure (DuplicateFieldCannotBeMerged a) + FieldCollision a -> + pure (FieldCollision a) + FieldTypeCollision a -> + pure (FieldTypeCollision a) + MustMergeARecord a b -> + MustMergeARecord <$> f a <*> f b + MustMergeUnionOrOptional a b -> + MustMergeUnionOrOptional <$> f a <*> f b + MustMapARecord a b -> + MustMapARecord <$> f a <*> f b + InvalidToMapRecordKind a b -> + InvalidToMapRecordKind <$> f a <*> f b + HeterogenousRecordToMap a b c -> + HeterogenousRecordToMap <$> f a <*> f b <*> f c + InvalidToMapType a -> + InvalidToMapType <$> f a + MapTypeMismatch a b -> + MapTypeMismatch <$> f a <*> f b + MissingToMapType -> + pure MissingToMapType + UnusedHandler a -> + UnusedHandler <$> pure a + MissingHandler e a -> + MissingHandler <$> pure e <*> pure a + HandlerInputTypeMismatch a b c -> + HandlerInputTypeMismatch <$> pure a <*> f b <*> f c + DisallowedHandlerType a b c d -> + DisallowedHandlerType <$> pure a <*> f b <*> f c <*> pure d + HandlerOutputTypeMismatch a b c d -> + HandlerOutputTypeMismatch <$> pure a <*> f b <*> pure c <*> f d + MissingMergeType -> + pure MissingMergeType + HandlerNotAFunction a b -> + HandlerNotAFunction <$> pure a <*> f b + CantAccess a b c -> + CantAccess <$> pure a <*> f b <*> f c + CantProject a b c -> + CantProject <$> pure a <*> f b <*> f c + CantProjectByExpression a -> + CantProjectByExpression <$> f a + DuplicateProjectionLabel a -> + pure (DuplicateProjectionLabel a) + MissingField a b -> + MissingField <$> pure a <*> f b + MissingConstructor a b -> + MissingConstructor <$> pure a <*> f b + ProjectionTypeMismatch a b c d e -> + ProjectionTypeMismatch <$> pure a <*> f b <*> f c <*> f d <*> f e + AssertionFailed a b -> + AssertionFailed <$> f a <*> f b + NotAnEquivalence a -> + NotAnEquivalence <$> f a + IncomparableExpression a -> + IncomparableExpression <$> f a + EquivalenceTypeMismatch a b c d -> + EquivalenceTypeMismatch <$> f a <*> f b <*> f c <*> f d + NotWithARecord a b -> + NotWithARecord <$> f a <*> f b + CantAnd a b -> + CantAnd <$> f a <*> f b + CantOr a b -> + CantOr <$> f a <*> f b + CantEQ a b -> + CantEQ <$> f a <*> f b + CantNE a b -> + CantNE <$> f a <*> f b + CantInterpolate a b -> + CantInterpolate <$> f a <*> f b + CantTextAppend a b -> + CantTextAppend <$> f a <*> f b + CantListAppend a b -> + CantListAppend <$> f a <*> f b + CantAdd a b -> + CantAdd <$> f a <*> f b + CantMultiply a b -> + CantMultiply <$> f a <*> f b + OptionalWithTypeMismatch -> + pure OptionalWithTypeMismatch + NotALabelPath -> + pure NotALabelPath + NotAQuestionPath k -> + pure (NotAQuestionPath k) + ShowConstructorNotOnUnion -> + pure ShowConstructorNotOnUnion + +{-| Newtype used to wrap error messages so that they render with a more + detailed explanation of what went wrong +-} +newtype DetailedTypeError s a = DetailedTypeError (TypeError s a) + deriving (Typeable) + +instance (Eq a, Pretty s, Pretty a) => Show (DetailedTypeError s a) where + show = Pretty.renderString . Dhall.Pretty.layout . prettyDetailedTypeError + +instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (DetailedTypeError s a) + +instance (Eq a, Pretty s, Pretty a) => Pretty (DetailedTypeError s a) where + pretty = Pretty.unAnnotate . prettyDetailedTypeError + +prettyDetailedTypeError :: (Eq a, Pretty s, Pretty a) => DetailedTypeError s a -> Doc Ann +prettyDetailedTypeError (DetailedTypeError (TypeError ctx expr msg)) = + ( "\n" + <> ( if null (Dhall.Context.toList ctx) + then "" + else prettyContext ctx <> "\n\n" + ) + <> longTypeMessage msg <> "\n" + <> "────────────────────────────────────────────────────────────────────────────────\n" + <> "\n" + <> source + ) + where + prettyKV (key, val) = + Dhall.Util.snipDoc + (Dhall.Pretty.Internal.prettyLabel key <> " : " <> Dhall.Pretty.prettyExpr val) + + prettyContext = + Pretty.vsep + . map prettyKV + . reverse + . Dhall.Context.toList + + source = case expr of + Note s _ -> pretty s + _ -> mempty + +{-| This function verifies that a custom context is well-formed so that + type-checking will not loop + + Note that `typeWith` already calls `checkContext` for you on the `Context` + that you supply +-} +checkContext :: Context (Expr s X) -> Either (TypeError s X) () +checkContext context = + case Dhall.Context.match context of + Nothing -> + return () + Just (x, v, context') -> do + let shiftedV = Dhall.Core.shift (-1) (V x 0) v + let shiftedContext = fmap (Dhall.Core.shift (-1) (V x 0)) context' + _ <- typeWith shiftedContext shiftedV + return () + +toPath :: (Functor list, Foldable list) => list Text -> Text +toPath ks = + Text.intercalate "." + (Foldable.toList (fmap (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome) ks)) + +duplicateElement :: Ord a => [a] -> Maybe a +duplicateElement = go Data.Set.empty + where + go _ [] = Nothing + go found (x : xs) + | Data.Set.member x found = Just x + | otherwise = go (Data.Set.insert x found) xs diff --git a/src/Dhall/URL.hs b/src/Dhall/URL.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/URL.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.URL where + +import Data.Text (Text) + +import Dhall.Syntax (Directory (..), File (..), Scheme (..), URL (..)) + +renderComponent :: Text -> Text +renderComponent component = "/" <> component + +renderQuery :: Text -> Text +renderQuery query = "?" <> query + +renderURL :: URL -> Text +renderURL url = + schemeText + <> authority + <> pathText + <> queryText + where + URL {..} = url + + File {..} = path + + Directory {..} = directory + + schemeText = case scheme of + HTTP -> "http://" + HTTPS -> "https://" + + pathText = + foldMap renderComponent (reverse components) + <> renderComponent file + + queryText = foldMap renderQuery query diff --git a/src/Dhall/Util.hs b/src/Dhall/Util.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Util.hs @@ -0,0 +1,291 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Shared utility functions + +module Dhall.Util + ( snip + , snipDoc + , insert + , _ERROR + , _WARNING + , printWarning + , Censor(..) + , Input(..) + , Transitivity(..) + , OutputMode(..) + , Output(..) + , getExpression + , getExpressionAndHeader + , getExpressionAndHeaderFromStdinText + , Header(..) + , CheckFailed(..) + , MultipleCheckFailed(..) + , handleMultipleChecksFailed + , renderExpression + ) where + +import Control.Exception (Exception (..)) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Bifunctor (first) +import Data.Either (lefts) +import Data.Foldable (toList) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.String (IsString) +import Data.Text (Text) +import Dhall.Parser (Header (..), ParseError) +import Dhall.Pretty (Ann, CharacterSet) +import Dhall.Src (Src) +import Dhall.Syntax (Expr, Import) +import Prettyprinter (Doc, Pretty) + +import qualified Control.Exception +import qualified Data.Text +import qualified Data.Text.IO +import qualified Dhall.Parser +import qualified Dhall.Pretty +import qualified Prettyprinter as Pretty +import qualified Prettyprinter.Render.Terminal as Pretty.Terminal +import qualified Prettyprinter.Render.Text as Pretty.Text +import qualified System.Console.ANSI as ANSI +import qualified System.IO as IO + +-- | Utility function to cut out the interior of a large text block +snip :: Text -> Text +snip text + | length ls <= numberOfLinesOfContext * 2 + 1 = text + | otherwise = + if Data.Text.last text == '\n' then preview else Data.Text.init preview + where + numberOfLinesOfContext = 20 + + ls = Data.Text.lines text + + header = take numberOfLinesOfContext ls + + footer = takeEnd numberOfLinesOfContext ls + + excerpt = filter (Data.Text.any (/= ' ')) (header <> footer) + + leadingSpaces = + Data.Text.length . Data.Text.takeWhile (== ' ') + + minSpaces = minimum (map leadingSpaces excerpt) + + maxLength = maximum (map Data.Text.length excerpt) + + separator = + Data.Text.replicate minSpaces " " + <> Data.Text.replicate (maxLength - minSpaces) "=" + + preview = + Data.Text.unlines header + <> Data.Text.take 80 separator <> "\n" + <> Data.Text.unlines footer + +{-| Like `snip`, but for `Doc`s + + Note that this has to be opinionated and render ANSI color codes, but that + should be fine because we don't use this in a non-interactive context +-} +snipDoc :: Doc Ann -> Doc a +snipDoc doc = Pretty.align (Pretty.pretty (snip text)) + where + stream = Dhall.Pretty.layout doc + + ansiStream = fmap Dhall.Pretty.annToAnsiStyle stream + + text = Pretty.Terminal.renderStrict ansiStream + +takeEnd :: Int -> [a] -> [a] +takeEnd n l = go (drop n l) l + where + go (_:xs) (_:ys) = go xs ys + go _ r = r + +-- | Function to insert an aligned pretty expression +insert :: Pretty a => a -> Doc Ann +insert expression = + "↳ " <> Pretty.align (snipDoc (Pretty.pretty expression)) + +-- | Prefix used for error messages +_ERROR :: IsString string => string +_ERROR = "\ESC[1;31mError\ESC[0m" + +-- | Prefix used for error messages +_WARNING :: IsString string => string +_WARNING = "\ESC[1;33mWarning\ESC[0m" + +-- | Output a warning message on stderr. +printWarning :: (MonadIO m) => String -> m () +printWarning message = do + let warning = + "\n" + <> _WARNING + <> ": " + <> message + + liftIO $ IO.hPutStrLn IO.stderr warning + +get + :: (String -> Text -> Either ParseError a) + -> Censor + -> InputOrTextFromStdin + -> IO a +get parser censor input = do + inText <- + case input of + Input_ (InputFile file) -> Data.Text.IO.readFile file + Input_ StandardInput -> Data.Text.IO.getContents + StdinText _ text -> pure text + + let name = + case input of + Input_ (InputFile file) -> file + Input_ StandardInput -> "(input)" + StdinText inputName _ -> inputName + + let result = parser name inText + + let censoredResult = + case censor of + NoCensor -> result + Censor -> first Dhall.Parser.censor result + + throws censoredResult + +{-| Convenience utility for converting `Either`-based exceptions to `IO`-based + exceptions +-} +throws :: (Exception e, MonadIO io) => Either e a -> io a +throws (Left e) = liftIO (Control.Exception.throwIO e) +throws (Right r) = return r + +-- | Set to `Censor` if you want to censor error text that might include secrets +data Censor = NoCensor | Censor + +-- | Path to input +data Input = StandardInput | InputFile FilePath deriving (Eq) + +-- | Path to input or raw input text, necessary since we can't read STDIN twice +data InputOrTextFromStdin + = Input_ Input + | StdinText String Text + -- ^ @StdinText name text@ where name is a user-friendly name describing the + -- input expression, used in parsing error messages + +{-| Specifies whether or not an input's transitive dependencies should also be + processed. Transitive dependencies are restricted to relative file imports. +-} +data Transitivity + = NonTransitive + -- ^ Do not process transitive dependencies + | Transitive + -- ^ Process transitive dependencies in the same way + +-- | Path to output +data Output = StandardOutput | OutputFile FilePath + +{-| Some command-line subcommands can either `Write` their input or `Check` + that the input has already been modified. This type is shared between them + to record that choice. +-} +data OutputMode = Write | Check + +-- | A check failure corresponding to a single input. +-- This type is intended to be used with 'MultipleCheckFailed' for error +-- reporting. +newtype CheckFailed = CheckFailed { input :: Input } + +-- | Exception thrown when the @--check@ flag to a command-line subcommand fails +data MultipleCheckFailed = MultipleCheckFailed + { command :: Text + , modified :: Text + , inputs :: NonEmpty Input + } + +instance Exception MultipleCheckFailed + +instance Show MultipleCheckFailed where + show MultipleCheckFailed{..} = + _ERROR <> ": ❰dhall " <> command_ <> " --check❱ failed on:\n\ + \\n" <> files <> + "\n\ + \You ran ❰dhall " <> command_ <> " --check❱, but the input appears to have not\n\ + \been " <> modified_ <> " before, or was changed since the last time the input\n\ + \was " <> modified_ <> ".\n" + where + modified_ = Data.Text.unpack modified + + command_ = Data.Text.unpack command + + files = unlines . map format $ toList inputs + + format input = case input of + StandardInput -> "↳ (stdin)" + InputFile file -> "↳ " <> file + +-- | Run IO for multiple inputs, then collate all the check failures before +-- throwing if there was any failure +handleMultipleChecksFailed + :: (Foldable t, Traversable t) + => Text + -> Text + -> (a -> IO (Either CheckFailed ())) + -> t a + -> IO () +handleMultipleChecksFailed command modified f xs = post =<< mapM f xs + where + post results = + case lefts (toList results) of + [] -> pure () + cf:cfs -> Control.Exception.throwIO $ MultipleCheckFailed + { command + , modified + , inputs = fmap input (cf:|cfs) + } + +-- | Convenient utility for retrieving an expression +getExpression :: Censor -> Input -> IO (Expr Src Import) +getExpression censor = get Dhall.Parser.exprFromText censor . Input_ + +-- | Convenient utility for retrieving an expression along with its header +getExpressionAndHeader :: Censor -> Input -> IO (Header, Expr Src Import) +getExpressionAndHeader censor = + get Dhall.Parser.exprAndHeaderFromText censor . Input_ + +-- | Convenient utility for retrieving an expression along with its header from +-- | text already read from STDIN (so it's not re-read) +getExpressionAndHeaderFromStdinText + :: Censor -> String -> Text -> IO (Header, Expr Src Import) +getExpressionAndHeaderFromStdinText censor inputName = + get Dhall.Parser.exprAndHeaderFromText censor . StdinText inputName + +{-| Convenient utility to output an expression either to a file + or to stdout. +-} +renderExpression :: Pretty a => CharacterSet -> Bool -> Maybe FilePath -> Expr Src a -> IO () +renderExpression characterSet plain output expression = do + let document = Dhall.Pretty.prettyCharacterSet characterSet expression + + let stream = Dhall.Pretty.layout document + + case output of + Nothing -> do + supportsANSI <- ANSI.hSupportsANSI IO.stdout + + let ansiStream = + if supportsANSI && not plain + then fmap Dhall.Pretty.annToAnsiStyle stream + else Pretty.unAnnotateS stream + + Pretty.Terminal.renderIO IO.stdout ansiStream + + Data.Text.IO.putStrLn "" + + Just file_ -> + IO.withFile file_ IO.WriteMode $ \h -> do + Pretty.Text.renderIO h stream + + Data.Text.IO.hPutStrLn h "" diff --git a/src/Dhall/Util.hs-boot b/src/Dhall/Util.hs-boot new file mode 100644 --- /dev/null +++ b/src/Dhall/Util.hs-boot @@ -0,0 +1,5 @@ +module Dhall.Util where + +import Data.Text (Text) + +snip :: Text -> Text diff --git a/src/Dhall/Version.hs b/src/Dhall/Version.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Version.hs @@ -0,0 +1,17 @@ +{-| Utilities for getting the current version of the Haskell implementation of + Dhall +-} +module Dhall.Version ( dhallVersion + , dhallVersionString + ) where + +import qualified Data.Version as V +import qualified Paths_dhall as P + +-- | The current `V.Version` of the Haskell implementation +dhallVersion :: V.Version +dhallVersion = P.version + +-- | The current version `String` for the Haskell implementation +dhallVersionString :: String +dhallVersionString = V.showVersion dhallVersion diff --git a/tests/Dhall/Test/Dhall.hs b/tests/Dhall/Test/Dhall.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Dhall.hs @@ -0,0 +1,498 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Dhall.Test.Dhall where + +import Control.Exception (SomeException, throwIO, try) +import Data.Either.Validation (validationToEither) +import Data.Fix (Fix (..)) +import Data.Functor.Classes (Eq1 (..), Show1 (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (isJust) +import Data.Scientific (Scientific) +import Data.Sequence (Seq) +import Data.Text (Text) +import Data.Vector (Vector) +import Data.Void (Void) +import Dhall (FromDhall, ToDhall) +import Dhall.Core (Expr (..)) +import GHC.Generics (Generic, Rep) +import Numeric.Natural (Natural) +import System.Timeout (timeout) +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.Functor.Classes as Classes +import qualified Data.Text.Lazy +import qualified Dhall +import qualified Dhall.Core +import qualified Dhall.Import +import qualified Dhall.Map +import qualified Dhall.Parser + +data ExprF expr + = LitF Natural + | AddF expr expr + | MulF expr expr + deriving (Eq, Functor, Generic, FromDhall, ToDhall, Show) + +instance Eq1 ExprF where + liftEq _ (LitF aL) (LitF aR) = aL == aR + liftEq eq (AddF aL bL) (AddF aR bR) = (aL `eq` aR) && (bL `eq` bR) + liftEq eq (MulF aL bL) (MulF aR bR) = (aL `eq` aR) && (bL `eq` bR) + liftEq _ _ _ = False + +instance Show1 ExprF where + liftShowsPrec _ _ d (LitF a) = showsPrec d a + liftShowsPrec sp _ d (AddF a b) = Classes.showsBinaryWith sp sp "AddF" d a b + liftShowsPrec sp _ d (MulF a b) = Classes.showsBinaryWith sp sp "MulF" d a b + +tests :: TestTree +tests = + testGroup "Input" + [ shouldShowDetailedTypeError + , shouldHandleUnionLiteral + , shouldHaveWorkingRecursiveFromDhall + , shouldHaveWorkingGenericAuto + , shouldHandleUnionsCorrectly + , shouldTreatAConstructorStoringUnitAsEmptyAlternative + , shouldConvertDhallToHaskellCorrectly + , shouldConvertHaskellToDhallCorrectly + , shouldShowCorrectErrorForInvalidDecoderInUnion + ] + +data MyType = MyType { foo :: String , bar :: Natural } + +wrongDhallType :: Dhall.Decoder MyType +wrongDhallType = Dhall.Decoder {..} + where expected = pure $ + Dhall.Core.Record + ( Dhall.Map.fromList + [ ( "bar", Dhall.Core.makeRecordField Dhall.Core.Natural) + , ( "foo", Dhall.Core.makeRecordField Dhall.Core.Text ) + ] + ) + extract expr = Dhall.typeError expected expr + +shouldShowDetailedTypeError :: TestTree +shouldShowDetailedTypeError = testCase "detailed TypeError" $ do + inputEx :: Either SomeException MyType <- + try ( Dhall.input wrongDhallType "{ bar = 0, foo = \"foo\" }") + + let expectedMsg = + "\ESC[1;31mError\ESC[0m: Invalid Dhall.Decoder \n\ + \ \n\ + \Every Decoder must provide an extract function that does not fail with a type \n\ + \error if an expression matches the expected type. You provided a Decoder that \n\ + \disobeys this contract \n\ + \ \n\ + \The Decoder provided has the expected dhall type: \n\ + \ \n\ + \↳ { bar : Natural, foo : Text }\n\ + \ \n\ + \and it threw a type error during extraction from the well-typed expression: \n\ + \ \n\ + \↳ { bar = 0, foo = \"foo\" }\n\ + \ \n" + + let assertMsg = "The exception message did not match the expected output" + + case inputEx of + Left ex -> assertEqual assertMsg expectedMsg (show ex) + Right _ -> fail "The extraction using a wrong type succeeded" + +-- https://github.com/dhall-lang/dhall-haskell/issues/915 +shouldHandleUnionLiteral :: TestTree +shouldHandleUnionLiteral = testCase "Marshal union literals" $ do + let example :: Dhall.Decoder Bool + example = Dhall.union (Dhall.constructor "Test" Dhall.bool) + + _ <- Dhall.input example "< Test : Bool >.Test True" + + return () + +shouldTreatAConstructorStoringUnitAsEmptyAlternative :: TestTree +shouldTreatAConstructorStoringUnitAsEmptyAlternative = testCase "Handle unit constructors" $ do + let exampleType :: Dhall.Decoder () + exampleType = Dhall.union (Dhall.constructor "A" Dhall.unit) + + () <- Dhall.input exampleType "< A >.A" + + let exampleEncoder :: Dhall.Encoder () + exampleEncoder = Dhall.unionEncoder (Dhall.encodeConstructor "A") + + let a = Dhall.Core.makeFieldSelection "A" + Dhall.embed exampleEncoder () @=? Field (Union (Dhall.Map.singleton "A" Nothing)) a + +newtype RecursiveType a = RecursiveType (RecursiveType a) + deriving Generic + +instance FromDhall (RecursiveType a) + +shouldHaveWorkingRecursiveFromDhall :: TestTree +shouldHaveWorkingRecursiveFromDhall = testGroup "recursive FromDhall instance" + [ testCase "works for a recursive expression" $ do + actual <- Dhall.input Dhall.auto "./tests/recursive/expr0.dhall" + + expected @=? actual + , testCase "roundtrips (one-way)" $ do + let expr = Dhall.embed Dhall.inject expected + actual <- either throwIO pure . validationToEither . Dhall.extract Dhall.auto $ expr + + expected @=? actual + , testCase "passes a shadowing sanity check" $ do + actual <- Dhall.input Dhall.auto "./tests/recursive/expr1.dhall" + + expected @=? actual + , testCase "terminate if type is recursive (monomorphic)" $ do + actual <- timeout (1 * 1000000) $ do + !typ <- return $ Dhall.expected (Dhall.auto :: Dhall.Decoder (RecursiveType Void)) + return typ + assertBool "Does not terminate!" $ isJust actual + , testCase "terminate if type is recursive (polymorphic)" $ do + actual <- timeout (1 * 1000000) $ do + !typ <- return $ Dhall.expected (Dhall.auto :: Dhall.Decoder (RecursiveType a)) + return typ + assertBool "Does not terminate!" $ isJust actual + ] + where + expected = + Fix + (AddF + (Fix (MulF (Fix (LitF 3)) (Fix (LitF 7)))) + (Fix (AddF (Fix (LitF 1)) (Fix (LitF 2)))) + ) + +data CompilerFlavor3 = + GHC3 | GHCJS3 | Helium3 + deriving (Generic, Show, Eq) + +data CompilerFlavor2 = + GHC2 | GHCJS2 + deriving (Generic, Show, Eq) + +-- https://github.com/dhall-lang/dhall-haskell/issues/926 +shouldHaveWorkingGenericAuto :: TestTree +shouldHaveWorkingGenericAuto = testGroup "genericAuto" + [ testCase "works for a three-constructor enum" $ do + compiler <- Dhall.input Dhall.genericAuto "< GHC3 | GHCJS3 | Helium3 >.GHC3" + assertEqual "genericAuto didn't give us what we wanted" GHC3 compiler + + , testCase "works for a two-constructor enum" $ do + compiler <- Dhall.input Dhall.genericAuto "< GHC2 | GHCJS2 >.GHC2" + assertEqual "genericAuto didn't give us what we wanted" GHC2 compiler + ] + +data NonEmptyUnion = N0 Bool | N1 Natural | N2 Text + deriving (Eq, Generic, ToDhall, FromDhall, Show) + +data Enum = E0 | E1 | E2 + deriving (Eq, Generic, ToDhall, FromDhall, Show) + +data Records + = R0 {} + | R1 { a :: () } + | R2 { x :: Double } + | R3 { a :: (), b :: () } + | R4 { x :: Double, y :: Double } + deriving (Eq, Generic, ToDhall, FromDhall, Show) + +data Products = P0 | P1 () | P2 Double | P3 () () | P4 Double Double + deriving (Eq, Generic, ToDhall, FromDhall, Show) + +shouldHandleUnionsCorrectly :: TestTree +shouldHandleUnionsCorrectly = + testGroup "Handle union literals" + [ "λ(x : < N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >) → x" + `shouldPassThroughWrapped` [ N0 True, N1 5, N2 "ABC" ] + , "λ(x : < E0 | E1 | E2 >) → x" + `shouldPassThroughWrapped` [ E0, E1, E2 ] + , "λ(x : < R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >) → x" + `shouldPassThroughWrapped` [ R0 {}, R1 { a = () }, R2 { x = 1.0 }, R3 { a = (), b = () }, R4 { x = 1.0, y = 2.0 } ] + , "λ(x : < P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >) → x" + `shouldPassThroughWrapped` [ P0 , P1 (), P2 1.0, P3 () (), P4 1.0 2.0 ] + + , "λ(x : < N0 : Bool | N1 : Natural | N2 : Text >) → x" + `shouldPassThroughSmart` [ N0 True, N1 5, N2 "ABC" ] + , "λ(x : < R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >) → x" + `shouldPassThroughSmart` [ R0 {}, R1 { a = () }, R2 { x = 1.0 }, R3 { a = (), b = () }, R4 { x = 1.0, y = 2.0 } ] + , "λ(x : < P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >) → x" + `shouldPassThroughSmart` [ P0 , P1 (), P2 1.0, P3 () (), P4 1.0 2.0 ] + + , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }" + `shouldMarshalIntoWrapped` N0 True + , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }" + `shouldMarshalIntoWrapped` N1 5 + , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }" + + `shouldMarshalIntoWrapped` N2 "ABC" + + , "(< N0 : Bool | N1 : Natural | N2 : Text >).N0 True" + `shouldMarshalIntoSmart` N0 True + , "(< N0 : Bool | N1 : Natural | N2 : Text >).N1 5" + `shouldMarshalIntoSmart` N1 5 + , "(< N0 : Bool | N1 : Natural | N2 : Text >).N2 \"ABC\"" + `shouldMarshalIntoSmart` N2 "ABC" + + , "(< E0 | E1 | E2>).E0" `shouldMarshalIntoWrapped` E0 + , "(< E0 | E1 | E2>).E1" `shouldMarshalIntoWrapped` E1 + , "(< E0 | E1 | E2>).E2" `shouldMarshalIntoWrapped` E2 + + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + `shouldMarshalIntoWrapped` R0 + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + `shouldMarshalIntoWrapped` R1 { a = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0 }" + `shouldMarshalIntoWrapped` R2 { x = 1.0 } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + `shouldMarshalIntoWrapped` R3 { a = (), b = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + `shouldMarshalIntoWrapped` R4 { x = 1.0, y = 2.0 } + + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + `shouldMarshalIntoSmart` R0 + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + `shouldMarshalIntoSmart` R1 { a = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0 }" + `shouldMarshalIntoSmart` R2 { x = 1.0 } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + `shouldMarshalIntoSmart` R3 { a = (), b = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + `shouldMarshalIntoSmart` R4 { x = 1.0, y = 2.0 } + + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + `shouldMarshalIntoWrapped` P0 + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }" + `shouldMarshalIntoWrapped` P1 () + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }" + `shouldMarshalIntoWrapped` P2 1.0 + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + `shouldMarshalIntoWrapped` P3 () () + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + `shouldMarshalIntoWrapped` P4 1.0 2.0 + + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + `shouldMarshalIntoSmart` P0 + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1" + `shouldMarshalIntoSmart` P1 () + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 1.0" + `shouldMarshalIntoSmart` P2 1.0 + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + `shouldMarshalIntoSmart` P3 () () + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + `shouldMarshalIntoSmart` P4 1.0 2.0 + + , N0 True + `shouldEmbedAsWrapped` + "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }" + , N1 5 + `shouldEmbedAsWrapped` + "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }" + , N2 "ABC" + `shouldEmbedAsWrapped` + "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }" + + , N0 True + `shouldEmbedAsSmart` + "(< N0 : Bool | N1 : Natural | N2 : Text >).N0 True" + , N1 5 + `shouldEmbedAsSmart` + "(< N0 : Bool | N1 : Natural | N2 : Text >).N1 5" + , N2 "ABC" + `shouldEmbedAsSmart` + "(< N0 : Bool | N1 : Natural | N2 : Text >).N2 \"ABC\"" + + , E0 `shouldEmbedAsWrapped` "< E0 | E1 | E2 >.E0" + , E1 `shouldEmbedAsWrapped` "< E0 | E1 | E2 >.E1" + , E2 `shouldEmbedAsWrapped` "< E0 | E1 | E2 >.E2" + + , R0 `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + , R1 { a = () } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + , R2 { x = 1.0 } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0}" + , R3 { a = (), b = () } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + , R4 { x = 1.0, y = 2.0 } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + + , R0 `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + , R1 { a = () } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + , R2 { x = 1.0 } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0}" + , R3 { a = (), b = () } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + , R4 { x = 1.0, y = 2.0 } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + + , P0 `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + , P1 () `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }" + , P2 1.0 `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }" + , P3 () () `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + , P4 1.0 2.0 `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + + , P0 `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + , P1 () `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1" + , P2 1.0 `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 1.0" + , P3 () () `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + , P4 1.0 2.0 `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + ] + where + smartOptions = + Dhall.defaultInterpretOptions + { Dhall.singletonConstructors = Dhall.Smart } + + wrappedOptions = + Dhall.defaultInterpretOptions + { Dhall.singletonConstructors = Dhall.Wrapped } + + functionWithOptions + :: ( Generic a + , Dhall.GenericToDhall (Rep a) + , Generic b + , Dhall.GenericFromDhall b (Rep b) + ) + => Dhall.InterpretOptions -> Dhall.Decoder (a -> b) + functionWithOptions options = + Dhall.function (Dhall.genericToDhallWith options) (Dhall.genericAutoWith options) + + code `shouldPassThroughWrapped` values = testCase "Pass through" $ do + f <- Dhall.input (functionWithOptions wrappedOptions) code + + values @=? map f values + + code `shouldPassThroughSmart` values = testCase "Pass through" $ do + f <- Dhall.input (functionWithOptions smartOptions) code + + values @=? map f values + + code `shouldMarshalIntoWrapped` expectedValue = testCase "Marshal" $ do + actualValue <- Dhall.input (Dhall.genericAutoWith wrappedOptions) code + + expectedValue @=? actualValue + + code `shouldMarshalIntoSmart` expectedValue = testCase "Marshal" $ do + actualValue <- Dhall.input (Dhall.genericAutoWith smartOptions) code + + expectedValue @=? actualValue + + value `shouldEmbedAsWrapped` expectedCode = testCase "ToDhall" $ do + parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode) + + resolvedExpression <- Dhall.Import.assertNoImports parsedExpression + + Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.genericToDhallWith wrappedOptions) value + + value `shouldEmbedAsSmart` expectedCode = testCase "ToDhall" $ do + parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode) + + resolvedExpression <- Dhall.Import.assertNoImports parsedExpression + + Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.genericToDhallWith smartOptions) value + +shouldConvertDhallToHaskellCorrectly :: TestTree +shouldConvertDhallToHaskellCorrectly = + testGroup + "Marshall Dhall code to Haskell" + [ "True" `correspondsTo` True + , "False" `correspondsTo` False + , "2" `correspondsTo` (2 :: Natural) + , "+2" `correspondsTo` (2 :: Integer) + , "2.0" `correspondsTo` (2.0 :: Double) + , "2.0" `correspondsTo` (2.0 :: Scientific) + , "\"ABC\"" `correspondsTo` ("ABC" :: Data.Text.Text) + , "\"ABC\"" `correspondsTo` ("ABC" :: Data.Text.Lazy.Text) + , "\"ABC\"" `correspondsTo` ("ABC" :: String) + , "Some 2" `correspondsTo` (Just 2 :: Maybe Natural) + , "None Natural" `correspondsTo` (Nothing :: Maybe Natural) + , "[ 2, 3, 5 ]" `correspondsTo` ([ 2, 3, 5 ] :: Seq Natural) + , "[ 2, 3, 5 ]" `correspondsTo` ([ 2, 3, 5 ] :: [Natural]) + , "[ 2, 3, 5 ]" `correspondsTo` ([ 2, 3, 5 ] :: Vector Natural) + , "[] : List Natural" `correspondsTo` ([] :: [Natural]) + , "{=}" `correspondsTo` () + , "{ _1 = True, _2 = {=} }" `correspondsTo` (True, ()) + ] + where + correspondsTo :: (Eq a, FromDhall a, Show a) => Text -> a -> TestTree + dhallCode `correspondsTo` expectedHaskellValue = + testCase "Marshall Dhall code to Haskell" $ do + actualHaskellValue <- Dhall.input Dhall.auto dhallCode + + expectedHaskellValue @=? actualHaskellValue + +shouldConvertHaskellToDhallCorrectly :: TestTree +shouldConvertHaskellToDhallCorrectly = + testGroup + "Marshall Haskell to Dhall code" + [ "True" `correspondsTo` True + , "False" `correspondsTo` False + , "2" `correspondsTo` (2 :: Natural) + , "+2" `correspondsTo` (2 :: Integer) + , "2.0" `correspondsTo` (2.0 :: Double) + , "2.0" `correspondsTo` (2.0 :: Scientific) + , "\"ABC\"" `correspondsTo` ("ABC" :: Data.Text.Text) + , "\"ABC\"" `correspondsTo` ("ABC" :: Data.Text.Lazy.Text) + , "\"ABC\"" `correspondsTo` ("ABC" :: String) + , "Some 2" `correspondsTo` (Just 2 :: Maybe Natural) + , "None Natural" `correspondsTo` (Nothing :: Maybe Natural) + , "[ 2, 3, 5 ]" `correspondsTo` ([ 2, 3, 5 ] :: Seq Natural) + , "[ 2, 3, 5 ]" `correspondsTo` ([ 2, 3, 5 ] :: [Natural]) + , "[ 2, 3, 5 ]" `correspondsTo` ([ 2, 3, 5 ] :: Vector Natural) + , "[] : List Natural" `correspondsTo` ([] :: [Natural]) + , "{=}" `correspondsTo` () + , "{ _1 = True, _2 = {=} }" `correspondsTo` (True, ()) + ] + where + correspondsTo :: ToDhall a => Text -> a -> TestTree + expectedDhallCode `correspondsTo` haskellValue = + testCase "Marshall Haskell to Dhall code" $ do + let actualDhallCode = + Dhall.Core.pretty (Dhall.embed Dhall.inject haskellValue) + + expectedDhallCode @=? actualDhallCode + +-- https://github.com/dhall-lang/dhall-haskell/issues/1711 +data Issue1711 + = A Bad + | B + | C + | D + deriving (Generic, Show, FromDhall) + +newtype Bad = Bad Text + deriving (Show) + +issue1711Msg :: Text +issue1711Msg = "Issue 1711" + +instance FromDhall Bad where + autoWith _ = + Dhall.Decoder + (const (Dhall.extractError issue1711Msg)) + (Dhall.expected Dhall.strictText) + +type DhallExtractErrors = Dhall.ExtractErrors Dhall.Parser.Src Void + +-- https://github.com/dhall-lang/dhall-haskell/issues/1711 +shouldShowCorrectErrorForInvalidDecoderInUnion :: TestTree +shouldShowCorrectErrorForInvalidDecoderInUnion = + testCase "Correct error is thrown for invalid decoder in union" $ do + let value = "< B | D | C | A : Text >.A \"\"" + + inputEx :: Either DhallExtractErrors Issue1711 <- try (Dhall.input Dhall.auto value) + + let expectedMsg = issue1711Msg + + let assertMsg = "The exception message did not match the expected output" + + case inputEx of + Left (Dhall.DhallErrors errs) -> case errs of + (err :| []) -> case err of + Dhall.TypeMismatch {} -> fail "The extraction using an invalid decoder failed with a type mismatch" + Dhall.ExpectedTypeError _ -> fail "An error occurred while determining the expected Dhall type" + Dhall.ExtractError extractError -> assertEqual assertMsg expectedMsg extractError + _ -> fail "The extraction using an invalid decoder failed with multiple errors" + Right _ -> fail "The extraction using an invalid decoder succeeded" diff --git a/tests/Dhall/Test/Diff.hs b/tests/Dhall/Test/Diff.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Diff.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Diff where + +import Data.Text (Text) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Diff as Diff +import qualified Dhall.Parser as Parser +import qualified Dhall.Pretty +import qualified Dhall.Test.Util as Test.Util +import qualified Prettyprinter.Render.Text as Pretty.Text +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +diffDirectory :: FilePath +diffDirectory = "./tests/diff" + +getTests :: IO TestTree +getTests = do + diffTests <- Test.Util.discover (Turtle.chars <* "A.dhall") diffTest (Turtle.lstree diffDirectory) + + let testTree = Tasty.testGroup "diff tests" [ diffTests ] + + return testTree + +diffTest :: Text -> TestTree +diffTest prefix = + Tasty.HUnit.testCase (Text.unpack prefix) $ do + let leftFile = Text.unpack (prefix <> "A.dhall") + let rightFile = Text.unpack (prefix <> "B.dhall") + let diffFile = Text.unpack (prefix <> ".txt") + + let toInput file = do + text <- Text.IO.readFile file + Core.throws (Parser.exprFromText mempty text) + + leftInput <- toInput leftFile + rightInput <- toInput rightFile + + expectedDiffText <- Text.IO.readFile diffFile + + let actualDiffDocument = + Diff.doc (Diff.diffNormalized leftInput rightInput) <> "\n" + + let actualDiffText = Pretty.Text.renderStrict + (Dhall.Pretty.layout actualDiffDocument) + + let message = "The diffed expressions did not match the expected output" + + Tasty.HUnit.assertEqual message expectedDiffText actualDiffText diff --git a/tests/Dhall/Test/DirectoryTree.hs b/tests/Dhall/Test/DirectoryTree.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/DirectoryTree.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.DirectoryTree (tests) where + +import Control.Monad +import Data.Either (partitionEithers) +import Data.Either.Validation +import Dhall.DirectoryTree +import Lens.Micro (set) +import System.FilePath (()) +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.List +import qualified Data.Text.IO +import qualified Dhall +import qualified Dhall.Core +import qualified System.Directory as Directory +import qualified System.FilePath as FilePath +import qualified System.PosixCompat.Files as Files + +tests :: TestTree +tests = testGroup "to-directory-tree" + [ testGroup "fixpointed" + [ fixpointedType + , fixpointedEmpty + , fixpointedSimple + , fixpointedAllowPathSeparators +#ifndef mingw32_HOST_OS + , fixpointedPermissions + , fixpointedUserGroup +#endif + ] + ] + +fixpointedType :: TestTree +fixpointedType = testCase "Type is as expected" $ do + let file = "./tests/to-directory-tree/type.dhall" + ref <- Dhall.inputExpr file + expected' <- case directoryTreeType of + Failure e -> assertFailure $ show e + Success expr -> return expr + assertBool "Type mismatch" $ expected' `Dhall.Core.judgmentallyEqual` ref + +fixpointedEmpty :: TestTree +fixpointedEmpty = testCase "empty" $ do + let outDir = "./tests/to-directory-tree/fixpoint-empty.out" + path = "./tests/to-directory-tree/fixpoint-empty.dhall" + entries <- runDirectoryTree False outDir path + entries @?= [Directory outDir] + +fixpointedSimple :: TestTree +fixpointedSimple = testCase "simple" $ do + let outDir = "./tests/to-directory-tree/fixpoint-simple.out" + path = "./tests/to-directory-tree/fixpoint-simple.dhall" + entries <- runDirectoryTree False outDir path + entries @?= Data.List.sort + [ Directory outDir + , File $ outDir "file" + , Directory $ outDir "directory" + ] + +fixpointedAllowPathSeparators :: TestTree +fixpointedAllowPathSeparators = testCase "allow-path-separators" $ do + let outDir = "./tests/to-directory-tree/fixpoint-allow-path-separators.out" + path = "./tests/to-directory-tree/fixpoint-allow-path-separators.dhall" + entries <- runDirectoryTree True outDir path + entries @?= Data.List.sort + [ Directory outDir + , Directory $ outDir "non-existent-1" + , File $ outDir "non-existent-1" "file" + , Directory $ outDir "non-existent-2" + , Directory $ outDir "non-existent-2" "directory" + ] + +{- +This test is disabled on Windows as it fails due to limitations of the : + expected: 448 + but got: 438 +-} +fixpointedPermissions :: TestTree +fixpointedPermissions = testCase "permissions" $ do + let outDir = "./tests/to-directory-tree/fixpoint-permissions.out" + path = "./tests/to-directory-tree/fixpoint-permissions.dhall" + entries <- runDirectoryTree False outDir path + entries @?= + [ Directory outDir + , File $ outDir "file" + ] + s <- Files.getFileStatus $ outDir "file" + let mode = Files.fileMode s `Files.intersectFileModes` Files.accessModes + prettyFileMode mode @?= prettyFileMode Files.ownerModes + +fixpointedUserGroup :: TestTree +fixpointedUserGroup = testCase "user and group" $ do + let file = "./tests/to-directory-tree/fixpoint-usergroup.dhall" + expr <- Dhall.inputExpr file + entries <- decodeDirectoryTree expr + entries @?= + [ TextFileEntry $ Entry + { entryName = "ids" + , entryContent = "" + , entryUser = Just (UserId 0) + , entryGroup = Just (GroupId 0) + , entryMode = Nothing + } + , TextFileEntry $ Entry + { entryName = "names" + , entryContent = "" + , entryUser = Just (UserName "user") + , entryGroup = Just (GroupName "group") + , entryMode = Nothing + } + ] + +runDirectoryTree :: Bool -> FilePath -> FilePath -> IO [WalkEntry] +runDirectoryTree allowSeparators outDir path = do + doesOutDirExist <- Directory.doesDirectoryExist outDir + when doesOutDirExist $ + Directory.removeDirectoryRecursive outDir + Directory.createDirectoryIfMissing True outDir + + text <- Data.Text.IO.readFile path + let inputSettings + = set Dhall.rootDirectory (FilePath.takeDirectory path) + . set Dhall.sourceName path + $ Dhall.defaultInputSettings + expr <- Dhall.inputExprWithSettings inputSettings text + + toDirectoryTree allowSeparators outDir $ Dhall.Core.denote expr + + Data.List.sort <$> walkFsTree outDir + +data WalkEntry + = Directory FilePath + | File FilePath + deriving (Eq, Ord, Show) + +walkFsTree :: FilePath -> IO [WalkEntry] +walkFsTree dir = do + entries <- Directory.listDirectory dir + (ds, fs) <- fmap partitionEithers $ forM entries $ \path -> do + let path' = dir path + isDirectory <- Directory.doesDirectoryExist path' + return $ if isDirectory then Left path' else Right (File path') + entries' <- traverse walkFsTree ds + return $ Directory dir : fs <> concat entries' diff --git a/tests/Dhall/Test/Format.hs b/tests/Dhall/Test/Format.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Format.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Format where + +import Data.Text (Text) +import Dhall.Parser (Header (..)) +import Dhall.Pretty (CharacterSet (..)) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Parser as Parser +import qualified Dhall.Pretty as Pretty +import qualified Dhall.Test.Util as Test.Util +import qualified Prettyprinter as Doc +import qualified Prettyprinter.Render.Text as Doc.Render.Text +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.Silver as Tasty.Silver +import qualified Turtle + +getTests :: IO TestTree +getTests = do + let unicodeFiles = do + path <- Turtle.lstree "./tests/format" + + let skip = [ "./tests/format/asciiA.dhall" ] + + path `Test.Util.pathNotIn` skip + + return path + + unicodeTests <- Test.Util.discover (Turtle.chars <* "A.dhall") (formatTest Unicode) unicodeFiles + + asciiTests <- Test.Util.discover (Turtle.chars <* "A.dhall") (formatTest ASCII) (pure "./tests/format/asciiA.dhall") + + let testTree = + Tasty.testGroup "format tests" + [ unicodeTests + , asciiTests + ] + + return testTree + +format :: CharacterSet -> (Header, Core.Expr Parser.Src Core.Import) -> Text +format characterSet (Header header, expr) = + let doc = Doc.pretty header + <> Pretty.prettyCharacterSet characterSet expr + <> "\n" + + docStream = Pretty.layout doc + in + Doc.Render.Text.renderStrict docStream + +formatTest :: CharacterSet -> Text -> TestTree +formatTest characterSet prefix = + let inputFile = Text.unpack (prefix <> "A.dhall") + outputFile = Text.unpack (prefix <> "B.dhall") + + action = do + inputText <- Text.IO.readFile inputFile + + headerAndExpr <- Core.throws (Parser.exprAndHeaderFromText mempty inputText) + + return (format characterSet headerAndExpr) + in + Tasty.Silver.goldenVsAction (Text.unpack prefix) outputFile action id diff --git a/tests/Dhall/Test/Freeze.hs b/tests/Dhall/Test/Freeze.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Freeze.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Freeze where + +import Data.Text (Text) +import Dhall.Freeze (Intent (..), Scope (..)) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Freeze as Freeze +import qualified Dhall.Parser as Parser +import qualified Dhall.Test.Util as Test.Util +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +freezeDirectoryCached :: FilePath +freezeDirectoryCached = "./tests/freeze/cached" + +freezeDirectorySecure :: FilePath +freezeDirectorySecure = "./tests/freeze/secure" + +getTests :: IO TestTree +getTests = do + freezeCachedTests <- Test.Util.discover (Turtle.chars <* "A.dhall") + (freezeTest freezeDirectoryCached Cache) + (Turtle.lstree freezeDirectoryCached) + freezeSecureTests <- Test.Util.discover (Turtle.chars <* "A.dhall") + (freezeTest freezeDirectorySecure Secure) + (Turtle.lstree freezeDirectorySecure) + + let testTree = Tasty.testGroup "freeze tests" + [ Tasty.testGroup "cached" [freezeCachedTests] + , Tasty.testGroup "secure" [freezeSecureTests] + ] + + return testTree + +freezeTest :: FilePath -> Intent -> Text -> TestTree +freezeTest dir intent prefix = + Tasty.HUnit.testCase (Text.unpack prefix) $ do + let inputFile = Text.unpack (prefix <> "A.dhall") + let outputFile = Text.unpack (prefix <> "B.dhall") + + inputText <- Text.IO.readFile inputFile + + parsedInput <- Core.throws (Parser.exprFromText mempty inputText) + + actualExpression <- Freeze.freezeExpression dir AllImports intent parsedInput + + let actualText = Core.pretty actualExpression <> "\n" + + expectedText <- Text.IO.readFile outputFile + + let message = "The linted expression did not match the expected output" + + Tasty.HUnit.assertEqual message expectedText actualText diff --git a/tests/Dhall/Test/Import.hs b/tests/Dhall/Test/Import.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Import.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Dhall.Test.Import where + +import Control.Exception (SomeException) +import Data.Text (Text) +import Data.Void (Void) +import System.FilePath (()) +import Test.Tasty (TestTree) + +import qualified Control.Exception as Exception +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Import as Import +import qualified Dhall.Parser as Parser +import qualified Dhall.Test.Util as Test.Util +import qualified System.FilePath as FilePath +import qualified System.IO.Temp as Temp +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +#if defined(WITH_HTTP) && defined(NETWORK_TESTS) +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Client.TLS as HTTP +#endif + + +importDirectory :: FilePath +importDirectory = "./dhall-lang/tests/import" + +getTests :: IO TestTree +getTests = do + let flakyTests = + [ -- This test is flaky, occasionally failing with: + -- + -- Error: Remote host not found + -- + -- URL: https://test.dhall-lang.org/Bool/package.dhall + importDirectory "success/headerForwardingA.dhall" + , importDirectory "success/unit/RemoteAsTextA.dhall" + , importDirectory "success/unit/SimpleRemoteA.dhall" + , importDirectory "success/unit/asLocation/RemoteChain1A.dhall" + , importDirectory "success/unit/asLocation/RemoteChain2A.dhall" + , importDirectory "success/unit/asLocation/RemoteChain3A.dhall" + , importDirectory "success/unit/asLocation/RemoteChainMissingA.dhall" + + -- Skip all tests that reference httpbin.org to avoid clobbering + -- their servers. These should eventually be replaced by tests + -- that depend on an equivalent endpoint on test.dhall-lang.org + -- instead of httpbin.org. + , importDirectory "failure/customHeadersUsingBoundVariable.dhall" + , importDirectory "failure/originHeadersFromRemote.dhall" + , importDirectory "failure/originHeadersFromRemoteENV.dhall" + , importDirectory "success/customHeadersA.dhall" + , importDirectory "success/noHeaderForwardingA.dhall" + , importDirectory "success/success/originHeadersA.dhall" + , importDirectory "success/originHeadersENV.dhall" + , importDirectory "success/originHeadersImportA.dhall" + , importDirectory "success/originHeadersImportENV.dhall" + , importDirectory "success/originHeadersImportFromEnvA.dhall" + , importDirectory "success/originHeadersImportFromEnvENV.dhall" + , importDirectory "success/originHeadersOverrideA.dhall" + , importDirectory "success/originHeadersOverrideENV.dhall" + ] + + successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest (do + path <- Turtle.lstree (importDirectory "success") + + path `Test.Util.pathNotIn` flakyTests + + return path ) + + failureTests <- Test.Util.discover (Turtle.chars <* ".dhall") failureTest (do + path <- Turtle.lstree (importDirectory "failure") + + let expectedSuccesses = + [ importDirectory "failure/unit/DontRecoverCycle.dhall" + , importDirectory "failure/unit/DontRecoverTypeError.dhall" +#if !(defined(WITH_HTTP) && defined(NETWORK_TESTS)) + -- We attempt to simulate test.dhall-lang.org, but even so + -- some tests unexpectedly succeed due to the inadequacy of + -- the simulation + , importDirectory "failure/unit/cors/OnlySelf.dhall" + , importDirectory "failure/unit/cors/OnlyOther.dhall" + , importDirectory "failure/unit/cors/Null.dhall" + , importDirectory "failure/unit/cors/TwoHops.dhall" + , importDirectory "failure/unit/cors/Empty.dhall" + , importDirectory "failure/unit/cors/NoCORS.dhall" + , importDirectory "failure/originHeadersFromRemote.dhall" +#endif + ] + + path `Test.Util.pathNotIn` expectedSuccesses + "ENV.dhall" `Test.Util.pathNotSuffixOf` path + + return path ) + + let testTree = + Tasty.testGroup "import tests" + [ successTests + , failureTests + ] + + return testTree + +successTest :: Text -> TestTree +successTest prefix = do + let inputPath = Text.unpack (prefix <> "A.dhall") + + let expectedPath = Text.unpack (prefix <> "B.dhall") + + let directoryString = FilePath.takeDirectory inputPath + + let expectedFailures = + [ + -- Importing relative to the home directory works, but I'm too + -- lazy to mock the home directory for testing purposes + importDirectory "success/unit/ImportRelativeToHome" +#if !(defined(WITH_HTTP) && defined(NETWORK_TESTS)) + , importDirectory "success/originHeadersImportFromEnv" + , importDirectory "success/originHeadersImport" + , importDirectory "success/originHeadersOverride" + , importDirectory "success/unit/asLocation/RemoteChainEnv" +#endif + ] + + Test.Util.testCase prefix expectedFailures (do + + text <- Text.IO.readFile inputPath + + expectedText <- Text.IO.readFile expectedPath + + actualExpr <- Core.throws (Parser.exprFromText mempty text) + + expectedExpr <- Core.throws (Parser.exprFromText mempty expectedText) + + let originalCache = "dhall-lang/tests/import/cache" + +#if defined(WITH_HTTP) && defined(NETWORK_TESTS) + let httpManager = + HTTP.newManager + HTTP.tlsManagerSettings + { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (120 * 1000 * 1000) } + + let status = + Import.makeEmptyStatus + httpManager + (pure Import.envOriginHeaders) + directoryString +#else + let status = Import.emptyStatus directoryString +#endif + + let load = + State.evalStateT + (Test.Util.loadWith actualExpr) + status + + let usesCache = [ "hashFromCache" + , "unit/asLocation/Hash" + , "unit/IgnorePoisonedCache" + , "unit/DontCacheIfHash" + ] + + let endsIn path' = + not (null (Turtle.match (Turtle.ends path') (Test.Util.toDhallPath prefix))) + + let buildNewCache = do + tempdir <- Turtle.managed (Temp.withSystemTempDirectory "dhall-cache") + Turtle.liftIO (Turtle.cptree originalCache tempdir) + return tempdir + + let cacheSetup = + if any endsIn usesCache + then do + cacheDir <- buildNewCache + + let set = do + m <- Turtle.need "XDG_CACHE_HOME" + + Turtle.export "XDG_CACHE_HOME" (Turtle.format Turtle.fp cacheDir) + + return m + + let reset Nothing = do + Turtle.unset "XDG_CACHE_HOME" + reset (Just x) = do + Turtle.export "XDG_CACHE_HOME" x + + _ <- Turtle.managed (Exception.bracket set reset) + return () + else pure () + + let setup = cacheSetup >> Test.Util.managedTestEnvironment prefix + + let resolve = Turtle.with setup (const load) + + let handler :: SomeException -> IO (Core.Expr Parser.Src Void) + handler exception = Tasty.HUnit.assertFailure (show exception) + + actualResolved <- Exception.handle handler resolve + + expectedResolved <- Import.assertNoImports expectedExpr + + let actual = Core.normalize actualResolved :: Core.Expr Void Void + + let expected = Core.normalize expectedResolved :: Core.Expr Void Void + + let message = + "The imported expression did not match the expected output" + + Tasty.HUnit.assertEqual message expected actual) + +failureTest :: Text -> TestTree +failureTest prefix = do + let path = prefix <> ".dhall" + + let pathString = Text.unpack path + + Tasty.HUnit.testCase pathString (do + actualExpr <- do + Core.throws (Parser.exprFromText mempty (Test.Util.toDhallPath path)) + + let setup = Test.Util.managedTestEnvironment prefix + + let run = Exception.catch @SomeException + (Test.Util.load actualExpr >> return True) + (\_ -> return False) + + succeeded <- Turtle.with setup (const run) + + if succeeded + then fail "Import should have failed, but it succeeds" + else return () ) diff --git a/tests/Dhall/Test/Lint.hs b/tests/Dhall/Test/Lint.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Lint.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Lint where + +import Data.Text (Text) +import Dhall.Parser (Header (..)) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Lint as Lint +import qualified Dhall.Parser as Parser +import qualified Dhall.Pretty as Pretty +import qualified Dhall.Test.Util as Test.Util +import qualified Prettyprinter as Doc +import qualified Prettyprinter.Render.Text as Doc.Render.Text +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +lintDirectory :: FilePath +lintDirectory = "./tests/lint" + +getTests :: IO TestTree +getTests = do + lintTests <- Test.Util.discover (Turtle.chars <* "A.dhall") lintTest (Turtle.lstree lintDirectory) + + let testTree = Tasty.testGroup "lint tests" [ lintTests ] + + return testTree + +format :: Header -> Core.Expr Parser.Src Core.Import -> Text +format (Header header) expr = + let doc = Doc.pretty header + <> Pretty.prettyCharacterSet Pretty.Unicode expr + <> "\n" + + docStream = Pretty.layout doc + in + Doc.Render.Text.renderStrict docStream + +lintTest :: Text -> TestTree +lintTest prefix = + Tasty.HUnit.testCase (Text.unpack prefix) $ do + let inputFile = Text.unpack (prefix <> "A.dhall") + let outputFile = Text.unpack (prefix <> "B.dhall") + + inputText <- Text.IO.readFile inputFile + + (header, parsedInput) <- Core.throws (Parser.exprAndHeaderFromText mempty inputText) + + let actualExpression = Lint.lint parsedInput + + let actualText = format header actualExpression + + expectedText <- Text.IO.readFile outputFile + + let message = "The linted expression did not match the expected output" + + Tasty.HUnit.assertEqual message expectedText actualText diff --git a/tests/Dhall/Test/Main.hs b/tests/Dhall/Test/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Main.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP #-} +module Main where + +import System.FilePath (()) +import Test.Tasty (TestTree) + +import qualified Dhall.Test.Dhall +import qualified Dhall.Test.Diff +import qualified Dhall.Test.DirectoryTree +import qualified Dhall.Test.Format +import qualified Dhall.Test.Freeze +import qualified Dhall.Test.Import +import qualified Dhall.Test.Lint +import qualified Dhall.Test.Normalization +import qualified Dhall.Test.Package +import qualified Dhall.Test.Parser +import qualified Dhall.Test.QuickCheck +import qualified Dhall.Test.Regression +import qualified Dhall.Test.Schemas +import qualified Dhall.Test.SemanticHash +#ifndef CROSS +import qualified Dhall.Test.TH +#endif +import qualified Dhall.Test.Tags +import qualified Dhall.Test.Tutorial +import qualified Dhall.Test.TypeInference +import qualified GHC.IO.Encoding +import qualified System.Directory +import qualified System.Environment +import qualified System.IO +import qualified Test.Tasty + +getAllTests :: IO TestTree +getAllTests = do + normalizationTests <- Dhall.Test.Normalization.getTests + + parsingTests <- Dhall.Test.Parser.getTests + + formattingTests <- Dhall.Test.Format.getTests + + typeinferenceTests <- Dhall.Test.TypeInference.getTests + + importingTests <- Dhall.Test.Import.getTests + + lintTests <- Dhall.Test.Lint.getTests + + tagsTests <- Dhall.Test.Tags.getTests + + diffTests <- Dhall.Test.Diff.getTests + + semanticHashTests <- Dhall.Test.SemanticHash.getTests + + freezeTests <- Dhall.Test.Freeze.getTests + + schemaTests <- Dhall.Test.Schemas.getTests + + let testTree = + Test.Tasty.testGroup "Dhall Tests" + [ normalizationTests + , parsingTests + , importingTests + , typeinferenceTests + , formattingTests + , lintTests + , diffTests + , semanticHashTests + , tagsTests + , freezeTests + , schemaTests + , Dhall.Test.DirectoryTree.tests + , Dhall.Test.Regression.tests + , Dhall.Test.Tutorial.tests + , Dhall.Test.QuickCheck.tests + , Dhall.Test.Dhall.tests +#ifndef CROSS + , Dhall.Test.TH.tests +#endif + , Dhall.Test.Package.tests + ] + + return testTree + +main :: IO () +main = do + GHC.IO.Encoding.setLocaleEncoding System.IO.utf8 + + pwd <- System.Directory.getCurrentDirectory + + System.Environment.setEnv "XDG_CACHE_HOME" (pwd ".cache") + + System.Environment.setEnv "DHALL_TEST_VAR" "6 * 7" + + -- Make test failures easier to find by eliding the successes. + -- https://github.com/feuerbach/tasty/issues/273#issuecomment-657054281 + System.Environment.setEnv "TASTY_HIDE_SUCCESSES" "true" + + allTests <- getAllTests + + Test.Tasty.defaultMain allTests diff --git a/tests/Dhall/Test/Normalization.hs b/tests/Dhall/Test/Normalization.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Normalization.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Normalization where + +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Core (Expr (..), Var (..), throws) +import System.FilePath (()) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Context as Context +import qualified Dhall.Core as Core +import qualified Dhall.Import as Import +import qualified Dhall.Parser as Parser +import qualified Dhall.Test.Util as Test.Util +import qualified Dhall.TypeCheck as TypeCheck +import qualified System.FilePath as FilePath +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +normalizationDirectory :: FilePath +normalizationDirectory = "./dhall-lang/tests/normalization/success" + +unitDirectory :: FilePath +unitDirectory = normalizationDirectory "unit/" + +getTests :: IO TestTree +getTests = do + let pattern = Turtle.chars <* "A.dhall" + + let normalizationFiles = do + path <- FilePath.normalise <$> Turtle.lstree normalizationDirectory + + unitDirectory `Test.Util.pathNotPrefixOf` path + + return path + + betaNormalizationTests <- Test.Util.discover pattern betaNormalizationTest normalizationFiles + + alphaNormalizationTests <- + Test.Util.discover pattern alphaNormalizationTest + (Turtle.lstree "./dhall-lang/tests/alpha-normalization/success/") + + let unitTestFiles = Turtle.lstree unitDirectory + + unitTests <- Test.Util.discover pattern unitTest unitTestFiles + + let testTree = + Tasty.testGroup "normalization" + [ Tasty.testGroup "beta-normalization" + [ betaNormalizationTests + ] + , Tasty.testGroup "unit tests" + [ unitTests + ] + , Tasty.testGroup "alpha-normalization" + [ alphaNormalizationTests + ] + , customization + ] + + return testTree + +customization :: TestTree +customization = + Tasty.testGroup "customization" + [ simpleCustomization + , nestedReduction + ] + +simpleCustomization :: TestTree +simpleCustomization = Tasty.HUnit.testCase "simpleCustomization" $ do + let tyCtx = + Context.insert + "min" + (Pi mempty "_" Natural (Pi mempty "_" Natural Natural)) + Context.empty + + valCtx e = + case e of + App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalLit y) -> + pure (Just (NaturalLit (min x y))) + _ -> + pure Nothing + + e <- Test.Util.codeWith tyCtx "min (min 11 12) 8 + 1" + + Test.Util.assertNormalizesToWith valCtx e "9" + +nestedReduction :: TestTree +nestedReduction = Tasty.HUnit.testCase "doubleReduction" $ do + minType <- Context.insert "min" <$> Test.Util.code "Natural → Natural → Natural" + fiveorlessType <- Context.insert "fiveorless" <$> Test.Util.code "Natural → Natural" + wurbleType <- Context.insert "wurble" <$> Test.Util.code "Natural → Natural" + + let tyCtx = minType . fiveorlessType . wurbleType $ Context.empty + + valCtx e = + case e of + App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalLit y) -> + pure (Just (NaturalLit (min x y))) + App (Var (V "wurble" 0)) (NaturalLit x) -> + pure (Just (App (Var (V "fiveorless" 0)) (NaturalPlus (NaturalLit x) (NaturalLit 2)))) + App (Var (V "fiveorless" 0)) (NaturalLit x) -> + pure (Just (App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalPlus (NaturalLit 3) (NaturalLit 2)))) + _ -> + pure Nothing + + e <- Test.Util.codeWith tyCtx "wurble 6" + + Test.Util.assertNormalizesToWith valCtx e "5" + +alphaNormalizationTest :: Text -> TestTree +alphaNormalizationTest prefix = do + let prefixString = Text.unpack prefix + + Tasty.HUnit.testCase prefixString $ do + let actualPath = prefixString <> "A.dhall" + let expectedPath = prefixString <> "B.dhall" + + actualCode <- Text.IO.readFile actualPath + expectedCode <- Text.IO.readFile expectedPath + + actualExpr <- throws (Parser.exprFromText mempty actualCode) + + actualResolved <- Import.assertNoImports actualExpr + + let actualNormalized = Core.alphaNormalize (Core.denote actualResolved) + + expectedExpr <- throws (Parser.exprFromText mempty expectedCode) + + expectedResolved <- Import.assertNoImports expectedExpr + + let expectedNormalized = Core.denote expectedResolved :: Expr Void Void + + let message = + "The alpha-normalized expression did not match the expected output" + + Tasty.HUnit.assertEqual message expectedNormalized actualNormalized + +{- Unit tests don't type-check, so we only verify that they normalize to the + expected output +-} +unitTest :: Text -> TestTree +unitTest prefix = do + let expectedFailures = [] + + let prefixString = Text.unpack prefix + + Test.Util.testCase prefix expectedFailures $ do + let actualPath = prefixString <> "A.dhall" + let expectedPath = prefixString <> "B.dhall" + + actualCode <- Text.IO.readFile actualPath + expectedCode <- Text.IO.readFile expectedPath + + actualExpr <- throws (Parser.exprFromText mempty actualCode) + + actualResolved <- Import.assertNoImports actualExpr + + let actualNormalized = + Core.alphaNormalize + (Core.normalize actualResolved :: Expr Void Void) + + expectedExpr <- throws (Parser.exprFromText mempty expectedCode) + + expectedResolved <- Import.assertNoImports expectedExpr + + let expectedNormalized = + Core.alphaNormalize (Core.denote expectedResolved) + + let message = + "The normalized expression did not match the expected output" + + Tasty.HUnit.assertEqual message expectedNormalized actualNormalized + +betaNormalizationTest :: Text -> TestTree +betaNormalizationTest prefix = do + let prefixString = Text.unpack prefix + + Tasty.HUnit.testCase prefixString $ do + let actualCode = Test.Util.toDhallPath (prefix <> "A.dhall") + + let expectedPath = prefixString <> "B.dhall" + expectedCode <- Text.IO.readFile expectedPath + + actualExpr <- throws (Parser.exprFromText mempty actualCode) + + actualResolved <- Import.load actualExpr + + _ <- throws (TypeCheck.typeOf actualResolved) + + let actualNormalized = + Core.alphaNormalize + (Core.normalize actualResolved :: Expr Void Void) + + expectedExpr <- throws (Parser.exprFromText mempty expectedCode) + + expectedResolved <- Import.load expectedExpr + + _ <- throws (TypeCheck.typeOf expectedResolved) + + -- Use `denote` instead of `normalize` to enforce that the expected + -- expression is already in normal form + let expectedNormalized = + Core.alphaNormalize (Core.denote expectedResolved) + + let message = + "The beta-normalized expression did not match the expected output" + + Tasty.HUnit.assertEqual message expectedNormalized actualNormalized diff --git a/tests/Dhall/Test/Package.hs b/tests/Dhall/Test/Package.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Package.hs @@ -0,0 +1,270 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Package where + +import Control.Exception (Exception, displayException, finally, try) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Void (Void) +import Dhall.Core + ( Directory (..) + , Expr (..) + , File (..) + , FilePrefix (..) + , Import (..) + , ImportHashed (..) + , ImportMode (..) + , ImportType (..) + , makeRecordField + ) +import qualified Dhall.Map as Map +import Dhall.Package +import Lens.Micro (set) +import qualified System.Directory as Directory +import System.FilePath (()) +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "Package" + [ packagePackageFile + , packageCustomPackageFile + , packageSingleFile + , packageEmptyDirectory + , packageSingleDirectory + , packageNested + , packageRecursive + , packageMissingFile + , packageFilesDifferentDirs + , packageIncompatibleFiles + ] + +packagePackageFile :: TestTree +packagePackageFile = testCase "package file" $ do + let path = "./tests/package" "package.dhall" + + let package :: Expr Void Import + package = RecordLit Map.empty + + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/package.dhall" :| []) + assertEqual "path" path output + assertEqual "content" package expr + +packageCustomPackageFile :: TestTree +packageCustomPackageFile = testCase "custom package file" $ do + let path = "./tests/package" "custom.dhall" + + let package :: Expr Void Import + package = RecordLit $ + Map.singleton "package" $ makeRecordField $ Embed packageDhall + + let options :: Options + options = set packageFileName "custom.dhall" defaultOptions + + (output, expr) <- getPackagePathAndContent options ("./tests/package/package.dhall" :| []) + assertEqual "path" path output + assertEqual "content" package expr + +packageSingleFile :: TestTree +packageSingleFile = testCase "single file" $ do + let path = "./tests/package/dir" "package.dhall" + + let package :: Expr Void Import + package = RecordLit $ + Map.singleton "test" $ makeRecordField $ Embed testDhall + + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/dir/test.dhall" :| []) + assertEqual "path" path output + assertEqual "content" package expr + +packageEmptyDirectory :: TestTree +packageEmptyDirectory = testCase "empty directory" $ do + let path = "./tests/package/empty" "package.dhall" + + let package :: Expr Void Import + package = RecordLit Map.empty + + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/empty" :| []) + assertEqual "path" path output + assertEqual "content" package expr + +packageSingleDirectory :: TestTree +packageSingleDirectory = testCase "single directory" $ do + let path = "./tests/package/dir" "package.dhall" + + let package :: Expr Void Import + package = RecordLit $ Map.singleton "test" $ + makeRecordField $ Embed testDhall + + (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/dir" :| []) + assertEqual "path" path output + assertEqual "content" package expr + +packageNested :: TestTree +packageNested = testCase "nested files" $ do + let path = "./tests/package" "package.dhall" + + let package :: Expr Void Import + package = RecordLit $ Map.fromList + [ ("dir", makeRecordField $ RecordLit $ Map.fromList + [ ("test", makeRecordField $ Embed dirTestDhall) + ] + ) + , ("other", makeRecordField $ Embed otherPackageDhall) + , ("test", makeRecordField $ Embed testDhall) + ] + + (output, expr) <- getPackagePathAndContent defaultOptions + ( "./tests/package/test.dhall" :| + [ "./tests/package/dir/test.dhall" + , "./tests/package/other/package.dhall" + ]) + assertEqual "path" path output + assertEqual "content" package expr + +packageRecursive :: TestTree +packageRecursive = testCase "recursively create subpackages" $ removePackagesAfter $ do + let path = "./tests/package/dir" "package.dhall" + + let package :: Expr Void Import + package = RecordLit $ Map.fromList + [ ("subdirectory1", makeRecordField $ Embed subdirectoryPackageDhall1) + , ("subdirectory2", makeRecordField $ Embed subdirectoryPackageDhall2) + , ("test", makeRecordField $ Embed testDhall) + ] + + let options :: Options + options = set packagingMode RecursiveSubpackages defaultOptions + + (output, expr) <- getPackagePathAndContent options + ( "./tests/package/dir" :| [] ) + assertEqual "path" path output + assertEqual "content" package expr + where + removePackagesAfter :: IO a -> IO a + removePackagesAfter action = action `finally` do + Directory.removePathForcibly "./tests/package/dir/subdirectory1/package.dhall" + Directory.removePathForcibly "./tests/package/dir/subdirectory2/package.dhall" + +packageMissingFile :: TestTree +packageMissingFile = testCase "missing file" $ do + let action :: IO (FilePath, Expr Void Import) + action = getPackagePathAndContent defaultOptions ("./tests/package/missing.dhall" :| []) + + assertThrow action $ \case + InvalidPath "./tests/package/missing.dhall" -> True + _ -> False + +packageFilesDifferentDirs :: TestTree +packageFilesDifferentDirs = testCase "files from different directories" $ do + let action :: IO (FilePath, Expr Void Import) + action = getPackagePathAndContent defaultOptions + ( "./tests/package/dir/test.dhall" :| + [ "./tests/package/test/test.dhall" + ]) + + assertThrow action $ \case + AmbiguousOutputDirectory "./tests/package/dir" "./tests/package/test" -> True + _ -> False + +packageIncompatibleFiles :: TestTree +packageIncompatibleFiles = testCase "files that are incompatible" $ do + let action :: IO (FilePath, Expr Void Import) + action = getPackagePathAndContent defaultOptions + ( "./tests/package/test.dhall" :| + [ "./tests/package/test/test.dhall" + ]) + + assertThrow action $ \case + IncompatiblePaths xs -> xs == [ testDhall , testTestDhall ] + _ -> False + +packageDhall :: Import +packageDhall = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here File + { directory = Directory [] + , file = "package.dhall" + } + } + , importMode = Code + } + +testDhall :: Import +testDhall = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here File + { directory = Directory [] + , file = "test.dhall" + } + } + , importMode = Code + } + +dirTestDhall :: Import +dirTestDhall = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here $ File + { directory = Directory {components = ["dir"]} + , file = "test.dhall" + } + } + , importMode = Code + } + +otherPackageDhall :: Import +otherPackageDhall = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here $ File + { directory = Directory {components = ["other"]} + , file = "package.dhall" + } + } + , importMode = Code + } + +subdirectoryPackageDhall1 :: Import +subdirectoryPackageDhall1 = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here $ File + { directory = Directory {components = ["subdirectory1"]} + , file = "package.dhall"} + } + , importMode = Code + } + +subdirectoryPackageDhall2 :: Import +subdirectoryPackageDhall2 = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here $ File + { directory = Directory {components = ["subdirectory2"]} + , file = "package.dhall"} + } + , importMode = Code + } + +testTestDhall :: Import +testTestDhall = Import + { importHashed = ImportHashed + { hash = Nothing + , importType = Local Here (File + { directory = Directory {components = ["test"]} + , file = "test.dhall" + }) + } + , importMode = Code + } + +assertThrow :: (Exception e, Show a) => IO a -> (e -> Bool) -> IO () +assertThrow k p = do + result <- try k + case result of + Left e | p e -> return () + Left e -> assertFailure $ "Predicate did not match: " <> displayException e + Right result' -> assertFailure $ "Expected exception, but got: " <> show result' diff --git a/tests/Dhall/Test/Parser.hs b/tests/Dhall/Test/Parser.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Parser.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Parser where + +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Core (Binding (..), Expr (..), Import, Var (..)) +import System.FilePath (()) +import Test.Tasty (TestTree) + +import qualified Control.Monad as Monad +import qualified Data.Bifunctor as Bifunctor +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as ByteString.Lazy +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text.Encoding +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Binary as Binary +import qualified Dhall.Core as Core +import qualified Dhall.Parser as Parser +import qualified Dhall.Test.Util as Test.Util +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Text.Printf as Printf +import qualified Turtle + +parseDirectory :: FilePath +parseDirectory = "./dhall-lang/tests/parser" + +binaryDecodeDirectory :: FilePath +binaryDecodeDirectory = "./dhall-lang/tests/binary-decode" + +getTests :: IO TestTree +getTests = do + let successFiles = Turtle.lstree (parseDirectory "success") + + successTests <- + Test.Util.discover (Turtle.chars <* "A.dhall") shouldParse successFiles + + let failureFiles = Turtle.lstree (parseDirectory "failure") + + failureTests <- + Test.Util.discover (Turtle.chars <> ".dhall") shouldNotParse failureFiles + + let binaryDecodeSuccessFiles = + Turtle.lstree (binaryDecodeDirectory "success") + + binaryDecodeSuccessTests <- + Test.Util.discover (Turtle.chars <* "A.dhallb") shouldDecode binaryDecodeSuccessFiles + + let binaryDecodeFailureFiles = Turtle.lstree (binaryDecodeDirectory "failure") + + binaryDecodeFailureTests <- + Test.Util.discover (Turtle.chars <* ".dhallb") shouldNotDecode binaryDecodeFailureFiles + + let testTree = + Tasty.testGroup "parser tests" + [ successTests + , failureTests + , internalTests + , binaryDecodeSuccessTests + , binaryDecodeFailureTests + ] + + return testTree + +internalTests :: TestTree +internalTests = + Tasty.testGroup "internal" + [ notesInLetInLet ] + +notesInLetInLet :: TestTree +notesInLetInLet = + Tasty.HUnit.testCase "Notes in let-in-let" $ do + let code = "let x = 0 let y = 1 in let z = 2 in x" + + expression <- Core.throws (Parser.exprFromText mempty code) + + let simplifyNotes = Bifunctor.first Parser.srcText + + let expected = + (Note code + (Let + (Binding + (Just " ") + "x" + (Just " ") + Nothing + (Just " ") + (Note "0 " (Note "0" (NaturalLit 0))) + ) + -- This 'Let' isn't wrapped in a 'Note'! + (Let + (Binding + (Just " ") + "y" + (Just " ") + Nothing + (Just " ") + (Note "1 " (Note "1" (NaturalLit 1))) + ) + (Note "let z = 2 in x" + (Let + (Binding + (Just " ") + "z" + (Just " ") + Nothing + (Just " ") + (Note "2 " (Note "2" (NaturalLit 2))) + ) + (Note "x" (Var (V "x" 0))) + ) + ) + ) + ) + ) + + let msg = "Unexpected parse result" + + Tasty.HUnit.assertEqual msg expected (simplifyNotes expression) + +shouldParse :: Text -> TestTree +shouldParse path = do + let expectedFailures = [] + + let pathString = Text.unpack path + + Test.Util.testCase path expectedFailures $ do + text <- Text.IO.readFile (pathString <> "A.dhall") + + encoded <- ByteString.Lazy.readFile (pathString <> "B.dhallb") + + expression <- case Parser.exprFromText mempty text of + Left exception -> Tasty.HUnit.assertFailure (show exception) + Right expression -> return expression + + let bytes = Binary.encodeExpression (Core.denote expression) + + let render = + concatMap (Printf.printf "%02x ") + . ByteString.Lazy.unpack + + Monad.unless (encoded == bytes) $ do + let message = "The expected CBOR representation doesn't match the actual one\n" + ++ "expected: " ++ render encoded ++ "\n but got: " ++ render bytes + ++ "\n expr: " ++ show (Core.denote expression :: Expr Void Import) + + Tasty.HUnit.assertFailure message + + +shouldNotParse :: Text -> TestTree +shouldNotParse path = do + let expectedFailures = + [ parseDirectory "failure/spacing/LetNoSpace4.dhall" + ] + + let pathString = Text.unpack path + + Test.Util.testCase path expectedFailures (do + bytes <- ByteString.readFile pathString + + case Text.Encoding.decodeUtf8' bytes of + Left _ -> return () + Right text -> + case Parser.exprFromText mempty text of + Left _ -> return () + Right _ -> Tasty.HUnit.assertFailure "Unexpected successful parse" ) + +shouldDecode :: Text -> TestTree +shouldDecode pathText = do + let expectedFailures = + [ {- Note that this test actually successfully decodes the value, but + mistakenly decodes the value to `_` instead of `x`. This is + because the 55799 tag causes normal decoding to fail, so it falls + back to treating the `"x"` as a version tag instead of a label. + + Either way, fixing 55799 decoding would cause this test to pass + again. + -} + binaryDecodeDirectory "success/unit/SelfDescribeCBORX2" + , binaryDecodeDirectory "success/unit/SelfDescribeCBORX3" + ] + + let pathString = Text.unpack pathText + + Test.Util.testCase pathText expectedFailures (do + bytes <- ByteString.Lazy.readFile (pathString <> "A.dhallb") + + decodedExpression <- case Binary.decodeExpression bytes of + Left exception -> + Tasty.HUnit.assertFailure (show exception) + Right decodedExpression -> + return decodedExpression + + text <- Text.IO.readFile (pathString <> "B.dhall") + + parsedExpression <- Core.throws (Parser.exprFromText mempty text) + + let strippedExpression :: Expr Void Import + strippedExpression = Core.denote parsedExpression + + let message = + "The decoded expression didn't match the parsed expression" + + Tasty.HUnit.assertEqual message strippedExpression decodedExpression ) + +shouldNotDecode :: Text -> TestTree +shouldNotDecode pathText = do + let expectedFailures = [] + + let pathString = Text.unpack pathText + + Test.Util.testCase pathText expectedFailures (do + bytes <- ByteString.Lazy.readFile (pathString <> ".dhallb") + + case Binary.decodeExpression bytes :: Either Binary.DecodingFailure (Expr Void Import) of + Left _ -> return () + Right _ -> Tasty.HUnit.assertFailure "Unexpected successful decode" ) diff --git a/tests/Dhall/Test/QuickCheck.hs b/tests/Dhall/Test/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/QuickCheck.hs @@ -0,0 +1,802 @@ +-- TODO: update because we added ShowConstructor constructor to Expr in Dhall.Syntax + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- Build without optimizations to prevent out-of-memory situations in Hydra CI +{-# OPTIONS_GHC -O0 #-} + +module Dhall.Test.QuickCheck where + +import Data.Either (isRight) +import Data.Either.Validation (Validation (..)) +import Data.Text (Text) +import Data.Void (Void) +import Dhall + ( FromDhall (..) + , ToDhall (..) + , Vector + , auto + , embed + , extract + , inject + ) +import Dhall.Core + ( Binding (..) + , Chunks (..) + , Const (..) + , DhallDouble (..) + , Directory (..) + , Expr (..) + , FieldSelection (..) + , File (..) + , FilePrefix (..) + , FunctionBinding (..) + , Import (..) + , ImportHashed (..) + , ImportMode (..) + , ImportType (..) + , PreferAnnotation (..) + , RecordField (..) + , Scheme (..) + , URL (..) + , Var (..) + , WithComponent (..) + ) +import Dhall.Map (Map) + +import Data.Functor.Identity (Identity (..)) +import Data.Proxy (Proxy (..)) +import Data.Typeable (Typeable, typeRep) +import Dhall.Parser (Header (..), createHeader) +import Dhall.Pretty (CharacterSet (..)) +import Dhall.Set (Set) +import Dhall.Src (Src (..)) +import Dhall.Test.Format (format) +import Dhall.TypeCheck (TypeError, Typer) +import Generic.Random (ConstrGen (..), W, Weights, (%), (:+) (..)) +import Test.QuickCheck + ( Arbitrary (..) + , Gen + , NonNegative (..) + , Positive (..) + , Property + , genericShrink + , suchThat + , (===) + , (==>) + ) +import Test.QuickCheck.Instances () +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (QuickCheckTests (..)) +import Text.Megaparsec (Pos, SourcePos (..)) + +import qualified Control.Spoon +import qualified Data.Char +import qualified Data.Foldable as Foldable +import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashSet +import qualified Data.List +import qualified Data.Map +import qualified Data.Sequence +import qualified Data.Set +import qualified Data.SpecialValues +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified Dhall.Binary +import qualified Dhall.Context +import qualified Dhall.Core +import qualified Dhall.Diff +import qualified Dhall.Map +import qualified Dhall.Parser as Parser +import qualified Dhall.Set +import qualified Dhall.TypeCheck +import qualified Generic.Random +import qualified Lens.Micro as Lens +import qualified Numeric.Natural as Nat +import qualified Test.QuickCheck +import qualified Test.Tasty +import qualified Test.Tasty.QuickCheck +import qualified Text.Megaparsec as Megaparsec + +instance (Arbitrary a, Ord a) => Arbitrary (Set a) where + arbitrary = Dhall.Set.fromList <$> arbitrary + shrink = map Dhall.Set.fromList . shrink . Dhall.Set.toList + +lift0 :: a -> Gen a +lift0 = pure + +lift1 :: Arbitrary a => (a -> b) -> Gen b +lift1 f = f <$> arbitrary + +lift2 :: (Arbitrary a, Arbitrary b) => (a -> b -> c) -> Gen c +lift2 f = f <$> arbitrary <*> arbitrary + +lift3 :: (Arbitrary a, Arbitrary b, Arbitrary c) => (a -> b -> c -> d) -> Gen d +lift3 f = f <$> arbitrary <*> arbitrary <*> arbitrary + +lift4 + :: (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) + => (a -> b -> c -> d -> e) -> Gen e +lift4 f = f <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +lift5 + :: ( Arbitrary a + , Arbitrary b + , Arbitrary c + , Arbitrary d + , Arbitrary e + ) + => (a -> b -> c -> d -> e -> f) -> Gen f +lift5 f = + f <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +lift6 + :: ( Arbitrary a + , Arbitrary b + , Arbitrary c + , Arbitrary d + , Arbitrary e + , Arbitrary f + ) + => (a -> b -> c -> d -> e -> f -> g) -> Gen g +lift6 f = + f <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +integer :: (Arbitrary a, Num a) => Gen a +integer = + Test.QuickCheck.frequency + [ (7, arbitrary) + , (1, fmap (\x -> x + (2 ^ (64 :: Int))) arbitrary) + , (1, fmap (\x -> x - (2 ^ (64 :: Int))) arbitrary) + ] + +whitespace :: Gen Text +whitespace = do + let commentChar = + Test.QuickCheck.frequency + [ (20, Test.QuickCheck.elements [' ' .. '\DEL']) + , ( 1, arbitrary) + ] + + noInteriorBlockComments text = + not (Text.isInfixOf "{-" text || Text.isInfixOf "-}" text) + + commentText = + suchThat + (Text.pack <$> Test.QuickCheck.listOf commentChar) + noInteriorBlockComments + + multiline = do + txt <- commentText + pure $ "{-" <> txt <> "-}" + + singleline = do + txt <- commentText `suchThat` (not . Text.isInfixOf "\n") + endOfLine <- Test.QuickCheck.elements ["\n", "\r\n"] + pure $ "--" <> txt <> endOfLine + + newlines = Text.concat <$> Test.QuickCheck.listOf (pure "\n") + + comments <- do + n <- Test.QuickCheck.choose (0, 2) + Test.QuickCheck.vectorOf n $ Test.QuickCheck.oneof + [ multiline + , singleline + , newlines + ] + + pure $ Text.unlines comments + +shrinkWhitespace :: Text -> [Text] +shrinkWhitespace "" = [] +shrinkWhitespace _ = [""] + +instance Arbitrary CharacterSet where + arbitrary = Test.QuickCheck.elements [ ASCII, Unicode ] + +instance Arbitrary Header where + arbitrary = createHeader <$> whitespace + + shrink (Header text) = Header <$> shrinkWhitespace text + +instance (Arbitrary v) => Arbitrary (Map Text v) where + arbitrary = do + n <- Test.QuickCheck.choose (0, 2) + kvs <- Test.QuickCheck.vectorOf n ((,) <$> label <*> arbitrary) + -- Sorting the fields here because serialization needs them in order + return (Dhall.Map.fromList (Data.List.sortOn fst kvs)) + + shrink = + map Dhall.Map.fromList + . shrink + . Dhall.Map.toList + +instance (Arbitrary s, Arbitrary a) => Arbitrary (Binding s a) where + arbitrary = do + bindingSrc0 <- arbitrary + + variable <- Test.QuickCheck.oneof [ pure "_", label ] + + bindingSrc1 <- arbitrary + + annotation <- arbitrary + + bindingSrc2 <- arbitrary + + value <- arbitrary + + return Binding{..} + + shrink = genericShrink + +instance (Arbitrary s, Arbitrary a) => Arbitrary (Chunks s a) where + arbitrary = do + n <- Test.QuickCheck.choose (0, 2) + Chunks <$> Test.QuickCheck.vectorOf n arbitrary <*> arbitrary + + shrink = genericShrink + +instance Arbitrary Const where + arbitrary = Test.QuickCheck.oneof [ pure Type, pure Kind, pure Sort ] + + shrink = genericShrink + +instance Arbitrary DhallDouble where + arbitrary = fmap DhallDouble (Test.QuickCheck.oneof [ arbitrary, special ]) + where + special = Test.QuickCheck.elements Data.SpecialValues.specialValues + + shrink = genericShrink + +instance Arbitrary Directory where + arbitrary = lift1 Directory + + shrink = genericShrink + +instance Arbitrary PreferAnnotation where + arbitrary = Test.QuickCheck.oneof + [ pure PreferFromSource + , pure PreferFromCompletion + ] + + shrink = genericShrink + +instance (Arbitrary s, Arbitrary a) => Arbitrary (RecordField s a) where + arbitrary = lift4 RecordField + + shrink = genericShrink + +instance (Arbitrary s, Arbitrary a) => Arbitrary (FunctionBinding s a) where + arbitrary = do + l <- label + type_ <- arbitrary + return $ FunctionBinding Nothing l Nothing Nothing type_ + + shrink = genericShrink + +instance Arbitrary s => Arbitrary (FieldSelection s) where + arbitrary = FieldSelection <$> pure Nothing <*> label <*> pure Nothing + shrink = genericShrink + +instance Arbitrary WithComponent where + arbitrary = + Test.QuickCheck.oneof [ pure WithQuestion, WithLabel <$> arbitrary ] + +instance (Arbitrary s, Arbitrary a) => Arbitrary (Expr s a) where + arbitrary = + Test.QuickCheck.suchThat + (Generic.Random.withBaseCase + (Generic.Random.genericArbitraryRecG customGens weights) + (Var <$> arbitrary) + ) + standardizedExpression + where + customGens + :: ConstrGen "Lam" 1 (FunctionBinding s a) + :+ ConstrGen "Pi" 1 Text + :+ ConstrGen "Field" 1 (FieldSelection s) + :+ ConstrGen "Project" 1 (Either [Text] (Expr s a)) + :+ Gen Integer -- Generates all Integer fields in Expr + :+ Gen Text -- Generates all Text fields in Expr + :+ () + customGens = + ConstrGen arbitrary + :+ ConstrGen label + :+ ConstrGen arbitrary + :+ ConstrGen projection + :+ integer + -- 'Lam's and 'Pi's are encoded differently when the binding is + -- the special string "_", so we generate some of these strings + -- to improve test coverage for these code paths. + :+ Test.QuickCheck.oneof [pure "_", arbitrary] + :+ () + + projection = + Test.QuickCheck.oneof + [ fmap Left (Test.QuickCheck.listOf label) + , arbitrary + ] + + -- These weights determine the frequency of constructors in the generated + -- Expr. + -- They will fail to compile if the constructors don't appear in the order + -- in which they are defined in 'Expr'! + weights :: Weights (Expr s a) + weights = + (7 :: W "Const") + % (7 :: W "Var") + % (7 :: W "Lam") + % (7 :: W "Pi") + % (7 :: W "App") + % (7 :: W "Let") + % (1 :: W "Annot") + % (1 :: W "Bool") + % (7 :: W "BoolLit") + % (1 :: W "BoolAnd") + % (1 :: W "BoolOr") + % (1 :: W "BoolEQ") + % (1 :: W "BoolNE") + % (1 :: W "BoolIf") + % (1 :: W "Bytes") + % (1 :: W "BytesLit") + % (1 :: W "Natural") + % (7 :: W "NaturalLit") + % (1 :: W "NaturalFold") + % (1 :: W "NaturalBuild") + % (1 :: W "NaturalIsZero") + % (1 :: W "NaturalEven") + % (1 :: W "NaturalOdd") + % (1 :: W "NaturalToInteger") + % (1 :: W "NaturalShow") + % (1 :: W "NaturalSubtract") + % (1 :: W "NaturalPlus") + % (1 :: W "NaturalTimes") + % (1 :: W "Integer") + % (7 :: W "IntegerLit") + % (1 :: W "IntegerClamp") + % (1 :: W "IntegerNegate") + % (1 :: W "IntegerShow") + % (1 :: W "IntegerToDouble") + % (1 :: W "Double") + % (7 :: W "DoubleLit") + % (1 :: W "DoubleShow") + % (1 :: W "Text") + % (1 :: W "TextLit") + % (1 :: W "TextAppend") + % (1 :: W "TextReplace") + % (1 :: W "TextShow") + % (1 :: W "Date") + % (1 :: W "DateLiteral") + % (1 :: W "DateShow") + % (1 :: W "Time") + % (1 :: W "TimeLiteral") + % (1 :: W "TimeShow") + % (1 :: W "TimeZone") + % (1 :: W "TimeZoneLiteral") + % (1 :: W "TimeZoneShow") + % (1 :: W "List") + % (1 :: W "ListLit") + % (1 :: W "ListAppend") + % (1 :: W "ListBuild") + % (1 :: W "ListFold") + % (1 :: W "ListLength") + % (1 :: W "ListHead") + % (1 :: W "ListLast") + % (1 :: W "ListIndexed") + % (1 :: W "ListReverse") + % (1 :: W "Optional") + % (7 :: W "Some") + % (1 :: W "None") + % (1 :: W "Record") + % (7 :: W "RecordLit") + % (1 :: W "Union") + % (7 :: W "Combine") + % (1 :: W "CombineTypes") + % (7 :: W "Prefer") + % (7 :: W "RecordCompletion") + % (1 :: W "Merge") + % (1 :: W "ToMap") + % (1 :: W "ShowConstructor") + % (7 :: W "Field") + % (7 :: W "Project") + % (1 :: W "Assert") + % (1 :: W "Equivalent") + % (1 :: W "With") + % (0 :: W "Note") + % (7 :: W "ImportAlt") + % (7 :: W "Embed") + % () + + shrink expression = filter standardizedExpression (genericShrink expression) + +standardizedExpression :: Expr s a -> Bool +standardizedExpression (ListLit Nothing xs) = + not (Data.Sequence.null xs) +standardizedExpression (ListLit (Just _ ) xs) = + Data.Sequence.null xs +standardizedExpression (Note _ _) = + False +standardizedExpression (Combine _ (Just _) _ _) = + False +standardizedExpression With{} = + False +standardizedExpression (Prefer _ PreferFromCompletion _ _) = + False +-- The following three expressions are valid ASTs, but they can never be parsed, +-- because the annotation will associate with `Merge`/`ListLit`/`ToMap` with +-- higher precedence +standardizedExpression (Annot (Merge _ _ Nothing) _) = + False +standardizedExpression (Annot (ListLit Nothing _) _) = + False +standardizedExpression (Annot (ToMap _ Nothing) _) = + False +standardizedExpression (TimeZoneLiteral (Time.TimeZone _ b t)) = + not b && null t +standardizedExpression (TimeLiteral (Time.TimeOfDay _ _ ss) precision) = + isInteger (ss * magnitude) + where + magnitude = 10 ^ precision + + isInteger x = x == fromInteger (round x) +standardizedExpression _ = + True + +chooseCharacter :: (Char, Char) -> Gen Char +chooseCharacter = Test.QuickCheck.chooseEnum + +instance Arbitrary File where + arbitrary = lift2 File + + shrink = genericShrink + +instance Arbitrary FilePrefix where + arbitrary = Test.QuickCheck.oneof [ pure Absolute, pure Here, pure Home ] + + shrink = genericShrink + +instance Arbitrary Src where + arbitrary = do + lift2 Src <*> whitespace + + shrink (Src start end text) = + (Src <$> shrink start <*> pure end <*> pure text) + ++ (Src <$> pure start <*> shrink end <*> pure text) + ++ (Src <$> pure start <*> pure end <*> shrinkWhitespace text) + +instance Arbitrary SourcePos where + arbitrary = lift3 SourcePos + + shrink = genericShrink + +instance Arbitrary Pos where + arbitrary = lift1 (Megaparsec.mkPos . getPositive) + +instance Arbitrary ImportType where + arbitrary = + Test.QuickCheck.oneof + [ do prefix <- arbitrary + + let nonEmptyText = + fmap Text.pack (Test.QuickCheck.listOf1 arbitrary) + + components <- Test.QuickCheck.listOf nonEmptyText + + file <- nonEmptyText + + let directory = Directory{ components } + + let path = File{ file, directory } + + return (Local prefix path) + , lift1 Remote + , lift1 Env + , lift0 Missing + ] + + shrink = genericShrink + +instance Arbitrary ImportHashed where + arbitrary = + lift1 (ImportHashed Nothing) + + shrink (ImportHashed { importType = oldImportType, .. }) = do + newImportType <- shrink oldImportType + let importHashed = ImportHashed { importType = newImportType, .. } + return importHashed + +-- The standard does not yet specify how to encode `as Text`, so don't test it +-- yet +instance Arbitrary ImportMode where + arbitrary = Test.QuickCheck.elements [ Code, RawText, Location, RawBytes ] + + shrink = genericShrink + +instance Arbitrary Import where + arbitrary = lift2 Import + + shrink = genericShrink + +instance Arbitrary Scheme where + arbitrary = Test.QuickCheck.oneof [ pure HTTP, pure HTTPS ] + + shrink = genericShrink + +instance Arbitrary URL where + arbitrary = do + scheme <- arbitrary + + -- TODO: the authority generator could be more precise, but it currently + -- seems good enough. + let validAuthorityChar = + arbitrary `suchThat` \ch -> + not (Data.Char.isSpace ch) && not (Data.Char.isPunctuation ch) + + authority <- Text.pack <$> Test.QuickCheck.listOf validAuthorityChar + + let validPChar = + Test.QuickCheck.frequency + [ (26, chooseCharacter ('A', 'Z')) + , (26, chooseCharacter ('a', 'z')) + , (10, chooseCharacter ('0', '9')) + , (17, Test.QuickCheck.elements "-._~!$&'*+;=:@") + ] + + let component = fmap Text.pack (Test.QuickCheck.listOf validPChar) + + components <- Test.QuickCheck.listOf component + + file <- component + + let directory = Directory{ components } + + let path = File{ file, directory } + + let validQueryCharacters = + Test.QuickCheck.frequency + [ (79, validPChar) + , ( 2, Test.QuickCheck.elements "/?") + ] + + query <- Test.QuickCheck.oneof + [ pure Nothing + , fmap (Just . Text.pack) (Test.QuickCheck.listOf validQueryCharacters) + ] + + headers <- arbitrary + + return URL{..} + + shrink _ = [] + +instance Arbitrary Var where + arbitrary = + Test.QuickCheck.oneof + [ fmap (V "_") (getNonNegative <$> arbitrary) + , fmap (\t -> V t 0) label + , V <$> label <*> (getNonNegative <$> arbitrary) + ] + shrink = genericShrink + +label :: Gen Text +label = fmap Text.pack (Test.QuickCheck.listOf labelCharacter) + where + labelCharacter = + Test.QuickCheck.frequency + [ (64, chooseCharacter ('\x20', '\x5F')) + , (30, chooseCharacter ('\x61', '\x7e')) + ] + +binaryRoundtrip :: Expr () Import -> Property +binaryRoundtrip expression = + Dhall.Binary.decodeExpression (Dhall.Binary.encodeExpression denotedExpression) + === Right denotedExpression + where + denotedExpression :: Expr Void Import + denotedExpression = denote' expression + + denote' :: Expr a Import -> Expr b Import + denote' = Dhall.Core.denote . fmap denoteHttpHeaders + + denoteHttpHeaders import_@(Import importHashed _) + | Remote url <- importType importHashed + = let headers' = denote' <$> headers url + importType' = Remote url { headers = headers' } + importHashed' = importHashed { importType = importType' } + in import_ {importHashed = importHashed'} + | otherwise = import_ + +everythingWellTypedNormalizes :: Expr () () -> Property +everythingWellTypedNormalizes expression = + isRight (Dhall.TypeCheck.typeWithA filterOutEmbeds Dhall.Context.empty expression) + ==> Test.QuickCheck.total (Dhall.Core.normalize expression :: Expr () ()) + where + filterOutEmbeds :: Typer a + filterOutEmbeds _ = Const Sort -- This could be any ill-typed expression. + +isNormalizedIsConsistentWithNormalize :: Expr () Import -> Property +isNormalizedIsConsistentWithNormalize expression = + case maybeProp of + Nothing -> Test.QuickCheck.discard + Just v -> v + where + denotedExpression :: Expr Void Import + denotedExpression = Dhall.Core.denote expression + + maybeProp = do + nf <- Control.Spoon.spoon (Dhall.Core.normalize expression) + isNormalized <- Control.Spoon.spoon (Dhall.Core.isNormalized expression) + -- Dhall.Core.isNormalized ignores 'Note's and other annotations. + -- So we do the same when checking the result of 'normalize'. + return $ isNormalized === (nf == denotedExpression) + +normalizeWithMIsConsistentWithNormalize :: Expr () Import -> Property +normalizeWithMIsConsistentWithNormalize expression = + case Control.Spoon.spoon (nfM, nf) of + Just (a, b) -> a === b + Nothing -> Test.QuickCheck.discard + where nfM = runIdentity (Dhall.Core.normalizeWithM (\_ -> Identity Nothing) expression) + nf = Dhall.Core.normalize expression :: Expr () Import + +isSameAsSelf :: Expr () Import -> Property +isSameAsSelf expression = + hasNoImportAndTypechecks ==> Dhall.Diff.same (Dhall.Diff.diff denoted denoted) + where denoted = Dhall.Core.denote expression + hasNoImportAndTypechecks = + case traverse (\_ -> Left ()) expression of + Right importlessExpression -> isRight (Dhall.TypeCheck.typeOf importlessExpression) + Left _ -> False + +inferredTypesAreNormalized :: Expr () Import -> Property +inferredTypesAreNormalized expression = + Test.Tasty.QuickCheck.counterexample report (all Dhall.Core.isNormalized result) + where + report = "Got: " ++ show result + ++ "\nExpected: " ++ show (fmap Dhall.Core.normalize result + :: Either (TypeError () Import) (Expr () Import)) + + result = Dhall.TypeCheck.typeWithA filterOutEmbeds Dhall.Context.empty expression + + filterOutEmbeds :: Typer a + filterOutEmbeds _ = Const Sort -- This could be any ill-typed expression. + +normalizingAnExpressionDoesntChangeItsInferredType :: Expr () Import -> Property +normalizingAnExpressionDoesntChangeItsInferredType expression = + case (eT0, eT1) of + (Right t0, Right t1) -> t0 === t1 + _ -> Test.QuickCheck.discard + where + eT0 = typeCheck expression + eT1 = typeCheck (Dhall.Core.normalize expression) + + typeCheck = Dhall.TypeCheck.typeWithA filterOutEmbeds Dhall.Context.empty + + filterOutEmbeds :: Typer a + filterOutEmbeds _ = Const Sort -- This could be any ill-typed expression. + +noDoubleNotes :: Expr () Import -> Property +noDoubleNotes expression = + length + [ () + | e <- Foldable.toList parsedExpression + , Note _ (Note _ _) <- Lens.toListOf Dhall.Core.subExpressions e + ] === 0 + where + text = Dhall.Core.pretty expression + + parsedExpression = Parser.exprFromText "" text + +embedThenExtractIsIdentity + :: forall a. (ToDhall a, FromDhall a, Eq a, Typeable a, Arbitrary a, Show a) + => Proxy a + -> (String, Property, TestTree -> TestTree) +embedThenExtractIsIdentity p = + ( "Embedding then extracting is identity for " ++ show (typeRep p) + , Test.QuickCheck.property (prop :: a -> Bool) + , adjustQuickCheckTests 1000 + ) + where + prop a = case extract auto (embed inject a) of + Success a' -> a == a' + Failure _ -> False + +idempotenceTest :: CharacterSet -> Header -> Expr Src Import -> Property +idempotenceTest characterSet header expr = + not (any hasHttpHeaders expr) + ==> let once = format characterSet (header, expr) + in case Parser.exprAndHeaderFromText mempty once of + Right (format characterSet -> twice) -> once === twice + Left _ -> Test.QuickCheck.discard + where + -- Workaround for https://github.com/dhall-lang/dhall-haskell/issues/1925. + hasHttpHeaders = \case + Import (ImportHashed _ (Remote (URL { headers = Just _ }))) _ -> True + _ -> False + +tests :: TestTree +tests = + testProperties' + "QuickCheck" + [ ( "Binary serialization should round-trip" + , Test.QuickCheck.property binaryRoundtrip + , adjustQuickCheckTests 100 + ) + , ( "everything well-typed should normalize" + , Test.QuickCheck.property everythingWellTypedNormalizes + , adjustQuickCheckTests 100000 + ) + , ( "isNormalized should be consistent with normalize" + , Test.QuickCheck.property isNormalizedIsConsistentWithNormalize + , adjustQuickCheckTests 10000 + ) + , ( "normalizeWithM should be consistent with normalize" + , Test.QuickCheck.property normalizeWithMIsConsistentWithNormalize + , adjustQuickCheckTests 10000 + ) + , ( "An expression should have no difference with itself" + , Test.QuickCheck.property isSameAsSelf + , adjustQuickCheckTests 10000 + ) + , ( "Inferred types should be normalized" + , Test.QuickCheck.property inferredTypesAreNormalized + , adjustQuickCheckTests 10000 + ) + , ( "Normalizing an expression doesn't change its inferred type" + , Test.QuickCheck.property normalizingAnExpressionDoesntChangeItsInferredType + , adjustQuickCheckTests 10000 + ) + , ( "Parsing an expression doesn't generated doubly-nested Note constructors" + , Test.QuickCheck.property noDoubleNotes + , adjustQuickCheckTests 100 + ) + , embedThenExtractIsIdentity (Proxy :: Proxy (Text)) + , embedThenExtractIsIdentity (Proxy :: Proxy [Nat.Natural]) + , embedThenExtractIsIdentity (Proxy :: Proxy (Bool, Double)) + , embedThenExtractIsIdentity (Proxy :: Proxy (Data.Sequence.Seq ())) + , embedThenExtractIsIdentity (Proxy :: Proxy (Maybe Integer)) + , embedThenExtractIsIdentity (Proxy :: Proxy (Data.Set.Set Nat.Natural)) + , embedThenExtractIsIdentity (Proxy :: Proxy (Data.HashSet.HashSet Text)) + , embedThenExtractIsIdentity (Proxy :: Proxy (Vector Double)) + , embedThenExtractIsIdentity (Proxy :: Proxy (Data.Map.Map Double Bool)) + , embedThenExtractIsIdentity (Proxy :: Proxy (HashMap.HashMap Double Bool)) + , ( "Formatting should be idempotent" + , Test.QuickCheck.property idempotenceTest + , adjustQuickCheckTests 10000 + ) + ] + +adjustQuickCheckMaxRatio :: Int -> TestTree -> TestTree +adjustQuickCheckMaxRatio maxSize = + Test.Tasty.adjustOption (max $ Test.Tasty.QuickCheck.QuickCheckMaxRatio maxSize) + +adjustQuickCheckTests :: Int -> TestTree -> TestTree +adjustQuickCheckTests nTests = + -- Using adjustOption instead of withMaxSuccess allows us to override the number of tests + -- with the --quickcheck-tests CLI option. + Test.Tasty.adjustOption (max $ QuickCheckTests nTests) + +testProperties' :: String -> [(String, Property, TestTree -> TestTree)] -> TestTree +testProperties' name = Test.Tasty.testGroup name . map f + where + f (n, p, adjust) = adjust (Test.Tasty.QuickCheck.testProperty n p) diff --git a/tests/Dhall/Test/Regression.hs b/tests/Dhall/Test/Regression.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Regression.hs @@ -0,0 +1,327 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Regression where + +import Data.Either.Validation (Validation (..)) +import Data.Void (Void) +import Dhall.Core (Expr (..), ReifiedNormalizer (..)) +import Dhall.Import (Imported, MissingImports (..)) +import Dhall.Parser (SourcedException (..), Src) +import Dhall.TypeCheck (TypeError) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit ((@?=)) + +import qualified Control.Exception +import qualified Data.Text.IO +import qualified Data.Text.Lazy.IO +import qualified Dhall +import qualified Dhall.Context as Context +import qualified Dhall.Core +import qualified Dhall.Map +import qualified Dhall.Parser +import qualified Dhall.Pretty +import qualified Dhall.Test.Util as Util +import qualified Dhall.TypeCheck +import qualified Lens.Micro as Lens +import qualified Prettyprinter +import qualified Prettyprinter.Render.Text +import qualified System.Timeout +import qualified Test.Tasty +import qualified Test.Tasty.HUnit + +tests :: TestTree +tests = + Test.Tasty.testGroup "regression tests" + [ issue96 + , issue126 + , issue151 + , issue164 + , issue201 + , issue216 + , issue253 + , issue1131a + , issue1131b + , issue1341 + , issue1584 + , issue1646 + , issue1732 + , issue1884 + , issue2088 + , issue2463 + , parsing0 + , typeChecking0 + , typeChecking1 + , typeChecking2 + , unnamedFields + , trailingSpaceAfterStringLiterals + ] + +data Foo = Foo Integer Bool | Bar Bool Bool Bool | Baz Integer Integer + deriving (Show, Dhall.Generic, Dhall.FromDhall, Dhall.ToDhall) + +unnamedFields :: TestTree +unnamedFields = Test.Tasty.HUnit.testCase "Unnamed Fields" (do + let ty = Dhall.auto :: Dhall.Decoder Foo + Test.Tasty.HUnit.assertEqual "Good type" (Dhall.expected ty) + (Success (Dhall.Core.Union + (Dhall.Map.fromList + [ ("Foo",Just (Dhall.Core.Record (Dhall.Map.fromList + [ ("_1", Dhall.Core.makeRecordField Dhall.Core.Integer) + , ("_2", Dhall.Core.makeRecordField Dhall.Core.Bool) + ]))) + , ("Bar",Just (Dhall.Core.Record (Dhall.Map.fromList + [ ("_1", Dhall.Core.makeRecordField Dhall.Core.Bool) + , ("_2", Dhall.Core.makeRecordField Dhall.Core.Bool) + , ("_3", Dhall.Core.makeRecordField Dhall.Core.Bool) + ]))) + , ("Baz",Just (Dhall.Core.Record (Dhall.Map.fromList + [ ("_1", Dhall.Core.makeRecordField Dhall.Core.Integer) + , ("_2", Dhall.Core.makeRecordField Dhall.Core.Integer) + ]))) + ] + ) + )) + + let inj = Dhall.inject :: Dhall.Encoder Foo + Test.Tasty.HUnit.assertEqual "Good ToDhall" (Success $ Dhall.declared inj) (Dhall.expected ty) + + let tu_ty = Dhall.auto :: Dhall.Decoder (Integer, Bool) + Test.Tasty.HUnit.assertEqual "Auto Tuple" (Dhall.expected tu_ty) (Success $ Dhall.Core.Record ( + Dhall.Map.fromList + [ ("_1", Dhall.Core.makeRecordField Dhall.Core.Integer) + , ("_2", Dhall.Core.makeRecordField Dhall.Core.Bool) + ])) + + let tu_in = Dhall.inject :: Dhall.Encoder (Integer, Bool) + Test.Tasty.HUnit.assertEqual "Inj. Tuple" (Success $ Dhall.declared tu_in) (Dhall.expected tu_ty) + + return () ) + +issue96 :: TestTree +issue96 = Test.Tasty.HUnit.testCase "Issue #96" (do + -- Verify that parsing should not fail + _ <- Util.code "\"bar'baz\"" + return () ) + +issue126 :: TestTree +issue126 = Test.Tasty.HUnit.testCase "Issue #126" (do + e <- Util.code "''\nfoo\nbar\n''" + Util.normalize' e @?= "''\nfoo\nbar\n''" ) + +issue151 :: TestTree +issue151 = Test.Tasty.HUnit.testCase "Issue #151" (do + let shouldNotTypeCheck text = do + let handler :: SourcedException MissingImports -> IO Bool + handler (SourcedException _ (MissingImports [e])) = + case Control.Exception.fromException e :: Maybe (Imported (TypeError Src Void)) of + Just _ -> return True + Nothing -> return False + handler _ = + return True + + let typeCheck = do + _ <- Util.code text + return False + b <- Control.Exception.handle handler typeCheck + Test.Tasty.HUnit.assertBool "The expression should not type-check" b + + -- These two examples contain the following expression that loops infinitely + -- if you normalize the expression before type-checking the expression: + -- + -- (λ(x : A) → x x) (λ(x : A) → x x) + -- + -- There was a bug in the Dhall type-checker were expressions were not + -- being type-checked before being added to the context (which is a + -- violation of the standard type-checking rules for a pure type system). + -- The reason this is problematic is that several places in the + -- type-checking logic assume that the context is safe to normalize. + -- + -- Both of these examples exercise area of the type-checker logic that + -- assume that the context is normalized. If you fail to type-check terms + -- before adding them to the context then this test will "fail" with an + -- infinite loop. This test "succeeds" if the examples terminate + -- immediately with a type-checking failure. + shouldNotTypeCheck "./tests/regression/issue151a.dhall" + shouldNotTypeCheck "./tests/regression/issue151b.dhall" ) + +issue164 :: TestTree +issue164 = Test.Tasty.HUnit.testCase "Issue #164" (do + -- Verify that parsing should not fail on a single-quote within a + -- single-quoted string + _ <- Util.code "./tests/regression/issue164.dhall" + return () ) + +issue201 :: TestTree +issue201 = Test.Tasty.HUnit.testCase "Issue #201" (do + -- Verify that type synonyms work + _ <- Util.code "./tests/regression/issue201.dhall" + return () ) + +issue216 :: TestTree +issue216 = Test.Tasty.HUnit.testCase "Issue #216" (do + -- Verify that pretty-printing preserves string interpolation + source <- Data.Text.IO.readFile "./tests/regression/issue216b.dhall" + e <- Util.code source + let doc = Prettyprinter.pretty e + let docStream = Dhall.Pretty.layout doc + let text0 = Prettyprinter.Render.Text.renderLazy docStream + + text1 <- Data.Text.Lazy.IO.readFile "./tests/regression/issue216b.dhall" + + Test.Tasty.HUnit.assertEqual "Pretty-printing should preserve string interpolation" text1 text0 ) + +issue253 :: TestTree +issue253 = Test.Tasty.HUnit.testCase "Issue #253" (do + -- Verify that type-checking rejects ill-formed custom contexts + let context = Context.insert "x" "x" Context.empty + let result = Dhall.TypeCheck.typeWith context "x" + + -- If the context is not validated correctly then type-checking will + -- infinitely loop + Just _ <- System.Timeout.timeout 1000000 (Control.Exception.evaluate $! result) + return () ) + +issue1131a :: TestTree +issue1131a = Test.Tasty.HUnit.testCase "Issue #1131 a" + (Util.assertDoesntTypeCheck "toMap {=} : <>.x") + +issue1131b :: TestTree +issue1131b = Test.Tasty.HUnit.testCase "Issue #1131 b" + (Util.assertDoesntTypeCheck "toMap {=} : List {mapKey : Text, mapValue : 0}") + +issue1341 :: TestTree +issue1341 = Test.Tasty.HUnit.testCase "Issue #1341" (do + let nan = Dhall.Core.DoubleLit (Dhall.Core.DhallDouble (0/0)) :: Dhall.Core.Expr () () + let actual = Dhall.Core.V "x" 0 `Dhall.Core.freeIn` nan + let msg = "NaN shouldn't contain any free variables" + Test.Tasty.HUnit.assertEqual msg False actual) + +issue1584 :: TestTree +issue1584 = Test.Tasty.HUnit.testCase "Issue #1584" (do + -- This test ensures that we can parse variables with keyword prefixes + -- (e.g. `ifX`) + _ <- Util.code "./tests/regression/issue1584.dhall" + return () ) + +issue1646 :: TestTree +issue1646 = Test.Tasty.HUnit.testCase "Issue #1646" (do + -- This test ensures that the parser doesn't eagerly consume trailing + -- whitespace after a `Double` + _ <- Util.code "./tests/regression/issue1646.dhall" + return () ) + +issue1732 :: TestTree +issue1732 = Test.Tasty.HUnit.testCase "Issue #1732" (do + -- This test ensures that the parser allows whitespace after a record pun + -- entry + _ <- Util.code "./tests/regression/issue1732.dhall" + return () ) + +issue1884 :: TestTree +issue1884 = Test.Tasty.HUnit.testCase "Issue #1884" (do + -- This test ensures that the parser allows a parenthesized application + -- expression as the first argument to a with expression + _ <- Util.code "./tests/regression/issue1884.dhall" + return () ) + +issue2088 :: TestTree +issue2088 = Test.Tasty.HUnit.testCase "Issue #2088" (do + -- This test ensures that the parser for projection by labels doesn't + -- accidentally swallow trailing commas OUTSIDE of the projection + _ <- Util.code "./tests/regression/issue2088.dhall" + return () ) + +issue2463 :: TestTree +issue2463 = Test.Tasty.HUnit.testCase "Issue #2463" (do + let startingContext = Context.insert "foo" Integer Context.empty + + let normalizer (Var "foo") = Just (IntegerLit 0) + normalizer _ = Nothing + + let inputSettings = transform Dhall.defaultInputSettings + where + transform = + Lens.set Dhall.normalizer + (Just (ReifiedNormalizer (pure . normalizer))) + . Lens.set Dhall.startingContext startingContext + + x <- Dhall.inputWithSettings inputSettings Dhall.auto "foo" + + Test.Tasty.HUnit.assertEqual "" (0 :: Integer) x ) + +parsing0 :: TestTree +parsing0 = Test.Tasty.HUnit.testCase "Parsing regression #0" ( + -- Verify that parsing should not fail + -- + -- In 267093f8cddf1c2f909f2d997c31fd0a7cb2440a I broke the parser when left + -- factoring the grammar by failing to handle the source tested by this + -- regression test. The root of the problem was that the parser was trying + -- to parse `List ./Node` as `Field List "/Node"` instead of + -- `App List (Embed (Path (File Homeless "./Node") Code))`. The latter is + -- the correct parse because `/Node` is not a valid field label, but the + -- mistaken parser was committed to the incorrect parse and never attempted + -- the correct parse. + case Dhall.Parser.exprFromText mempty "List ./Node" of + Left e -> Control.Exception.throwIO e + Right _ -> return () ) + +typeChecking0 :: TestTree +typeChecking0 = Test.Tasty.HUnit.testCase "Type-checking regression #0" (do + -- There used to be a bug in the type-checking logic where `T` would be + -- added to the context when inferring the type of `λ(x : T) → x`, but was + -- missing from the context when inferring the kind of the inferred type + -- (i.e. the kind of `∀(x : T) → T`). This led to an unbound variable + -- error when inferring the kind + -- + -- This bug was originally reported in issue #10 + _ <- Util.code "let Day : Type = Natural in λ(x : Day) → x" + return () ) + +typeChecking1 :: TestTree +typeChecking1 = Test.Tasty.HUnit.testCase "Type-checking regression #1" (do + -- There used to be a bug in the type-checking logic when inferring the + -- type of `let`. Specifically, given an expression of the form: + -- + -- let x : t = e1 in e2 + -- + -- ... the type-checker would not substitute `x` for `e1` in the inferred + -- of the `let` expression. This meant that if the inferred type contained + -- any references to `x` then these references would escape their scope and + -- result in unbound variable exceptions + -- + -- This regression test exercises that code path by creating a `let` + -- expression where the inferred type before substitution (`∀(x : b) → b` in + -- this example), contains a reference to the `let`-bound variable (`b`) + -- that needs to be substituted with `a` in order to produce the final + -- correct inferred type (`∀(x : a) → a`). If this test passes then + -- substitution worked correctly. If substitution doesn't occur then you + -- expect an `Unbound variable` error from `b` escaping its scope due to + -- being returned as part of the inferred type + _ <- Util.code "λ(a : Type) → let b : Type = a in λ(x : b) → x" + return () ) + +typeChecking2 :: TestTree +typeChecking2 = Test.Tasty.HUnit.testCase "Type-checking regression #2" (do + -- There used to be a bug in the type-checking logic where `let` bound + -- variables would not correctly shadow variables of the same name when + -- inferring the type of of the `let` expression + -- + -- This example exercises this code path with a `let` expression where the + -- `let`-bound variable (`a`) has the same name as its own type (`a`). If + -- shadowing works correctly then the final `a` in the expression should + -- refer to the `let`-bound variable and not its type. An invalid reference + -- to the shadowed type `a` would result in an invalid dependently typed + -- function + _ <- Util.code "λ(a : Type) → λ(x : a) → let a : a = x in a" + return () ) + +trailingSpaceAfterStringLiterals :: TestTree +trailingSpaceAfterStringLiterals = + Test.Tasty.HUnit.testCase "Trailing space after string literals" (do + -- Verify that string literals parse correctly with trailing space + -- (Yes, I did get this wrong at some point) + _ <- Util.code "(''\nABC'' ++ \"DEF\" )" + return () ) diff --git a/tests/Dhall/Test/Schemas.hs b/tests/Dhall/Test/Schemas.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Schemas.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Schemas where + +import Data.Text (Text) +import Dhall.Parser (Header (..)) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Parser as Parser +import qualified Dhall.Pretty as Pretty +import qualified Dhall.Schemas as Schemas +import qualified Dhall.Test.Util as Test.Util +import qualified Prettyprinter as Doc +import qualified Prettyprinter.Render.Text as Doc.Render.Text +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +schemasDirectory :: FilePath +schemasDirectory = "./tests/schemas" + +getTests :: IO TestTree +getTests = do + schemasTests <- Test.Util.discover (Turtle.chars <* "A.dhall") schemaTest (Turtle.lstree schemasDirectory) + + return (Tasty.testGroup "schemas tests" [ schemasTests ]) + +format :: Header -> Core.Expr Parser.Src Core.Import -> Text +format (Header header) expr = + let doc = Doc.pretty header + <> Pretty.prettyCharacterSet Pretty.Unicode expr + <> "\n" + + docStream = Pretty.layout doc + in + Doc.Render.Text.renderStrict docStream + +schemaTest :: Text -> TestTree +schemaTest prefix = + Tasty.HUnit.testCase (Text.unpack prefix) $ do + let inputFile = Text.unpack (prefix <> "A.dhall") + let outputFile = Text.unpack (prefix <> "B.dhall") + + inputText <- Text.IO.readFile inputFile + + (header, parsedInput) <- Core.throws (Parser.exprAndHeaderFromText mempty inputText) + + parsedSchema <- Core.throws (Parser.exprFromText mempty (Test.Util.toDhallPath (prefix <> "Schema.dhall"))) + + actualExpression <- Schemas.rewriteWithSchemas parsedSchema parsedInput + + let actualText = format header actualExpression + + expectedText <- Text.IO.readFile outputFile + + let message = "The rewritten expression did not match the expected output" + + Tasty.HUnit.assertEqual message expectedText actualText diff --git a/tests/Dhall/Test/SemanticHash.hs b/tests/Dhall/Test/SemanticHash.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/SemanticHash.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.SemanticHash where + +import Data.Text (Text) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Import as Import +import qualified Dhall.Parser as Parser +import qualified Dhall.Test.Util as Test.Util +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +hashDirectory :: FilePath +hashDirectory = "./dhall-lang/tests/semantic-hash" + +getTests :: IO TestTree +getTests = do + hashTests <- Test.Util.discover (Turtle.chars <* "A.dhall") hashTest (Turtle.lstree hashDirectory) + + return (Tasty.testGroup "semantic-hash tests" [ hashTests ]) + +hashTest :: Text -> TestTree +hashTest prefix = + Tasty.HUnit.testCase (Text.unpack prefix) $ do + let codeFile = Test.Util.toDhallPath (prefix <> "A.dhall") + let hashFile = Test.Util.toDhallPath (prefix <> "B.hash") + + expr <- Core.throws (Parser.exprFromText mempty codeFile) + + resolved <- Import.load expr + + let normalized = Core.alphaNormalize (Core.normalize resolved) + + let actualHash = Import.hashExpressionToCode normalized + + expectedHash <- Text.stripEnd <$> Text.IO.readFile (Text.unpack hashFile) + + let message = "The hash did not match the expected hash." + + Tasty.HUnit.assertEqual message expectedHash actualHash diff --git a/tests/Dhall/Test/Substitution.hs b/tests/Dhall/Test/Substitution.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Substitution.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Substitution where + +import Control.Exception (throwIO) +import Data.Void (Void) +import Dhall.Core (Expr (BoolLit, Var)) +import Dhall.Src (Src) + +import qualified Data.Either.Validation +import qualified Dhall +import qualified Dhall.Map +import qualified Lens.Micro as Lens + +data Result = Failure Integer | Success String + deriving (Eq, Dhall.Generic, Show) + +instance Dhall.FromDhall Result + +substituteResult :: FilePath -> IO Result +substituteResult fp = do + rt <- resultType + let evaluateSettings = Lens.over Dhall.substitutions (Dhall.Map.insert "Result" rt) Dhall.defaultEvaluateSettings + Dhall.inputFileWithSettings evaluateSettings resultDecoder fp + +resultDecoder :: Dhall.Decoder Result +resultDecoder = Dhall.auto + +resultType :: IO (Expr Src Void) +resultType = case Dhall.expected resultDecoder of + Data.Either.Validation.Failure e -> throwIO e + Data.Either.Validation.Success x -> return x + +substituteFoo :: FilePath -> IO Bool +substituteFoo fp = let + evaluateSettings = Lens.set Dhall.substitutions (Dhall.Map.fromList [("Foo", Var "Bar"), ("Bar", BoolLit True)]) Dhall.defaultEvaluateSettings + in Dhall.inputFileWithSettings evaluateSettings Dhall.auto fp diff --git a/tests/Dhall/Test/TH.hs b/tests/Dhall/Test/TH.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/TH.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} + +module Dhall.Test.TH where + +import Control.Exception (throwIO) +import Data.Either.Validation (Validation (..)) +import Data.Time (TimeOfDay (..), TimeZone (..), fromGregorian) +import Dhall.TH (HaskellType (..)) +import Test.Tasty (TestTree) + +import qualified Data.Text +import qualified Dhall +import qualified Dhall.TH +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit + +Dhall.TH.makeHaskellTypeFromUnion "T" "./tests/th/example.dhall" + +deriving instance Eq T +deriving instance Show T + +Dhall.TH.makeHaskellTypes + [ MultipleConstructors "Department" "./tests/th/Department.dhall" + , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall" + , SingleConstructor "TimeExample" "TimeExample" "./tests/th/Time.dhall" + ] + +deriving instance Eq Department +deriving instance Show Department + +deriving instance Eq Employee +deriving instance Show Employee + +deriving instance Eq TimeExample +deriving instance Show TimeExample + +Dhall.TH.makeHaskellTypes + [ SingleConstructor "Bar" "MakeBar" "(./tests/th/issue2066.dhall).Bar" + , SingleConstructor "Foo" "MakeFoo" "(./tests/th/issue2066.dhall).Foo" + , MultipleConstructors "Qux" "(./tests/th/issue2066.dhall).Qux" + ] + +deriving instance Eq Bar +deriving instance Show Bar + +deriving instance Eq Foo +deriving instance Show Foo + +deriving instance Eq Qux +deriving instance Show Qux + +tests :: TestTree +tests = Tasty.testGroup "Template Haskell" [ makeHaskellTypeFromUnion ] + +makeHaskellTypeFromUnion :: TestTree +makeHaskellTypeFromUnion = Tasty.HUnit.testCase "makeHaskellTypeFromUnion" $ do + t0 <- Dhall.input Dhall.auto "let T = ./tests/th/example.dhall in T.A { x = True, y = [ \"ABC\" ] }" + + Tasty.HUnit.assertEqual "" t0 A{ x = True, y = [ "ABC" ] } + + t1 <- Dhall.input Dhall.auto "let T = ./tests/th/example.dhall in T.B (Some [ 1 ])" + + Tasty.HUnit.assertEqual "" t1 (B (Just [ 1 ])) + + t2 <- Dhall.input Dhall.auto "let T = ./tests/th/example.dhall in T.C" + + Tasty.HUnit.assertEqual "" t2 C + + employee <- Dhall.input Dhall.auto "let Department = ./tests/th/Department.dhall in { name = \"John\", department = Department.Marketing }" + + Tasty.HUnit.assertEqual "" employee MakeEmployee{ name = "John", department = Marketing } + + qux <- Dhall.input Dhall.auto "let T = ./tests/th/issue2066.dhall in T.Qux.Foo { foo = +2, bar = { baz = +3 } }" + + Tasty.HUnit.assertEqual "" qux (Foo MakeFoo{ foo = 2, bar = MakeBar{ baz = 3 } }) + + timex <- Dhall.input Dhall.auto "let T = ./tests/th/Time.dhall in { txTime = 21:12:00, txDate = 1976-04-01, txTimeZone = +05:00 } : T" + + Tasty.HUnit.assertEqual "" timex TimeExample { txTime = tod, txDate = day, txTimeZone = tz} + + where + tod = TimeOfDay { todHour = 21, todMin = 12, todSec = 0 } + day = fromGregorian 1976 4 1 + tz = TimeZone { timeZoneMinutes = 300, timeZoneSummerOnly = False, timeZoneName = "" } + + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("My" <>) + , Dhall.TH.fieldModifier = ("my" <>) . Data.Text.toTitle + }) + [ MultipleConstructors "MyT" "./tests/th/example.dhall" + , MultipleConstructors "MyDepartment" "./tests/th/Department.dhall" + , SingleConstructor "MyEmployee" "Employee" "./tests/th/Employee.dhall" + ] + + +deriving instance Eq MyT +deriving instance Eq MyDepartment +deriving instance Eq MyEmployee +deriving instance Show MyT +deriving instance Show MyDepartment +deriving instance Show MyEmployee + + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("My" <>) + , Dhall.TH.fieldModifier = ("my" <>) . Data.Text.toTitle + , Dhall.TH.generateFromDhallInstance = False + , Dhall.TH.generateToDhallInstance = False + }) + [ SingleConstructor "MyHKSingle" "HKSingle" "./tests/th/HigherKindSingle.dhall" + , MultipleConstructors "MyHKUnion" "./tests/th/HigherKindUnion.dhall" + ] + +type MyHKSingle_ = MyHKSingle Maybe Int +type MyHKUnion_ = MyHKUnion Bool Int + +deriving instance Eq MyHKSingle_ +deriving instance Show MyHKSingle_ +deriving instance Dhall.Generic MyHKSingle_ +instance Dhall.FromDhall MyHKSingle_ +instance Dhall.ToDhall MyHKSingle_ + +deriving instance Eq MyHKUnion_ +deriving instance Show MyHKUnion_ +deriving instance Dhall.Generic MyHKUnion_ +instance Dhall.FromDhall MyHKUnion_ +instance Dhall.ToDhall MyHKUnion_ + +testMakeHaskellTypesWith :: TestTree +testMakeHaskellTypesWith = Tasty.HUnit.testCase "makeHaskellTypesWith" $ do + let text0 = "let T = ./tests/th/example.dhall in T.A { x = True, y = [] : List Text }" + ref0 = MyA{ myX = True, myY = [] } + myTest text0 ref0 + + let text1 = "let T = ./tests/th/example.dhall in T.B (None (List Natural))" + ref1 = MyB Nothing + myTest text1 ref1 + + let text2 = "let T = ./tests/th/example.dhall in T.C" + ref2 = MyC + myTest text2 ref2 + + let textDepartment = "let T = ./tests/th/Department.dhall in T.Sales" + refDepartment = MySales + myTest textDepartment refDepartment + + let textEmployee = "let T = ./tests/th/Department.dhall in T.Sales" + refEmployee = MyEmployee{ myName = "", myDepartment = MySales } + myTest textEmployee refEmployee + + let textHKSingle = "let T = (./tests/th/HigherKindSingle.dhall) Optional Int in T { foo = +1, bar = Some +2, bam = \"\" }" + refHKSingle = MyHKSingle { myFoo = 1, myBar = Just 2, myBam = "" } :: MyHKSingle_ + myTest textHKSingle refHKSingle + + let textHKUnion0 = "let T = (./tests/th/HigherKindUnion.dhall) Bool Int in T.Foo True" + refHKUnion0 = MyFoo True :: MyHKUnion_ + myTest textHKUnion0 refHKUnion0 + + let textHKUnion1 = "let T = (./tests/th/HigherKindUnion.dhall) Bool Int in T.Bar +1" + refHKUnion1 = MyBar 1 :: MyHKUnion_ + myTest textHKUnion1 refHKUnion1 + + where + myTest text ref = do + expr <- Dhall.inputExpr text + t <- case Dhall.extract Dhall.auto expr of + Failure e -> throwIO e + Success t -> return t + + Tasty.HUnit.assertEqual "" t ref + Tasty.HUnit.assertEqual "" expr $ Dhall.embed Dhall.inject ref + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("NoFromDhall" <>) + , Dhall.TH.fieldModifier = ("noFromDhall" <>) . Data.Text.toTitle + , Dhall.TH.generateFromDhallInstance = False + }) + [ MultipleConstructors "NoFromDhallT" "./tests/th/example.dhall" + ] + +instance Dhall.FromDhall NoFromDhallT + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("NoToDhall" <>) + , Dhall.TH.fieldModifier = ("noToDhall" <>) . Data.Text.toTitle + , Dhall.TH.generateToDhallInstance = False + }) + [ MultipleConstructors "NoToDhallT" "./tests/th/example.dhall" + ] + +instance Dhall.ToDhall NoToDhallT + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("NoInstances" <>) + , Dhall.TH.fieldModifier = ("noInstances" <>) . Data.Text.toTitle + , Dhall.TH.generateFromDhallInstance = False + , Dhall.TH.generateToDhallInstance = False + }) + [ MultipleConstructors "NoInstancesT" "./tests/th/example.dhall" + ] + +deriving instance Dhall.Generic NoInstancesT +instance Dhall.FromDhall NoInstancesT +instance Dhall.ToDhall NoInstancesT + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("Strict" <>) + , Dhall.TH.fieldModifier = ("strict" <>) . Data.Text.toTitle + , Dhall.TH.makeStrict = True + }) + [ MultipleConstructors "StrictFields" "./tests/th/example.dhall" + ] diff --git a/tests/Dhall/Test/Tags.hs b/tests/Dhall/Test/Tags.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Tags.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Tags where + +import Data.Text (Text) +import Dhall.Util (Input (..)) +import System.FilePath (()) +import Test.Tasty (TestTree) + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Tags as Tags +import qualified Dhall.Test.Util as Test.Util +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +tagsDirectory :: FilePath +tagsDirectory = "./tests/tags" + +getTests :: IO TestTree +getTests = do + tagsTests <- Test.Util.discover (Turtle.chars <* ".dhall") tagsTest (Turtle.lstree tagsDirectory) + + let testTree = Tasty.testGroup "tags tests" [ tagsTests, tagsDirTest ] + + return testTree + +tagsTest :: Text -> TestTree +tagsTest prefix = + Tasty.HUnit.testCase (Text.unpack prefix) $ do + -- The use of toDhallPah is a hack to ensure we always get the same file + -- paths, i.e. ones with a '.' prefixed and UNIX path separators. + let inputFile = Text.unpack (Test.Util.toDhallPath prefix <> ".dhall") + let outputFile = Text.unpack (prefix <> ".tags") + + actualTags <- fixPathSeparators <$> Tags.generate (InputFile inputFile) Nothing False + + expectedTags <- Text.IO.readFile outputFile + + let message = "The actual tags did not match the expected tags" + + Tasty.HUnit.assertEqual message expectedTags actualTags + +tagsDirTest :: TestTree +tagsDirTest = + Tasty.HUnit.testCase "all" $ do + let outputFile = Text.unpack . Turtle.format Turtle.fp $ tagsDirectory "all.tags" + + actualTags <- fmap fixPathSeparators + (Tags.generate + (InputFile (Text.unpack . Turtle.format Turtle.fp $ tagsDirectory)) + (Just [".dhall"]) + False) + + expectedTags <- Text.IO.readFile outputFile + + let message = "The actual tags did not match the expected tags for directory test" + + Tasty.HUnit.assertEqual message expectedTags actualTags + +fixPathSeparators :: Text -> Text +fixPathSeparators = Text.replace "\\" "/" diff --git a/tests/Dhall/Test/Tutorial.hs b/tests/Dhall/Test/Tutorial.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Tutorial.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Tutorial where + +import qualified Data.Vector +import qualified Dhall +import qualified Dhall.Test.Substitution as Substitution +import qualified Dhall.Test.Util as Util +import qualified Test.Tasty +import qualified Test.Tasty.HUnit + +import Data.Text (Text) +import Dhall (ToDhall) +import GHC.Generics (Generic) +import Numeric.Natural (Natural) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit ((@?=)) + +tests :: TestTree +tests = + Test.Tasty.testGroup "tutorial" + [ Test.Tasty.testGroup "Interpolation" + [ _Interpolation_0 + , _Interpolation_1 + ] + , Test.Tasty.testGroup "Functions" + [ _Functions_0 + , _Functions_1 + , _Functions_2 + ] + , Test.Tasty.testGroup "Unions" + [ example 0 "./tests/tutorial/unions0A.dhall" "./tests/tutorial/unions0B.dhall" + , example 1 "./tests/tutorial/unions1A.dhall" "./tests/tutorial/unions1B.dhall" + , example 3 "./tests/tutorial/unions3A.dhall" "./tests/tutorial/unions3B.dhall" + , example 4 "./tests/tutorial/unions4A.dhall" "./tests/tutorial/unions4B.dhall" + ] + , Test.Tasty.testGroup "Substitutions" + [ Test.Tasty.HUnit.testCase "substitution1.dhall" $ do + res <- Substitution.substituteResult "tests/tutorial/substitution1.dhall" + res @?= Substitution.Failure 1 + , Test.Tasty.HUnit.testCase "substitution2.dhall" $ do + res <- Substitution.substituteResult "tests/tutorial/substitution2.dhall" + res @?= Substitution.Failure 1 + , Test.Tasty.HUnit.testCase "substitution3.dhall" $ do + res <- Substitution.substituteFoo "tests/tutorial/substitution3.dhall" + res @?= True + ] + ] + +_Interpolation_0 :: TestTree +_Interpolation_0 = Test.Tasty.HUnit.testCase "Example #0" (do + e <- Util.code + " let name = \"John Doe\" \n\ + \in let age = 21 \n\ + \in \"My name is ${name} and my age is ${Natural/show age}\"\n" + Util.assertNormalizesTo e "\"My name is John Doe and my age is 21\"" ) + +_Interpolation_1 :: TestTree +_Interpolation_1 = Test.Tasty.HUnit.testCase "Example #1" (do + e <- Util.code + "''\n\ + \ for file in *; do \n\ + \ echo \"Found ''${file}\"\n\ + \ done \n\ + \'' \n" + Util.assertNormalized e ) + +_Functions_0 :: TestTree +_Functions_0 = Test.Tasty.HUnit.testCase "Example #0" (do + let text = "\\(n : Bool) -> [ n && True, n && False, n || True, n || False ]" + makeBools <- Dhall.input Dhall.auto text + makeBools True @?= Data.Vector.fromList [True,False,True,True] ) + +_Functions_1 :: TestTree +_Functions_1 = Test.Tasty.HUnit.testCase "Example #1" (do + let text = "λ(x : Bool) → λ(y : Bool) → x && y" + makeBools <- Dhall.input Dhall.auto text + makeBools True False @?= False ) + +data Example0 = Example0 { foo :: Bool, bar :: Bool } + deriving (Generic, ToDhall) + +_Functions_2 :: TestTree +_Functions_2 = Test.Tasty.HUnit.testCase "Example #2" (do + f <- Dhall.input Dhall.auto "λ(r : { foo : Bool, bar : Bool }) → r.foo && r.bar" + f (Example0 { foo = True, bar = False }) @?= False + f (Example0 { foo = True, bar = True }) @?= True ) + +example :: Natural -> Text -> Text -> TestTree +example n text0 text1 = + Test.Tasty.HUnit.testCase + ("Example #" <> show n) + (Util.equivalent text0 text1) diff --git a/tests/Dhall/Test/TypeInference.hs b/tests/Dhall/Test/TypeInference.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/TypeInference.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.TypeInference where + +import Control.Exception (SomeException (..)) +import Data.Text (Text) +import System.FilePath (()) +import Test.Tasty (TestTree) + +import qualified Control.Exception as Exception +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Core as Core +import qualified Dhall.Import as Import +import qualified Dhall.Parser as Parser +import qualified Dhall.Test.Util as Test.Util +import qualified Dhall.TypeCheck as TypeCheck +import qualified System.FilePath as FilePath +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as Tasty.HUnit +import qualified Turtle + +typeInferenceDirectory :: FilePath +typeInferenceDirectory = "./dhall-lang/tests/type-inference" + +getTests :: IO TestTree +getTests = do + let successTestFiles = do + path <- Turtle.lstree (typeInferenceDirectory "success") + + let skip = + -- These tests intermittently fails with: + -- "Error: Remote host not found" + [ typeInferenceDirectory "success/CacheImportsA.dhall" + , typeInferenceDirectory "success/CacheImportsCanonicalizeA.dhall" + ] + + path `Test.Util.pathNotIn` skip + + return path + + successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest successTestFiles + + let failureTestFiles = Turtle.lstree (typeInferenceDirectory "failure") + + failureTests <- Test.Util.discover (Turtle.chars <* ".dhall") failureTest failureTestFiles + + let testTree = Tasty.testGroup "type-inference tests" + [ successTests + , failureTests + ] + + return testTree + +successTest :: Text -> TestTree +successTest prefix = do + let expectedFailures = + [] +#if defined(WITH_HTTP) && defined(NETWORK_TESTS) +#else + ++ [ typeInferenceDirectory "success/CacheImports" + ] +#endif + + Test.Util.testCase prefix expectedFailures $ do + let prefixFP = Text.unpack prefix + + actualCode <- Text.IO.readFile (prefixFP <> "A.dhall") + + actualExpr <- Core.throws (Parser.exprFromText mempty actualCode) + + tryResolvedExpr <- + Exception.try + (Test.Util.loadRelativeTo + (FilePath.takeDirectory prefixFP) + Import.IgnoreSemanticCache + (Core.denote actualExpr)) + + resolvedExpr <- case tryResolvedExpr of + Left exception -> Tasty.HUnit.assertFailure (show (exception :: SomeException)) + Right resolvedExpr -> return resolvedExpr + + expectedTypeCode <- Text.IO.readFile (prefixFP <> "B.dhall") + + expectedType <- Core.throws (Parser.exprFromText mempty expectedTypeCode) + + resolvedExpectedType <- Import.assertNoImports (Core.denote expectedType) + + inferredType <- case TypeCheck.typeOf resolvedExpr of + Left exception -> Tasty.HUnit.assertFailure (show exception) + Right inferredType -> return inferredType + + let message = "The inferred type did not match the expected type" + + Tasty.HUnit.assertEqual message resolvedExpectedType inferredType + + -- We also add this to exercise the `Dhall.Eval.conv` code path, since + -- it's easy to forget to update it when adding new syntax + _ <- Core.throws (TypeCheck.typeOf (Core.Annot resolvedExpr resolvedExpectedType)) + return () + +failureTest :: Text -> TestTree +failureTest prefix = do + let expectedFailures = + [ + -- Duplicate fields are incorrectly caught during parsing: + -- https://github.com/dhall-lang/dhall-haskell/issues/772 + typeInferenceDirectory "failure/unit/RecordTypeDuplicateFields" + , typeInferenceDirectory "failure/unit/UnionTypeDuplicateVariants1" + , typeInferenceDirectory "failure/unit/UnionTypeDuplicateVariants2" + ] + + Test.Util.testCase prefix expectedFailures $ do + let prefixFP = Text.unpack prefix + + code <- Text.IO.readFile (prefixFP <> ".dhall") + + expression <- case Parser.exprFromText mempty code of + Left _ -> Tasty.HUnit.assertFailure (prefixFP <> " should have parsed") + Right e -> return e + + resolved <- Import.assertNoImports expression + + case TypeCheck.typeOf resolved of + Left _ -> return () + Right _ -> Tasty.HUnit.assertFailure (prefixFP <> " should not have type-checked") diff --git a/tests/Dhall/Test/Util.hs b/tests/Dhall/Test/Util.hs new file mode 100644 --- /dev/null +++ b/tests/Dhall/Test/Util.hs @@ -0,0 +1,333 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} + +module Dhall.Test.Util + ( code + , codeWith + , equivalent + , load + , loadRelativeTo + , loadWith + , normalize' + , normalizeWith' + , assertNormalizesTo + , assertNormalizesToWith + , assertNormalized + , assertTypeChecks + , assertDoesntTypeCheck + , discover + , Dhall.Test.Util.testCase + , pathIn + , pathNotIn + , pathNotPrefixOf + , pathNotSuffixOf + , toDhallPath + , managedTestEnvironment + ) where + +import Control.Applicative (Alternative, liftA2, (<|>)) +import Control.Exception (tryJust) +import Control.Monad (guard) +import Control.Monad.Trans.State.Strict (StateT) +import Data.Bifunctor (first) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.Context (Context) +import Dhall.Core + ( Chunks (..) + , Expr (..) + , Import + , Normalizer + , ReifiedNormalizer (..) + ) +import Dhall.Import (SemanticCacheMode (..), Status (..)) +import Dhall.Parser (Src) +import System.IO.Error (isDoesNotExistError) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit +import Turtle (Pattern, Shell, fp) + +import qualified Control.Exception +import qualified Control.Foldl as Foldl +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Functor +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Context +import qualified Dhall.Core +import qualified Dhall.Import +import qualified Dhall.Map +import qualified Dhall.Parser +import qualified Dhall.TypeCheck +import qualified System.FilePath as FilePath +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.ExpectedFailure as Tasty.ExpectedFailure +import qualified Turtle + +#if defined(WITH_HTTP) && defined(NETWORK_TESTS) +import qualified Data.Foldable +#else +import Control.Monad.IO.Class (MonadIO (..)) +import Dhall.Core (Directory (..), File (..), URL (..)) +import Lens.Micro.Mtl (zoom) + +import qualified Data.Foldable +import qualified Data.Text.Encoding +import qualified Data.Text.IO +#endif + +normalize' :: Expr Src Void -> Text +normalize' = Dhall.Core.pretty . Dhall.Core.normalize + +normalizeWith' :: Normalizer Void -> Expr Src Void -> Text +normalizeWith' ctx t = + Dhall.Core.pretty (Dhall.Core.normalizeWith (Just (ReifiedNormalizer ctx)) t) + +code :: Text -> IO (Expr Src Void) +code = codeWith Dhall.Context.empty + +codeWith :: Context (Expr Src Void) -> Text -> IO (Expr Src Void) +codeWith ctx expr = do + expr0 <- case Dhall.Parser.exprFromText mempty expr of + Left parseError -> Control.Exception.throwIO parseError + Right expr0 -> return expr0 + expr1 <- load expr0 + case Dhall.TypeCheck.typeWith ctx expr1 of + Left typeError -> Control.Exception.throwIO typeError + Right _ -> return () + return expr1 + +load :: Expr Src Import -> IO (Expr Src Void) +load = loadRelativeTo "." UseSemanticCache + +loadRelativeTo :: FilePath.FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void) +loadRelativeTo rootDirectory semanticCacheMode expression = + State.evalStateT + (loadWith expression) + (Dhall.Import.emptyStatus rootDirectory) { _semanticCacheMode = semanticCacheMode } + +#if defined(WITH_HTTP) && defined(NETWORK_TESTS) +loadWith :: Expr Src Import -> StateT Status IO (Expr Src Void) +loadWith = Dhall.Import.loadWith + +#else +loadWith :: Expr Src Import -> StateT Status IO (Expr Src Void) +loadWith expr = do + zoom Dhall.Import.remote (State.put mockRemote) + Dhall.Import.loadWith expr + +mockRemote :: Dhall.Core.URL -> StateT Status IO Data.Text.Text +mockRemote + url@URL + { authority = "raw.githubusercontent.com" + , path = File (Directory components) file + } = do + let localDir = case reverse components of + "dhall-lang" : "dhall-lang" : _ : rest -> + reverse ("dhall-lang" : rest) + "Nadrieril" : "dhall-rust" : _ : "dhall" : rest -> + reverse ("dhall-lang" : rest) + _ -> do + fail ("Unable to mock URL: " <> Text.unpack (Dhall.Core.pretty url)) + + localPath <- Dhall.Import.localToPath Dhall.Core.Here (File (Directory localDir) file) + + liftIO (Data.Text.IO.readFile localPath) + +mockRemote + URL { authority = "prelude.dhall-lang.org" + , path = File (Directory components) file + } = do + let localDir = components ++ [ "Prelude", "dhall-lang" ] + + localPath <- Dhall.Import.localToPath Dhall.Core.Here (File (Directory localDir) file) + + liftIO (Data.Text.IO.readFile localPath) + +mockRemote url@URL{ authority = "test.dhall-lang.org", path, headers } = + case (path, fmap Dhall.Import.toHeaders headers) of + (File (Directory []) "foo", Just [("test", _)]) -> + return "./bar" + (File (Directory []) "bar", Just [("test", _)]) -> + return "True" + (File (Directory ["cors"]) "AllowedAll.dhall", _) -> + return "42" + (File (Directory ["cors"]) "OnlyGithub.dhall", _) -> + return "42" + (File (Directory ["cors"]) "OnlySelf.dhall", _) -> + return "42" + (File (Directory ["cors"]) "OnlyOther.dhall", _) -> + return "42" + (File (Directory ["cors"]) "Empty.dhall", _) -> + return "42" + (File (Directory ["cors"]) "NoCORS.dhall", _) -> + return "42" + (File (Directory ["cors"]) "Null.dhall", _) -> + return "42" + (File (Directory ["cors"]) "SelfImportAbsolute.dhall", _) -> + return "https://test.dhall-lang.org/cors/NoCORS.dhall" + (File (Directory ["cors"]) "SelfImportRelative.dhall", _) -> + return "./NoCORS.dhall" + (File (Directory ["cors"]) "TwoHopsFail.dhall", _) -> + return "https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/OnlySelf.dhall" + (File (Directory ["cors"]) "TwoHopsSuccess.dhall", _) -> + return "https://raw.githubusercontent.com/dhall-lang/dhall-lang/5ff7ecd2411894dd9ce307dc23020987361d2d43/tests/import/data/cors/OnlyGithub.dhall" + _ -> do + fail ("Unable to mock URL: " <> Text.unpack (Dhall.Core.pretty url)) + +mockRemote url@URL{ authority = "httpbin.org", path, headers } = + case (path, fmap Dhall.Import.toHeaders headers) of + (File (Directory []) "user-agent", Just [("user-agent", userAgent)]) -> do + let agentText = Data.Text.Encoding.decodeUtf8 userAgent + + return ("{\n \"user-agent\": \"" <> agentText <> "\"\n}\n") + (File (Directory []) "user-agent", Nothing) -> do + return ("{\n \"user-agent\": \"Dhall\"\n}\n") + _ -> do + fail ("Unable to mock URL: " <> Text.unpack (Dhall.Core.pretty url)) + +mockRemote url = do + let urlString = Text.unpack (Dhall.Core.pretty url) + fail ("(mock http) Url does not match any of the hard-coded rules: " + <> urlString) +#endif + +{- Given a test prefix, returns a managed resource + which sets / reverts relevant environment variables based + on `prefix <> "ENV.dhall"` (if present) + -} +managedTestEnvironment :: Text -> Turtle.Managed [(Text, Maybe Text)] +managedTestEnvironment prefix = Turtle.managed (Control.Exception.bracket setup cleanup) + where + envPath = Text.unpack (prefix <> "ENV.dhall") + + setup :: IO [(Text, Maybe Text)] + setup = do + envFileContents <- + tryJust (guard . isDoesNotExistError) (Text.IO.readFile envPath) + + testEnv <- case envFileContents of + Right contents -> do + resolved <- code contents + return (convertEnvExpr (Dhall.Core.normalize resolved)) + Left _ -> return [] + + traverse setEnv testEnv + + cleanup :: [(Text, Maybe Text)] -> IO () + cleanup = Data.Foldable.traverse_ restoreEnv + + convertEnvExpr :: Expr Src Void -> [(Text, Text)] + convertEnvExpr (ListLit _ hs) = Data.Foldable.toList (Data.Foldable.fold maybePairs) + where + maybePairs = mapM toPair hs + + toPair :: Expr s a -> Maybe (Text, Text) + toPair (RecordLit m) = do + (Dhall.Core.recordFieldValue -> TextLit (Chunks [] key), Dhall.Core.recordFieldValue -> TextLit (Chunks [] value)) + <- lookupHeader <|> lookupMapKey + return (key, value) + where + lookupHeader = liftA2 (,) (Dhall.Map.lookup "header" m) (Dhall.Map.lookup "value" m) + lookupMapKey = liftA2 (,) (Dhall.Map.lookup "mapKey" m) (Dhall.Map.lookup "mapValue" m) + toPair _ = Nothing + convertEnvExpr _ = [] + + setEnv :: (Text, Text) -> IO (Text, Maybe Text) + setEnv (k, v) = do + old <- Turtle.need k + Turtle.export k v + return (k, old) + + restoreEnv :: (Text, Maybe Text) -> IO () + restoreEnv (k, Just old) = Turtle.export k old + restoreEnv (k, Nothing) = Turtle.unset k + +equivalent :: Text -> Text -> IO () +equivalent text0 text1 = do + expr0 <- fmap Dhall.Core.normalize (code text0) :: IO (Expr Void Void) + expr1 <- fmap Dhall.Core.normalize (code text1) :: IO (Expr Void Void) + assertEqual "Expressions are not equivalent" expr0 expr1 + +assertNormalizesTo :: Expr Src Void -> Text -> IO () +assertNormalizesTo e expected = do + assertBool msg (not $ Dhall.Core.isNormalized e) + normalize' e @?= expected + where msg = "Given expression is already in normal form" + +assertNormalizesToWith :: Normalizer Void -> Expr Src Void -> Text -> IO () +assertNormalizesToWith ctx e expected = do + assertBool msg (not $ Dhall.Core.isNormalizedWith ctx (first (const ()) e)) + normalizeWith' ctx e @?= expected + where msg = "Given expression is already in normal form" + +assertNormalized :: Expr Src Void -> IO () +assertNormalized e = do + assertBool msg1 (Dhall.Core.isNormalized e) + assertEqual msg2 (normalize' e) (Dhall.Core.pretty e) + where msg1 = "Expression was not in normal form" + msg2 = "Normalization is not supposed to change the expression" + +assertTypeChecks :: Text -> IO () +assertTypeChecks text = Data.Functor.void (code text) + +assertDoesntTypeCheck :: Text -> IO () +assertDoesntTypeCheck text = do + expr0 <- case Dhall.Parser.exprFromText mempty text of + Left parseError -> Control.Exception.throwIO parseError + Right e -> return e + expr1 <- load expr0 + case Dhall.TypeCheck.typeOf expr1 of + Left _ -> return () + Right type_ -> fail ("Bad type for " <> Text.unpack text <> "\n " <> show type_) + +{-| Automatically run a test on all files in a directory tree that end in + @A.dhall@ +-} +discover :: Pattern Text -> (Text -> TestTree) -> Shell FilePath -> IO TestTree +discover pattern buildTest paths = do + let shell = do + path_ <- paths + + let pathText = Turtle.format fp (FilePath.normalise path_) + + prefix : _ <- return (Turtle.match pattern pathText) + + return (buildTest prefix) + + tests <- Turtle.fold shell Foldl.list + + return (Tasty.testGroup "discover" tests) + +testCase :: Text -> [ FilePath ] -> Assertion -> TestTree +testCase prefix expectedFailures assertion = + if prefix `elem` map (Turtle.format fp . FilePath.normalise) expectedFailures + then Tasty.ExpectedFailure.expectFail test + else test + where + test = Test.Tasty.HUnit.testCase (Text.unpack prefix) assertion + +pathIn :: Alternative f => FilePath -> [FilePath] -> f () +pathIn this = guard . any (FilePath.equalFilePath this) + +pathNotIn :: Alternative f => FilePath -> [FilePath] -> f () +pathNotIn this = guard . not . any (FilePath.equalFilePath this) + +pathNotPrefixOf :: Alternative f => FilePath -> FilePath -> f () +pathNotPrefixOf this = + guard . not . List.isPrefixOf (FilePath.normalise this) . FilePath.normalise + +pathNotSuffixOf :: Alternative f => FilePath -> FilePath -> f () +pathNotSuffixOf this = + guard . not . List.isSuffixOf (FilePath.normalise this) . FilePath.normalise + +{-| Path names on Windows are not valid Dhall paths due to using backslashes + instead of forwardslashes to separate path components. This utility fixes + them if necessary +-} +toDhallPath :: Text -> Text +toDhallPath = ("./" <>) . Text.replace "\\" "/" diff --git a/tests/Format.hs b/tests/Format.hs deleted file mode 100644 --- a/tests/Format.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Format where - -import Data.Monoid (mempty, (<>)) -import Data.Text (Text) -import Test.Tasty (TestTree) - -import qualified Control.Exception -import qualified Data.Text -import qualified Data.Text.Lazy.IO -import qualified Data.Text.Prettyprint.Doc -import qualified Data.Text.Prettyprint.Doc.Render.Text -import qualified Dhall.Parser -import qualified Test.Tasty -import qualified Test.Tasty.HUnit - -formatTests :: TestTree -formatTests = - Test.Tasty.testGroup "format tests" - [ should - "prefer multi-line strings when newlines present" - "multiline" - , should - "escape ${ for single-quoted strings" - "escapeSingleQuotedOpenInterpolation" - , should - "preserve the original order of fields" - "fieldOrder" - , should - "escape numeric labels correctly" - "escapeNumericLabel" - , should - "correctly handle scientific notation with a large exponent" - "largeExponent" - , should - "correctly format the empty record literal" - "emptyRecord" - ] - -opts :: Data.Text.Prettyprint.Doc.LayoutOptions -opts = - Data.Text.Prettyprint.Doc.defaultLayoutOptions - { Data.Text.Prettyprint.Doc.layoutPageWidth = - Data.Text.Prettyprint.Doc.AvailablePerLine 80 1.0 - } - -should :: Text -> Text -> TestTree -should name basename = - Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do - let inputFile = - Data.Text.unpack ("./tests/format/" <> basename <> "A.dhall") - let outputFile = - Data.Text.unpack ("./tests/format/" <> basename <> "B.dhall") - inputText <- Data.Text.Lazy.IO.readFile inputFile - - expr <- case Dhall.Parser.exprFromText mempty inputText of - Left err -> Control.Exception.throwIO err - Right expr -> return expr - - let doc = Data.Text.Prettyprint.Doc.pretty expr - let docStream = Data.Text.Prettyprint.Doc.layoutSmart opts doc - let actualText = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream - - expectedText <- Data.Text.Lazy.IO.readFile outputFile - - let message = - "The formatted expression did not match the expected output" - Test.Tasty.HUnit.assertEqual message expectedText actualText diff --git a/tests/Normalization.hs b/tests/Normalization.hs deleted file mode 100644 --- a/tests/Normalization.hs +++ /dev/null @@ -1,248 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} - -module Normalization (normalizationTests) where - -import Data.Monoid ((<>)) -import Data.Text.Lazy (Text) -import Dhall.Core (Expr) -import Dhall.TypeCheck (X) - -import qualified Control.Exception -import qualified Data.Text.Lazy -import qualified Dhall.Core -import qualified Dhall.Import -import qualified Dhall.Parser -import qualified Dhall.TypeCheck - -import Dhall.Core -import Dhall.Context -import Test.Tasty -import Test.Tasty.HUnit -import Util - -normalizationTests :: TestTree -normalizationTests = - testGroup "normalization" - [ examples - , simplifications - , constantFolding - , conversions - , shouldNormalize "Optional build/fold fusion" "optionalBuildFold" - , customization - , shouldNormalize "a remote-systems.conf builder" "remoteSystems" - ] - -examples :: TestTree -examples = - testGroup "Prelude examples" - [ shouldNormalize "Bool/and" "./examples/Bool/and/0" - , shouldNormalize "Bool/and" "./examples/Bool/and/1" - , shouldNormalize "Bool/build" "./examples/Bool/build/0" - , shouldNormalize "Bool/build" "./examples/Bool/build/1" - , shouldNormalize "Bool/even" "./examples/Bool/even/0" - , shouldNormalize "Bool/even" "./examples/Bool/even/1" - , shouldNormalize "Bool/even" "./examples/Bool/even/2" - , shouldNormalize "Bool/even" "./examples/Bool/even/3" - , shouldNormalize "Bool/fold" "./examples/Bool/fold/0" - , shouldNormalize "Bool/fold" "./examples/Bool/fold/1" - , shouldNormalize "Bool/not" "./examples/Bool/not/0" - , shouldNormalize "Bool/not" "./examples/Bool/not/1" - , shouldNormalize "Bool/odd" "./examples/Bool/odd/0" - , shouldNormalize "Bool/odd" "./examples/Bool/odd/1" - , shouldNormalize "Bool/odd" "./examples/Bool/odd/2" - , shouldNormalize "Bool/odd" "./examples/Bool/odd/3" - , shouldNormalize "Bool/or" "./examples/Bool/or/0" - , shouldNormalize "Bool/or" "./examples/Bool/or/1" - , shouldNormalize "Bool/show" "./examples/Bool/show/0" - , shouldNormalize "Bool/show" "./examples/Bool/show/1" - , shouldNormalize "Double/show" "./examples/Double/show/0" - , shouldNormalize "Double/show" "./examples/Double/show/1" - , shouldNormalize "Integer/show" "./examples/Integer/show/0" - , shouldNormalize "Integer/show" "./examples/Integer/show/1" - , shouldNormalize "List/all" "./examples/List/all/0" - , shouldNormalize "List/all" "./examples/List/all/1" - , shouldNormalize "List/any" "./examples/List/any/0" - , shouldNormalize "List/any" "./examples/List/any/1" - , shouldNormalize "List/build" "./examples/List/build/0" - , shouldNormalize "List/build" "./examples/List/build/1" - , shouldNormalize "List/concat" "./examples/List/concat/0" - , shouldNormalize "List/concat" "./examples/List/concat/1" - , shouldNormalize "List/concatMap" "./examples/List/concatMap/0" - , shouldNormalize "List/concatMap" "./examples/List/concatMap/1" - , shouldNormalize "List/filter" "./examples/List/filter/0" - , shouldNormalize "List/filter" "./examples/List/filter/1" - , shouldNormalize "List/fold" "./examples/List/fold/0" - , shouldNormalize "List/fold" "./examples/List/fold/1" - , shouldNormalize "List/fold" "./examples/List/fold/2" - , shouldNormalize "List/generate" "./examples/List/generate/0" - , shouldNormalize "List/generate" "./examples/List/generate/1" - , shouldNormalize "List/head" "./examples/List/head/0" - , shouldNormalize "List/head" "./examples/List/head/1" - , shouldNormalize "List/iterate" "./examples/List/iterate/0" - , shouldNormalize "List/iterate" "./examples/List/iterate/1" - , shouldNormalize "List/last" "./examples/List/last/0" - , shouldNormalize "List/last" "./examples/List/last/1" - , shouldNormalize "List/length" "./examples/List/length/0" - , shouldNormalize "List/length" "./examples/List/length/1" - , shouldNormalize "List/map" "./examples/List/map/0" - , shouldNormalize "List/map" "./examples/List/map/1" - , shouldNormalize "List/null" "./examples/List/null/0" - , shouldNormalize "List/null" "./examples/List/null/1" - , shouldNormalize "List/replicate" "./examples/List/replicate/0" - , shouldNormalize "List/replicate" "./examples/List/replicate/1" - , shouldNormalize "List/reverse" "./examples/List/reverse/0" - , shouldNormalize "List/reverse" "./examples/List/reverse/1" - , shouldNormalize "List/shifted" "./examples/List/shifted/0" - , shouldNormalize "List/shifted" "./examples/List/shifted/1" - , shouldNormalize "List/unzip" "./examples/List/unzip/0" - , shouldNormalize "List/unzip" "./examples/List/unzip/1" - , shouldNormalize "Natural/build" "./examples/Natural/build/0" - , shouldNormalize "Natural/build" "./examples/Natural/build/1" - , shouldNormalize "Natural/enumerate" "./examples/Natural/enumerate/0" - , shouldNormalize "Natural/enumerate" "./examples/Natural/enumerate/1" - , shouldNormalize "Natural/even" "./examples/Natural/even/0" - , shouldNormalize "Natural/even" "./examples/Natural/even/1" - , shouldNormalize "Natural/fold" "./examples/Natural/fold/0" - , shouldNormalize "Natural/fold" "./examples/Natural/fold/1" - , shouldNormalize "Natural/fold" "./examples/Natural/fold/2" - , shouldNormalize "Natural/isZero" "./examples/Natural/isZero/0" - , shouldNormalize "Natural/isZero" "./examples/Natural/isZero/1" - , shouldNormalize "Natural/odd" "./examples/Natural/odd/0" - , shouldNormalize "Natural/odd" "./examples/Natural/odd/1" - , shouldNormalize "Natural/product" "./examples/Natural/product/0" - , shouldNormalize "Natural/product" "./examples/Natural/product/1" - , shouldNormalize "Natural/show" "./examples/Natural/show/0" - , shouldNormalize "Natural/show" "./examples/Natural/show/1" - , shouldNormalize "Natural/sum" "./examples/Natural/sum/0" - , shouldNormalize "Natural/sum" "./examples/Natural/sum/1" - , shouldNormalize "Natural/toInteger" "./examples/Natural/toInteger/0" - , shouldNormalize "Natural/toInteger" "./examples/Natural/toInteger/1" - , shouldNormalize "Optional/all" "./examples/Optional/all/0" - , shouldNormalize "Optional/all" "./examples/Optional/all/1" - , shouldNormalize "Optional/any" "./examples/Optional/any/0" - , shouldNormalize "Optional/any" "./examples/Optional/any/1" - , shouldNormalize "Optional/build" "./examples/Optional/build/0" - , shouldNormalize "Optional/build" "./examples/Optional/build/1" - , shouldNormalize "Optional/concat" "./examples/Optional/concat/0" - , shouldNormalize "Optional/concat" "./examples/Optional/concat/1" - , shouldNormalize "Optional/concat" "./examples/Optional/concat/2" - , shouldNormalize "Optional/filter" "./examples/Optional/filter/0" - , shouldNormalize "Optional/filter" "./examples/Optional/filter/1" - , shouldNormalize "Optional/fold" "./examples/Optional/fold/0" - , shouldNormalize "Optional/fold" "./examples/Optional/fold/1" - , shouldNormalize "Optional/head" "./examples/Optional/head/0" - , shouldNormalize "Optional/head" "./examples/Optional/head/1" - , shouldNormalize "Optional/last" "./examples/Optional/last/0" - , shouldNormalize "Optional/last" "./examples/Optional/last/1" - , shouldNormalize "Optional/length" "./examples/Optional/length/0" - , shouldNormalize "Optional/length" "./examples/Optional/length/1" - , shouldNormalize "Optional/map" "./examples/Optional/map/0" - , shouldNormalize "Optional/map" "./examples/Optional/map/1" - , shouldNormalize "Optional/null" "./examples/Optional/null/0" - , shouldNormalize "Optional/null" "./examples/Optional/null/1" - , shouldNormalize "Optional/toList" "./examples/Optional/toList/0" - , shouldNormalize "Optional/toList" "./examples/Optional/toList/1" - , shouldNormalize "Optional/unzip" "./examples/Optional/unzip/0" - , shouldNormalize "Optional/unzip" "./examples/Optional/unzip/1" - , shouldNormalize "Text/concat" "./examples/Text/concat/0" - , shouldNormalize "Text/concat" "./examples/Text/concat/1" - , shouldNormalize "Text/concatMap" "./examples/Text/concatMap/0" - , shouldNormalize "Text/concatMap" "./examples/Text/concatMap/1" - , shouldNormalize "Text/concatMapSep" "./examples/Text/concatMapSep/0" - , shouldNormalize "Text/concatMapSep" "./examples/Text/concatMapSep/1" - , shouldNormalize "Text/concatSep" "./examples/Text/concatSep/0" - , shouldNormalize "Text/concatSep" "./examples/Text/concatSep/1" - ] - -simplifications :: TestTree -simplifications = - testGroup "Simplifications" - [ shouldNormalize "if/then/else" "./simplifications/ifThenElse" - , shouldNormalize "||" "./simplifications/or" - , shouldNormalize "&&" "./simplifications/and" - , shouldNormalize "==" "./simplifications/eq" - , shouldNormalize "!=" "./simplifications/ne" - ] - -constantFolding :: TestTree -constantFolding = - testGroup "folding of constants" - [ shouldNormalize "Natural/plus" "naturalPlus" - , shouldNormalize "Optional/fold" "optionalFold" - , shouldNormalize "Optional/build" "optionalBuild" - ] - -conversions :: TestTree -conversions = - testGroup "conversions" - [ shouldNormalize "Natural/show" "naturalShow" - , shouldNormalize "Integer/show" "integerShow" - , shouldNormalize "Double/show" "doubleShow" - , shouldNormalize "Natural/toInteger" "naturalToInteger" - ] - -customization :: TestTree -customization = - testGroup "customization" - [ simpleCustomization - , nestedReduction - ] - -simpleCustomization :: TestTree -simpleCustomization = testCase "simpleCustomization" $ do - let tyCtx = insert "min" (Pi "_" Natural (Pi "_" Natural Natural)) empty - valCtx e = case e of - (App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalLit y)) -> Just (NaturalLit (min x y)) - _ -> Nothing - e <- codeWith tyCtx "min (min +11 +12) +8 + +1" - assertNormalizesToWith valCtx e "+9" - -nestedReduction :: TestTree -nestedReduction = testCase "doubleReduction" $ do - minType <- insert "min" <$> code "Natural → Natural → Natural" - fiveorlessType <- insert "fiveorless" <$> code "Natural → Natural" - wurbleType <- insert "wurble" <$> code "Natural → Integer" - let tyCtx = minType . fiveorlessType . wurbleType $ empty - valCtx e = case e of - (App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalLit y)) -> Just (NaturalLit (min x y)) - (App (Var (V "wurble" 0)) (NaturalLit x)) -> Just - (App (Var (V "fiveorless" 0)) (NaturalPlus (NaturalLit x) (NaturalLit 2))) - (App (Var (V "fiveorless" 0)) (NaturalLit x)) -> Just - (App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalPlus (NaturalLit 3) (NaturalLit 2))) - _ -> Nothing - e <- codeWith tyCtx "wurble +6" - assertNormalizesToWith valCtx e "+5" - -should :: Text -> Text -> TestTree -should name basename = - Test.Tasty.HUnit.testCase (Data.Text.Lazy.unpack name) $ do - let actualCode = "./tests/normalization/" <> basename <> "A.dhall" - let expectedCode = "./tests/normalization/" <> basename <> "B.dhall" - - actualExpr <- case Dhall.Parser.exprFromText mempty actualCode of - Left err -> Control.Exception.throwIO err - Right expr -> return expr - actualResolved <- Dhall.Import.load actualExpr - case Dhall.TypeCheck.typeOf actualResolved of - Left err -> Control.Exception.throwIO err - Right _ -> return () - let actualNormalized = Dhall.Core.normalize actualResolved :: Expr X X - - expectedExpr <- case Dhall.Parser.exprFromText mempty expectedCode of - Left err -> Control.Exception.throwIO err - Right expr -> return expr - expectedResolved <- Dhall.Import.load expectedExpr - case Dhall.TypeCheck.typeOf expectedResolved of - Left err -> Control.Exception.throwIO err - Right _ -> return () - -- Use `denote` instead of `normalize` to enforce that the expected - -- expression is already in normal form - let expectedNormalized = Dhall.Core.denote expectedResolved - - let message = - "The normalized expression did not match the expected output" - Test.Tasty.HUnit.assertEqual message expectedNormalized actualNormalized - -shouldNormalize :: Text -> Text -> TestTree -shouldNormalize name = should ("normalize " <> name <> " correctly") diff --git a/tests/Parser.hs b/tests/Parser.hs deleted file mode 100644 --- a/tests/Parser.hs +++ /dev/null @@ -1,141 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Parser where - -import Data.Text (Text) -import Test.Tasty (TestTree) - -import qualified Control.Exception -import qualified Data.Text -import qualified Data.Text.Lazy.IO -import qualified Dhall.Parser -import qualified Test.Tasty -import qualified Test.Tasty.HUnit - -parserTests :: TestTree -parserTests = - Test.Tasty.testGroup "parser tests" - [ Test.Tasty.testGroup "whitespace" - [ shouldParse - "prefix/suffix" - "./tests/parser/whitespace.dhall" - , shouldParse - "block comment" - "./tests/parser/blockComment.dhall" - , shouldParse - "nested block comment" - "./tests/parser/nestedBlockComment.dhall" - , shouldParse - "line comment" - "./tests/parser/lineComment.dhall" - , shouldParse - "Unicode comment" - "./tests/parser/unicodeComment.dhall" - , shouldParse - "whitespace buffet" - "./tests/parser/whitespaceBuffet.dhall" - , shouldParse - "label" - "./tests/parser/label.dhall" - , shouldParse - "quoted label" - "./tests/parser/quotedLabel.dhall" - , shouldParse - "double quoted string" - "./tests/parser/doubleQuotedString.dhall" - , shouldParse - "Unicode double quoted string" - "./tests/parser/unicodeDoubleQuotedString.dhall" - , shouldParse - "escaped double quoted string" - "./tests/parser/escapedDoubleQuotedString.dhall" - , shouldParse - "interpolated double quoted string" - "./tests/parser/interpolatedDoubleQuotedString.dhall" - , shouldParse - "single quoted string" - "./tests/parser/singleQuotedString.dhall" - , shouldParse - "escaped single quoted string" - "./tests/parser/escapedSingleQuotedString.dhall" - , shouldParse - "interpolated single quoted string" - "./tests/parser/interpolatedSingleQuotedString.dhall" - , shouldParse - "double" - "./tests/parser/double.dhall" - , shouldParse - "natural" - "./tests/parser/natural.dhall" - , shouldParse - "identifier" - "./tests/parser/identifier.dhall" - , shouldParse - "paths" - "./tests/parser/paths.dhall" - , shouldParse - "path termination" - "./tests/parser/pathTermination.dhall" - , shouldParse - "urls" - "./tests/parser/urls.dhall" - , shouldParse - "environmentVariables" - "./tests/parser/environmentVariables.dhall" - , shouldParse - "lambda" - "./tests/parser/lambda.dhall" - , shouldParse - "if then else" - "./tests/parser/ifThenElse.dhall" - , shouldParse - "let" - "./tests/parser/let.dhall" - , shouldParse - "forall" - "./tests/parser/forall.dhall" - , shouldParse - "function type" - "./tests/parser/functionType.dhall" - , shouldParse - "operators" - "./tests/parser/operators.dhall" - , shouldParse - "annotations" - "./tests/parser/annotations.dhall" - , shouldParse - "merge" - "./tests/parser/merge.dhall" - , shouldParse - "constructors" - "./tests/parser/constructors.dhall" - , shouldParse - "fields" - "./tests/parser/fields.dhall" - , shouldParse - "record" - "./tests/parser/record.dhall" - , shouldParse - "union" - "./tests/parser/union.dhall" - , shouldParse - "list" - "./tests/parser/list.dhall" - , shouldParse - "builtins" - "./tests/parser/builtins.dhall" - , shouldParse - "large expression" - "./tests/parser/largeExpression.dhall" - , shouldParse - "names that begin with reserved identifiers" - "./tests/parser/reservedPrefix.dhall" - ] - ] - -shouldParse :: Text -> FilePath -> TestTree -shouldParse name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) (do - text <- Data.Text.Lazy.IO.readFile path - case Dhall.Parser.exprFromText mempty text of - Left err -> Control.Exception.throwIO err - Right _ -> return () ) diff --git a/tests/Regression.hs b/tests/Regression.hs deleted file mode 100644 --- a/tests/Regression.hs +++ /dev/null @@ -1,246 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} - -module Regression where - -import qualified Control.Exception -import qualified Data.HashMap.Strict.InsOrd -import qualified Data.Text.Lazy.IO -import qualified Data.Text.Prettyprint.Doc -import qualified Data.Text.Prettyprint.Doc.Render.Text -import qualified Dhall -import qualified Dhall.Context -import qualified Dhall.Core -import qualified Dhall.Parser -import qualified Dhall.TypeCheck -import qualified System.Timeout -import qualified Test.Tasty -import qualified Test.Tasty.HUnit -import qualified Util - -import Control.DeepSeq (($!!)) -import Dhall.Import (Imported) -import Dhall.Parser (Src) -import Dhall.TypeCheck (TypeError, X) -import Test.Tasty (TestTree) -import Test.Tasty.HUnit ((@?=)) - -regressionTests :: TestTree -regressionTests = - Test.Tasty.testGroup "regression tests" - [ issue96 - , issue126 - , issue151 - , issue164 - , issue201 - , issue209 - , issue216 - , issue253 - , parsing0 - , typeChecking0 - , typeChecking1 - , typeChecking2 - , unnamedFields - , trailingSpaceAfterStringLiterals - ] - -data Foo = Foo Integer Bool | Bar Bool Bool Bool | Baz Integer Integer - deriving (Show, Dhall.Generic, Dhall.Interpret, Dhall.Inject) - -unnamedFields :: TestTree -unnamedFields = Test.Tasty.HUnit.testCase "Unnamed Fields" (do - let ty = Dhall.auto @Foo - Test.Tasty.HUnit.assertEqual "Good type" (Dhall.expected ty) (Dhall.Core.Union ( - Data.HashMap.Strict.InsOrd.fromList [ - ("Bar",Dhall.Core.Record (Data.HashMap.Strict.InsOrd.fromList [ - ("_1",Dhall.Core.Bool),("_2",Dhall.Core.Bool),("_3",Dhall.Core.Bool)])) - , ("Baz",Dhall.Core.Record (Data.HashMap.Strict.InsOrd.fromList [ - ("_1",Dhall.Core.Integer),("_2",Dhall.Core.Integer)])) - ,("Foo",Dhall.Core.Record (Data.HashMap.Strict.InsOrd.fromList [ - ("_1",Dhall.Core.Integer),("_2",Dhall.Core.Bool)]))])) - - let inj = Dhall.inject @Foo - Test.Tasty.HUnit.assertEqual "Good Inject" (Dhall.declared inj) (Dhall.expected ty) - - let tu_ty = Dhall.auto @(Integer, Bool) - Test.Tasty.HUnit.assertEqual "Auto Tuple" (Dhall.expected tu_ty) (Dhall.Core.Record ( - Data.HashMap.Strict.InsOrd.fromList [ ("_1",Dhall.Core.Integer),("_2",Dhall.Core.Bool) ])) - - let tu_in = Dhall.inject @(Integer, Bool) - Test.Tasty.HUnit.assertEqual "Inj. Tuple" (Dhall.declared tu_in) (Dhall.expected tu_ty) - - return () ) - -issue96 :: TestTree -issue96 = Test.Tasty.HUnit.testCase "Issue #96" (do - -- Verify that parsing should not fail - _ <- Util.code "\"bar'baz\"" - return () ) - -issue126 :: TestTree -issue126 = Test.Tasty.HUnit.testCase "Issue #126" (do - e <- Util.code - "''\n\ - \ foo\n\ - \ bar\n\ - \''" - Util.normalize' e @?= "''\nfoo\nbar\n''" ) - -issue151 :: TestTree -issue151 = Test.Tasty.HUnit.testCase "Issue #151" (do - let shouldNotTypeCheck text = do - let handler :: Imported (TypeError Src X) -> IO Bool - handler _ = return True - - let typeCheck = do - _ <- Util.code text - return False - b <- Control.Exception.handle handler typeCheck - Test.Tasty.HUnit.assertBool "The expression should not type-check" b - - -- These two examples contain the following expression that loops infinitely - -- if you normalize the expression before type-checking the expression: - -- - -- (λ(x : A) → x x) (λ(x : A) → x x) - -- - -- There was a bug in the Dhall type-checker were expressions were not - -- being type-checked before being added to the context (which is a - -- violation of the standard type-checking rules for a pure type system). - -- The reason this is problematic is that several places in the - -- type-checking logic assume that the context is safe to normalize. - -- - -- Both of these examples exercise area of the type-checker logic that - -- assume that the context is normalized. If you fail to type-check terms - -- before adding them to the context then this test will "fail" with an - -- infinite loop. This test "succeeds" if the examples terminate - -- immediately with a type-checking failure. - shouldNotTypeCheck "./tests/regression/issue151a.dhall" - shouldNotTypeCheck "./tests/regression/issue151b.dhall" ) - -issue164 :: TestTree -issue164 = Test.Tasty.HUnit.testCase "Issue #164" (do - -- Verify that parsing should not fail on a single-quote within a - -- single-quoted string - _ <- Util.code "./tests/regression/issue164.dhall" - return () ) - -issue201 :: TestTree -issue201 = Test.Tasty.HUnit.testCase "Issue #201" (do - -- Verify that type synonyms work - _ <- Util.code "./tests/regression/issue201.dhall" - return () ) - -issue209 :: TestTree -issue209 = Test.Tasty.HUnit.testCase "Issue #209" (do - -- Verify that pretty-printing `constructors` doesn't trigger an infinite - -- loop - e <- Util.code "./tests/regression/issue209.dhall" - let text = Dhall.Core.pretty e - Just _ <- System.Timeout.timeout 1000000 (Control.Exception.evaluate $!! text) - return () ) - -opts :: Data.Text.Prettyprint.Doc.LayoutOptions -opts = - Data.Text.Prettyprint.Doc.defaultLayoutOptions - { Data.Text.Prettyprint.Doc.layoutPageWidth = - Data.Text.Prettyprint.Doc.AvailablePerLine 80 1.0 - } - -issue216 :: TestTree -issue216 = Test.Tasty.HUnit.testCase "Issue #216" (do - -- Verify that pretty-printing preserves string interpolation - e <- Util.code "./tests/regression/issue216a.dhall" - let doc = Data.Text.Prettyprint.Doc.pretty e - let docStream = Data.Text.Prettyprint.Doc.layoutSmart opts doc - let text0 = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream - - text1 <- Data.Text.Lazy.IO.readFile "./tests/regression/issue216b.dhall" - - Test.Tasty.HUnit.assertEqual "Pretty-printing should preserve string interpolation" text1 text0 ) - -issue253 :: TestTree -issue253 = Test.Tasty.HUnit.testCase "Issue #253" (do - -- Verify that type-checking rejects ill-formed custom contexts - let context = Dhall.Context.insert "x" "x" Dhall.Context.empty - let result = Dhall.TypeCheck.typeWith context "x" - - -- If the context is not validated correctly then type-checking will - -- infinitely loop - Just _ <- System.Timeout.timeout 1000000 (Control.Exception.evaluate $! result) - return () ) - -parsing0 :: TestTree -parsing0 = Test.Tasty.HUnit.testCase "Parsing regression #0" (do - -- Verify that parsing should not fail - -- - -- In 267093f8cddf1c2f909f2d997c31fd0a7cb2440a I broke the parser when left - -- factoring the grammer by failing to handle the source tested by this - -- regression test. The root of the problem was that the parser was trying - -- to parse `List ./Node` as `Field List "/Node"` instead of - -- `App List (Embed (Path (File Homeless "./Node") Code))`. The latter is - -- the correct parse because `/Node` is not a valid field label, but the - -- mistaken parser was committed to the incorrect parse and never attempted - -- the correct parse. - case Dhall.Parser.exprFromText mempty "List ./Node" of - Left e -> Control.Exception.throwIO e - Right _ -> return () ) - -typeChecking0 :: TestTree -typeChecking0 = Test.Tasty.HUnit.testCase "Type-checking regression #0" (do - -- There used to be a bug in the type-checking logic where `T` would be - -- added to the context when inferring the type of `λ(x : T) → x`, but was - -- missing from the context when inferring the kind of the inferred type - -- (i.e. the kind of `∀(x : T) → T`). This led to an unbound variable - -- error when inferring the kind - -- - -- This bug was originally reported in issue #10 - _ <- Util.code "let Day : Type = Natural in λ(x : Day) → x" - return () ) - -typeChecking1 :: TestTree -typeChecking1 = Test.Tasty.HUnit.testCase "Type-checking regression #1" (do - -- There used to be a bug in the type-checking logic when inferring the - -- type of `let`. Specifically, given an expression of the form: - -- - -- let x : t = e1 in e2 - -- - -- ... the type-checker would not substitute `x` for `e1` in the inferred - -- of the `let` expression. This meant that if the inferred type contained - -- any references to `x` then these references would escape their scope and - -- result in unbound variable exceptions - -- - -- This regression test exercises that code path by creating a `let` - -- expression where the inferred type before substitution (`∀(x : b) → b` in - -- this example), contains a reference to the `let`-bound variable (`b`) - -- that needs to be substituted with `a` in order to produce the final - -- correct inferred type (`∀(x : a) → a`). If this test passes then - -- substitution worked correctly. If substitution doesn't occur then you - -- expect an `Unbound variable` error from `b` escaping its scope due to - -- being returned as part of the inferred type - _ <- Util.code "λ(a : Type) → let b : Type = a in λ(x : b) → x" - return () ) - -typeChecking2 :: TestTree -typeChecking2 = Test.Tasty.HUnit.testCase "Type-checking regression #2" (do - -- There used to be a bug in the type-checking logic where `let` bound - -- variables would not correctly shadow variables of the same name when - -- inferring the type of of the `let` expression - -- - -- This example exercises this code path with a `let` expression where the - -- `let`-bound variable (`a`) has the same name as its own type (`a`). If - -- shadowing works correctly then the final `a` in the expression should - -- refer to the `let`-bound variable and not its type. An invalid reference - -- to the shadowed type `a` would result in an invalid dependently typed - -- function - _ <- Util.code "λ(a : Type) → λ(x : a) → let a : a = x in a" - return () ) - -trailingSpaceAfterStringLiterals :: TestTree -trailingSpaceAfterStringLiterals = - Test.Tasty.HUnit.testCase "Trailing space after string literals" (do - -- Verify that string literals parse correctly with trailing space - -- (Yes, I did get this wrong at some point) - _ <- Util.code "(''ABC'' ++ \"DEF\" )" - return () ) diff --git a/tests/Tests.hs b/tests/Tests.hs deleted file mode 100644 --- a/tests/Tests.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main where - -import Normalization (normalizationTests) -import Parser (parserTests) -import Regression (regressionTests) -import Tutorial (tutorialTests) -import TypeCheck (typecheckTests) -import Format (formatTests) -import Test.Tasty - -allTests :: TestTree -allTests = - testGroup "Dhall Tests" - [ normalizationTests - , parserTests - , regressionTests - , tutorialTests - , formatTests - , typecheckTests - ] - -main :: IO () -main = defaultMain allTests diff --git a/tests/Tutorial.hs b/tests/Tutorial.hs deleted file mode 100644 --- a/tests/Tutorial.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} - -module Tutorial where - -import qualified Data.Vector -import qualified Dhall -import qualified Test.Tasty -import qualified Test.Tasty.HUnit -import qualified Util - -import Data.Monoid ((<>)) -import Data.Text (Text) -import Dhall (Inject) -import GHC.Generics (Generic) -import Numeric.Natural (Natural) -import Test.Tasty (TestTree) -import Test.Tasty.HUnit ((@?=)) - -tutorialTests :: TestTree -tutorialTests = - Test.Tasty.testGroup "tutorial" - [ Test.Tasty.testGroup "Interpolation" - [ _Interpolation_0 - , _Interpolation_1 - ] - , Test.Tasty.testGroup "Functions" - [ _Functions_0 - , _Functions_1 - , _Functions_2 - ] - , Test.Tasty.testGroup "Unions" - [ example 0 "./tests/tutorial/unions0A.dhall" "./tests/tutorial/unions0B.dhall" - , example 1 "./tests/tutorial/unions1A.dhall" "./tests/tutorial/unions1B.dhall" - , example 2 "./tests/tutorial/unions2A.dhall" "./tests/tutorial/unions2B.dhall" - , example 3 "./tests/tutorial/unions3A.dhall" "./tests/tutorial/unions3B.dhall" - , example 4 "./tests/tutorial/unions4A.dhall" "./tests/tutorial/unions4B.dhall" - ] - ] - -_Interpolation_0 :: TestTree -_Interpolation_0 = Test.Tasty.HUnit.testCase "Example #0" (do - e <- Util.code - " let name = \"John Doe\" \n\ - \in let age = 21 \n\ - \in \"My name is ${name} and my age is ${Integer/show age}\"\n" - Util.assertNormalizesTo e "\"My name is John Doe and my age is 21\"" ) - -_Interpolation_1 :: TestTree -_Interpolation_1 = Test.Tasty.HUnit.testCase "Example #1" (do - e <- Util.code - "'' \n\ - \ for file in *; do \n\ - \ echo \"Found ''${file}\"\n\ - \ done \n\ - \'' \n" - Util.assertNormalized e ) - -_Functions_0 :: TestTree -_Functions_0 = Test.Tasty.HUnit.testCase "Example #0" (do - let text = "\\(n : Bool) -> [ n && True, n && False, n || True, n || False ]" - makeBools <- Dhall.input Dhall.auto text - makeBools True @?= Data.Vector.fromList [True,False,True,True] ) - -_Functions_1 :: TestTree -_Functions_1 = Test.Tasty.HUnit.testCase "Example #1" (do - let text = "λ(x : Bool) → λ(y : Bool) → x && y" - makeBools <- Dhall.input Dhall.auto text - makeBools True False @?= False ) - -data Example0 = Example0 { foo :: Bool, bar :: Bool } - deriving (Generic, Inject) - -_Functions_2 :: TestTree -_Functions_2 = Test.Tasty.HUnit.testCase "Example #2" (do - f <- Dhall.input Dhall.auto "λ(r : { foo : Bool, bar : Bool }) → r.foo && r.bar" - f (Example0 { foo = True, bar = False }) @?= False - f (Example0 { foo = True, bar = True }) @?= True ) - -example :: Natural -> Text -> Text -> TestTree -example n text0 text1 = - Test.Tasty.HUnit.testCase - ("Example #" <> show n) - (Util.equivalent text0 text1) diff --git a/tests/TypeCheck.hs b/tests/TypeCheck.hs deleted file mode 100644 --- a/tests/TypeCheck.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module TypeCheck where - -import Data.Monoid (mempty, (<>)) -import Data.Text.Lazy (Text) -import Test.Tasty (TestTree) - -import qualified Control.Exception -import qualified Data.Text.Lazy -import qualified Dhall.Core -import qualified Dhall.Import -import qualified Dhall.Parser -import qualified Dhall.TypeCheck -import qualified Test.Tasty -import qualified Test.Tasty.HUnit - -typecheckTests :: TestTree -typecheckTests = - Test.Tasty.testGroup "typecheck tests" - [ Test.Tasty.testGroup "Prelude examples" - [ should "Monoid" "./examples/Monoid/00" - , should "Monoid" "./examples/Monoid/01" - , should "Monoid" "./examples/Monoid/02" - , should "Monoid" "./examples/Monoid/03" - , should "Monoid" "./examples/Monoid/04" - , should "Monoid" "./examples/Monoid/05" - , should "Monoid" "./examples/Monoid/06" - , should "Monoid" "./examples/Monoid/07" - , should "Monoid" "./examples/Monoid/08" - , should "Monoid" "./examples/Monoid/09" - , should "Monoid" "./examples/Monoid/10" - ] - , should - "allow type-valued fields in a record" - "fieldsAreTypes" - , should - "allow type-valued alternatives in a union" - "alternativesAreTypes" - , should - "allow anonymous functions in types to be judgmentally equal" - "anonymousFunctionsInTypes" - ] - -should :: Text -> Text -> TestTree -should name basename = - Test.Tasty.HUnit.testCase (Data.Text.Lazy.unpack name) $ do - let actualCode = "./tests/typecheck/" <> basename <> "A.dhall" - let expectedCode = "./tests/typecheck/" <> basename <> "B.dhall" - - actualExpr <- case Dhall.Parser.exprFromText mempty actualCode of - Left err -> Control.Exception.throwIO err - Right expr -> return expr - expectedExpr <- case Dhall.Parser.exprFromText mempty expectedCode of - Left err -> Control.Exception.throwIO err - Right expr -> return expr - - let annotatedExpr = Dhall.Core.Annot actualExpr expectedExpr - - resolvedExpr <- Dhall.Import.load annotatedExpr - case Dhall.TypeCheck.typeOf resolvedExpr of - Left err -> Control.Exception.throwIO err - Right _ -> return () diff --git a/tests/Util.hs b/tests/Util.hs deleted file mode 100644 --- a/tests/Util.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -module Util - ( code - , codeWith - , equivalent - , normalize' - , normalizeWith' - , assertNormalizesTo - , assertNormalizesToWith - , assertNormalized - , assertTypeChecks - ) where - -import qualified Control.Exception -import qualified Data.Functor -import Data.Bifunctor (first) -import Data.Text (Text) -import qualified Data.Text.Lazy -import qualified Dhall.Core -import Dhall.Core (Expr, Normalizer) -import qualified Dhall.Context -import Dhall.Context (Context) -import qualified Dhall.Import -import qualified Dhall.Parser -import Dhall.Parser (Src) -import qualified Dhall.TypeCheck -import Dhall.TypeCheck (X) -import Test.Tasty.HUnit - -normalize' :: Expr Src X -> Data.Text.Lazy.Text -normalize' = Dhall.Core.pretty . Dhall.Core.normalize - -normalizeWith' :: Normalizer X -> Expr Src X -> Data.Text.Lazy.Text -normalizeWith' ctx = Dhall.Core.pretty . Dhall.Core.normalizeWith ctx - -code :: Data.Text.Text -> IO (Expr Src X) -code = codeWith Dhall.Context.empty - -codeWith :: Context (Expr Src X) -> Data.Text.Text -> IO (Expr Src X) -codeWith ctx strictText = do - let lazyText = Data.Text.Lazy.fromStrict strictText - expr0 <- case Dhall.Parser.exprFromText mempty lazyText of - Left parseError -> Control.Exception.throwIO parseError - Right expr0 -> return expr0 - expr1 <- Dhall.Import.load expr0 - case Dhall.TypeCheck.typeWith ctx expr1 of - Left typeError -> Control.Exception.throwIO typeError - Right _ -> return () - return expr1 - -equivalent :: Data.Text.Text -> Data.Text.Text -> IO () -equivalent text0 text1 = do - expr0 <- fmap Dhall.Core.normalize (Util.code text0) :: IO (Expr X X) - expr1 <- fmap Dhall.Core.normalize (Util.code text1) :: IO (Expr X X) - assertEqual "Expressions are not equivalent" expr0 expr1 - -assertNormalizesTo :: Expr Src X -> Data.Text.Lazy.Text -> IO () -assertNormalizesTo e expected = do - assertBool msg (not $ Dhall.Core.isNormalized e) - normalize' e @?= expected - where msg = "Given expression is already in normal form" - -assertNormalizesToWith :: Normalizer X -> Expr Src X -> Data.Text.Lazy.Text -> IO () -assertNormalizesToWith ctx e expected = do - assertBool msg (not $ Dhall.Core.isNormalizedWith ctx (first (const ()) e)) - normalizeWith' ctx e @?= expected - where msg = "Given expression is already in normal form" - -assertNormalized :: Expr Src X -> IO () -assertNormalized e = do - assertBool msg1 (Dhall.Core.isNormalized e) - assertEqual msg2 (normalize' e) (Dhall.Core.pretty e) - where msg1 = "Expression was not in normal form" - msg2 = "Normalization is not supposed to change the expression" - -assertTypeChecks :: Text -> IO () -assertTypeChecks text = Data.Functor.void (code text) diff --git a/tests/diff/appList.txt b/tests/diff/appList.txt new file mode 100644 --- /dev/null +++ b/tests/diff/appList.txt @@ -0,0 +1,4 @@ + λ(… : … + → …) +→ … + … diff --git a/tests/diff/appListA.dhall b/tests/diff/appListA.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/appListA.dhall @@ -0,0 +1,1 @@ +λ(f : List Bool -> Bool) → f ([] : List Bool) diff --git a/tests/diff/appListB.dhall b/tests/diff/appListB.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/appListB.dhall @@ -0,0 +1,1 @@ +λ(f : List Bool -> Bool) → f ([] : List Bool) diff --git a/tests/diff/emptyList.txt b/tests/diff/emptyList.txt new file mode 100644 --- /dev/null +++ b/tests/diff/emptyList.txt @@ -0,0 +1,2 @@ +- [] : … ++ True diff --git a/tests/diff/emptyListA.dhall b/tests/diff/emptyListA.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/emptyListA.dhall @@ -0,0 +1,1 @@ +[] : List Natural diff --git a/tests/diff/emptyListB.dhall b/tests/diff/emptyListB.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/emptyListB.dhall @@ -0,0 +1,1 @@ +True diff --git a/tests/diff/function.txt b/tests/diff/function.txt new file mode 100644 --- /dev/null +++ b/tests/diff/function.txt @@ -0,0 +1,6 @@ + … +→ … +→ …@- 1 + + 0 + +→ … diff --git a/tests/diff/functionA.dhall b/tests/diff/functionA.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/functionA.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(b : Type) → ∀(x : a) → Bool diff --git a/tests/diff/functionB.dhall b/tests/diff/functionB.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/functionB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(b : Type) → ∀(x : b) → Bool diff --git a/tests/diff/insideList.txt b/tests/diff/insideList.txt new file mode 100644 --- /dev/null +++ b/tests/diff/insideList.txt @@ -0,0 +1,7 @@ +[ … +, { y = - 4 + + 5 + , … + } +] + diff --git a/tests/diff/insideListA.dhall b/tests/diff/insideListA.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/insideListA.dhall @@ -0,0 +1,3 @@ +[ { x = 1, y = 2 } +, { x = 3, y = 4 } +] diff --git a/tests/diff/insideListB.dhall b/tests/diff/insideListB.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/insideListB.dhall @@ -0,0 +1,3 @@ +[ { x = 1, y = 2 } +, { x = 3, y = 5 } +] diff --git a/tests/diff/nonEmptyList.txt b/tests/diff/nonEmptyList.txt new file mode 100644 --- /dev/null +++ b/tests/diff/nonEmptyList.txt @@ -0,0 +1,2 @@ +- [ … ] ++ True diff --git a/tests/diff/nonEmptyListA.dhall b/tests/diff/nonEmptyListA.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/nonEmptyListA.dhall @@ -0,0 +1,1 @@ +[1] diff --git a/tests/diff/nonEmptyListB.dhall b/tests/diff/nonEmptyListB.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/nonEmptyListB.dhall @@ -0,0 +1,1 @@ +True diff --git a/tests/diff/with.txt b/tests/diff/with.txt new file mode 100644 --- /dev/null +++ b/tests/diff/with.txt @@ -0,0 +1,5 @@ + λ(… : { … + }) +→ … with …+ .c.d + = - 2 + + 3 diff --git a/tests/diff/withA.dhall b/tests/diff/withA.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/withA.dhall @@ -0,0 +1,1 @@ +λ(r : { a : Natural }) → r with b = 2 diff --git a/tests/diff/withB.dhall b/tests/diff/withB.dhall new file mode 100644 --- /dev/null +++ b/tests/diff/withB.dhall @@ -0,0 +1,1 @@ +λ(r : { a : Natural }) → r with b.c.d = 3 diff --git a/tests/format/applicationMultilineA.dhall b/tests/format/applicationMultilineA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/applicationMultilineA.dhall @@ -0,0 +1,33 @@ +{ app = + ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff + aaaaaaaaaaaaaaaaa +, app2 = + f + a + b + cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +, app3 = + f + a + b + c + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd +, some = + Some + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa +, someList = + Some + [ aaaaaaaaaaaaaaaaaaaaaaaaaa, bbbbbbbbbbbbbbbbbbbb, cccccccccccccccccccccccc, dddddddddddddd ] +, merge1 = + merge + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +, merge3 = + merge + a + b + ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +, toMap1 = + toMap + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa +} diff --git a/tests/format/applicationMultilineB.dhall b/tests/format/applicationMultilineB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/applicationMultilineB.dhall @@ -0,0 +1,34 @@ +{ app = + ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff + aaaaaaaaaaaaaaaaa +, app2 = + f + a + b + cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +, app3 = + f + a + b + c + dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd +, some = Some + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa +, someList = Some + [ aaaaaaaaaaaaaaaaaaaaaaaaaa + , bbbbbbbbbbbbbbbbbbbb + , cccccccccccccccccccccccc + , dddddddddddddd + ] +, merge1 = + merge + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb +, merge3 = + merge + a + b + ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +, toMap1 = toMap + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa +} diff --git a/tests/format/asciiA.dhall b/tests/format/asciiA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/asciiA.dhall @@ -0,0 +1,1 @@ +λ(a : Type) → ∀(b : a) → a diff --git a/tests/format/asciiB.dhall b/tests/format/asciiB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/asciiB.dhall @@ -0,0 +1,1 @@ +\(a : Type) -> forall (b : a) -> a diff --git a/tests/format/concatSepA.dhall b/tests/format/concatSepA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/concatSepA.dhall @@ -0,0 +1,30 @@ +{- +Concatenate a `List` of `Text` values with a separator in between each value +-} +let Status = < Empty | NonEmpty : Text > + +let concatSep + : ∀(separator : Text) → ∀(elements : List Text) → Text + = λ(separator : Text) + → λ(elements : List Text) + → let status = + List/fold Text elements Status + ( λ(element : Text) + → λ(status : Status) + → merge + { Empty = Status.NonEmpty element + , NonEmpty = + λ(result : Text) + → Status.NonEmpty (element ++ separator ++ result) + } + status + ) + Status.Empty + + in merge { Empty = "", NonEmpty = λ(result : Text) → result } status + +let example0 = assert : concatSep ", " [ "ABC", "DEF", "GHI" ] ≡ "ABC, DEF, GHI" + +let example1 = assert : concatSep ", " ([] : List Text) ≡ "" + +in concatSep diff --git a/tests/format/concatSepB.dhall b/tests/format/concatSepB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/concatSepB.dhall @@ -0,0 +1,33 @@ +{- +Concatenate a `List` of `Text` values with a separator in between each value +-} +let Status = < Empty | NonEmpty : Text > + +let concatSep + : ∀(separator : Text) → ∀(elements : List Text) → Text + = λ(separator : Text) → + λ(elements : List Text) → + let status = + List/fold + Text + elements + Status + ( λ(element : Text) → + λ(status : Status) → + merge + { Empty = Status.NonEmpty element + , NonEmpty = + λ(result : Text) → + Status.NonEmpty (element ++ separator ++ result) + } + status + ) + Status.Empty + + in merge { Empty = "", NonEmpty = λ(result : Text) → result } status + +let example0 = assert : concatSep ", " [ "ABC", "DEF", "GHI" ] ≡ "ABC, DEF, GHI" + +let example1 = assert : concatSep ", " ([] : List Text) ≡ "" + +in concatSep diff --git a/tests/format/dottedFieldsA.dhall b/tests/format/dottedFieldsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/dottedFieldsA.dhall @@ -0,0 +1,1 @@ +{ x = { y = { a = { b = 1 }, c = { d = 2 } } } } diff --git a/tests/format/dottedFieldsB.dhall b/tests/format/dottedFieldsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/dottedFieldsB.dhall @@ -0,0 +1,1 @@ +{ x.y = { a.b = 1, c.d = 2 } } diff --git a/tests/format/dottedFieldsCommentsA.dhall b/tests/format/dottedFieldsCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/dottedFieldsCommentsA.dhall @@ -0,0 +1,17 @@ +{ {- A -} + a + -- B + . -- C + b + . c + {- D -} + . d = + -- E + x +, {- F -} + e + {- G -} + . f = + {- H -} + { g = y } +} diff --git a/tests/format/dottedFieldsCommentsB.dhall b/tests/format/dottedFieldsCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/dottedFieldsCommentsB.dhall @@ -0,0 +1,17 @@ +{ {- A -} + a + -- B + . -- C + b + . c + {- D -} + . d + = -- E + x +, {- F -} + e + {- G -} + . f + = {- H -} + { g = y } +} diff --git a/tests/format/doubleRoundA.dhall b/tests/format/doubleRoundA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/doubleRoundA.dhall @@ -0,0 +1,41 @@ +[ 1.0000000000000000 +, 1.0000000000000001 +, 1.0000000000000002 +, 1.0000000000000003 +, 1.0000000000000004 +, 1.0000000000000005 +, 1.0000000000000006 +, 1.0000000000000007 +, 1.0000000000000008 +, 1.0000000000000009 + +, 1.0000000000000000e64 +, 1.0000000000000001e64 +, 1.0000000000000002e64 +, 1.0000000000000003e64 +, 1.0000000000000004e64 +, 1.0000000000000005e64 +, 1.0000000000000006e64 +, 1.0000000000000007e64 +, 1.0000000000000008e64 +, 1.0000000000000009e64 + +, 1.0000000000000000e100 +, 1.0000000000000001e100 +, 1.0000000000000002e100 +, 1.0000000000000003e100 +, 1.0000000000000004e100 +, 1.0000000000000005e100 +, 1.0000000000000006e100 +, 1.0000000000000007e100 +, 1.0000000000000008e100 +, 1.0000000000000009e100 + +, 179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791.0 +, 179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945.0 +, 179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944.0 + +, -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791.0 +, -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945.0 +, -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944.0 +] diff --git a/tests/format/doubleRoundB.dhall b/tests/format/doubleRoundB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/doubleRoundB.dhall @@ -0,0 +1,37 @@ +[ 1.0000000000000000 +, 1.0000000000000001 +, 1.0000000000000002 +, 1.0000000000000003 +, 1.0000000000000004 +, 1.0000000000000005 +, 1.0000000000000006 +, 1.0000000000000007 +, 1.0000000000000008 +, 1.0000000000000009 +, 1.0000000000000000e64 +, 1.0000000000000001e64 +, 1.0000000000000002e64 +, 1.0000000000000003e64 +, 1.0000000000000004e64 +, 1.0000000000000005e64 +, 1.0000000000000006e64 +, 1.0000000000000007e64 +, 1.0000000000000008e64 +, 1.0000000000000009e64 +, 1.0000000000000000e100 +, 1.0000000000000001e100 +, 1.0000000000000002e100 +, 1.0000000000000003e100 +, 1.0000000000000004e100 +, 1.0000000000000005e100 +, 1.0000000000000006e100 +, 1.0000000000000007e100 +, 1.0000000000000008e100 +, 1.0000000000000009e100 +, 179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791.0 +, 179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945.0 +, 179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944.0 +, -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791.0 +, -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945.0 +, -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944.0 +] diff --git a/tests/format/duplicatesA.dhall b/tests/format/duplicatesA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/duplicatesA.dhall @@ -0,0 +1,4 @@ +{ {- Comments around duplicate fields are not preserved -} foo.bar = 1 +, foo = { baz = {- Comments within values are still preserved-} 2 } +, foo = qux +} diff --git a/tests/format/duplicatesB.dhall b/tests/format/duplicatesB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/duplicatesB.dhall @@ -0,0 +1,6 @@ +{ foo.bar = 1 +, foo.baz + = {- Comments within values are still preserved-} + 2 +, foo = qux +} diff --git a/tests/format/emptyRecordB.dhall b/tests/format/emptyRecordB.dhall --- a/tests/format/emptyRecordB.dhall +++ b/tests/format/emptyRecordB.dhall diff --git a/tests/format/envVarsA.dhall b/tests/format/envVarsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/envVarsA.dhall @@ -0,0 +1,1 @@ +[ env:x, env:"1", env:" ", env:"\\", env:"." ] diff --git a/tests/format/envVarsB.dhall b/tests/format/envVarsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/envVarsB.dhall @@ -0,0 +1,1 @@ +[ env:x, env:"1", env:" ", env:"\\", env:"." ] diff --git a/tests/format/escapeNumericLabelB.dhall b/tests/format/escapeNumericLabelB.dhall --- a/tests/format/escapeNumericLabelB.dhall +++ b/tests/format/escapeNumericLabelB.dhall diff --git a/tests/format/escapeSingleQuotedOpenInterpolationB.dhall b/tests/format/escapeSingleQuotedOpenInterpolationB.dhall --- a/tests/format/escapeSingleQuotedOpenInterpolationB.dhall +++ b/tests/format/escapeSingleQuotedOpenInterpolationB.dhall diff --git a/tests/format/fieldOrderB.dhall b/tests/format/fieldOrderB.dhall --- a/tests/format/fieldOrderB.dhall +++ b/tests/format/fieldOrderB.dhall diff --git a/tests/format/functionLikeA.dhall b/tests/format/functionLikeA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/functionLikeA.dhall @@ -0,0 +1,6 @@ +{ example0 = merge a b + merge a b +, example1 = (merge a b : T) + (merge a b : T) +, example2 = toMap a + toMap a +, example3 = (toMap a b : T) + (toMap a b : T) +, example4 = Some a + Some a +} diff --git a/tests/format/functionLikeB.dhall b/tests/format/functionLikeB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/functionLikeB.dhall @@ -0,0 +1,6 @@ +{ example0 = merge a b + merge a b +, example1 = (merge a b : T) + (merge a b : T) +, example2 = toMap a + toMap a +, example3 = (toMap a b : T) + (toMap a b : T) +, example4 = Some a + Some a +} diff --git a/tests/format/headerA.dhall b/tests/format/headerA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/headerA.dhall @@ -0,0 +1,4 @@ + +{- bla -} + +True diff --git a/tests/format/headerB.dhall b/tests/format/headerB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/headerB.dhall @@ -0,0 +1,2 @@ +{- bla -} +True diff --git a/tests/format/headerNoNewlineA.dhall b/tests/format/headerNoNewlineA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/headerNoNewlineA.dhall @@ -0,0 +1,1 @@ +{- -}0 diff --git a/tests/format/headerNoNewlineB.dhall b/tests/format/headerNoNewlineB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/headerNoNewlineB.dhall @@ -0,0 +1,2 @@ +{- -} +0 diff --git a/tests/format/ifThenElseA.dhall b/tests/format/ifThenElseA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/ifThenElseA.dhall @@ -0,0 +1,2 @@ +if True then if True then if True then 1 else 2 else if True then 3 else 4 +else if True then if True then 5 else 6 else if True then 7 else 8 diff --git a/tests/format/ifThenElseB.dhall b/tests/format/ifThenElseB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/ifThenElseB.dhall @@ -0,0 +1,7 @@ +if True +then if True then if True then 1 else 2 else if True then 3 else 4 +else if True +then if True then 5 else 6 +else if True +then 7 +else 8 diff --git a/tests/format/importAccessA.dhall b/tests/format/importAccessA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importAccessA.dhall @@ -0,0 +1,1 @@ +(./testImport).hello diff --git a/tests/format/importAccessB.dhall b/tests/format/importAccessB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importAccessB.dhall @@ -0,0 +1,1 @@ +(./testImport).hello diff --git a/tests/format/importAltPrecedenceA.dhall b/tests/format/importAltPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importAltPrecedenceA.dhall @@ -0,0 +1,1 @@ +a ? b || c diff --git a/tests/format/importAltPrecedenceB.dhall b/tests/format/importAltPrecedenceB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importAltPrecedenceB.dhall @@ -0,0 +1,1 @@ +a ? b || c diff --git a/tests/format/importLines2A.dhall b/tests/format/importLines2A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importLines2A.dhall @@ -0,0 +1,2 @@ +let _ = ./emptyRecordA.dhall +in let _ = ./emptyRecordA.dhall in 123 diff --git a/tests/format/importLines2B.dhall b/tests/format/importLines2B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importLines2B.dhall @@ -0,0 +1,1 @@ +let _ = ./emptyRecordA.dhall in let _ = ./emptyRecordA.dhall in 123 diff --git a/tests/format/importLinesA.dhall b/tests/format/importLinesA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importLinesA.dhall @@ -0,0 +1,7 @@ +let _ = ./emptyRecordA.dhall +let _ = ./emptyRecordA.dhall +let _ = ./emptyRecordA.dhall +let _ = ./emptyRecordA.dhall +let _ = ./emptyRecordA.dhall +let _ = ./emptyRecordA.dhall +in 123 diff --git a/tests/format/importLinesB.dhall b/tests/format/importLinesB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importLinesB.dhall @@ -0,0 +1,13 @@ +let _ = ./emptyRecordA.dhall + +let _ = ./emptyRecordA.dhall + +let _ = ./emptyRecordA.dhall + +let _ = ./emptyRecordA.dhall + +let _ = ./emptyRecordA.dhall + +let _ = ./emptyRecordA.dhall + +in 123 diff --git a/tests/format/importSuffixA.dhall b/tests/format/importSuffixA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importSuffixA.dhall @@ -0,0 +1,1 @@ +let a = env:AAA as Text in a diff --git a/tests/format/importSuffixB.dhall b/tests/format/importSuffixB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/importSuffixB.dhall @@ -0,0 +1,1 @@ +let a = env:AAA as Text in a diff --git a/tests/format/innerMultilineA.dhall b/tests/format/innerMultilineA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/innerMultilineA.dhall @@ -0,0 +1,11 @@ +{ inner = + '' + + one + + two + + three + + '' +} diff --git a/tests/format/innerMultilineB.dhall b/tests/format/innerMultilineB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/innerMultilineB.dhall @@ -0,0 +1,11 @@ +{ inner = + '' + + one + + two + + three + + '' +} diff --git a/tests/format/interpolation0A.dhall b/tests/format/interpolation0A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/interpolation0A.dhall @@ -0,0 +1,1 @@ +"foo\n${a} bar" diff --git a/tests/format/interpolation0B.dhall b/tests/format/interpolation0B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/interpolation0B.dhall @@ -0,0 +1,3 @@ +'' +foo +${a} bar'' diff --git a/tests/format/ipfsA.dhall b/tests/format/ipfsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/ipfsA.dhall @@ -0,0 +1,163 @@ +let name = "ipfs" + +let labels = + { `app.kubernetes.io/name` = name + , `app.kubernetes.io/instance` = "wintering-rodent" + , `app.kubernetes.io/version` = "0.4.0" + , `app.kubernetes.io/managed-by` = "dhall" + } + +let matchLabels = + labels.{ `app.kubernetes.io/name`, `app.kubernetes.io/instance` } + +let k8s = + https://raw.githubusercontent.com/dhall-lang/dhall-kubernetes/4ab28225a150498aef67c226d3c5f026c95b5a1e/package.dhall sha256:2c7ac35494f16b1f39afcf3467b2f3b0ab579edb0c711cddd2c93f1cbed358bd + +let serviceName = "ipfs" + +let apiPort = k8s.IntOrString.Int 5001 + +let gatewayPort = k8s.IntOrString.Int 8080 + +let toRule = + λ ( args + : { host : Text + , path : Text + , serviceName : Text + , servicePort : k8s.IntOrString + } + ) + → k8s.IngressRule::{ + , host = Some args.host + , http = + Some + k8s.HTTPIngressRuleValue::{ + , paths = + [ k8s.HTTPIngressPath::{ + , path = Some args.path + , backend = + k8s.IngressBackend::args.{ serviceName, servicePort } + } + ] + } + } + +in [ k8s.Resource.Ingress + k8s.Ingress::{ + , metadata = + k8s.ObjectMeta::{ labels = toMap labels, name = "${name}-api" } + , spec = + Some + k8s.IngressSpec::{ + , rules = + [ toRule + { host = "localhost" + , path = "/" + , serviceName = serviceName + , servicePort = gatewayPort + } + , toRule + { host = "localhost" + , path = "/" + , serviceName = serviceName + , servicePort = apiPort + } + ] + } + } + , k8s.Resource.Service + k8s.Service::{ + , metadata = + k8s.ObjectMeta::{ name = serviceName, labels = toMap labels } + , spec = + Some + k8s.ServiceSpec::{ + , ports = + [ k8s.ServicePort::{ + , port = 5001 + , targetPort = Some apiPort + , name = Some "api" + } + , k8s.ServicePort::{ + , port = 8080 + , targetPort = Some gatewayPort + , name = Some "api" + } + ] + , selector = toMap matchLabels + } + } + , k8s.Resource.StatefulSet + k8s.StatefulSet::{ + , metadata = k8s.ObjectMeta::{ name = name, labels = toMap labels } + , spec = + Some + k8s.StatefulSetSpec::{ + , serviceName = serviceName + , selector = + k8s.LabelSelector::{ matchLabels = toMap matchLabels } + , template = + k8s.PodTemplateSpec::{ + , metadata = + k8s.ObjectMeta::{ name = name, labels = toMap labels } + , spec = + Some + k8s.PodSpec::{ + , securityContext = + Some + k8s.PodSecurityContext::{ + , runAsUser = Some 1000 + , runAsGroup = Some 1000 + , fsGroup = Some 1000 + } + , containers = + [ k8s.Container::{ + , name = name + , image = Some "ipfs/go-ipfs:v0.4.22" + , livenessProbe = + k8s.Probe::{ + , httpGet = + Some + k8s.HTTPGetAction::{ + , path = + Some "/debug/metrics/prometheus" + , port = k8s.IntOrString.String "api" + } + , initialDelaySeconds = Some 15 + , periodSeconds = Some 3 + } + , readinessProbe = + k8s.Probe::{ + , httpGet = + Some + k8s.HTTPGetAction::{ + , path = + Some "/debug/metrics/prometheus" + , port = k8s.IntOrString.String "api" + } + , initialDelaySeconds = Some 15 + , periodSeconds = Some 3 + } + , ports = + [ k8s.ContainerPort::{ + , containerPort = 5001 + , name = Some "api" + } + , k8s.ContainerPort::{ + , containerPort = 8080 + , name = Some "gateway" + } + ] + , volumeMounts = + [ k8s.VolumeMount::{ + , name = "ipfs-storage" + , mountPath = "/data/ipfs" + } + ] + } + ] + } + } + } + } + ] diff --git a/tests/format/ipfsB.dhall b/tests/format/ipfsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/ipfsB.dhall @@ -0,0 +1,144 @@ +let name = "ipfs" + +let labels = + { `app.kubernetes.io/name` = name + , `app.kubernetes.io/instance` = "wintering-rodent" + , `app.kubernetes.io/version` = "0.4.0" + , `app.kubernetes.io/managed-by` = "dhall" + } + +let matchLabels = + labels.{ `app.kubernetes.io/name`, `app.kubernetes.io/instance` } + +let k8s = + https://raw.githubusercontent.com/dhall-lang/dhall-kubernetes/4ab28225a150498aef67c226d3c5f026c95b5a1e/package.dhall + sha256:2c7ac35494f16b1f39afcf3467b2f3b0ab579edb0c711cddd2c93f1cbed358bd + +let serviceName = "ipfs" + +let apiPort = k8s.IntOrString.Int 5001 + +let gatewayPort = k8s.IntOrString.Int 8080 + +let toRule = + λ ( args + : { host : Text + , path : Text + , serviceName : Text + , servicePort : k8s.IntOrString + } + ) → + k8s.IngressRule::{ + , host = Some args.host + , http = Some k8s.HTTPIngressRuleValue::{ + , paths = + [ k8s.HTTPIngressPath::{ + , path = Some args.path + , backend = k8s.IngressBackend::args.{ serviceName, servicePort } + } + ] + } + } + +in [ k8s.Resource.Ingress + k8s.Ingress::{ + , metadata = k8s.ObjectMeta::{ + , labels = toMap labels + , name = "${name}-api" + } + , spec = Some k8s.IngressSpec::{ + , rules = + [ toRule + { host = "localhost" + , path = "/" + , serviceName + , servicePort = gatewayPort + } + , toRule + { host = "localhost" + , path = "/" + , serviceName + , servicePort = apiPort + } + ] + } + } + , k8s.Resource.Service + k8s.Service::{ + , metadata = k8s.ObjectMeta::{ + , name = serviceName + , labels = toMap labels + } + , spec = Some k8s.ServiceSpec::{ + , ports = + [ k8s.ServicePort::{ + , port = 5001 + , targetPort = Some apiPort + , name = Some "api" + } + , k8s.ServicePort::{ + , port = 8080 + , targetPort = Some gatewayPort + , name = Some "api" + } + ] + , selector = toMap matchLabels + } + } + , k8s.Resource.StatefulSet + k8s.StatefulSet::{ + , metadata = k8s.ObjectMeta::{ name, labels = toMap labels } + , spec = Some k8s.StatefulSetSpec::{ + , serviceName + , selector = k8s.LabelSelector::{ matchLabels = toMap matchLabels } + , template = k8s.PodTemplateSpec::{ + , metadata = k8s.ObjectMeta::{ name, labels = toMap labels } + , spec = Some k8s.PodSpec::{ + , securityContext = Some k8s.PodSecurityContext::{ + , runAsUser = Some 1000 + , runAsGroup = Some 1000 + , fsGroup = Some 1000 + } + , containers = + [ k8s.Container::{ + , name + , image = Some "ipfs/go-ipfs:v0.4.22" + , livenessProbe = k8s.Probe::{ + , httpGet = Some k8s.HTTPGetAction::{ + , path = Some "/debug/metrics/prometheus" + , port = k8s.IntOrString.String "api" + } + , initialDelaySeconds = Some 15 + , periodSeconds = Some 3 + } + , readinessProbe = k8s.Probe::{ + , httpGet = Some k8s.HTTPGetAction::{ + , path = Some "/debug/metrics/prometheus" + , port = k8s.IntOrString.String "api" + } + , initialDelaySeconds = Some 15 + , periodSeconds = Some 3 + } + , ports = + [ k8s.ContainerPort::{ + , containerPort = 5001 + , name = Some "api" + } + , k8s.ContainerPort::{ + , containerPort = 8080 + , name = Some "gateway" + } + ] + , volumeMounts = + [ k8s.VolumeMount::{ + , name = "ipfs-storage" + , mountPath = "/data/ipfs" + } + ] + } + ] + } + } + } + } + ] diff --git a/tests/format/issue1301A.dhall b/tests/format/issue1301A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1301A.dhall @@ -0,0 +1,5 @@ +let attribute + : Text → Text → { mapKey : Text, mapValue : Text } + = λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } + +in attribute diff --git a/tests/format/issue1301B.dhall b/tests/format/issue1301B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1301B.dhall @@ -0,0 +1,5 @@ +let attribute + : Text → Text → { mapKey : Text, mapValue : Text } + = λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } + +in attribute diff --git a/tests/format/issue1400-1A.dhall b/tests/format/issue1400-1A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1400-1A.dhall @@ -0,0 +1,14 @@ +{ conversation = + [ { author = "robert", content = xs } + , { author = "robert", content = xs } + , { author = + "bob" + , content = + [ text + '' + any line going past the 80 characters boundary (e.g. this one is 82) + '' + ] + } + ] +} diff --git a/tests/format/issue1400-1B.dhall b/tests/format/issue1400-1B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1400-1B.dhall @@ -0,0 +1,13 @@ +{ conversation = + [ { author = "robert", content = xs } + , { author = "robert", content = xs } + , { author = "bob" + , content = + [ text + '' + any line going past the 80 characters boundary (e.g. this one is 82) + '' + ] + } + ] +} diff --git a/tests/format/issue1400-2A.dhall b/tests/format/issue1400-2A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1400-2A.dhall @@ -0,0 +1,14 @@ +let Tagged + : Type → Type + = λ ( a + : Type + ) + → { field : + Text + , nesting : + ./Nesting sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting + , contents : a + } + +in Tagged diff --git a/tests/format/issue1400-2B.dhall b/tests/format/issue1400-2B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1400-2B.dhall @@ -0,0 +1,12 @@ +let Tagged + : Type → Type + = λ(a : Type) → + { field : Text + , nesting : + ./Nesting + sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting + , contents : a + } + +in Tagged diff --git a/tests/format/issue1413A.dhall b/tests/format/issue1413A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1413A.dhall @@ -0,0 +1,6 @@ +let foo = + + {- test -} + "hello" + +in foo diff --git a/tests/format/issue1413B.dhall b/tests/format/issue1413B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1413B.dhall @@ -0,0 +1,6 @@ +let foo = + + {- test -} + "hello" + +in foo diff --git a/tests/format/issue1545-1A.dhall b/tests/format/issue1545-1A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1545-1A.dhall @@ -0,0 +1,1 @@ +"\n\tx" diff --git a/tests/format/issue1545-1B.dhall b/tests/format/issue1545-1B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1545-1B.dhall @@ -0,0 +1,3 @@ +'' + +${"\t"}x'' diff --git a/tests/format/issue1545-2A.dhall b/tests/format/issue1545-2A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1545-2A.dhall @@ -0,0 +1,1 @@ +"\n x" diff --git a/tests/format/issue1545-2B.dhall b/tests/format/issue1545-2B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1545-2B.dhall @@ -0,0 +1,3 @@ +'' + +${" "}x'' diff --git a/tests/format/issue1687A.dhall b/tests/format/issue1687A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1687A.dhall @@ -0,0 +1,7 @@ +let {- foo + + bar -} + x = + 1 + +in x diff --git a/tests/format/issue1687B.dhall b/tests/format/issue1687B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1687B.dhall @@ -0,0 +1,7 @@ +let {- foo + + bar -} + x = + 1 + +in x diff --git a/tests/format/issue1805KeywordRecordFieldShouldBeQuotedA.dhall b/tests/format/issue1805KeywordRecordFieldShouldBeQuotedA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1805KeywordRecordFieldShouldBeQuotedA.dhall @@ -0,0 +1,1 @@ +{ `if` = True } diff --git a/tests/format/issue1805KeywordRecordFieldShouldBeQuotedB.dhall b/tests/format/issue1805KeywordRecordFieldShouldBeQuotedB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1805KeywordRecordFieldShouldBeQuotedB.dhall @@ -0,0 +1,1 @@ +{ `if` = True } diff --git a/tests/format/issue1805SomeQuotedInLetButNotInRecordA.dhall b/tests/format/issue1805SomeQuotedInLetButNotInRecordA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1805SomeQuotedInLetButNotInRecordA.dhall @@ -0,0 +1,1 @@ +let `Some` = 3 in { `if` = True, Some = 333 } diff --git a/tests/format/issue1805SomeQuotedInLetButNotInRecordB.dhall b/tests/format/issue1805SomeQuotedInLetButNotInRecordB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue1805SomeQuotedInLetButNotInRecordB.dhall @@ -0,0 +1,1 @@ +let `Some` = 3 in { `if` = True, Some = 333 } diff --git a/tests/format/issue183A.dhall b/tests/format/issue183A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue183A.dhall @@ -0,0 +1,11 @@ + let foo = 1 + +in λ(bar : Integer) + → let exposePort = + λ(portSpec : { ext : Integer, int : Integer }) + → Integer/show portSpec.ext ++ ":" ++ Integer/show portSpec.int + + in let exposeSamePort = + λ(port : Integer) → exposePort { ext = port, int = port } + + in { blah = bar } diff --git a/tests/format/issue183B.dhall b/tests/format/issue183B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue183B.dhall @@ -0,0 +1,11 @@ +let foo = 1 + +in λ(bar : Integer) → + let exposePort = + λ(portSpec : { ext : Integer, int : Integer }) → + Integer/show portSpec.ext ++ ":" ++ Integer/show portSpec.int + + in let exposeSamePort = + λ(port : Integer) → exposePort { ext = port, int = port } + + in { blah = bar } diff --git a/tests/format/issue2047A.dhall b/tests/format/issue2047A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2047A.dhall @@ -0,0 +1,4 @@ +let x = ({ foo = 1 } ∧ { bar = 2 }) + with bar = 3 + with foo = 4 +in x diff --git a/tests/format/issue2047B.dhall b/tests/format/issue2047B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2047B.dhall @@ -0,0 +1,1 @@ +let x = ({ foo = 1 } ∧ { bar = 2 }) with bar = 3 with foo = 4 in x diff --git a/tests/format/issue2078A.dhall b/tests/format/issue2078A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2078A.dhall @@ -0,0 +1,1 @@ +"'\${x}'\n" diff --git a/tests/format/issue2078B.dhall b/tests/format/issue2078B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2078B.dhall @@ -0,0 +1,3 @@ +'' +${"'"}''${x}' +'' diff --git a/tests/format/issue2601A.dhall b/tests/format/issue2601A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2601A.dhall @@ -0,0 +1,11 @@ +let T = < Some | Type > + +let t + : T + = T.`Some` + +let x + : T + = T.Type + +in True diff --git a/tests/format/issue2601B.dhall b/tests/format/issue2601B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2601B.dhall @@ -0,0 +1,11 @@ +let T = < Some | Type > + +let t + : T + = T.`Some` + +let x + : T + = T.Type + +in True diff --git a/tests/format/largeExponentA.dhall b/tests/format/largeExponentA.dhall --- a/tests/format/largeExponentA.dhall +++ b/tests/format/largeExponentA.dhall @@ -1,1 +1,1 @@ -[ 1.0, 1e1000000000, 1e-1000000000 ] +[ 1.0, 1e100, 1e-100 ] diff --git a/tests/format/largeExponentB.dhall b/tests/format/largeExponentB.dhall --- a/tests/format/largeExponentB.dhall +++ b/tests/format/largeExponentB.dhall @@ -1,1 +1,1 @@ -[ 1.0, 1.0e1000000000, 1.0e-1000000000 ] +[ 1.0, 1e100, 1e-100 ] diff --git a/tests/format/largeRecordA.dhall b/tests/format/largeRecordA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/largeRecordA.dhall @@ -0,0 +1,142 @@ +-- This file was tested using console NetHack version 3.6.1 +-- +-- To exercise all options documented in https://nethackwiki.com/wiki/Options +-- see `./unvalidated.dhall` +let types = ./../types.dhall + +let defaults = ./../defaults.dhall + +in defaults.Config + ⫽ { AUTOCOMPLETE = + [ { enable = True, value = "zap" } + , { enable = False, value = "annotate" } + ] + , acoustics = Some True + , align = Some { enable = True, value = types.Alignment.chaotic } + , autodescribe = Some False + , autodig = Some False + , AUTOPICKUP_EXCEPTION = + [ { pickup = False, name = "chest" } + , { pickup = True, name = "dagger" } + ] + , BIND = + [ { keybinding = "!", command = "loot" } + , { keybinding = "^v", command = "untrap" } + , { keybinding = "M-x", command = "terrain" } + ] + , catname = Some "Mirri" + , checkpoint = Some True + , checkspace = Some True + , clicklook = Some False + , cmdassist = Some True + , confirm = Some True + , dark_room = Some False + , disclose = + Some + ( defaults.Disclose + ⫽ { inventory = Some { prompt = True, default = True } + , attributes = Some { prompt = True, default = False } + , monsters_killed = Some { prompt = False, default = True } + , monsters_genocided = Some { prompt = False, default = False } + , conduct = Some { prompt = False, default = False } + , dungeon_overview = Some { prompt = False, default = False } + } + ) + , dogname = Some "Cujo" + , extmenu = Some False + , fixinv = Some True + , force_invmenu = Some False + , fruit = Some "slime mold" + , gender = Some types.Gender.female + , goldX = Some False + , help = Some True + , hilite_pet = Some False + , hilite_pile = Some False + , hilite_status = + defaults.HiliteStatus + ⫽ { gold = + [ { color = types.Color.yellow + , trigger = Some types.Numeric.always + , attributes = None types.Attributes + } + ] + } + , hitpointbar = Some True + , horsename = Some "Erhir" + , ignintr = Some False + , implicit_uncursed = Some True + , legacy = Some True + , lit_corridor = Some False + , lootabc = Some False + , mail = Some True + , mention_walls = Some False + , menucolors = + [ { regex = "blessed" + , color = Some types.Color.cyan + , attributes = defaults.Attributes ⫽ { bold = Some True } + } + ] + , menustyle = Some types.MenuStyle.traditional + , menu_deselect_all = Some "-" + , menu_deselect_page = Some "\\" + , menu_first_page = Some "^" + , menu_headings = Some types.MenuHeadings.bold + , menu_invert_all = Some "@" + , menu_invert_page = Some "~" + , menu_last_page = Some "|" + , menu_next_page = Some ">" + , menu_objsyms = Some False + , menu_previous_page = Some "<" + , menu_search = Some ":" + , menu_select_all = Some "." + , menu_tab_sep = Some False + , msg_window = Some types.MsgWindow.single + , MSGTYPE = [ types.MsgType.hide "You swap places with .*" ] + , name = Some "Kaeru" + , news = Some True + , nudist = Some False + , null = Some False + , number_pad = Some types.NumberPad.Letters + , packorder = Some "\")[%?+!=/(*`0_" + , paranoid_confirmation = + defaults.ParanoidConfirmation ⫽ { pray = Some True } + , pettype = Some types.PetType.cat + , pickup_burden = Some types.PickupBurden.stressed + , pickup_thrown = Some True + , pickup_types = Some "?!/" + , pile_limit = Some (types.PileLimit.limit 5) + , playmode = Some types.PlayMode.normal + , pushweapon = Some False + , race = Some { enable = True, value = types.Race.elf } + , rest_on_space = Some False + , role = Some { enable = True, value = types.Role.wizard } + , roguesymset = Some types.SymSet.RogueEpyx + , runmode = Some types.RunMode.walk + , safe_pet = Some True + , sanity_check = Some False + , scores = { own = Some True, around = Some 2, top = Some 10 } + , showexp = Some False + , showrace = Some False + , showscore = Some False + , silent = Some True + , sortloot = Some types.SortLoot.none + , sortpack = Some True + , sparkle = Some True + , standout = Some False + , status_updates = Some True + , statushilites = Some 10 + , suppress_alert = Some "3.3.1" + , symset = Some types.SymSet.DECgraphics + , time = Some False + , timed_delay = Some True + , tombstone = Some True + , toptenwin = Some False + , travel = Some True + , verbose = Some True + , whatis_coord = Some types.WhatisCoord.none + , whatis_filter = Some types.WhatisFilter.no_filtering + , whatis_menu = Some False + , whatis_moveskip = Some False + , windowtype = Some "tty" + , wizkit = Some "wizkit.txt" + } diff --git a/tests/format/largeRecordB.dhall b/tests/format/largeRecordB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/largeRecordB.dhall @@ -0,0 +1,141 @@ +-- This file was tested using console NetHack version 3.6.1 +-- +-- To exercise all options documented in https://nethackwiki.com/wiki/Options +-- see `./unvalidated.dhall` +let types = ./../types.dhall + +let defaults = ./../defaults.dhall + +in defaults.Config + ⫽ { AUTOCOMPLETE = + [ { enable = True, value = "zap" } + , { enable = False, value = "annotate" } + ] + , acoustics = Some True + , align = Some { enable = True, value = types.Alignment.chaotic } + , autodescribe = Some False + , autodig = Some False + , AUTOPICKUP_EXCEPTION = + [ { pickup = False, name = "chest" } + , { pickup = True, name = "dagger" } + ] + , BIND = + [ { keybinding = "!", command = "loot" } + , { keybinding = "^v", command = "untrap" } + , { keybinding = "M-x", command = "terrain" } + ] + , catname = Some "Mirri" + , checkpoint = Some True + , checkspace = Some True + , clicklook = Some False + , cmdassist = Some True + , confirm = Some True + , dark_room = Some False + , disclose = Some + ( defaults.Disclose + ⫽ { inventory = Some { prompt = True, default = True } + , attributes = Some { prompt = True, default = False } + , monsters_killed = Some { prompt = False, default = True } + , monsters_genocided = Some { prompt = False, default = False } + , conduct = Some { prompt = False, default = False } + , dungeon_overview = Some { prompt = False, default = False } + } + ) + , dogname = Some "Cujo" + , extmenu = Some False + , fixinv = Some True + , force_invmenu = Some False + , fruit = Some "slime mold" + , gender = Some types.Gender.female + , goldX = Some False + , help = Some True + , hilite_pet = Some False + , hilite_pile = Some False + , hilite_status = + defaults.HiliteStatus + ⫽ { gold = + [ { color = types.Color.yellow + , trigger = Some types.Numeric.always + , attributes = None types.Attributes + } + ] + } + , hitpointbar = Some True + , horsename = Some "Erhir" + , ignintr = Some False + , implicit_uncursed = Some True + , legacy = Some True + , lit_corridor = Some False + , lootabc = Some False + , mail = Some True + , mention_walls = Some False + , menucolors = + [ { regex = "blessed" + , color = Some types.Color.cyan + , attributes = defaults.Attributes ⫽ { bold = Some True } + } + ] + , menustyle = Some types.MenuStyle.traditional + , menu_deselect_all = Some "-" + , menu_deselect_page = Some "\\" + , menu_first_page = Some "^" + , menu_headings = Some types.MenuHeadings.bold + , menu_invert_all = Some "@" + , menu_invert_page = Some "~" + , menu_last_page = Some "|" + , menu_next_page = Some ">" + , menu_objsyms = Some False + , menu_previous_page = Some "<" + , menu_search = Some ":" + , menu_select_all = Some "." + , menu_tab_sep = Some False + , msg_window = Some types.MsgWindow.single + , MSGTYPE = [ types.MsgType.hide "You swap places with .*" ] + , name = Some "Kaeru" + , news = Some True + , nudist = Some False + , null = Some False + , number_pad = Some types.NumberPad.Letters + , packorder = Some "\")[%?+!=/(*`0_" + , paranoid_confirmation = + defaults.ParanoidConfirmation ⫽ { pray = Some True } + , pettype = Some types.PetType.cat + , pickup_burden = Some types.PickupBurden.stressed + , pickup_thrown = Some True + , pickup_types = Some "?!/" + , pile_limit = Some (types.PileLimit.limit 5) + , playmode = Some types.PlayMode.normal + , pushweapon = Some False + , race = Some { enable = True, value = types.Race.elf } + , rest_on_space = Some False + , role = Some { enable = True, value = types.Role.wizard } + , roguesymset = Some types.SymSet.RogueEpyx + , runmode = Some types.RunMode.walk + , safe_pet = Some True + , sanity_check = Some False + , scores = { own = Some True, around = Some 2, top = Some 10 } + , showexp = Some False + , showrace = Some False + , showscore = Some False + , silent = Some True + , sortloot = Some types.SortLoot.none + , sortpack = Some True + , sparkle = Some True + , standout = Some False + , status_updates = Some True + , statushilites = Some 10 + , suppress_alert = Some "3.3.1" + , symset = Some types.SymSet.DECgraphics + , time = Some False + , timed_delay = Some True + , tombstone = Some True + , toptenwin = Some False + , travel = Some True + , verbose = Some True + , whatis_coord = Some types.WhatisCoord.none + , whatis_filter = Some types.WhatisFilter.no_filtering + , whatis_menu = Some False + , whatis_moveskip = Some False + , windowtype = Some "tty" + , wizkit = Some "wizkit.txt" + } diff --git a/tests/format/letA.dhall b/tests/format/letA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letA.dhall @@ -0,0 +1,1 @@ +let x = "Lorem ipsum" let y = "Lorem ipsum" in let z = "Lorem ipsum" in x ++ y ++ z diff --git a/tests/format/letAnnotatedShortA.dhall b/tests/format/letAnnotatedShortA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letAnnotatedShortA.dhall @@ -0,0 +1,1 @@ +let empty : ∀(a : Type) → List a = λ(a : Type) → [] : List a in empty diff --git a/tests/format/letAnnotatedShortB.dhall b/tests/format/letAnnotatedShortB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letAnnotatedShortB.dhall @@ -0,0 +1,5 @@ +let empty + : ∀(a : Type) → List a + = λ(a : Type) → [] : List a + +in empty diff --git a/tests/format/letB.dhall b/tests/format/letB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letB.dhall @@ -0,0 +1,5 @@ +let x = "Lorem ipsum" + +let y = "Lorem ipsum" + +in let z = "Lorem ipsum" in x ++ y ++ z diff --git a/tests/format/letCommentsA.dhall b/tests/format/letCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letCommentsA.dhall @@ -0,0 +1,7 @@ +let {- Example documentation for a let binding + that spans more than one line + -} + x {- we can interject things here -} = -- Make sure one-line comments work + 1 + +in x diff --git a/tests/format/letCommentsB.dhall b/tests/format/letCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letCommentsB.dhall @@ -0,0 +1,8 @@ +let {- Example documentation for a let binding + that spans more than one line + -} + x {- we can interject things here -} = + -- Make sure one-line comments work + 1 + +in x diff --git a/tests/format/letLineCommentsAfterVariableA.dhall b/tests/format/letLineCommentsAfterVariableA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letLineCommentsAfterVariableA.dhall @@ -0,0 +1,10 @@ +let x -- xxxxxxxxxx xxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxx + : Natural + = 0 + +let y -- yyyyyyyyyy yyyyyyyyyyyyyyyyy yyyyyyyyyyyyyyyyy + -- yyyyyyyyyyyyyy yyyyyyyyyyyyyyyyyyyyyyy + : Natural + = 1 + +in x + y diff --git a/tests/format/letLineCommentsAfterVariableB.dhall b/tests/format/letLineCommentsAfterVariableB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letLineCommentsAfterVariableB.dhall @@ -0,0 +1,12 @@ +let x + -- xxxxxxxxxx xxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxx + : Natural + = 0 + +let y + -- yyyyyyyyyy yyyyyyyyyyyyyyyyy yyyyyyyyyyyyyyyyy + -- yyyyyyyyyyyyyy yyyyyyyyyyyyyyyyyyyyyyy + : Natural + = 1 + +in x + y diff --git a/tests/format/letLongCommentsA.dhall b/tests/format/letLongCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letLongCommentsA.dhall @@ -0,0 +1,3 @@ +let x {- foo -} : {- bar -} Bool {- baz -} = {- bla -} True + +in x diff --git a/tests/format/letLongCommentsB.dhall b/tests/format/letLongCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letLongCommentsB.dhall @@ -0,0 +1,5 @@ +let x + {- foo -} : {- bar -} Bool + = {- bla -} True + +in x diff --git a/tests/format/letNewlineCommentsA.dhall b/tests/format/letNewlineCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letNewlineCommentsA.dhall @@ -0,0 +1,7 @@ +let x = 1 +in +let {- aaaaaaaaaaaaaaaaaaa + -} y : {- bbbbbbbbbbbbbbbbbbbbb + -} Natural {- cccccccccccccc + -} = {- ddddddddddddddddd -} 2 + in x diff --git a/tests/format/letNewlineCommentsB.dhall b/tests/format/letNewlineCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letNewlineCommentsB.dhall @@ -0,0 +1,9 @@ +let x = 1 + +in let {- aaaaaaaaaaaaaaaaaaa + -} y + : {- bbbbbbbbbbbbbbbbbbbbb + -} Natural + = {- ddddddddddddddddd -} 2 + + in x diff --git a/tests/format/letShortCommentsA.dhall b/tests/format/letShortCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letShortCommentsA.dhall @@ -0,0 +1,3 @@ +let x = True +let {- 0 -} y {- 1 -} : {- 2 -} Bool = {- 3-} False +in x diff --git a/tests/format/letShortCommentsB.dhall b/tests/format/letShortCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/letShortCommentsB.dhall @@ -0,0 +1,7 @@ +let x = True + +let {- 0 -} y + {- 1 -} : {- 2 -} Bool + = {- 3-} False + +in x diff --git a/tests/format/multilineArgumentA.dhall b/tests/format/multilineArgumentA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/multilineArgumentA.dhall @@ -0,0 +1,1 @@ +fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff xxxxxxxxxxxxxxxx "\n" diff --git a/tests/format/multilineArgumentB.dhall b/tests/format/multilineArgumentB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/multilineArgumentB.dhall @@ -0,0 +1,3 @@ +fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff + xxxxxxxxxxxxxxxx + "\n" diff --git a/tests/format/multilineB.dhall b/tests/format/multilineB.dhall --- a/tests/format/multilineB.dhall +++ b/tests/format/multilineB.dhall diff --git a/tests/format/multilineTrailingSingleQuoteA.dhall b/tests/format/multilineTrailingSingleQuoteA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/multilineTrailingSingleQuoteA.dhall @@ -0,0 +1,1 @@ +"\n'" diff --git a/tests/format/multilineTrailingSingleQuoteB.dhall b/tests/format/multilineTrailingSingleQuoteB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/multilineTrailingSingleQuoteB.dhall @@ -0,0 +1,3 @@ +'' + +${"'"}'' diff --git a/tests/format/multilineTrailingWhitespaceA.dhall b/tests/format/multilineTrailingWhitespaceA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/multilineTrailingWhitespaceA.dhall @@ -0,0 +1,1 @@ +{ x = " \n\nfoo \n" } diff --git a/tests/format/multilineTrailingWhitespaceB.dhall b/tests/format/multilineTrailingWhitespaceB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/multilineTrailingWhitespaceB.dhall @@ -0,0 +1,7 @@ +{ x = + '' + + + foo + '' +} diff --git a/tests/format/negativeTimeZoneA.dhall b/tests/format/negativeTimeZoneA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/negativeTimeZoneA.dhall @@ -0,0 +1,1 @@ +04:00:00-04:00 diff --git a/tests/format/negativeTimeZoneB.dhall b/tests/format/negativeTimeZoneB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/negativeTimeZoneB.dhall @@ -0,0 +1,1 @@ +04:00:00-04:00 diff --git a/tests/format/nestedAnnotationA.dhall b/tests/format/nestedAnnotationA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/nestedAnnotationA.dhall @@ -0,0 +1,1 @@ +([] : a) : b diff --git a/tests/format/nestedAnnotationB.dhall b/tests/format/nestedAnnotationB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/nestedAnnotationB.dhall @@ -0,0 +1,1 @@ +([] : a) : b diff --git a/tests/format/numericLiteralsA.dhall b/tests/format/numericLiteralsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/numericLiteralsA.dhall @@ -0,0 +1,1 @@ +{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 } diff --git a/tests/format/numericLiteralsB.dhall b/tests/format/numericLiteralsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/numericLiteralsB.dhall @@ -0,0 +1,1 @@ +{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 } diff --git a/tests/format/parentA.dhall b/tests/format/parentA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/parentA.dhall @@ -0,0 +1,1 @@ +../a diff --git a/tests/format/parentB.dhall b/tests/format/parentB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/parentB.dhall @@ -0,0 +1,1 @@ +../a diff --git a/tests/format/parenthesizeUsingA.dhall b/tests/format/parenthesizeUsingA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/parenthesizeUsingA.dhall @@ -0,0 +1,6 @@ +-- https://github.com/dhall-lang/dhall-haskell/issues/2273 +let MyPackage = + https://server.test/package.dhall using (./headers.dhall) + sha256:03a6e298ff140d430cea8b387fad886ce9f5bee24622c7d1102115cc08ed9cf8 + +in MyPackage diff --git a/tests/format/parenthesizeUsingB.dhall b/tests/format/parenthesizeUsingB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/parenthesizeUsingB.dhall @@ -0,0 +1,6 @@ +-- https://github.com/dhall-lang/dhall-haskell/issues/2273 +let MyPackage = + https://server.test/package.dhall using (./headers.dhall) + sha256:03a6e298ff140d430cea8b387fad886ce9f5bee24622c7d1102115cc08ed9cf8 + +in MyPackage diff --git a/tests/format/preserveShebangA.dhall b/tests/format/preserveShebangA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/preserveShebangA.dhall @@ -0,0 +1,2 @@ +#!/usr/bin/env -S dhall text --file +"Hello, world!" diff --git a/tests/format/preserveShebangB.dhall b/tests/format/preserveShebangB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/preserveShebangB.dhall @@ -0,0 +1,2 @@ +#!/usr/bin/env -S dhall text --file +"Hello, world!" diff --git a/tests/format/projectionOrderA.dhall b/tests/format/projectionOrderA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/projectionOrderA.dhall @@ -0,0 +1,1 @@ +e.{ foo, bar, baz } diff --git a/tests/format/projectionOrderB.dhall b/tests/format/projectionOrderB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/projectionOrderB.dhall @@ -0,0 +1,1 @@ +e.{ foo, bar, baz } diff --git a/tests/format/punA.dhall b/tests/format/punA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/punA.dhall @@ -0,0 +1,1 @@ +{ x = x, y = 1, z = z } diff --git a/tests/format/punB.dhall b/tests/format/punB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/punB.dhall @@ -0,0 +1,1 @@ +{ x, y = 1, z } diff --git a/tests/format/punCommentsA.dhall b/tests/format/punCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/punCommentsA.dhall @@ -0,0 +1,7 @@ +{ {- A -} + x + {- B -} +, y = + {- C -} + y +} diff --git a/tests/format/punCommentsB.dhall b/tests/format/punCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/punCommentsB.dhall @@ -0,0 +1,7 @@ +{ {- A -} + x + {- B -} +, y = + {- C -} + y +} diff --git a/tests/format/recordCompletionA.dhall b/tests/format/recordCompletionA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordCompletionA.dhall @@ -0,0 +1,26 @@ +{ field0 = +T::{ +, a = 1 +, b = 1 +, c = 1 +, d = 1 +, e = 1 +, f = 1 +, g = 1 +, h = 1 +, i = 1 +, j = 1 +, k = 1 +, l = 1 +, m = 1 +, n = 1 +, o = 1 +, p = 1 +, q = 1 +, r = 1 +, s = 1 +, t = 1 +} +, field1 = T::{ a = 1 } +, field2 = T::{ a = a } +} diff --git a/tests/format/recordCompletionB.dhall b/tests/format/recordCompletionB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordCompletionB.dhall @@ -0,0 +1,25 @@ +{ field0 = T::{ + , a = 1 + , b = 1 + , c = 1 + , d = 1 + , e = 1 + , f = 1 + , g = 1 + , h = 1 + , i = 1 + , j = 1 + , k = 1 + , l = 1 + , m = 1 + , n = 1 + , o = 1 + , p = 1 + , q = 1 + , r = 1 + , s = 1 + , t = 1 + } +, field1 = T::{ a = 1 } +, field2 = T::{ a } +} diff --git a/tests/format/recordLitComments0A.dhall b/tests/format/recordLitComments0A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordLitComments0A.dhall @@ -0,0 +1,6 @@ +{ {- A -} + x + {- B -} + = {- C -} + T +} diff --git a/tests/format/recordLitComments0B.dhall b/tests/format/recordLitComments0B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordLitComments0B.dhall @@ -0,0 +1,6 @@ +{ {- A -} + x + {- B -} + = {- C -} + T +} diff --git a/tests/format/recordLitComments1A.dhall b/tests/format/recordLitComments1A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordLitComments1A.dhall @@ -0,0 +1,4 @@ +{ +--| a comment for y +y = 42 +} diff --git a/tests/format/recordLitComments1B.dhall b/tests/format/recordLitComments1B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordLitComments1B.dhall @@ -0,0 +1,3 @@ +{ --| a comment for y + y = 42 +} diff --git a/tests/format/recordLitMultilineBlockCommentsA.dhall b/tests/format/recordLitMultilineBlockCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordLitMultilineBlockCommentsA.dhall @@ -0,0 +1,9 @@ +{ {- A + A -} + x + {- B + B -} + = {- C + C -} + y +} diff --git a/tests/format/recordLitMultilineBlockCommentsB.dhall b/tests/format/recordLitMultilineBlockCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordLitMultilineBlockCommentsB.dhall @@ -0,0 +1,9 @@ +{ {- A + A -} + x + {- B + B -} + = {- C + C -} + y +} diff --git a/tests/format/recordTypeCommentsA.dhall b/tests/format/recordTypeCommentsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordTypeCommentsA.dhall @@ -0,0 +1,6 @@ +{ {- A -} + a + {- B -} + : {- C -} + A +} diff --git a/tests/format/recordTypeCommentsB.dhall b/tests/format/recordTypeCommentsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/recordTypeCommentsB.dhall @@ -0,0 +1,6 @@ +{ {- A -} + a + {- B -} + : {- C -} + A +} diff --git a/tests/format/sha256PrintingA.dhall b/tests/format/sha256PrintingA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/sha256PrintingA.dhall @@ -0,0 +1,4 @@ +let replicate = + https://raw.githubusercontent.com/dhall-lang/Prelude/c79c2bc3c46f129cc5b6d594ce298a381bcae92c/List/replicate sha256:cc856d59b63f7699881bdb8e4b1036ca4c0013827268040a50c1e1405f646a2c + +in replicate 5 diff --git a/tests/format/sha256PrintingB.dhall b/tests/format/sha256PrintingB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/sha256PrintingB.dhall @@ -0,0 +1,5 @@ +let replicate = + https://raw.githubusercontent.com/dhall-lang/Prelude/c79c2bc3c46f129cc5b6d594ce298a381bcae92c/List/replicate + sha256:cc856d59b63f7699881bdb8e4b1036ca4c0013827268040a50c1e1405f646a2c + +in replicate 5 diff --git a/tests/format/significantLeadingSpacesA.dhall b/tests/format/significantLeadingSpacesA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/significantLeadingSpacesA.dhall @@ -0,0 +1,1 @@ +" x\n\n y\n " diff --git a/tests/format/significantLeadingSpacesB.dhall b/tests/format/significantLeadingSpacesB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/significantLeadingSpacesB.dhall @@ -0,0 +1,5 @@ +'' +${" "} x + +${" "} y +${" "}'' diff --git a/tests/format/stringWithNullA.dhall b/tests/format/stringWithNullA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/stringWithNullA.dhall @@ -0,0 +1,1 @@ +"\u0000 \$ \\ \n ☺" diff --git a/tests/format/stringWithNullB.dhall b/tests/format/stringWithNullB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/stringWithNullB.dhall @@ -0,0 +1,3 @@ +'' +${"\u0000"} $ \ + ☺'' diff --git a/tests/format/textLitNewlinesOnlyA.dhall b/tests/format/textLitNewlinesOnlyA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/textLitNewlinesOnlyA.dhall @@ -0,0 +1,1 @@ +"\n\n" diff --git a/tests/format/textLitNewlinesOnlyB.dhall b/tests/format/textLitNewlinesOnlyB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/textLitNewlinesOnlyB.dhall @@ -0,0 +1,1 @@ +"\n\n" diff --git a/tests/format/timePrecisionA.dhall b/tests/format/timePrecisionA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/timePrecisionA.dhall @@ -0,0 +1,3 @@ +-- This test ensures that we don't strip leading zeros from the fractional +-- component of seconds when pretty-printing them +00:00:00.01 diff --git a/tests/format/timePrecisionB.dhall b/tests/format/timePrecisionB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/timePrecisionB.dhall @@ -0,0 +1,3 @@ +-- This test ensures that we don't strip leading zeros from the fractional +-- component of seconds when pretty-printing them +00:00:00.01 diff --git a/tests/format/unicodeA.dhall b/tests/format/unicodeA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/unicodeA.dhall @@ -0,0 +1,16 @@ + λ(isActive : Bool) +→ { barLeftEnd = + Some "┨" + , barRightEnd = + Some "┠" + , separator = + Some "┃" + , alignment = + < ToTheLeft | ToTheRight | Centered >.ToTheLeft + : ./Alignment.dhall + , barWidth = + None Natural + , barSegments = + [ "index", "command", "path", "title" ] + } + : ./Bar.dhall diff --git a/tests/format/unicodeB.dhall b/tests/format/unicodeB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/unicodeB.dhall @@ -0,0 +1,10 @@ +λ(isActive : Bool) → + { barLeftEnd = Some "┨" + , barRightEnd = Some "┠" + , separator = Some "┃" + , alignment = + < ToTheLeft | ToTheRight | Centered >.ToTheLeft : ./Alignment.dhall + , barWidth = None Natural + , barSegments = [ "index", "command", "path", "title" ] + } + : ./Bar.dhall diff --git a/tests/format/urlsA.dhall b/tests/format/urlsA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/urlsA.dhall @@ -0,0 +1,7 @@ +let unreserved = http://x/y%7ez + +let uppercasehex = http://x/y%3bz + +let reserved = http://x/y:z + +in "done" diff --git a/tests/format/urlsB.dhall b/tests/format/urlsB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/urlsB.dhall @@ -0,0 +1,7 @@ +let unreserved = http://x/y~z + +let uppercasehex = http://x/y%3Bz + +let reserved = http://x/y:z + +in "done" diff --git a/tests/format/usingToMapA.dhall b/tests/format/usingToMapA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/usingToMapA.dhall @@ -0,0 +1,1 @@ +https://httpbin.org/headers using (toMap { TOKEN = "AAAA" }) as Text diff --git a/tests/format/usingToMapB.dhall b/tests/format/usingToMapB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/usingToMapB.dhall @@ -0,0 +1,1 @@ +https://httpbin.org/headers using (toMap { TOKEN = "AAAA" }) as Text diff --git a/tests/format/withA.dhall b/tests/format/withA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/withA.dhall @@ -0,0 +1,5 @@ +r with a = Some { b = 1, c = 1, d = 1, e = 1, f = 1, g = 1, h = 1, i = 1, j = 1, k = 1, l = 1 } + with b = T::{ b = 1, c = 1, d = 1, e = 1, f = 1, g = 1, h = 1, i = 1, j = 1, k = 1, l = 1 } + with c = [ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ] + with d = 1 + with e = 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 diff --git a/tests/format/withB.dhall b/tests/format/withB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/withB.dhall @@ -0,0 +1,58 @@ +r + with a = Some + { b = 1 + , c = 1 + , d = 1 + , e = 1 + , f = 1 + , g = 1 + , h = 1 + , i = 1 + , j = 1 + , k = 1 + , l = 1 + } + with b = T::{ + , b = 1 + , c = 1 + , d = 1 + , e = 1 + , f = 1 + , g = 1 + , h = 1 + , i = 1 + , j = 1 + , k = 1 + , l = 1 + } + with c = + [ 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + , 1 + ] + with d = 1 + with e = + 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 diff --git a/tests/format/withPrecedenceA.dhall b/tests/format/withPrecedenceA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/withPrecedenceA.dhall @@ -0,0 +1,5 @@ +let Foo = + Bar + with default = (Bar.default ⫽ { bar = 0 }) + +in Foo diff --git a/tests/format/withPrecedenceB.dhall b/tests/format/withPrecedenceB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/withPrecedenceB.dhall @@ -0,0 +1,1 @@ +let Foo = Bar with default = Bar.default ⫽ { bar = 0 } in Foo diff --git a/tests/format/withQuestionA.dhall b/tests/format/withQuestionA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/withQuestionA.dhall @@ -0,0 +1,1 @@ +λ(x : Optional Natural) → x with ? = 2 diff --git a/tests/format/withQuestionB.dhall b/tests/format/withQuestionB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/withQuestionB.dhall @@ -0,0 +1,1 @@ +λ(x : Optional Natural) → x with ? = 2 diff --git a/tests/freeze/cached/True.dhall b/tests/freeze/cached/True.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/True.dhall @@ -0,0 +1,1 @@ +True diff --git a/tests/freeze/cached/cachedA.dhall b/tests/freeze/cached/cachedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/cachedA.dhall @@ -0,0 +1,2 @@ + ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/cached/cachedB.dhall b/tests/freeze/cached/cachedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/cachedB.dhall @@ -0,0 +1,3 @@ + missing + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/cached/idempotentA.dhall b/tests/freeze/cached/idempotentA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/idempotentA.dhall @@ -0,0 +1,5 @@ +-- The purpose of this test is to verify that `dhall freeze --cached` is +-- idempotent and doesn't attempt to resolve the `missing` import + missing + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/cached/idempotentB.dhall b/tests/freeze/cached/idempotentB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/idempotentB.dhall @@ -0,0 +1,3 @@ + missing + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/cached/incorrectHashA.dhall b/tests/freeze/cached/incorrectHashA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/incorrectHashA.dhall @@ -0,0 +1,1 @@ +./True.dhall sha256:0000000000000000000000000000000000000000000000000000000000000000 diff --git a/tests/freeze/cached/incorrectHashB.dhall b/tests/freeze/cached/incorrectHashB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/incorrectHashB.dhall @@ -0,0 +1,3 @@ + missing + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/cached/protectedA.dhall b/tests/freeze/cached/protectedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/protectedA.dhall @@ -0,0 +1,1 @@ +./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/cached/protectedB.dhall b/tests/freeze/cached/protectedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/protectedB.dhall @@ -0,0 +1,3 @@ + missing + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/cached/unprotectedA.dhall b/tests/freeze/cached/unprotectedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/unprotectedA.dhall @@ -0,0 +1,1 @@ +./True.dhall diff --git a/tests/freeze/cached/unprotectedB.dhall b/tests/freeze/cached/unprotectedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/cached/unprotectedB.dhall @@ -0,0 +1,3 @@ + missing + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/secure/True.dhall b/tests/freeze/secure/True.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/True.dhall @@ -0,0 +1,1 @@ +True diff --git a/tests/freeze/secure/cachedA.dhall b/tests/freeze/secure/cachedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/cachedA.dhall @@ -0,0 +1,2 @@ + ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/secure/cachedB.dhall b/tests/freeze/secure/cachedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/cachedB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/incorrectHashA.dhall b/tests/freeze/secure/incorrectHashA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/incorrectHashA.dhall @@ -0,0 +1,1 @@ +./True.dhall sha256:0000000000000000000000000000000000000000000000000000000000000000 diff --git a/tests/freeze/secure/incorrectHashB.dhall b/tests/freeze/secure/incorrectHashB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/incorrectHashB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/protectedA.dhall b/tests/freeze/secure/protectedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/protectedA.dhall @@ -0,0 +1,1 @@ +./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/protectedB.dhall b/tests/freeze/secure/protectedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/protectedB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/unprotectedA.dhall b/tests/freeze/secure/unprotectedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/unprotectedA.dhall @@ -0,0 +1,1 @@ +./True.dhall diff --git a/tests/freeze/secure/unprotectedB.dhall b/tests/freeze/secure/unprotectedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/unprotectedB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/lint/success/PreludeExtensionA.dhall b/tests/lint/success/PreludeExtensionA.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/PreludeExtensionA.dhall @@ -0,0 +1,1 @@ +https://prelude.dhall-lang.org/List/map diff --git a/tests/lint/success/PreludeExtensionB.dhall b/tests/lint/success/PreludeExtensionB.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/PreludeExtensionB.dhall @@ -0,0 +1,1 @@ +https://prelude.dhall-lang.org/List/map.dhall diff --git a/tests/lint/success/assertA.dhall b/tests/lint/success/assertA.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/assertA.dhall @@ -0,0 +1,14 @@ +let simpleAssert = assert : 1 + 1 ≡ 2 + +let assertIn1Lam = λ(n : Natural) → assert : Natural/subtract 0 n ≡ n + +let assertIn2Lams = + λ(m : Natural) + → λ(n : Natural) + → assert : Natural/subtract m m ≡ Natural/subtract n n + +let assertInLetInLam = λ(m : Natural) → let n = m + 0 in assert : m ≡ n + +let unusedNonAssert = "Foo" + +in {=} diff --git a/tests/lint/success/assertB.dhall b/tests/lint/success/assertB.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/assertB.dhall @@ -0,0 +1,12 @@ +let simpleAssert = assert : 1 + 1 ≡ 2 + +let assertIn1Lam = λ(n : Natural) → assert : Natural/subtract 0 n ≡ n + +let assertIn2Lams = + λ(m : Natural) → + λ(n : Natural) → + assert : Natural/subtract m m ≡ Natural/subtract n n + +let assertInLetInLam = λ(m : Natural) → let n = m + 0 in assert : m ≡ n + +in {=} diff --git a/tests/lint/success/fixAssertA.dhall b/tests/lint/success/fixAssertA.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/fixAssertA.dhall @@ -0,0 +1,5 @@ +let example0 = 1 ≡ 1 + +let example1 = let x = 1 in x ≡ 1 + +in 1 diff --git a/tests/lint/success/fixAssertB.dhall b/tests/lint/success/fixAssertB.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/fixAssertB.dhall @@ -0,0 +1,1 @@ +let example0 = assert : 1 ≡ 1 let example1 = let x = 1 in assert : x ≡ 1 in 1 diff --git a/tests/lint/success/issue1586A.dhall b/tests/lint/success/issue1586A.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/issue1586A.dhall @@ -0,0 +1,1 @@ +let {- 1 -} x {- 2 -} : {- 3 -} Natural = {- 4 -} 1 {- 5 -} in x diff --git a/tests/lint/success/issue1586B.dhall b/tests/lint/success/issue1586B.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/issue1586B.dhall @@ -0,0 +1,5 @@ +let {- 1 -} x + {- 2 -} : {- 3 -} Natural + = {- 4 -} 1 + +in x diff --git a/tests/lint/success/multiletA.dhall b/tests/lint/success/multiletA.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/multiletA.dhall @@ -0,0 +1,34 @@ +-- example0.dhall +let Person + : Type + = ∀(Person : Type) + → ∀(MakePerson : { children : List Person, name : Text } → Person) + → Person + +let example + : Person + = λ(Person : Type) + → λ(MakePerson : { children : List Person, name : Text } → Person) + → MakePerson + { children = + [ MakePerson { children = [] : List Person, name = "Mary" } + , MakePerson { children = [] : List Person, name = "Jane" } + ] + , name = + "John" + } + +let everybody + : Person → List Text + = let concat = http://prelude.dhall-lang.org/List/concat.dhall + + in λ(x : Person) + → x + (List Text) + ( λ(p : { children : List (List Text), name : Text }) + → [ p.name ] # concat Text p.children + ) + +let result : List Text = everybody example + +in result diff --git a/tests/lint/success/multiletB.dhall b/tests/lint/success/multiletB.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/multiletB.dhall @@ -0,0 +1,35 @@ +-- example0.dhall +let Person + : Type + = ∀(Person : Type) → + ∀(MakePerson : { children : List Person, name : Text } → Person) → + Person + +let example + : Person + = λ(Person : Type) → + λ(MakePerson : { children : List Person, name : Text } → Person) → + MakePerson + { children = + [ MakePerson { children = [] : List Person, name = "Mary" } + , MakePerson { children = [] : List Person, name = "Jane" } + ] + , name = "John" + } + +let everybody + : Person → List Text + = let concat = http://prelude.dhall-lang.org/List/concat.dhall + + in λ(x : Person) → + x + (List Text) + ( λ(p : { children : List (List Text), name : Text }) → + [ p.name ] # concat Text p.children + ) + +let result + : List Text + = everybody example + +in result diff --git a/tests/lint/success/regression0A.dhall b/tests/lint/success/regression0A.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/regression0A.dhall @@ -0,0 +1,7 @@ + let replicate = https://prelude.dhall-lang.org/List/replicate.dhall + +in let Config = { name : Text, age : Natural } + +in let Configs = List Config + +in replicate 10 Text "!" diff --git a/tests/lint/success/regression0B.dhall b/tests/lint/success/regression0B.dhall new file mode 100644 --- /dev/null +++ b/tests/lint/success/regression0B.dhall @@ -0,0 +1,3 @@ +let replicate = https://prelude.dhall-lang.org/List/replicate.dhall + +in replicate 10 Text "!" diff --git a/tests/normalization/doubleShowA.dhall b/tests/normalization/doubleShowA.dhall deleted file mode 100644 --- a/tests/normalization/doubleShowA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ example0 = Double/show -0.42, example1 = Double/show 13.37 } diff --git a/tests/normalization/doubleShowB.dhall b/tests/normalization/doubleShowB.dhall deleted file mode 100644 --- a/tests/normalization/doubleShowB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ example0 = "-0.42", example1 = "13.37" } diff --git a/tests/normalization/examples/Bool/and/0A.dhall b/tests/normalization/examples/Bool/and/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/and/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/and [ True, False, True ] diff --git a/tests/normalization/examples/Bool/and/0B.dhall b/tests/normalization/examples/Bool/and/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/and/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/and/1A.dhall b/tests/normalization/examples/Bool/and/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/and/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/and ([] : List Bool) diff --git a/tests/normalization/examples/Bool/and/1B.dhall b/tests/normalization/examples/Bool/and/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/and/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/build/0A.dhall b/tests/normalization/examples/Bool/build/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/build/0A.dhall +++ /dev/null @@ -1,2 +0,0 @@ -../../../../../Prelude/Bool/build -(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) diff --git a/tests/normalization/examples/Bool/build/0B.dhall b/tests/normalization/examples/Bool/build/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/build/1A.dhall b/tests/normalization/examples/Bool/build/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/build/1A.dhall +++ /dev/null @@ -1,2 +0,0 @@ -../../../../../Prelude/Bool/build -(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) diff --git a/tests/normalization/examples/Bool/build/1B.dhall b/tests/normalization/examples/Bool/build/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/even/0A.dhall b/tests/normalization/examples/Bool/even/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/even [ False, True, False ] diff --git a/tests/normalization/examples/Bool/even/0B.dhall b/tests/normalization/examples/Bool/even/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/even/1A.dhall b/tests/normalization/examples/Bool/even/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/even [ False, True ] diff --git a/tests/normalization/examples/Bool/even/1B.dhall b/tests/normalization/examples/Bool/even/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/even/2A.dhall b/tests/normalization/examples/Bool/even/2A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/even [ False ] diff --git a/tests/normalization/examples/Bool/even/2B.dhall b/tests/normalization/examples/Bool/even/2B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/even/3A.dhall b/tests/normalization/examples/Bool/even/3A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/3A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/even ([] : List Bool) diff --git a/tests/normalization/examples/Bool/even/3B.dhall b/tests/normalization/examples/Bool/even/3B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/even/3B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/fold/0A.dhall b/tests/normalization/examples/Bool/fold/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/fold/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/fold True Integer 0 1 diff --git a/tests/normalization/examples/Bool/fold/0B.dhall b/tests/normalization/examples/Bool/fold/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -0 diff --git a/tests/normalization/examples/Bool/fold/1A.dhall b/tests/normalization/examples/Bool/fold/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/fold/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/fold False Integer 0 1 diff --git a/tests/normalization/examples/Bool/fold/1B.dhall b/tests/normalization/examples/Bool/fold/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -1 diff --git a/tests/normalization/examples/Bool/not/0A.dhall b/tests/normalization/examples/Bool/not/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/not/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/not True diff --git a/tests/normalization/examples/Bool/not/0B.dhall b/tests/normalization/examples/Bool/not/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/not/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/not/1A.dhall b/tests/normalization/examples/Bool/not/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/not/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/not False diff --git a/tests/normalization/examples/Bool/not/1B.dhall b/tests/normalization/examples/Bool/not/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/not/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/odd/0A.dhall b/tests/normalization/examples/Bool/odd/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/odd [ True, False, True ] diff --git a/tests/normalization/examples/Bool/odd/0B.dhall b/tests/normalization/examples/Bool/odd/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/odd/1A.dhall b/tests/normalization/examples/Bool/odd/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/odd [ True, False ] diff --git a/tests/normalization/examples/Bool/odd/1B.dhall b/tests/normalization/examples/Bool/odd/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/odd/2A.dhall b/tests/normalization/examples/Bool/odd/2A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/odd [ True ] diff --git a/tests/normalization/examples/Bool/odd/2B.dhall b/tests/normalization/examples/Bool/odd/2B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/odd/3A.dhall b/tests/normalization/examples/Bool/odd/3A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/3A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/odd ([] : List Bool) diff --git a/tests/normalization/examples/Bool/odd/3B.dhall b/tests/normalization/examples/Bool/odd/3B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/odd/3B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/or/0A.dhall b/tests/normalization/examples/Bool/or/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/or/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/or [ True, False, True ] diff --git a/tests/normalization/examples/Bool/or/0B.dhall b/tests/normalization/examples/Bool/or/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/or/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Bool/or/1A.dhall b/tests/normalization/examples/Bool/or/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/or/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/or ([] : List Bool) diff --git a/tests/normalization/examples/Bool/or/1B.dhall b/tests/normalization/examples/Bool/or/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/or/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Bool/show/0A.dhall b/tests/normalization/examples/Bool/show/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/show True diff --git a/tests/normalization/examples/Bool/show/0B.dhall b/tests/normalization/examples/Bool/show/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"True" diff --git a/tests/normalization/examples/Bool/show/1A.dhall b/tests/normalization/examples/Bool/show/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/show False diff --git a/tests/normalization/examples/Bool/show/1B.dhall b/tests/normalization/examples/Bool/show/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Bool/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"False" diff --git a/tests/normalization/examples/Double/show/0A.dhall b/tests/normalization/examples/Double/show/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Double/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Double/show -3.1 diff --git a/tests/normalization/examples/Double/show/0B.dhall b/tests/normalization/examples/Double/show/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Double/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"-3.1" diff --git a/tests/normalization/examples/Double/show/1A.dhall b/tests/normalization/examples/Double/show/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Double/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Double/show 0.4 diff --git a/tests/normalization/examples/Double/show/1B.dhall b/tests/normalization/examples/Double/show/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Double/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"0.4" diff --git a/tests/normalization/examples/Integer/show/0A.dhall b/tests/normalization/examples/Integer/show/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Integer/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Integer/show -3 diff --git a/tests/normalization/examples/Integer/show/0B.dhall b/tests/normalization/examples/Integer/show/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Integer/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"-3" diff --git a/tests/normalization/examples/Integer/show/1A.dhall b/tests/normalization/examples/Integer/show/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Integer/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Integer/show 0 diff --git a/tests/normalization/examples/Integer/show/1B.dhall b/tests/normalization/examples/Integer/show/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Integer/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"0" diff --git a/tests/normalization/examples/List/all/0A.dhall b/tests/normalization/examples/List/all/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/all/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/all Natural Natural/even [ +2, +3, +5 ] diff --git a/tests/normalization/examples/List/all/0B.dhall b/tests/normalization/examples/List/all/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/all/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/List/all/1A.dhall b/tests/normalization/examples/List/all/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/all/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/all Natural Natural/even ([] : List Natural) diff --git a/tests/normalization/examples/List/all/1B.dhall b/tests/normalization/examples/List/all/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/all/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/List/any/0A.dhall b/tests/normalization/examples/List/any/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/any/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/any Natural Natural/even [ +2, +3, +5 ] diff --git a/tests/normalization/examples/List/any/0B.dhall b/tests/normalization/examples/List/any/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/any/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/List/any/1A.dhall b/tests/normalization/examples/List/any/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/any/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/any Natural Natural/even ([] : List Natural) diff --git a/tests/normalization/examples/List/any/1B.dhall b/tests/normalization/examples/List/any/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/any/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/List/build/0A.dhall b/tests/normalization/examples/List/build/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/build/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../Prelude/List/build -Text -( λ(list : Type) -→ λ(cons : Text → list → list) -→ λ(nil : list) -→ cons "ABC" (cons "DEF" nil) -) diff --git a/tests/normalization/examples/List/build/0B.dhall b/tests/normalization/examples/List/build/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ "ABC", "DEF" ] diff --git a/tests/normalization/examples/List/build/1A.dhall b/tests/normalization/examples/List/build/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/build/1A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../Prelude/List/build -Text -( λ(list : Type) -→ λ(cons : Text → list → list) -→ λ(nil : list) -→ nil -) diff --git a/tests/normalization/examples/List/build/1B.dhall b/tests/normalization/examples/List/build/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Text diff --git a/tests/normalization/examples/List/concat/0A.dhall b/tests/normalization/examples/List/concat/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concat/0A.dhall +++ /dev/null @@ -1,5 +0,0 @@ -../../../../../Prelude/List/concat Integer -[ [ 0, 1, 2 ] -, [ 3, 4 ] -, [ 5, 6, 7, 8 ] -] diff --git a/tests/normalization/examples/List/concat/0B.dhall b/tests/normalization/examples/List/concat/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concat/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] diff --git a/tests/normalization/examples/List/concat/1A.dhall b/tests/normalization/examples/List/concat/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concat/1A.dhall +++ /dev/null @@ -1,5 +0,0 @@ -../../../../../Prelude/List/concat Integer -[ [] : List Integer -, [] : List Integer -, [] : List Integer -] diff --git a/tests/normalization/examples/List/concat/1B.dhall b/tests/normalization/examples/List/concat/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concat/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Integer diff --git a/tests/normalization/examples/List/concatMap/0A.dhall b/tests/normalization/examples/List/concatMap/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concatMap/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) [ +2, +3, +5 ] diff --git a/tests/normalization/examples/List/concatMap/0B.dhall b/tests/normalization/examples/List/concatMap/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concatMap/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +2, +2, +3, +3, +5, +5 ] diff --git a/tests/normalization/examples/List/concatMap/1A.dhall b/tests/normalization/examples/List/concatMap/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concatMap/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural) diff --git a/tests/normalization/examples/List/concatMap/1B.dhall b/tests/normalization/examples/List/concatMap/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/concatMap/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Natural diff --git a/tests/normalization/examples/List/filter/0A.dhall b/tests/normalization/examples/List/filter/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/filter/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/filter Natural Natural/even [ +2, +3, +5 ] diff --git a/tests/normalization/examples/List/filter/0B.dhall b/tests/normalization/examples/List/filter/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/filter/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +2 ] diff --git a/tests/normalization/examples/List/filter/1A.dhall b/tests/normalization/examples/List/filter/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/filter/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/filter Natural Natural/odd [ +2, +3, +5 ] diff --git a/tests/normalization/examples/List/filter/1B.dhall b/tests/normalization/examples/List/filter/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/filter/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +3, +5 ] diff --git a/tests/normalization/examples/List/fold/0A.dhall b/tests/normalization/examples/List/fold/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/fold/0A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../Prelude/List/fold -Natural -[ +2, +3, +5 ] -Natural -(λ(x : Natural) → λ(y : Natural) → x + y) -+0 diff --git a/tests/normalization/examples/List/fold/0B.dhall b/tests/normalization/examples/List/fold/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+10 diff --git a/tests/normalization/examples/List/fold/1A.dhall b/tests/normalization/examples/List/fold/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/fold/1A.dhall +++ /dev/null @@ -1,7 +0,0 @@ - λ(nil : Natural) -→ ../../../../../Prelude/List/fold - Natural - [ +2, +3, +5 ] - Natural - (λ(x : Natural) → λ(y : Natural) → x + y) - nil diff --git a/tests/normalization/examples/List/fold/1B.dhall b/tests/normalization/examples/List/fold/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(nil : Natural) → +2 + +3 + +5 + nil diff --git a/tests/normalization/examples/List/fold/2A.dhall b/tests/normalization/examples/List/fold/2A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/fold/2A.dhall +++ /dev/null @@ -1,4 +0,0 @@ - λ(list : Type) -→ λ(cons : Natural → list → list) -→ λ(nil : list) -→ ../../../../../Prelude/List/fold Natural [ +2, +3, +5 ] list cons nil diff --git a/tests/normalization/examples/List/fold/2B.dhall b/tests/normalization/examples/List/fold/2B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/fold/2B.dhall +++ /dev/null @@ -1,4 +0,0 @@ - λ(list : Type) -→ λ(cons : Natural → list → list) -→ λ(nil : list) -→ cons +2 (cons +3 (cons +5 nil)) diff --git a/tests/normalization/examples/List/generate/0A.dhall b/tests/normalization/examples/List/generate/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/generate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/generate +5 Bool Natural/even diff --git a/tests/normalization/examples/List/generate/0B.dhall b/tests/normalization/examples/List/generate/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/generate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ True, False, True, False, True ] diff --git a/tests/normalization/examples/List/generate/1A.dhall b/tests/normalization/examples/List/generate/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/generate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/generate +0 Bool Natural/even diff --git a/tests/normalization/examples/List/generate/1B.dhall b/tests/normalization/examples/List/generate/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/generate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Bool diff --git a/tests/normalization/examples/List/head/0A.dhall b/tests/normalization/examples/List/head/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/head/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/head Integer [ 0, 1, 2 ] diff --git a/tests/normalization/examples/List/head/0B.dhall b/tests/normalization/examples/List/head/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/head/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 0 ] : Optional Integer diff --git a/tests/normalization/examples/List/head/1A.dhall b/tests/normalization/examples/List/head/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/head/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/head Integer ([] : List Integer) diff --git a/tests/normalization/examples/List/head/1B.dhall b/tests/normalization/examples/List/head/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/head/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/List/indexed/0A.dhall b/tests/normalization/examples/List/indexed/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/indexed/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/indexed Bool ([] : List Bool) diff --git a/tests/normalization/examples/List/indexed/0B.dhall b/tests/normalization/examples/List/indexed/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/indexed/0B.dhall +++ /dev/null @@ -1,4 +0,0 @@ -[ { index = +0, value = True } -, { index = +1, value = False } -, { index = +2, valu;e = True } -] diff --git a/tests/normalization/examples/List/indexed/1A.dhall b/tests/normalization/examples/List/indexed/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/indexed/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/indexed Bool ([] : List Bool) diff --git a/tests/normalization/examples/List/indexed/1B.dhall b/tests/normalization/examples/List/indexed/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/indexed/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List { index : Natural, value : Bool } diff --git a/tests/normalization/examples/List/iterate/0A.dhall b/tests/normalization/examples/List/iterate/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/iterate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/iterate +10 Natural (λ(x : Natural) → x * +2) +1 diff --git a/tests/normalization/examples/List/iterate/0B.dhall b/tests/normalization/examples/List/iterate/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/iterate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +1, +2, +4, +8, +16, +32, +64, +128, +256, +512 ] diff --git a/tests/normalization/examples/List/iterate/1A.dhall b/tests/normalization/examples/List/iterate/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/iterate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/iterate +0 Natural (λ(x : Natural) → x * +2) +1 diff --git a/tests/normalization/examples/List/iterate/1B.dhall b/tests/normalization/examples/List/iterate/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/iterate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Natural diff --git a/tests/normalization/examples/List/last/0A.dhall b/tests/normalization/examples/List/last/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/last/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/last Integer [ 0, 1, 2 ] diff --git a/tests/normalization/examples/List/last/0B.dhall b/tests/normalization/examples/List/last/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/last/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 2 ] : Optional Integer diff --git a/tests/normalization/examples/List/last/1A.dhall b/tests/normalization/examples/List/last/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/last/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/last Integer ([] : List Integer) diff --git a/tests/normalization/examples/List/last/1B.dhall b/tests/normalization/examples/List/last/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/last/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/List/length/0A.dhall b/tests/normalization/examples/List/length/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/length/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/length Integer [ 0, 1, 2 ] diff --git a/tests/normalization/examples/List/length/0B.dhall b/tests/normalization/examples/List/length/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/length/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+3 diff --git a/tests/normalization/examples/List/length/1A.dhall b/tests/normalization/examples/List/length/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/length/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/length Integer ([] : List Integer) diff --git a/tests/normalization/examples/List/length/1B.dhall b/tests/normalization/examples/List/length/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/length/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+0 diff --git a/tests/normalization/examples/List/map/0A.dhall b/tests/normalization/examples/List/map/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/map/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/map Natural Bool Natural/even [ +2, +3, +5 ] diff --git a/tests/normalization/examples/List/map/0B.dhall b/tests/normalization/examples/List/map/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/map/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ True, False, False ] diff --git a/tests/normalization/examples/List/map/1A.dhall b/tests/normalization/examples/List/map/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/map/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/map Natural Bool Natural/even ([] : List Natural) diff --git a/tests/normalization/examples/List/map/1B.dhall b/tests/normalization/examples/List/map/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/map/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Bool diff --git a/tests/normalization/examples/List/null/0A.dhall b/tests/normalization/examples/List/null/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/null/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/null Integer [ 0, 1, 2 ] diff --git a/tests/normalization/examples/List/null/0B.dhall b/tests/normalization/examples/List/null/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/null/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/List/null/1A.dhall b/tests/normalization/examples/List/null/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/null/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/null Integer ([] : List Integer) diff --git a/tests/normalization/examples/List/null/1B.dhall b/tests/normalization/examples/List/null/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/null/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/List/replicate/0A.dhall b/tests/normalization/examples/List/replicate/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/replicate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/replicate +9 Integer 1 diff --git a/tests/normalization/examples/List/replicate/0B.dhall b/tests/normalization/examples/List/replicate/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/replicate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 1, 1, 1, 1, 1, 1, 1, 1, 1 ] diff --git a/tests/normalization/examples/List/replicate/1A.dhall b/tests/normalization/examples/List/replicate/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/replicate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/replicate +0 Integer 1 diff --git a/tests/normalization/examples/List/replicate/1B.dhall b/tests/normalization/examples/List/replicate/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/replicate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Integer diff --git a/tests/normalization/examples/List/reverse/0A.dhall b/tests/normalization/examples/List/reverse/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/reverse/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/reverse Integer [ 0, 1, 2 ] diff --git a/tests/normalization/examples/List/reverse/0B.dhall b/tests/normalization/examples/List/reverse/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/reverse/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 2, 1, 0 ] diff --git a/tests/normalization/examples/List/reverse/1A.dhall b/tests/normalization/examples/List/reverse/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/reverse/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/reverse Integer ([] : List Integer) diff --git a/tests/normalization/examples/List/reverse/1B.dhall b/tests/normalization/examples/List/reverse/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/reverse/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Integer diff --git a/tests/normalization/examples/List/shifted/0A.dhall b/tests/normalization/examples/List/shifted/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/shifted/0A.dhall +++ /dev/null @@ -1,15 +0,0 @@ -../../../../../Prelude/List/shifted -Bool -[ [ { index = +0, value = True } - , { index = +1, value = True } - , { index = +2, value = False } - ] -, [ { index = +0, value = False } - , { index = +1, value = False } - ] -, [ { index = +0, value = True } - , { index = +1, value = True } - , { index = +2, value = True } - , { index = +3, value = True } - ] -] diff --git a/tests/normalization/examples/List/shifted/0B.dhall b/tests/normalization/examples/List/shifted/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/shifted/0B.dhall +++ /dev/null @@ -1,10 +0,0 @@ -[ { index = +0, value = True } -, { index = +1, value = True } -, { index = +2, value = False } -, { index = +3, value = False } -, { index = +4, value = False } -, { index = +5, value = True } -, { index = +6, value = True } -, { index = +7, value = True } -, { index = +8, value = True } -] diff --git a/tests/normalization/examples/List/shifted/1A.dhall b/tests/normalization/examples/List/shifted/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/shifted/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/shifted Bool ([] : List (List { index : Natural, value : Bool })) diff --git a/tests/normalization/examples/List/shifted/1B.dhall b/tests/normalization/examples/List/shifted/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/shifted/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List { index : Natural, value : Bool } diff --git a/tests/normalization/examples/List/unzip/0A.dhall b/tests/normalization/examples/List/unzip/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/unzip/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../Prelude/List/unzip -Text -Bool -[ { _1 = "ABC", _2 = True } -, { _1 = "DEF", _2 = False } -, { _1 = "GHI", _2 = True } -] diff --git a/tests/normalization/examples/List/unzip/0B.dhall b/tests/normalization/examples/List/unzip/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/unzip/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 = [ "ABC", "DEF", "GHI" ], _2 = [ True, False, True ] } diff --git a/tests/normalization/examples/List/unzip/1A.dhall b/tests/normalization/examples/List/unzip/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/unzip/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/unzip Text Bool ([] : List { _1 : Text, _2 : Bool }) diff --git a/tests/normalization/examples/List/unzip/1B.dhall b/tests/normalization/examples/List/unzip/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/List/unzip/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 = [] : List Text, _2 = [] : List Bool } diff --git a/tests/normalization/examples/Natural/build/0A.dhall b/tests/normalization/examples/Natural/build/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/build/0A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../Prelude/Natural/build -( λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ succ (succ (succ zero)) -) diff --git a/tests/normalization/examples/Natural/build/0B.dhall b/tests/normalization/examples/Natural/build/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+3 diff --git a/tests/normalization/examples/Natural/build/1A.dhall b/tests/normalization/examples/Natural/build/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/build/1A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../Prelude/Natural/build -( λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ zero -) diff --git a/tests/normalization/examples/Natural/build/1B.dhall b/tests/normalization/examples/Natural/build/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+0 diff --git a/tests/normalization/examples/Natural/enumerate/0A.dhall b/tests/normalization/examples/Natural/enumerate/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/enumerate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/enumerate +10 diff --git a/tests/normalization/examples/Natural/enumerate/0B.dhall b/tests/normalization/examples/Natural/enumerate/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/enumerate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +0, +1, +2, +3, +4, +5, +6, +7, +8, +9 ] diff --git a/tests/normalization/examples/Natural/enumerate/1A.dhall b/tests/normalization/examples/Natural/enumerate/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/enumerate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/enumerate +0 diff --git a/tests/normalization/examples/Natural/enumerate/1B.dhall b/tests/normalization/examples/Natural/enumerate/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/enumerate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Natural diff --git a/tests/normalization/examples/Natural/even/0A.dhall b/tests/normalization/examples/Natural/even/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/even/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/even +3 diff --git a/tests/normalization/examples/Natural/even/0B.dhall b/tests/normalization/examples/Natural/even/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/even/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Natural/even/1A.dhall b/tests/normalization/examples/Natural/even/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/even/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/even +0 diff --git a/tests/normalization/examples/Natural/even/1B.dhall b/tests/normalization/examples/Natural/even/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/even/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Natural/fold/0A.dhall b/tests/normalization/examples/Natural/fold/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/fold/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/fold +3 Natural (λ(x : Natural) → +5 * x) +1 diff --git a/tests/normalization/examples/Natural/fold/0B.dhall b/tests/normalization/examples/Natural/fold/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+125 diff --git a/tests/normalization/examples/Natural/fold/1A.dhall b/tests/normalization/examples/Natural/fold/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/fold/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(zero : Natural) → ../../../../../Prelude/Natural/fold +3 Natural (λ(x : Natural) → +5 * x) zero diff --git a/tests/normalization/examples/Natural/fold/1B.dhall b/tests/normalization/examples/Natural/fold/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(zero : Natural) → +5 * +5 * +5 * zero diff --git a/tests/normalization/examples/Natural/fold/2A.dhall b/tests/normalization/examples/Natural/fold/2A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/fold/2A.dhall +++ /dev/null @@ -1,4 +0,0 @@ - λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ ../../../../../Prelude/Natural/fold +3 natural succ zero diff --git a/tests/normalization/examples/Natural/fold/2B.dhall b/tests/normalization/examples/Natural/fold/2B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/fold/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(natural : Type) → λ(succ : natural → natural) → λ(zero : natural) → succ (succ (succ zero)) diff --git a/tests/normalization/examples/Natural/isZero/0A.dhall b/tests/normalization/examples/Natural/isZero/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/isZero/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/isZero +2 diff --git a/tests/normalization/examples/Natural/isZero/0B.dhall b/tests/normalization/examples/Natural/isZero/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/isZero/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Natural/isZero/1A.dhall b/tests/normalization/examples/Natural/isZero/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/isZero/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/isZero +0 diff --git a/tests/normalization/examples/Natural/isZero/1B.dhall b/tests/normalization/examples/Natural/isZero/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/isZero/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Natural/odd/0A.dhall b/tests/normalization/examples/Natural/odd/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/odd/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/odd +3 diff --git a/tests/normalization/examples/Natural/odd/0B.dhall b/tests/normalization/examples/Natural/odd/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/odd/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Natural/odd/1A.dhall b/tests/normalization/examples/Natural/odd/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/odd/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/odd +0 diff --git a/tests/normalization/examples/Natural/odd/1B.dhall b/tests/normalization/examples/Natural/odd/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/odd/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Natural/product/0A.dhall b/tests/normalization/examples/Natural/product/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/product/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/product [ +2, +3, +5 ] diff --git a/tests/normalization/examples/Natural/product/0B.dhall b/tests/normalization/examples/Natural/product/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/product/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+30 diff --git a/tests/normalization/examples/Natural/product/1A.dhall b/tests/normalization/examples/Natural/product/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/product/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/product ([] : List Natural) diff --git a/tests/normalization/examples/Natural/product/1B.dhall b/tests/normalization/examples/Natural/product/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/product/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+1 diff --git a/tests/normalization/examples/Natural/show/0A.dhall b/tests/normalization/examples/Natural/show/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/show +3 diff --git a/tests/normalization/examples/Natural/show/0B.dhall b/tests/normalization/examples/Natural/show/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"+3" diff --git a/tests/normalization/examples/Natural/show/1A.dhall b/tests/normalization/examples/Natural/show/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/show +0 diff --git a/tests/normalization/examples/Natural/show/1B.dhall b/tests/normalization/examples/Natural/show/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"+0" diff --git a/tests/normalization/examples/Natural/sum/0A.dhall b/tests/normalization/examples/Natural/sum/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/sum/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/sum [ +2, +3, +5 ] diff --git a/tests/normalization/examples/Natural/sum/0B.dhall b/tests/normalization/examples/Natural/sum/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/sum/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+10 diff --git a/tests/normalization/examples/Natural/sum/1A.dhall b/tests/normalization/examples/Natural/sum/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/sum/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/sum ([] : List Natural) diff --git a/tests/normalization/examples/Natural/sum/1B.dhall b/tests/normalization/examples/Natural/sum/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/sum/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+0 diff --git a/tests/normalization/examples/Natural/toInteger/0A.dhall b/tests/normalization/examples/Natural/toInteger/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/toInteger/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/toInteger +3 diff --git a/tests/normalization/examples/Natural/toInteger/0B.dhall b/tests/normalization/examples/Natural/toInteger/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/toInteger/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -3 diff --git a/tests/normalization/examples/Natural/toInteger/1A.dhall b/tests/normalization/examples/Natural/toInteger/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/toInteger/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/toInteger +0 diff --git a/tests/normalization/examples/Natural/toInteger/1B.dhall b/tests/normalization/examples/Natural/toInteger/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Natural/toInteger/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -0 diff --git a/tests/normalization/examples/Optional/all/0A.dhall b/tests/normalization/examples/Optional/all/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/all/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/all Natural Natural/even ([ +3 ] : Optional Natural) diff --git a/tests/normalization/examples/Optional/all/0B.dhall b/tests/normalization/examples/Optional/all/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/all/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Optional/all/1A.dhall b/tests/normalization/examples/Optional/all/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/all/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/all Natural Natural/even ([] : Optional Natural) diff --git a/tests/normalization/examples/Optional/all/1B.dhall b/tests/normalization/examples/Optional/all/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/all/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Optional/any/0A.dhall b/tests/normalization/examples/Optional/any/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/any/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/any Natural Natural/even ([ +2 ] : Optional Natural) diff --git a/tests/normalization/examples/Optional/any/0B.dhall b/tests/normalization/examples/Optional/any/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/any/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Optional/any/1A.dhall b/tests/normalization/examples/Optional/any/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/any/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/any Natural Natural/even ([] : Optional Natural) diff --git a/tests/normalization/examples/Optional/any/1B.dhall b/tests/normalization/examples/Optional/any/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/any/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Optional/build/0A.dhall b/tests/normalization/examples/Optional/build/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/build/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../Prelude/Optional/build -Integer -( λ(optional : Type) -→ λ(just : Integer → optional) -→ λ(nothing : optional) -→ just 1 -) diff --git a/tests/normalization/examples/Optional/build/0B.dhall b/tests/normalization/examples/Optional/build/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 1 ] : Optional Integer diff --git a/tests/normalization/examples/Optional/build/1A.dhall b/tests/normalization/examples/Optional/build/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/build/1A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../Prelude/Optional/build -Integer -( λ(optional : Type) -→ λ(just : Integer → optional) -→ λ(nothing : optional) -→ nothing -) diff --git a/tests/normalization/examples/Optional/build/1B.dhall b/tests/normalization/examples/Optional/build/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/Optional/concat/0A.dhall b/tests/normalization/examples/Optional/concat/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/concat/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/concat Integer ([ [ 1 ] : Optional Integer ] : Optional (Optional Integer)) diff --git a/tests/normalization/examples/Optional/concat/0B.dhall b/tests/normalization/examples/Optional/concat/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/concat/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 1 ] : Optional Integer diff --git a/tests/normalization/examples/Optional/concat/1A.dhall b/tests/normalization/examples/Optional/concat/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/concat/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/concat Integer ([ [] : Optional Integer ] : Optional (Optional Integer)) diff --git a/tests/normalization/examples/Optional/concat/1B.dhall b/tests/normalization/examples/Optional/concat/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/concat/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/Optional/concat/2A.dhall b/tests/normalization/examples/Optional/concat/2A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/concat/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/concat Integer ([ [] : Optional Integer ]: Optional (Optional Integer)) diff --git a/tests/normalization/examples/Optional/concat/2B.dhall b/tests/normalization/examples/Optional/concat/2B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/concat/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/Optional/filter/0A.dhall b/tests/normalization/examples/Optional/filter/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/filter/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/filter Natural Natural/even ([ +2 ] : Optional Natural) diff --git a/tests/normalization/examples/Optional/filter/0B.dhall b/tests/normalization/examples/Optional/filter/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/filter/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +2 ] : Optional Natural diff --git a/tests/normalization/examples/Optional/filter/1A.dhall b/tests/normalization/examples/Optional/filter/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/filter/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/filter Natural Natural/odd ([ +2 ] : Optional Natural) diff --git a/tests/normalization/examples/Optional/filter/1B.dhall b/tests/normalization/examples/Optional/filter/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/filter/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Natural diff --git a/tests/normalization/examples/Optional/fold/0A.dhall b/tests/normalization/examples/Optional/fold/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/fold/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/fold Integer ([ 2 ] : Optional Integer) Integer (λ(x : Integer) → x) 0 diff --git a/tests/normalization/examples/Optional/fold/0B.dhall b/tests/normalization/examples/Optional/fold/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -2 diff --git a/tests/normalization/examples/Optional/fold/1A.dhall b/tests/normalization/examples/Optional/fold/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/fold/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/fold Integer ([] : Optional Integer) Integer (λ(x : Integer) → x) 0 diff --git a/tests/normalization/examples/Optional/fold/1B.dhall b/tests/normalization/examples/Optional/fold/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -0 diff --git a/tests/normalization/examples/Optional/head/0A.dhall b/tests/normalization/examples/Optional/head/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/head/0A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../Prelude/Optional/head -Integer -[ [] : Optional Integer -, [ 1 ] : Optional Integer -, [ 2 ] : Optional Integer -] diff --git a/tests/normalization/examples/Optional/head/0B.dhall b/tests/normalization/examples/Optional/head/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/head/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 1 ] : Optional Integer diff --git a/tests/normalization/examples/Optional/head/1A.dhall b/tests/normalization/examples/Optional/head/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/head/1A.dhall +++ /dev/null @@ -1,3 +0,0 @@ -../../../../../Prelude/Optional/head -Integer -[ [] : Optional Integer, [] : Optional Integer ] diff --git a/tests/normalization/examples/Optional/head/1B.dhall b/tests/normalization/examples/Optional/head/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/head/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/Optional/last/0A.dhall b/tests/normalization/examples/Optional/last/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/last/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../Prelude/Optional/last -Integer -( [ [] : Optional Integer - , [ 1 ] : Optional Integer - , [ 2 ] : Optional Integer - ] -) diff --git a/tests/normalization/examples/Optional/last/0B.dhall b/tests/normalization/examples/Optional/last/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/last/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 2 ] : Optional Integer diff --git a/tests/normalization/examples/Optional/last/1A.dhall b/tests/normalization/examples/Optional/last/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/last/1A.dhall +++ /dev/null @@ -1,3 +0,0 @@ -../../../../../Prelude/Optional/last -Integer -[ [] : Optional Integer, [] : Optional Integer ] diff --git a/tests/normalization/examples/Optional/last/1B.dhall b/tests/normalization/examples/Optional/last/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/last/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/Optional/last/2A.dhall b/tests/normalization/examples/Optional/last/2A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/last/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/last Integer ([] : List (Optional Integer)) diff --git a/tests/normalization/examples/Optional/last/2B.dhall b/tests/normalization/examples/Optional/last/2B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/last/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Integer diff --git a/tests/normalization/examples/Optional/length/0A.dhall b/tests/normalization/examples/Optional/length/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/length/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/length Integer ([ 2 ] : Optional Integer) diff --git a/tests/normalization/examples/Optional/length/0B.dhall b/tests/normalization/examples/Optional/length/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/length/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+1 diff --git a/tests/normalization/examples/Optional/length/1A.dhall b/tests/normalization/examples/Optional/length/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/length/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/length Integer ([] : Optional Integer) diff --git a/tests/normalization/examples/Optional/length/1B.dhall b/tests/normalization/examples/Optional/length/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/length/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+0 diff --git a/tests/normalization/examples/Optional/map/0A.dhall b/tests/normalization/examples/Optional/map/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/map/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/map Natural Bool Natural/even ([ +3 ] : Optional Natural) diff --git a/tests/normalization/examples/Optional/map/0B.dhall b/tests/normalization/examples/Optional/map/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/map/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ False ] : Optional Bool diff --git a/tests/normalization/examples/Optional/map/1A.dhall b/tests/normalization/examples/Optional/map/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/map/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/map Natural Bool Natural/even ([] : Optional Natural) diff --git a/tests/normalization/examples/Optional/map/1B.dhall b/tests/normalization/examples/Optional/map/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/map/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : Optional Bool diff --git a/tests/normalization/examples/Optional/null/0A.dhall b/tests/normalization/examples/Optional/null/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/null/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/null Integer ([ 2 ] : Optional Integer) diff --git a/tests/normalization/examples/Optional/null/0B.dhall b/tests/normalization/examples/Optional/null/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/null/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -False diff --git a/tests/normalization/examples/Optional/null/1A.dhall b/tests/normalization/examples/Optional/null/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/null/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/null Integer ([] : Optional Integer) diff --git a/tests/normalization/examples/Optional/null/1B.dhall b/tests/normalization/examples/Optional/null/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/null/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -True diff --git a/tests/normalization/examples/Optional/toList/0A.dhall b/tests/normalization/examples/Optional/toList/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/toList/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/toList Integer ([ 1 ] : Optional Integer) diff --git a/tests/normalization/examples/Optional/toList/0B.dhall b/tests/normalization/examples/Optional/toList/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/toList/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 1 ] diff --git a/tests/normalization/examples/Optional/toList/1A.dhall b/tests/normalization/examples/Optional/toList/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/toList/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/toList Integer ([] : Optional Integer) diff --git a/tests/normalization/examples/Optional/toList/1B.dhall b/tests/normalization/examples/Optional/toList/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/toList/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[] : List Integer diff --git a/tests/normalization/examples/Optional/unzip/0A.dhall b/tests/normalization/examples/Optional/unzip/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/unzip/0A.dhall +++ /dev/null @@ -1,4 +0,0 @@ -../../../../../Prelude/Optional/unzip -Text -Bool -([ { _1 = "ABC", _2 = True } ] : Optional { _1 : Text, _2 : Bool }) diff --git a/tests/normalization/examples/Optional/unzip/0B.dhall b/tests/normalization/examples/Optional/unzip/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/unzip/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 = [ "ABC" ] : Optional Text, _2 = [ True ] : Optional Bool } diff --git a/tests/normalization/examples/Optional/unzip/1A.dhall b/tests/normalization/examples/Optional/unzip/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/unzip/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/unzip Text Bool ([] : Optional { _1 : Text, _2 : Bool }) diff --git a/tests/normalization/examples/Optional/unzip/1B.dhall b/tests/normalization/examples/Optional/unzip/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Optional/unzip/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 = [] : Optional Text, _2 = [] : Optional Bool } diff --git a/tests/normalization/examples/Text/concat/0A.dhall b/tests/normalization/examples/Text/concat/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concat/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concat [ "ABC", "DEF", "GHI" ] diff --git a/tests/normalization/examples/Text/concat/0B.dhall b/tests/normalization/examples/Text/concat/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concat/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"ABCDEFGHI" diff --git a/tests/normalization/examples/Text/concat/1A.dhall b/tests/normalization/examples/Text/concat/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concat/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concat ([] : List Text) diff --git a/tests/normalization/examples/Text/concat/1B.dhall b/tests/normalization/examples/Text/concat/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concat/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"" diff --git a/tests/normalization/examples/Text/concatMap/0A.dhall b/tests/normalization/examples/Text/concatMap/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMap/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concatMap Integer (λ(n : Integer) → "${Integer/show n} ") [ 0, 1, 2 ] diff --git a/tests/normalization/examples/Text/concatMap/0B.dhall b/tests/normalization/examples/Text/concatMap/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMap/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"0 1 2 " diff --git a/tests/normalization/examples/Text/concatMap/1A.dhall b/tests/normalization/examples/Text/concatMap/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMap/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concatMap Integer (λ(n : Integer) → "${Integer/show n} ") ([] : List Integer) diff --git a/tests/normalization/examples/Text/concatMap/1B.dhall b/tests/normalization/examples/Text/concatMap/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMap/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"" diff --git a/tests/normalization/examples/Text/concatMapSep/0A.dhall b/tests/normalization/examples/Text/concatMapSep/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMapSep/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concatMapSep ", " Integer Integer/show [ 0, 1, 2 ] diff --git a/tests/normalization/examples/Text/concatMapSep/0B.dhall b/tests/normalization/examples/Text/concatMapSep/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMapSep/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"0, 1, 2" diff --git a/tests/normalization/examples/Text/concatMapSep/1A.dhall b/tests/normalization/examples/Text/concatMapSep/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMapSep/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concatMapSep ", " Integer Integer/show ([] : List Integer) diff --git a/tests/normalization/examples/Text/concatMapSep/1B.dhall b/tests/normalization/examples/Text/concatMapSep/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatMapSep/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"" diff --git a/tests/normalization/examples/Text/concatSep/0A.dhall b/tests/normalization/examples/Text/concatSep/0A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatSep/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concatSep ", " [ "ABC", "DEF", "GHI" ] diff --git a/tests/normalization/examples/Text/concatSep/0B.dhall b/tests/normalization/examples/Text/concatSep/0B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatSep/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"ABC, DEF, GHI" diff --git a/tests/normalization/examples/Text/concatSep/1A.dhall b/tests/normalization/examples/Text/concatSep/1A.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatSep/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concatSep ", " ([] : List Text) diff --git a/tests/normalization/examples/Text/concatSep/1B.dhall b/tests/normalization/examples/Text/concatSep/1B.dhall deleted file mode 100644 --- a/tests/normalization/examples/Text/concatSep/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"" diff --git a/tests/normalization/integerShowA.dhall b/tests/normalization/integerShowA.dhall deleted file mode 100644 --- a/tests/normalization/integerShowA.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ example0 = Integer/show 1337 -, example1 = Integer/show -42 -, example2 = Integer/show 0 -} diff --git a/tests/normalization/integerShowB.dhall b/tests/normalization/integerShowB.dhall deleted file mode 100644 --- a/tests/normalization/integerShowB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ example0 = "1337", example1 = "-42", example2 = "0" } diff --git a/tests/normalization/listBuildA.dhall b/tests/normalization/listBuildA.dhall deleted file mode 100644 --- a/tests/normalization/listBuildA.dhall +++ /dev/null @@ -1,22 +0,0 @@ -{ example0 = - List/build - Bool - ( λ(list : Type) - → λ(cons : Bool → list → list) - → λ(nil : list) - → cons True (cons False nil) - ) -, example1 = - List/build - Bool - (λ(x : Type) → λ(x : Bool → x → x) → λ(x : x@1) → x@1 True (x@1 False x)) -, example2 = - λ(id : ∀(a : Type) → a → a) - → List/build - Bool - ( λ(list : Type) - → λ(cons : Bool → list → list) - → λ(nil : list) - → id list (cons True (cons False nil)) - ) -} diff --git a/tests/normalization/listBuildB.dhall b/tests/normalization/listBuildB.dhall deleted file mode 100644 --- a/tests/normalization/listBuildB.dhall +++ /dev/null @@ -1,7 +0,0 @@ -{ example0 = - [ True, False ] : List Bool -, example1 = - [ True, False ] : List Bool -, example2 = - λ(id : ∀(a : Type) → a → a) → id (List Bool) [ True, False ] -} diff --git a/tests/normalization/naturalBuildA.dhall b/tests/normalization/naturalBuildA.dhall deleted file mode 100644 --- a/tests/normalization/naturalBuildA.dhall +++ /dev/null @@ -1,18 +0,0 @@ -{ example0 = - Natural/build - ( λ(natural : Type) - → λ(succ : natural → natural) - → λ(zero : natural) - → succ zero - ) -, example1 = - Natural/build (λ(x : Type) → λ(x : x → x) → λ(x : x@1) → x@1 x) -, example2 = - λ(id : ∀(a : Type) → a → a) - → Natural/build - ( λ(natural : Type) - → λ(succ : natural → natural) - → λ(zero : natural) - → id natural (succ zero) - ) -} diff --git a/tests/normalization/naturalBuildB.dhall b/tests/normalization/naturalBuildB.dhall deleted file mode 100644 --- a/tests/normalization/naturalBuildB.dhall +++ /dev/null @@ -1,7 +0,0 @@ -{ example0 = - +1 -, example1 = - +1 -, example2 = - λ(id : ∀(a : Type) → a → a) → id Natural +1 -} diff --git a/tests/normalization/naturalPlusA.dhall b/tests/normalization/naturalPlusA.dhall deleted file mode 100644 --- a/tests/normalization/naturalPlusA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+1 + +2 diff --git a/tests/normalization/naturalPlusB.dhall b/tests/normalization/naturalPlusB.dhall deleted file mode 100644 --- a/tests/normalization/naturalPlusB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -+3 diff --git a/tests/normalization/naturalShowA.dhall b/tests/normalization/naturalShowA.dhall deleted file mode 100644 --- a/tests/normalization/naturalShowA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural/show +42 diff --git a/tests/normalization/naturalShowB.dhall b/tests/normalization/naturalShowB.dhall deleted file mode 100644 --- a/tests/normalization/naturalShowB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"+42" diff --git a/tests/normalization/naturalToIntegerA.dhall b/tests/normalization/naturalToIntegerA.dhall deleted file mode 100644 --- a/tests/normalization/naturalToIntegerA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural/toInteger +1 diff --git a/tests/normalization/naturalToIntegerB.dhall b/tests/normalization/naturalToIntegerB.dhall deleted file mode 100644 --- a/tests/normalization/naturalToIntegerB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -1 diff --git a/tests/normalization/optionalBuildA.dhall b/tests/normalization/optionalBuildA.dhall deleted file mode 100644 --- a/tests/normalization/optionalBuildA.dhall +++ /dev/null @@ -1,32 +0,0 @@ -{ example0 = - Optional/build - Natural - ( λ(optional : Type) - → λ(just : Natural → optional) - → λ(nothing : optional) - → just +1 - ) -, example1 = - Optional/build - Integer - (λ(optional : Type) → λ(x : Integer → optional) → λ(x : optional) → x@1 1) -, example2 = - λ(id : ∀(a : Type) → a → a) - → Optional/build - Bool - ( λ(optional : Type) - → λ(just : Bool → optional) - → λ(nothing : optional) - → id optional (just True) - ) -, example3 = - λ(a : Type) - → λ(x : a) - → Optional/build - a - ( λ(optional : Type) - → λ(just : a → optional) - → λ(nothing : optional) - → just x - ) -} diff --git a/tests/normalization/optionalBuildB.dhall b/tests/normalization/optionalBuildB.dhall deleted file mode 100644 --- a/tests/normalization/optionalBuildB.dhall +++ /dev/null @@ -1,9 +0,0 @@ -{ example0 = - [ +1 ] : Optional Natural -, example1 = - [ 1 ] : Optional Integer -, example2 = - λ(id : ∀(a : Type) → a → a) → id (Optional Bool) ([ True ] : Optional Bool) -, example3 = - λ(a : Type) → λ(x : a) → [ x ] : Optional a -} diff --git a/tests/normalization/optionalBuildFoldA.dhall b/tests/normalization/optionalBuildFoldA.dhall deleted file mode 100644 --- a/tests/normalization/optionalBuildFoldA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional/build Text (Optional/fold Text ([ "foo" ] : Optional Text)) diff --git a/tests/normalization/optionalBuildFoldB.dhall b/tests/normalization/optionalBuildFoldB.dhall deleted file mode 100644 --- a/tests/normalization/optionalBuildFoldB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ "foo" ] : Optional Text diff --git a/tests/normalization/optionalFoldA.dhall b/tests/normalization/optionalFoldA.dhall deleted file mode 100644 --- a/tests/normalization/optionalFoldA.dhall +++ /dev/null @@ -1,7 +0,0 @@ - let f = - λ(o : Optional Text) - → Optional/fold Text o Natural (λ(j : Text) → +1) +2 - -in { example0 = f ([ "foo" ] : Optional Text) - , example1 = f ([] : Optional Text) - } diff --git a/tests/normalization/optionalFoldB.dhall b/tests/normalization/optionalFoldB.dhall deleted file mode 100644 --- a/tests/normalization/optionalFoldB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ example0 = +1, example1 = +2 } diff --git a/tests/normalization/remoteSystemsA.dhall b/tests/normalization/remoteSystemsA.dhall deleted file mode 100644 --- a/tests/normalization/remoteSystemsA.dhall +++ /dev/null @@ -1,55 +0,0 @@ - let Text/concatMap = - ../../Prelude/Text/concatMap - -in let Text/concatSep = - ../../Prelude/Text/concatSep - -in let Row = - { cores : - Natural - , host : - Text - , key : - Text - , mandatoryFeatures : - List Text - , platforms : - List Text - , speedFactor : - Natural - , supportedFeatures : - List Text - , user : - Optional Text - } - -in let renderRow = - λ ( row - : Row - ) - → let host = - Optional/fold - Text - row.user - Text - (λ(user : Text) → "${user}@${row.host}") - row.host - - in let platforms = Text/concatSep "," row.platforms - - in let key = row.key - - in let cores = Integer/show (Natural/toInteger row.cores) - - in let speedFactor = - Integer/show (Natural/toInteger row.speedFactor) - - in let supportedFeatures = Text/concatSep "," row.supportedFeatures - - in let mandatoryFeatures = Text/concatSep "," row.mandatoryFeatures - - in '' - ${host} ${platforms} ${key} ${cores} ${speedFactor} ${supportedFeatures} ${mandatoryFeatures} - '' - -in Text/concatMap Row renderRow diff --git a/tests/normalization/remoteSystemsB.dhall b/tests/normalization/remoteSystemsB.dhall deleted file mode 100644 --- a/tests/normalization/remoteSystemsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(xs : List { cores : Natural, host : Text, key : Text, mandatoryFeatures : List Text, platforms : List Text, speedFactor : Natural, supportedFeatures : List Text, user : Optional Text }) → List/fold { cores : Natural, host : Text, key : Text, mandatoryFeatures : List Text, platforms : List Text, speedFactor : Natural, supportedFeatures : List Text, user : Optional Text } xs Text (λ(x : { cores : Natural, host : Text, key : Text, mandatoryFeatures : List Text, platforms : List Text, speedFactor : Natural, supportedFeatures : List Text, user : Optional Text }) → λ(y : Text) → "${Optional/fold Text x.user Text (λ(user : Text) → "${user}@${x.host}") x.host} ${merge { Empty = λ(_ : {}) → "", NonEmpty = λ(result : Text) → result } (List/fold Text x.platforms < Empty : {} | NonEmpty : Text > (λ(element : Text) → λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → < NonEmpty = element | Empty : {} >, NonEmpty = λ(result : Text) → < NonEmpty = element ++ "," ++ result | Empty : {} > } status : < Empty : {} | NonEmpty : Text >) < Empty = {=} | NonEmpty : Text >) : Text} ${x.key} ${Integer/show (Natural/toInteger x.cores)} ${Integer/show (Natural/toInteger x.speedFactor)} ${merge { Empty = λ(_ : {}) → "", NonEmpty = λ(result : Text) → result } (List/fold Text x.supportedFeatures < Empty : {} | NonEmpty : Text > (λ(element : Text) → λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → < NonEmpty = element | Empty : {} >, NonEmpty = λ(result : Text) → < NonEmpty = element ++ "," ++ result | Empty : {} > } status : < Empty : {} | NonEmpty : Text >) < Empty = {=} | NonEmpty : Text >) : Text} ${merge { Empty = λ(_ : {}) → "", NonEmpty = λ(result : Text) → result } (List/fold Text x.mandatoryFeatures < Empty : {} | NonEmpty : Text > (λ(element : Text) → λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → < NonEmpty = element | Empty : {} >, NonEmpty = λ(result : Text) → < NonEmpty = element ++ "," ++ result | Empty : {} > } status : < Empty : {} | NonEmpty : Text >) < Empty = {=} | NonEmpty : Text >) : Text}\n" ++ y) "" diff --git a/tests/normalization/simplifications/andA.dhall b/tests/normalization/simplifications/andA.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/andA.dhall +++ /dev/null @@ -1,6 +0,0 @@ -{ example0 = λ(x : Bool) → x && True -, example1 = λ(x : Bool) → True && x -, example2 = λ(x : Bool) → x && False -, example3 = λ(x : Bool) → False && x -, example4 = λ(x : Bool) → x && x -} diff --git a/tests/normalization/simplifications/andB.dhall b/tests/normalization/simplifications/andB.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/andB.dhall +++ /dev/null @@ -1,6 +0,0 @@ -{ example0 = λ(x : Bool) → x -, example1 = λ(x : Bool) → x -, example2 = λ(x : Bool) → False -, example3 = λ(x : Bool) → False -, example4 = λ(x : Bool) → x -} diff --git a/tests/normalization/simplifications/eqA.dhall b/tests/normalization/simplifications/eqA.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/eqA.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ example0 = λ(x : Bool) → x == True -, example1 = λ(x : Bool) → True == x -, example2 = λ(x : Bool) → x == x -} diff --git a/tests/normalization/simplifications/eqB.dhall b/tests/normalization/simplifications/eqB.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/eqB.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ example0 = λ(x : Bool) → x -, example1 = λ(x : Bool) → x -, example2 = λ(x : Bool) → True -} diff --git a/tests/normalization/simplifications/ifThenElseA.dhall b/tests/normalization/simplifications/ifThenElseA.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/ifThenElseA.dhall +++ /dev/null @@ -1,3 +0,0 @@ -{ example0 = λ(x : Bool) → if x then True else False -, example1 = λ(x : Bool) → λ(y : Text) → if x then y else y -} diff --git a/tests/normalization/simplifications/ifThenElseB.dhall b/tests/normalization/simplifications/ifThenElseB.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/ifThenElseB.dhall +++ /dev/null @@ -1,3 +0,0 @@ -{ example0 = λ(x : Bool) → x -, example1 = λ(x : Bool) → λ(y : Text) → y -} diff --git a/tests/normalization/simplifications/neA.dhall b/tests/normalization/simplifications/neA.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/neA.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ example0 = λ(x : Bool) → x != False -, example1 = λ(x : Bool) → False != x -, example2 = λ(x : Bool) → x != x -} diff --git a/tests/normalization/simplifications/neB.dhall b/tests/normalization/simplifications/neB.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/neB.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ example0 = λ(x : Bool) → x -, example1 = λ(x : Bool) → x -, example2 = λ(x : Bool) → False -} diff --git a/tests/normalization/simplifications/orA.dhall b/tests/normalization/simplifications/orA.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/orA.dhall +++ /dev/null @@ -1,6 +0,0 @@ -{ example0 = λ(x : Bool) → x || True -, example1 = λ(x : Bool) → True || x -, example2 = λ(x : Bool) → x || False -, example3 = λ(x : Bool) → False || x -, example4 = λ(x : Bool) → x || x -} diff --git a/tests/normalization/simplifications/orB.dhall b/tests/normalization/simplifications/orB.dhall deleted file mode 100644 --- a/tests/normalization/simplifications/orB.dhall +++ /dev/null @@ -1,6 +0,0 @@ -{ example0 = λ(x : Bool) → True -, example1 = λ(x : Bool) → True -, example2 = λ(x : Bool) → x -, example3 = λ(x : Bool) → x -, example4 = λ(x : Bool) → x -} diff --git a/tests/package/dir/package.dhall b/tests/package/dir/package.dhall new file mode 100644 --- /dev/null +++ b/tests/package/dir/package.dhall diff --git a/tests/package/dir/subdirectory1/test.dhall b/tests/package/dir/subdirectory1/test.dhall new file mode 100644 --- /dev/null +++ b/tests/package/dir/subdirectory1/test.dhall diff --git a/tests/package/dir/subdirectory2/wrong-extension.txt b/tests/package/dir/subdirectory2/wrong-extension.txt new file mode 100644 --- /dev/null +++ b/tests/package/dir/subdirectory2/wrong-extension.txt diff --git a/tests/package/dir/test.dhall b/tests/package/dir/test.dhall new file mode 100644 --- /dev/null +++ b/tests/package/dir/test.dhall diff --git a/tests/package/dir/wrong-extension.txt b/tests/package/dir/wrong-extension.txt new file mode 100644 --- /dev/null +++ b/tests/package/dir/wrong-extension.txt diff --git a/tests/package/empty/wrong-extension.txt b/tests/package/empty/wrong-extension.txt new file mode 100644 --- /dev/null +++ b/tests/package/empty/wrong-extension.txt diff --git a/tests/package/other/package.dhall b/tests/package/other/package.dhall new file mode 100644 --- /dev/null +++ b/tests/package/other/package.dhall diff --git a/tests/package/package.dhall b/tests/package/package.dhall new file mode 100644 --- /dev/null +++ b/tests/package/package.dhall diff --git a/tests/package/test.dhall b/tests/package/test.dhall new file mode 100644 --- /dev/null +++ b/tests/package/test.dhall diff --git a/tests/package/test/test.dhall b/tests/package/test/test.dhall new file mode 100644 --- /dev/null +++ b/tests/package/test/test.dhall diff --git a/tests/parser/annotations.dhall b/tests/parser/annotations.dhall deleted file mode 100644 --- a/tests/parser/annotations.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ foo = ([] : List Integer) # [1, 2, 3] # ([1, 2, 3] : List Integer) -, bar = [] : Optional Integer -, baz = [1] : Optional Integer -} : { foo : List Integer, bar : Optional Integer, baz : Optional Integer } diff --git a/tests/parser/blockComment.dhall b/tests/parser/blockComment.dhall deleted file mode 100644 --- a/tests/parser/blockComment.dhall +++ /dev/null @@ -1,3 +0,0 @@ -{- foo -} - -1 diff --git a/tests/parser/builtins.dhall b/tests/parser/builtins.dhall deleted file mode 100644 --- a/tests/parser/builtins.dhall +++ /dev/null @@ -1,31 +0,0 @@ - λ ( x - : { field0 : Bool - , field1 : Optional (Optional Bool) - , field2 : Natural - , field3 : Integer - , field4 : Double - , field5 : Text - , field6 : List (List Bool) - } - ) -→ { field00 = Natural/fold - , field01 = Natural/build - , field02 = Natural/isZero - , field03 = Natural/even - , field04 = Natural/odd - , field05 = Natural/toInteger - , field06 = Natural/show - , field07 = Integer/show - , field08 = Double/show - , field09 = List/build - , field10 = List/fold - , field11 = List/length - , field12 = List/head - , field13 = List/last - , field14 = List/indexed - , field15 = List/reverse - , field16 = Optional/fold - , field17 = Optional/build - , field18 = True - , field19 = False - } diff --git a/tests/parser/constructors.dhall b/tests/parser/constructors.dhall deleted file mode 100644 --- a/tests/parser/constructors.dhall +++ /dev/null @@ -1,1 +0,0 @@ -constructors < Left : Natural | Right : Bool > diff --git a/tests/parser/double.dhall b/tests/parser/double.dhall deleted file mode 100644 --- a/tests/parser/double.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ 1.1, -1.1, 1e1, 1.1e1, -1.1 ] diff --git a/tests/parser/doubleQuotedString.dhall b/tests/parser/doubleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/doubleQuotedString.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"ABC" diff --git a/tests/parser/environmentVariables.dhall b/tests/parser/environmentVariables.dhall deleted file mode 100644 --- a/tests/parser/environmentVariables.dhall +++ /dev/null @@ -1,5 +0,0 @@ -[ env:FOO - - -- Yes, this is legal -, env:"\"\\\a\b\f\n\r\t\v" -] diff --git a/tests/parser/escapedDoubleQuotedString.dhall b/tests/parser/escapedDoubleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/escapedDoubleQuotedString.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"\\\"\$\\\/\b\f\n\r\t \u2200(a : Type) \u2192 a" diff --git a/tests/parser/escapedSingleQuotedString.dhall b/tests/parser/escapedSingleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/escapedSingleQuotedString.dhall +++ /dev/null @@ -1,4 +0,0 @@ -'' -''${ -''' -'' diff --git a/tests/parser/fields.dhall b/tests/parser/fields.dhall deleted file mode 100644 --- a/tests/parser/fields.dhall +++ /dev/null @@ -1,1 +0,0 @@ -({ foo = { bar = { baz = 1 } } }).foo. bar .baz diff --git a/tests/parser/forall.dhall b/tests/parser/forall.dhall deleted file mode 100644 --- a/tests/parser/forall.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → forall (b : Type) -> a diff --git a/tests/parser/functionType.dhall b/tests/parser/functionType.dhall deleted file mode 100644 --- a/tests/parser/functionType.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool → Bool -> Bool diff --git a/tests/parser/identifier.dhall b/tests/parser/identifier.dhall deleted file mode 100644 --- a/tests/parser/identifier.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(a : Type) → λ(a : Type) → a@1 diff --git a/tests/parser/ifThenElse.dhall b/tests/parser/ifThenElse.dhall deleted file mode 100644 --- a/tests/parser/ifThenElse.dhall +++ /dev/null @@ -1,1 +0,0 @@ -if True then 1 else 2 diff --git a/tests/parser/interpolatedDoubleQuotedString.dhall b/tests/parser/interpolatedDoubleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/interpolatedDoubleQuotedString.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"ABC${Integer/show 123}" diff --git a/tests/parser/interpolatedSingleQuotedString.dhall b/tests/parser/interpolatedSingleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/interpolatedSingleQuotedString.dhall +++ /dev/null @@ -1,4 +0,0 @@ -'' -ABC -${Integer/show 123} -'' diff --git a/tests/parser/label.dhall b/tests/parser/label.dhall deleted file mode 100644 --- a/tests/parser/label.dhall +++ /dev/null @@ -1,2 +0,0 @@ -let _ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-/ = 1 -in _ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-/ diff --git a/tests/parser/lambda.dhall b/tests/parser/lambda.dhall deleted file mode 100644 --- a/tests/parser/lambda.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(a : Type) → \(b : Type) -> a diff --git a/tests/parser/largeExpression.dhall b/tests/parser/largeExpression.dhall deleted file mode 100644 --- a/tests/parser/largeExpression.dhall +++ /dev/null @@ -1,254 +0,0 @@ - λ ( xs - : List - { cores : Natural - , host : Text - , key : Text - , mandatoryFeatures : List Text - , platforms : - List - < AArch64_Linux : {} - | ARMv5tel_Linux : {} - | ARMv7l_Linux : {} - | I686_Cygwin : {} - | I686_Linux : {} - | MIPS64el_Linux : {} - | PowerPC_Linux : {} - | X86_64_Cygwin : {} - | X86_64_Darwin : {} - | X86_64_FreeBSD : {} - | X86_64_Linux : {} - | X86_64_Solaris : {} - > - , speedFactor : Natural - , supportedFeatures : List Text - , user : Optional Text - } - ) -→ List/fold - { cores : Natural - , host : Text - , key : Text - , mandatoryFeatures : List Text - , platforms : - List - < AArch64_Linux : {} - | ARMv5tel_Linux : {} - | ARMv7l_Linux : {} - | I686_Cygwin : {} - | I686_Linux : {} - | MIPS64el_Linux : {} - | PowerPC_Linux : {} - | X86_64_Cygwin : {} - | X86_64_Darwin : {} - | X86_64_FreeBSD : {} - | X86_64_Linux : {} - | X86_64_Solaris : {} - > - , speedFactor : Natural - , supportedFeatures : List Text - , user : Optional Text - } - xs - Text - ( λ ( x - : { cores : Natural - , host : Text - , key : Text - , mandatoryFeatures : List Text - , platforms : - List - < AArch64_Linux : {} - | ARMv5tel_Linux : {} - | ARMv7l_Linux : {} - | I686_Cygwin : {} - | I686_Linux : {} - | MIPS64el_Linux : {} - | PowerPC_Linux : {} - | X86_64_Cygwin : {} - | X86_64_Darwin : {} - | X86_64_FreeBSD : {} - | X86_64_Linux : {} - | X86_64_Solaris : {} - > - , speedFactor : Natural - , supportedFeatures : List Text - , user : Optional Text - } - ) - → λ(y : Text) - → ( Optional/fold - Text - x.user - Text - (λ(user : Text) → user ++ "@" ++ x.host ++ "") - x.host - ++ " " - ++ ( merge - { Empty = λ(_ : {}) → "" - , NonEmpty = λ(result : Text) → result - } - ( List/fold - < AArch64_Linux : {} - | ARMv5tel_Linux : {} - | ARMv7l_Linux : {} - | I686_Cygwin : {} - | I686_Linux : {} - | MIPS64el_Linux : {} - | PowerPC_Linux : {} - | X86_64_Cygwin : {} - | X86_64_Darwin : {} - | X86_64_FreeBSD : {} - | X86_64_Linux : {} - | X86_64_Solaris : {} - > - x.platforms - < Empty : {} | NonEmpty : Text > - ( λ ( element - : < AArch64_Linux : {} - | ARMv5tel_Linux : {} - | ARMv7l_Linux : {} - | I686_Cygwin : {} - | I686_Linux : {} - | MIPS64el_Linux : {} - | PowerPC_Linux : {} - | X86_64_Cygwin : {} - | X86_64_Darwin : {} - | X86_64_FreeBSD : {} - | X86_64_Linux : {} - | X86_64_Solaris : {} - > - ) - → λ(status : < Empty : {} | NonEmpty : Text >) - → merge - { Empty = - λ(_ : {}) - → < NonEmpty = - merge - { AArch64_Linux = λ(_ : {}) → "aarch64-linux" - , ARMv5tel_Linux = - λ(_ : {}) → "armv5tel-linux" - , ARMv7l_Linux = λ(_ : {}) → "armv7l-linux" - , I686_Cygwin = λ(_ : {}) → "i686-cygwin" - , I686_Linux = λ(_ : {}) → "i686-linux" - , MIPS64el_Linux = - λ(_ : {}) → "mips64el-linux" - , PowerPC_Linux = λ(_ : {}) → "powerpc-linux" - , X86_64_Cygwin = λ(_ : {}) → "x86_64-cygwin" - , X86_64_Darwin = λ(_ : {}) → "x86_64-darwin" - , X86_64_FreeBSD = - λ(_ : {}) → "x86_64-freebsd" - , X86_64_Linux = λ(_ : {}) → "x86_64-linux" - , X86_64_Solaris = - λ(_ : {}) → "x86_64-solaris" - } - element - | Empty : {} - > - , NonEmpty = - λ(result : Text) - → < NonEmpty = - ( merge - { AArch64_Linux = - λ(_ : {}) → "aarch64-linux" - , ARMv5tel_Linux = - λ(_ : {}) → "armv5tel-linux" - , ARMv7l_Linux = - λ(_ : {}) → "armv7l-linux" - , I686_Cygwin = - λ(_ : {}) → "i686-cygwin" - , I686_Linux = - λ(_ : {}) → "i686-linux" - , MIPS64el_Linux = - λ(_ : {}) → "mips64el-linux" - , PowerPC_Linux = - λ(_ : {}) → "powerpc-linux" - , X86_64_Cygwin = - λ(_ : {}) → "x86_64-cygwin" - , X86_64_Darwin = - λ(_ : {}) → "x86_64-darwin" - , X86_64_FreeBSD = - λ(_ : {}) → "x86_64-freebsd" - , X86_64_Linux = - λ(_ : {}) → "x86_64-linux" - , X86_64_Solaris = - λ(_ : {}) → "x86_64-solaris" - } - element - ) - ++ "," - ++ result - | Empty : {} - > - } - status - : < Empty : {} | NonEmpty : Text > - ) - < Empty = {=} | NonEmpty : Text > - ) - : Text - ) - ++ " " - ++ x.key - ++ " " - ++ Integer/show (Natural/toInteger x.cores) - ++ " " - ++ Integer/show (Natural/toInteger x.speedFactor) - ++ " " - ++ ( merge - { Empty = λ(_ : {}) → "" - , NonEmpty = λ(result : Text) → result - } - ( List/fold - Text - x.supportedFeatures - < Empty : {} | NonEmpty : Text > - ( λ(element : Text) - → λ(status : < Empty : {} | NonEmpty : Text >) - → merge - { Empty = - λ(_ : {}) → < NonEmpty = element | Empty : {} > - , NonEmpty = - λ(result : Text) - → < NonEmpty = element ++ "," ++ result - | Empty : {} - > - } - status - : < Empty : {} | NonEmpty : Text > - ) - < Empty = {=} | NonEmpty : Text > - ) - : Text - ) - ++ " " - ++ ( merge - { Empty = λ(_ : {}) → "" - , NonEmpty = λ(result : Text) → result - } - ( List/fold - Text - x.mandatoryFeatures - < Empty : {} | NonEmpty : Text > - ( λ(element : Text) - → λ(status : < Empty : {} | NonEmpty : Text >) - → merge - { Empty = - λ(_ : {}) → < NonEmpty = element | Empty : {} > - , NonEmpty = - λ(result : Text) - → < NonEmpty = element ++ "," ++ result - | Empty : {} - > - } - status - : < Empty : {} | NonEmpty : Text > - ) - < Empty = {=} | NonEmpty : Text > - ) - : Text - ) - ++ "\n" - ) - ++ y - ) - "" diff --git a/tests/parser/let.dhall b/tests/parser/let.dhall deleted file mode 100644 --- a/tests/parser/let.dhall +++ /dev/null @@ -1,3 +0,0 @@ - let x = 1 -in let y : Integer = 2 -in x diff --git a/tests/parser/lineComment.dhall b/tests/parser/lineComment.dhall deleted file mode 100644 --- a/tests/parser/lineComment.dhall +++ /dev/null @@ -1,3 +0,0 @@ --- foo - -1 diff --git a/tests/parser/list.dhall b/tests/parser/list.dhall deleted file mode 100644 --- a/tests/parser/list.dhall +++ /dev/null @@ -1,4 +0,0 @@ -[ [1, 2, 3] -, [1, 2, 3] : List Integer -, [] : List Integer -] diff --git a/tests/parser/merge.dhall b/tests/parser/merge.dhall deleted file mode 100644 --- a/tests/parser/merge.dhall +++ /dev/null @@ -1,7 +0,0 @@ - λ(x : <>) -→ { bar = merge {=} x : Integer - , foo = - merge - { Left = λ(b : Bool) → b, Right = Natural/even } - < Left = True | Right : Natural > - } diff --git a/tests/parser/natural.dhall b/tests/parser/natural.dhall deleted file mode 100644 --- a/tests/parser/natural.dhall +++ /dev/null @@ -1,1 +0,0 @@ -[ +0, +1, +01, +10 ] diff --git a/tests/parser/nestedBlockComment.dhall b/tests/parser/nestedBlockComment.dhall deleted file mode 100644 --- a/tests/parser/nestedBlockComment.dhall +++ /dev/null @@ -1,3 +0,0 @@ -{- foo {- bar -} baz -} - -1 diff --git a/tests/parser/operators.dhall b/tests/parser/operators.dhall deleted file mode 100644 --- a/tests/parser/operators.dhall +++ /dev/null @@ -1,2 +0,0 @@ - { foo = (False && Natural/even (+1 + +2 * +3)) || True == False != True } -∧ { bar = [ "ABC" ++ "DEF" ] # [ "GHI" ] } ⫽ { baz = True } diff --git a/tests/parser/pathTermination.dhall b/tests/parser/pathTermination.dhall deleted file mode 100644 --- a/tests/parser/pathTermination.dhall +++ /dev/null @@ -1,3 +0,0 @@ --- Verify that certain punctuation marks terminate paths correctly - λ(x : ./example) -→ ./example[./example, ./example{bar = ./example, qux = ./example}, ./example] diff --git a/tests/parser/paths.dhall b/tests/parser/paths.dhall deleted file mode 100644 --- a/tests/parser/paths.dhall +++ /dev/null @@ -1,5 +0,0 @@ -[ /absolute/path -, ./relative/path -, ~/home/anchored/path -, /ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude -] diff --git a/tests/parser/quotedLabel.dhall b/tests/parser/quotedLabel.dhall deleted file mode 100644 --- a/tests/parser/quotedLabel.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ example1 = let `let` = 1 in `let`, example2 = let `:.` = 1 in `:.` } diff --git a/tests/parser/record.dhall b/tests/parser/record.dhall deleted file mode 100644 --- a/tests/parser/record.dhall +++ /dev/null @@ -1,4 +0,0 @@ -{ foo = 1 -, bar = +2 -, baz = True -} : { foo : Integer, bar : Natural, baz : Bool } diff --git a/tests/parser/reservedPrefix.dhall b/tests/parser/reservedPrefix.dhall deleted file mode 100644 --- a/tests/parser/reservedPrefix.dhall +++ /dev/null @@ -1,1 +0,0 @@ -let TypeSynonym = Integer in 1 : TypeSynonym diff --git a/tests/parser/singleQuotedString.dhall b/tests/parser/singleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/singleQuotedString.dhall +++ /dev/null @@ -1,4 +0,0 @@ -'' -ABC -DEF -'' diff --git a/tests/parser/unicodeComment.dhall b/tests/parser/unicodeComment.dhall deleted file mode 100644 --- a/tests/parser/unicodeComment.dhall +++ /dev/null @@ -1,3 +0,0 @@ -{- ∀(a : Type) → a -} - -1 diff --git a/tests/parser/unicodeDoubleQuotedString.dhall b/tests/parser/unicodeDoubleQuotedString.dhall deleted file mode 100644 --- a/tests/parser/unicodeDoubleQuotedString.dhall +++ /dev/null @@ -1,1 +0,0 @@ -"∀(a : Type) → a" diff --git a/tests/parser/union.dhall b/tests/parser/union.dhall deleted file mode 100644 --- a/tests/parser/union.dhall +++ /dev/null @@ -1,4 +0,0 @@ -< A : { } -| B = { = } -| C : {} -> : < A : {} | B : {} | C : {} > diff --git a/tests/parser/urls.dhall b/tests/parser/urls.dhall deleted file mode 100644 --- a/tests/parser/urls.dhall +++ /dev/null @@ -1,11 +0,0 @@ -[ http://example.com -, https://john:doe@example.com:8080/foo/bar?qux=0#xyzzy -, http://prelude.dhall-lang.org/ -, https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude -, https://127.0.0.1 -, https://[::] -, https://[2001:0db8:85a3:0000:0000:8a2e:0370:7334] - - -- Yes, this is legal -, https://-._~%2C!$&'()*+,;=:@-._~%2C!$&'()*+,;=:/-._~%2C!$&'()*+,;=:@?/-._~%2C!$&'()*+,;=:@/?#/-._~%2C!$&'()*+,;=:@/? -] diff --git a/tests/parser/whitespace.dhall b/tests/parser/whitespace.dhall deleted file mode 100644 --- a/tests/parser/whitespace.dhall +++ /dev/null @@ -1,3 +0,0 @@ - -1 - diff --git a/tests/parser/whitespaceBuffet.dhall b/tests/parser/whitespaceBuffet.dhall deleted file mode 100644 --- a/tests/parser/whitespaceBuffet.dhall +++ /dev/null @@ -1,9 +0,0 @@ - -- This - - Natural/even {- - -{- file --} - has - - -} +2 -- mixed {- line endings -} diff --git a/tests/recursive/expr0.dhall b/tests/recursive/expr0.dhall new file mode 100644 --- /dev/null +++ b/tests/recursive/expr0.dhall @@ -0,0 +1,17 @@ + λ(Expr : Type) +→ let ExprF = + < LitF : Natural + | AddF : { _1 : Expr, _2 : Expr } + | MulF : { _1 : Expr, _2 : Expr } + > + + in λ(Fix : ExprF → Expr) + → let Lit = λ(x : Natural) → Fix (ExprF.LitF x) + + let Add = + λ(x : Expr) → λ(y : Expr) → Fix (ExprF.AddF { _1 = x, _2 = y }) + + let Mul = + λ(x : Expr) → λ(y : Expr) → Fix (ExprF.MulF { _1 = x, _2 = y }) + + in Add (Mul (Lit 3) (Lit 7)) (Add (Lit 1) (Lit 2)) diff --git a/tests/recursive/expr1.dhall b/tests/recursive/expr1.dhall new file mode 100644 --- /dev/null +++ b/tests/recursive/expr1.dhall @@ -0,0 +1,15 @@ + λ(a : Type) +→ let ExprF = + < LitF : Natural + | AddF : { _1 : a, _2 : a } + | MulF : { _1 : a, _2 : a } + > + + in λ(a : ExprF → a) + → let Lit = λ(x : Natural) → a (ExprF.LitF x) + + let Add = λ(x : a@1) → λ(y : a@1) → a (ExprF.AddF { _1 = x, _2 = y }) + + let Mul = λ(x : a@1) → λ(y : a@1) → a (ExprF.MulF { _1 = x, _2 = y }) + + in Add (Mul (Lit 3) (Lit 7)) (Add (Lit 1) (Lit 2)) diff --git a/tests/regression/issue151a.dhall b/tests/regression/issue151a.dhall --- a/tests/regression/issue151a.dhall +++ b/tests/regression/issue151a.dhall @@ -1,1 +1,1 @@ -let foo : (\(x : A) -> x x) (\(x : A) -> x x) = 1 in foo +\(A : Type) -> let foo : (\(x : A) -> x x) (\(x : A) -> x x) = 1 in foo diff --git a/tests/regression/issue151b.dhall b/tests/regression/issue151b.dhall --- a/tests/regression/issue151b.dhall +++ b/tests/regression/issue151b.dhall @@ -1,1 +1,1 @@ -\(omega : ((\(x : A) -> x x) (\(x : A) -> x x))) -> omega 1 +\(A : Type) -> \(omega : ((\(x : A) -> x x) (\(x : A) -> x x))) -> omega 1 diff --git a/tests/regression/issue1584.dhall b/tests/regression/issue1584.dhall new file mode 100644 --- /dev/null +++ b/tests/regression/issue1584.dhall @@ -0,0 +1,19 @@ +[ let ifX = 1 in ifX +, let thenX = 1 in thenX +, let elseX = 1 in elseX +, let letX = 1 in letX +, let inX = 1 in inX +, let usingX = 1 in usingX +{- Fixing this case appears to be difficult for the current parser + implementation +-} +-- , let missingX = 1 in missingX +, let asX = 1 in asX +, let InfinityX = 1 in InfinityX +, let NaNX = 1 in NaNX +, let mergeX = 1 in mergeX +, let SomeX = 1 in SomeX +, let toMapX = 1 in toMapX +, let assertX = 1 in assertX +, let forallX = 1 in forallX +] diff --git a/tests/regression/issue164.dhall b/tests/regression/issue164.dhall --- a/tests/regression/issue164.dhall +++ b/tests/regression/issue164.dhall @@ -1,1 +1,2 @@ -''Single quotes like ' should be allowed in a single-quoted string'' +'' +Single quotes like ' should be allowed in a single-quoted string'' diff --git a/tests/regression/issue1646.dhall b/tests/regression/issue1646.dhall new file mode 100644 --- /dev/null +++ b/tests/regression/issue1646.dhall @@ -0,0 +1,1 @@ +let f = \(d : Double) -> \(i : Integer) -> {=} in f 3.1 -1 diff --git a/tests/regression/issue1732.dhall b/tests/regression/issue1732.dhall new file mode 100644 --- /dev/null +++ b/tests/regression/issue1732.dhall @@ -0,0 +1,1 @@ +let x = 0 in { x , a = 0 } diff --git a/tests/regression/issue1884.dhall b/tests/regression/issue1884.dhall new file mode 100644 --- /dev/null +++ b/tests/regression/issue1884.dhall @@ -0,0 +1,4 @@ +let Make = \(T: Type) -> { Type = { a: T }, default = {=} } + +in +(Make Natural) with default = { a = 2 } diff --git a/tests/regression/issue2088.dhall b/tests/regression/issue2088.dhall new file mode 100644 --- /dev/null +++ b/tests/regression/issue2088.dhall @@ -0,0 +1,1 @@ +[ { x = 1 }.{ x }, { x = 1 } ] diff --git a/tests/regression/issue209.dhall b/tests/regression/issue209.dhall deleted file mode 100644 --- a/tests/regression/issue209.dhall +++ /dev/null @@ -1,1 +0,0 @@ -constructors <> diff --git a/tests/regression/issue216a.dhall b/tests/regression/issue216a.dhall --- a/tests/regression/issue216a.dhall +++ b/tests/regression/issue216a.dhall @@ -1,5 +1,5 @@ let GitHubProject : Type = { owner : Text, repo : Text } in let gitHubProject = \( github : GitHubProject ) -> let gitHubRoot = "https://github.com/${github.owner}/${github.repo}" - in { bugReports = "${gitHubRoot}/issues" } + in { bugReports = "${gitHubRoot}/issues" } in gitHubProject diff --git a/tests/regression/issue216b.dhall b/tests/regression/issue216b.dhall --- a/tests/regression/issue216b.dhall +++ b/tests/regression/issue216b.dhall @@ -1,10 +1,2 @@ - let GitHubProject : Type = { owner : Text, repo : Text } - -in let gitHubProject = - λ(github : GitHubProject) - → let gitHubRoot = - "https://github.com/${github.owner}/${github.repo}" - - in { bugReports = "${gitHubRoot}/issues" } - -in gitHubProject +λ(github : { owner : Text, repo : Text }) → + { bugReports = "https://github.com/${github.owner}/${github.repo}/issues" } diff --git a/tests/schemas/multipleA.dhall b/tests/schemas/multipleA.dhall new file mode 100644 --- /dev/null +++ b/tests/schemas/multipleA.dhall @@ -0,0 +1,1 @@ +{=} diff --git a/tests/schemas/multipleB.dhall b/tests/schemas/multipleB.dhall new file mode 100644 --- /dev/null +++ b/tests/schemas/multipleB.dhall @@ -0,0 +1,1 @@ +let schemas = ./tests/schemas/multipleSchema.dhall in schemas.B::{=} diff --git a/tests/schemas/multipleSchema.dhall b/tests/schemas/multipleSchema.dhall new file mode 100644 --- /dev/null +++ b/tests/schemas/multipleSchema.dhall @@ -0,0 +1,3 @@ +{ A = { Type = {}, default = {=} } +, B = { Type = {}, default = {=} } +} diff --git a/tests/schemas/personA.dhall b/tests/schemas/personA.dhall new file mode 100644 --- /dev/null +++ b/tests/schemas/personA.dhall @@ -0,0 +1,4 @@ +{ addr = { city = None Text, country = "Switzerland" } +, alive = True +, name = "Alice" +} diff --git a/tests/schemas/personB.dhall b/tests/schemas/personB.dhall new file mode 100644 --- /dev/null +++ b/tests/schemas/personB.dhall @@ -0,0 +1,6 @@ +let schemas = ./tests/schemas/personSchema.dhall + +in schemas.Person::{ + , addr = schemas.Address::{ country = "Switzerland" } + , name = "Alice" + } diff --git a/tests/schemas/personSchema.dhall b/tests/schemas/personSchema.dhall new file mode 100644 --- /dev/null +++ b/tests/schemas/personSchema.dhall @@ -0,0 +1,11 @@ +let Address = + { Type = { country : Text, city : Optional Text } + , default.city = None Text + } + +let Person = + { Type = { name : Text, addr : Address.Type, alive : Bool } + , default.alive = True + } + +in { Person, Address } diff --git a/tests/tags/all.tags b/tests/tags/all.tags new file mode 100644 --- /dev/null +++ b/tests/tags/all.tags @@ -0,0 +1,61 @@ + +./tests/tags/let.dhall,66 +let.dhall1,1 +/let.dhall1,1 +let foo foo1,5 +let bar bar3,22 + +./tests/tags/nonunicode.dhall,63 +nonunicode.dhall1,1 +/nonunicode.dhall1,1 +let foo foo2,12 + +./tests/tags/record.dhall,335 +record.dhall1,1 +/record.dhall1,1 +let Config Config6,81 + { home home8,161 + , privateKey privateKey9,181 + , publicKey publicKey10,207 + , name name11,232 + , name : { firstName firstName11,241 + , secondName secondName12,275 +let makeUser makeUser16,323 +let configs configs30,804 + +./tests/tags/recordlit.dhall,223 +recordlit.dhall1,1 +/recordlit.dhall1,1 +{ home home8,143 +, privateKey privateKey9,171 +, publicKey publicKey10,215 +, name name11,263 +, name = { firstName firstName11,272 + , secondName secondName12,302 + +./tests/tags/simple.dhall,254 +simple.dhall1,1 +/simple.dhall1,1 +let generate generate6,100 +let makeUser makeUser17,409 +let buildUser buildUser26,680 +let Config Config32,880 + { home home33,897 + , privateKey privateKey34,917 + , publicKey publicKey35,943 + +./tests/tags/unicode.dhall,57 +unicode.dhall1,1 +/unicode.dhall1,1 +let foo foo2,15 + +./tests/tags/union.dhall,394 +union.dhall1,1 +/union.dhall1,1 +let Element Element1,5 +let Element = < Left Left1,17 +let Element = < Left : Natural | Right Right1,34 +let Element = < Left : Natural | Right : Bool | Middle Middle1,49 +let Element = < Left : Natural | Right : Bool | Middle : < Top Top1,60 +let Element = < Left : Natural | Right : Bool | Middle : < Top : Text | Bottom Bottom1,73 +let foo foo3,95 diff --git a/tests/tags/let.dhall b/tests/tags/let.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/let.dhall @@ -0,0 +1,4 @@ +let foo = "foo" + +let bar = foo +in bar diff --git a/tests/tags/let.tags b/tests/tags/let.tags new file mode 100644 --- /dev/null +++ b/tests/tags/let.tags @@ -0,0 +1,6 @@ + +./tests/tags/let.dhall,66 +let.dhall1,1 +/let.dhall1,1 +let foo foo1,5 +let bar bar3,22 diff --git a/tests/tags/nonunicode.dhall b/tests/tags/nonunicode.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/nonunicode.dhall @@ -0,0 +1,3 @@ +-- abc +let foo = "bar" +in foo diff --git a/tests/tags/nonunicode.tags b/tests/tags/nonunicode.tags new file mode 100644 --- /dev/null +++ b/tests/tags/nonunicode.tags @@ -0,0 +1,5 @@ + +./tests/tags/nonunicode.dhall,63 +nonunicode.dhall1,1 +/nonunicode.dhall1,1 +let foo foo2,12 diff --git a/tests/tags/record.dhall b/tests/tags/record.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/record.dhall @@ -0,0 +1,35 @@ +{- You can optionally add types + + `x : T` means that `x` has type `T` +-} + +let Config : Type = + {- What happens if you add another field here? -} + { home : Text + , privateKey : Text + , publicKey : Text + , name : { firstName : Text + , secondName : Text + } + } + +let makeUser : Text -> Config = \(user : Text) -> + let home : Text = "/home/${user}" + let privateKey : Text = "${home}/.ssh/id_ed25519" + let publicKey : Text = "${privateKey}.pub" + let config : Config = + { home = home + , privateKey = privateKey + , publicKey = publicKey + , name = { firstName = user + , secondName = "" + } + } + in config + +let configs : List Config = + [ makeUser "bill" + , makeUser "jane" + ] + +in configs diff --git a/tests/tags/record.tags b/tests/tags/record.tags new file mode 100644 --- /dev/null +++ b/tests/tags/record.tags @@ -0,0 +1,13 @@ + +./tests/tags/record.dhall,335 +record.dhall1,1 +/record.dhall1,1 +let Config Config6,81 + { home home8,161 + , privateKey privateKey9,181 + , publicKey publicKey10,207 + , name name11,232 + , name : { firstName firstName11,241 + , secondName secondName12,275 +let makeUser makeUser16,323 +let configs configs30,804 diff --git a/tests/tags/recordlit.dhall b/tests/tags/recordlit.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/recordlit.dhall @@ -0,0 +1,14 @@ +{- This is an example Dhall configuration file + + Can you spot the mistake? + + Fix the typo, then move onto the "Definitions" example +-} + +{ home = "/home/bill" +, privateKey = "/home/bill/.ssh/id_ed25519" +, publicKey = "/home/blil/.ssh/id_ed25519.pub" +, name = { firstName = "Bill" + , secondName = "Bar" + } +} diff --git a/tests/tags/recordlit.tags b/tests/tags/recordlit.tags new file mode 100644 --- /dev/null +++ b/tests/tags/recordlit.tags @@ -0,0 +1,10 @@ + +./tests/tags/recordlit.dhall,223 +recordlit.dhall1,1 +/recordlit.dhall1,1 +{ home home8,143 +, privateKey privateKey9,171 +, publicKey publicKey10,215 +, name name11,263 +, name = { firstName firstName11,272 + , secondName secondName12,302 diff --git a/tests/tags/simple.dhall b/tests/tags/simple.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/simple.dhall @@ -0,0 +1,39 @@ +{- Need to generate a lot of users? + + Use the `generate` function from the Dhall Prelude +-} + +let generate = https://prelude.dhall-lang.org/List/generate + +{- You can import Dhall expressions from URLs that support + CORS + + The command-line tools also let you import from files, + environment variables, and URLs without CORS support. + + Browse https://prelude.dhall-lang.org for more utilities +-} + +let makeUser = \(user : Text) -> + let home = "/home/${user}" + let privateKey = "${home}/.ssh/id_ed25519" + let publicKey = "${privateKey}.pub" + in { home = home + , privateKey = privateKey + , publicKey = publicKey + } + +let buildUser = \(index : Natural) -> + {- `Natural/show` is a "built-in", meaning that + you can use `Natural/show` without an import + -} + makeUser "build${Natural/show index}" + +let Config = + { home : Text + , privateKey : Text + , publicKey : Text + } + +in {- Try generating 20 users instead of 10 -} + generate 10 Config buildUser diff --git a/tests/tags/simple.tags b/tests/tags/simple.tags new file mode 100644 --- /dev/null +++ b/tests/tags/simple.tags @@ -0,0 +1,11 @@ + +./tests/tags/simple.dhall,254 +simple.dhall1,1 +/simple.dhall1,1 +let generate generate6,100 +let makeUser makeUser17,409 +let buildUser buildUser26,680 +let Config Config32,880 + { home home33,897 + , privateKey privateKey34,917 + , publicKey publicKey35,943 diff --git a/tests/tags/unicode.dhall b/tests/tags/unicode.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/unicode.dhall @@ -0,0 +1,3 @@ +-- αβξ +let foo = "bar" +in foo diff --git a/tests/tags/unicode.tags b/tests/tags/unicode.tags new file mode 100644 --- /dev/null +++ b/tests/tags/unicode.tags @@ -0,0 +1,5 @@ + +./tests/tags/unicode.dhall,57 +unicode.dhall1,1 +/unicode.dhall1,1 +let foo foo2,15 diff --git a/tests/tags/union.dhall b/tests/tags/union.dhall new file mode 100644 --- /dev/null +++ b/tests/tags/union.dhall @@ -0,0 +1,4 @@ +let Element = < Left : Natural | Right : Bool | Middle : < Top : Text | Bottom : Bool> > + +let foo = Element.Left 6 +in foo diff --git a/tests/tags/union.tags b/tests/tags/union.tags new file mode 100644 --- /dev/null +++ b/tests/tags/union.tags @@ -0,0 +1,11 @@ + +./tests/tags/union.dhall,394 +union.dhall1,1 +/union.dhall1,1 +let Element Element1,5 +let Element = < Left Left1,17 +let Element = < Left : Natural | Right Right1,34 +let Element = < Left : Natural | Right : Bool | Middle Middle1,49 +let Element = < Left : Natural | Right : Bool | Middle : < Top Top1,60 +let Element = < Left : Natural | Right : Bool | Middle : < Top : Text | Bottom Bottom1,73 +let foo foo3,95 diff --git a/tests/th/Department.dhall b/tests/th/Department.dhall new file mode 100644 --- /dev/null +++ b/tests/th/Department.dhall @@ -0,0 +1,1 @@ +< Sales | Engineering | Marketing > diff --git a/tests/th/Employee.dhall b/tests/th/Employee.dhall new file mode 100644 --- /dev/null +++ b/tests/th/Employee.dhall @@ -0,0 +1,1 @@ +{ name : Text, department : ./Department.dhall } diff --git a/tests/th/HigherKindSingle.dhall b/tests/th/HigherKindSingle.dhall new file mode 100644 --- /dev/null +++ b/tests/th/HigherKindSingle.dhall @@ -0,0 +1,1 @@ +\(a : Type -> Type) -> \(a : Type) -> { foo : a, bar : a@1 a, bam : Text } diff --git a/tests/th/HigherKindUnion.dhall b/tests/th/HigherKindUnion.dhall new file mode 100644 --- /dev/null +++ b/tests/th/HigherKindUnion.dhall @@ -0,0 +1,1 @@ +\(a : Type) -> \(b : Type) -> < Foo : a | Bar : b > diff --git a/tests/th/Time.dhall b/tests/th/Time.dhall new file mode 100644 --- /dev/null +++ b/tests/th/Time.dhall @@ -0,0 +1,1 @@ +{ txTime : Time, txDate : Date, txTimeZone : TimeZone } diff --git a/tests/th/example.dhall b/tests/th/example.dhall new file mode 100644 --- /dev/null +++ b/tests/th/example.dhall @@ -0,0 +1,1 @@ +< A : { x : Bool, y : List Text } | B : Optional (List Natural) | C > diff --git a/tests/th/issue2066.dhall b/tests/th/issue2066.dhall new file mode 100644 --- /dev/null +++ b/tests/th/issue2066.dhall @@ -0,0 +1,7 @@ +let Bar = { baz : Integer } + +let Foo = { foo : Integer, bar : Bar } + +let Qux = < Foo : Foo | Bar : Bar > + +in { Foo, Bar, Qux } diff --git a/tests/to-directory-tree/fixpoint-allow-path-separators.dhall b/tests/to-directory-tree/fixpoint-allow-path-separators.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-allow-path-separators.dhall @@ -0,0 +1,25 @@ +let User = (./fixpoint-helper.dhall).User + +let Group = (./fixpoint-helper.dhall).Group + +let Mode = (./fixpoint-helper.dhall).Mode + +let Make = (./fixpoint-helper.dhall).Make + +in \(r : Type) -> + \(make : Make r) -> + [ make.file + { name = "non-existent-1/file" + , content = "" + , user = None User + , group = None Group + , mode = None Mode + } + , make.directory + { name = "non-existent-2/directory" + , content = [] : List r + , user = None User + , group = None Group + , mode = None Mode + } + ] diff --git a/tests/to-directory-tree/fixpoint-empty.dhall b/tests/to-directory-tree/fixpoint-empty.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-empty.dhall @@ -0,0 +1,3 @@ +let Make = (./fixpoint-helper.dhall).Make + +in \(r : Type) -> \(make : Make r) -> [] : List r diff --git a/tests/to-directory-tree/fixpoint-helper.dhall b/tests/to-directory-tree/fixpoint-helper.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-helper.dhall @@ -0,0 +1,30 @@ +let User = < UserId : Natural | UserName : Text > + +let Group = < GroupId : Natural | GroupName : Text > + +let Access = + { execute : Optional Bool, read : Optional Bool, write : Optional Bool } + +let Mode = + { user : Optional Access + , group : Optional Access + , other : Optional Access + } + +let Entry = + \(content : Type) -> + { name : Text + , content : content + , user : Optional User + , group : Optional Group + , mode : Optional Mode + } + +let Make = + \(r : Type) -> + { directory : Entry (List r) -> r + , binary-file : Entry Bytes -> r + , file : Entry Text -> r + } + +in { User, Group, Access, Mode, Entry, Make } diff --git a/tests/to-directory-tree/fixpoint-permissions.dhall b/tests/to-directory-tree/fixpoint-permissions.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-permissions.dhall @@ -0,0 +1,24 @@ +let User = (./fixpoint-helper.dhall).User + +let Group = (./fixpoint-helper.dhall).Group + +let Make = (./fixpoint-helper.dhall).Make + +let no-access = { execute = Some False, read = Some False, write = Some False } + +let full-access = { execute = Some True, read = Some True, write = Some True } + +in \(r : Type) -> + \(make : Make r) -> + [ make.file + { name = "file" + , content = "" + , user = None User + , group = None Group + , mode = Some + { user = Some full-access + , group = Some no-access + , other = Some no-access + } + } + ] diff --git a/tests/to-directory-tree/fixpoint-simple.dhall b/tests/to-directory-tree/fixpoint-simple.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-simple.dhall @@ -0,0 +1,25 @@ +let User = (./fixpoint-helper.dhall).User + +let Group = (./fixpoint-helper.dhall).Group + +let Mode = (./fixpoint-helper.dhall).Mode + +let Make = (./fixpoint-helper.dhall).Make + +in \(r : Type) -> + \(make : Make r) -> + [ make.file + { name = "file" + , content = "" + , user = None User + , group = None Group + , mode = None Mode + } + , make.directory + { name = "directory" + , content = [] : List r + , user = None User + , group = None Group + , mode = None Mode + } + ] diff --git a/tests/to-directory-tree/fixpoint-usergroup.dhall b/tests/to-directory-tree/fixpoint-usergroup.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/fixpoint-usergroup.dhall @@ -0,0 +1,25 @@ +let User = (./fixpoint-helper.dhall).User + +let Group = (./fixpoint-helper.dhall).Group + +let Mode = (./fixpoint-helper.dhall).Mode + +let Make = (./fixpoint-helper.dhall).Make + +in \(r : Type) -> + \(make : Make r) -> + [ make.file + { name = "ids" + , content = "" + , user = Some (User.UserId 0) + , group = Some (Group.GroupId 0) + , mode = None Mode + } + , make.file + { name = "names" + , content = "" + , user = Some (User.UserName "user") + , group = Some (Group.GroupName "group") + , mode = None Mode + } + ] diff --git a/tests/to-directory-tree/type.dhall b/tests/to-directory-tree/type.dhall new file mode 100644 --- /dev/null +++ b/tests/to-directory-tree/type.dhall @@ -0,0 +1,36 @@ +let User = < UserId : Natural | UserName : Text > + +let Group = < GroupId : Natural | GroupName : Text > + +let Access = + { execute : Optional Bool, read : Optional Bool, write : Optional Bool } + +let Mode = + { user : Optional Access + , group : Optional Access + , other : Optional Access + } + +let Entry = + \(content : Type) -> + { name : Text + , content : content + , user : Optional User + , group : Optional Group + , mode : Optional Mode + } + +in forall (result : Type) -> + let DirectoryEntry = Entry (List result) + + let BinaryFileEntry = Entry Bytes + + let TextFileEntry = Entry Text + + let Make = + { directory : DirectoryEntry -> result + , binary-file : BinaryFileEntry -> result + , file : TextFileEntry -> result + } + + in forall (make : Make) -> List result diff --git a/tests/tutorial/Union.dhall b/tests/tutorial/Union.dhall new file mode 100644 --- /dev/null +++ b/tests/tutorial/Union.dhall @@ -0,0 +1,1 @@ +< Left : Natural | Right : Bool> diff --git a/tests/tutorial/substitution1.dhall b/tests/tutorial/substitution1.dhall new file mode 100644 --- /dev/null +++ b/tests/tutorial/substitution1.dhall @@ -0,0 +1,1 @@ +Result.Failure +1 diff --git a/tests/tutorial/substitution2.dhall b/tests/tutorial/substitution2.dhall new file mode 100644 --- /dev/null +++ b/tests/tutorial/substitution2.dhall @@ -0,0 +1,1 @@ +./substitution1.dhall diff --git a/tests/tutorial/substitution3.dhall b/tests/tutorial/substitution3.dhall new file mode 100644 --- /dev/null +++ b/tests/tutorial/substitution3.dhall @@ -0,0 +1,1 @@ +Foo diff --git a/tests/tutorial/unions0A.dhall b/tests/tutorial/unions0A.dhall --- a/tests/tutorial/unions0A.dhall +++ b/tests/tutorial/unions0A.dhall @@ -1,1 +1,1 @@ -./process.dhall < Left = +3 | Right : Bool > +./process.dhall ((./Union.dhall).Left 3) diff --git a/tests/tutorial/unions1A.dhall b/tests/tutorial/unions1A.dhall --- a/tests/tutorial/unions1A.dhall +++ b/tests/tutorial/unions1A.dhall @@ -1,1 +1,1 @@ -./process.dhall < Right = True | Left : Natural > +./process.dhall ((./Union.dhall).Right True) diff --git a/tests/tutorial/unions2A.dhall b/tests/tutorial/unions2A.dhall deleted file mode 100644 --- a/tests/tutorial/unions2A.dhall +++ /dev/null @@ -1,8 +0,0 @@ - let Empty = < Empty = {=} | Person : { name : Text, age : Natural } > -in let Person = - λ(p : { name : Text, age : Natural }) → < Person = p | Empty : {} > -in [ Empty - , Person { name = "John", age = +23 } - , Person { name = "Amy" , age = +25 } - , Empty - ] diff --git a/tests/tutorial/unions2B.dhall b/tests/tutorial/unions2B.dhall deleted file mode 100644 --- a/tests/tutorial/unions2B.dhall +++ /dev/null @@ -1,5 +0,0 @@ -[ < Empty = {=} | Person : { age : Natural, name : Text } > -, < Person = { age = +23, name = "John" } | Empty : {} > -, < Person = { age = +25, name = "Amy" } | Empty : {} > -, < Empty = {=} | Person : { age : Natural, name : Text } > -] diff --git a/tests/tutorial/unions3A.dhall b/tests/tutorial/unions3A.dhall --- a/tests/tutorial/unions3A.dhall +++ b/tests/tutorial/unions3A.dhall @@ -1,5 +1,6 @@ - let MyType = constructors < Empty : {} | Person : { name : Text, age : Natural } > -in [ MyType.Empty {=} - , MyType.Person { name = "John", age = +23 } - , MyType.Person { name = "Amy" , age = +25 } +let MyType = < Empty | Person : { name : Text, age : Natural } > + +in [ MyType.Empty -- Note the absence of any argument to `Empty` + , MyType.Person { name = "John", age = 23 } + , MyType.Person { name = "Amy" , age = 25 } ] diff --git a/tests/tutorial/unions3B.dhall b/tests/tutorial/unions3B.dhall --- a/tests/tutorial/unions3B.dhall +++ b/tests/tutorial/unions3B.dhall @@ -1,4 +1,6 @@ -[ < Empty = {=} | Person : { age : Natural, name : Text } > -, < Person = { age = +23, name = "John" } | Empty : {} > -, < Person = { age = +25, name = "Amy" } | Empty : {} > +[ < Empty | Person : { age : Natural, name : Text } >.Empty +, < Empty | Person : { age : Natural, name : Text } >.Person + { age = 23, name = "John" } +, < Empty | Person : { age : Natural, name : Text } >.Person + { age = 25, name = "Amy" } ] diff --git a/tests/tutorial/unions4A.dhall b/tests/tutorial/unions4A.dhall --- a/tests/tutorial/unions4A.dhall +++ b/tests/tutorial/unions4A.dhall @@ -1,1 +1,1 @@ -constructors < Empty : {} | Person : { name : Text, age : Natural } > +< Empty : {} | Person : { name : Text, age : Natural } > diff --git a/tests/tutorial/unions4B.dhall b/tests/tutorial/unions4B.dhall --- a/tests/tutorial/unions4B.dhall +++ b/tests/tutorial/unions4B.dhall @@ -1,6 +1,1 @@ -{ Empty = - λ(Empty : {}) → < Empty = Empty | Person : { age : Natural, name : Text } > -, Person = - λ(Person : { age : Natural, name : Text }) - → < Person = Person | Empty : {} > -} +< Empty : {} | Person : { name : Text, age : Natural } > diff --git a/tests/typecheck/alternativesAreTypesA.dhall b/tests/typecheck/alternativesAreTypesA.dhall deleted file mode 100644 --- a/tests/typecheck/alternativesAreTypesA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Left = List | Right : Type > diff --git a/tests/typecheck/alternativesAreTypesB.dhall b/tests/typecheck/alternativesAreTypesB.dhall deleted file mode 100644 --- a/tests/typecheck/alternativesAreTypesB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Left : Type → Type | Right : Type > diff --git a/tests/typecheck/anonymousFunctionsInTypesA.dhall b/tests/typecheck/anonymousFunctionsInTypesA.dhall deleted file mode 100644 --- a/tests/typecheck/anonymousFunctionsInTypesA.dhall +++ /dev/null @@ -1,5 +0,0 @@ - let anonymousFunction = λ(a : Type) → List a - -in λ(HigherOrderType : (Type → Type) → Type) - → λ(x : HigherOrderType anonymousFunction) - → (x : HigherOrderType anonymousFunction) diff --git a/tests/typecheck/anonymousFunctionsInTypesB.dhall b/tests/typecheck/anonymousFunctionsInTypesB.dhall deleted file mode 100644 --- a/tests/typecheck/anonymousFunctionsInTypesB.dhall +++ /dev/null @@ -1,4 +0,0 @@ - ∀(HigherOrderType : (Type → Type) → Type) -→ ∀(x : HigherOrderType (λ(a : Type) → List a)) -→ HigherOrderType (λ(a : Type) → List a) - diff --git a/tests/typecheck/examples/Monoid/00A.dhall b/tests/typecheck/examples/Monoid/00A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/00A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Bool/and diff --git a/tests/typecheck/examples/Monoid/00B.dhall b/tests/typecheck/examples/Monoid/00B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/00B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Bool diff --git a/tests/typecheck/examples/Monoid/01A.dhall b/tests/typecheck/examples/Monoid/01A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/01A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Bool/or diff --git a/tests/typecheck/examples/Monoid/01B.dhall b/tests/typecheck/examples/Monoid/01B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/01B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Bool diff --git a/tests/typecheck/examples/Monoid/02A.dhall b/tests/typecheck/examples/Monoid/02A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/02A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Bool/even diff --git a/tests/typecheck/examples/Monoid/02B.dhall b/tests/typecheck/examples/Monoid/02B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/02B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Bool diff --git a/tests/typecheck/examples/Monoid/03A.dhall b/tests/typecheck/examples/Monoid/03A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/03A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Bool/odd diff --git a/tests/typecheck/examples/Monoid/03B.dhall b/tests/typecheck/examples/Monoid/03B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/03B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Bool diff --git a/tests/typecheck/examples/Monoid/04A.dhall b/tests/typecheck/examples/Monoid/04A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/04A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/List/concat diff --git a/tests/typecheck/examples/Monoid/04B.dhall b/tests/typecheck/examples/Monoid/04B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/04B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../Prelude/Monoid (List a) diff --git a/tests/typecheck/examples/Monoid/05A.dhall b/tests/typecheck/examples/Monoid/05A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/05A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/List/shifted diff --git a/tests/typecheck/examples/Monoid/05B.dhall b/tests/typecheck/examples/Monoid/05B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/05B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../Prelude/Monoid (List { index : Natural, value : a }) diff --git a/tests/typecheck/examples/Monoid/06A.dhall b/tests/typecheck/examples/Monoid/06A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/06A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Natural/sum diff --git a/tests/typecheck/examples/Monoid/06B.dhall b/tests/typecheck/examples/Monoid/06B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/06B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Natural diff --git a/tests/typecheck/examples/Monoid/07A.dhall b/tests/typecheck/examples/Monoid/07A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/07A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Natural/product diff --git a/tests/typecheck/examples/Monoid/07B.dhall b/tests/typecheck/examples/Monoid/07B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/07B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Natural diff --git a/tests/typecheck/examples/Monoid/08A.dhall b/tests/typecheck/examples/Monoid/08A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/08A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Optional/head diff --git a/tests/typecheck/examples/Monoid/08B.dhall b/tests/typecheck/examples/Monoid/08B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/08B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../Prelude/Monoid (Optional a) diff --git a/tests/typecheck/examples/Monoid/09A.dhall b/tests/typecheck/examples/Monoid/09A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/09A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Optional/last diff --git a/tests/typecheck/examples/Monoid/09B.dhall b/tests/typecheck/examples/Monoid/09B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/09B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../Prelude/Monoid (Optional a) diff --git a/tests/typecheck/examples/Monoid/10A.dhall b/tests/typecheck/examples/Monoid/10A.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/10A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Text/concat diff --git a/tests/typecheck/examples/Monoid/10B.dhall b/tests/typecheck/examples/Monoid/10B.dhall deleted file mode 100644 --- a/tests/typecheck/examples/Monoid/10B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../Prelude/Monoid Text diff --git a/tests/typecheck/fieldsAreTypesA.dhall b/tests/typecheck/fieldsAreTypesA.dhall deleted file mode 100644 --- a/tests/typecheck/fieldsAreTypesA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = Bool, y = List } diff --git a/tests/typecheck/fieldsAreTypesB.dhall b/tests/typecheck/fieldsAreTypesB.dhall deleted file mode 100644 --- a/tests/typecheck/fieldsAreTypesB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Type, y : Type → Type }