diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,279 @@
+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)
@@ -114,6 +390,12 @@
* 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
@@ -850,7 +1132,7 @@
* 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
+* 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
@@ -1233,7 +1515,7 @@
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
+ features
* This also includes a breaking change to `ImportType` in the API
* BREAKING CHANGE TO THE LANGUAGE: Disallow combining records of terms and
types
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2020 Gabriel Gonzalez
+Copyright (c) 2020 Gabriella Gonzalez
All rights reserved.
Redistribution and use in source and binary forms, with or without
diff --git a/benchmark/deep-nested-large-record/Main.hs b/benchmark/deep-nested-large-record/Main.hs
--- a/benchmark/deep-nested-large-record/Main.hs
+++ b/benchmark/deep-nested-large-record/Main.hs
@@ -1,14 +1,13 @@
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
-import Data.Void (Void)
-import Gauge (defaultMain)
+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
-import qualified Gauge
dhallPreludeImport :: Core.Import
dhallPreludeImport = Core.Import
@@ -22,8 +21,8 @@
}
}
-issue412 :: Core.Expr s Void -> Gauge.Benchmarkable
-issue412 prelude = Gauge.whnf TypeCheck.typeOf expr
+issue412 :: Core.Expr s Void -> Benchmarkable
+issue412 prelude = whnf TypeCheck.typeOf expr
where
expr
= Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude)
@@ -34,8 +33,8 @@
little = Core.makeFieldSelection "little"
foo = Core.makeFieldSelection "Foo"
-unionPerformance :: Core.Expr s Void -> Gauge.Benchmarkable
-unionPerformance prelude = Gauge.whnf TypeCheck.typeOf expr
+unionPerformance :: Core.Expr s Void -> Benchmarkable
+unionPerformance prelude = whnf TypeCheck.typeOf expr
where
expr =
Core.Let
@@ -54,7 +53,7 @@
Nothing
(prelude `Core.Field` types `Core.Field` big)
)
- (Core.Prefer Core.PreferFromSource "big" "big")
+ (Core.Prefer mempty Core.PreferFromSource "big" "big")
)
)
"x"
@@ -64,10 +63,10 @@
main :: IO ()
main =
defaultMain
- [ Gauge.env prelude $ \p ->
- Gauge.bgroup "Prelude"
- [ Gauge.bench "issue 412" (issue412 p)
- , Gauge.bench "union performance" (unionPerformance p)
+ [ 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/examples/cpkg.dhall b/benchmark/examples/cpkg.dhall
deleted file mode 100644
# file too large to diff: benchmark/examples/cpkg.dhall
diff --git a/benchmark/examples/issue108.dhall b/benchmark/examples/issue108.dhall
deleted file mode 100644
--- a/benchmark/examples/issue108.dhall
+++ /dev/null
@@ -1,63 +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) →
-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/examples/normalize/ChurchEval.dhall b/benchmark/examples/normalize/ChurchEval.dhall
deleted file mode 100644
--- a/benchmark/examples/normalize/ChurchEval.dhall
+++ /dev/null
@@ -1,22 +0,0 @@
-
-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/examples/normalize/FunCompose.dhall b/benchmark/examples/normalize/FunCompose.dhall
deleted file mode 100644
--- a/benchmark/examples/normalize/FunCompose.dhall
+++ /dev/null
@@ -1,18 +0,0 @@
-
-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/examples/normalize/ListBench.dhall b/benchmark/examples/normalize/ListBench.dhall
deleted file mode 100644
--- a/benchmark/examples/normalize/ListBench.dhall
+++ /dev/null
@@ -1,75 +0,0 @@
-
-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/examples/normalize/ListBenchAlt.dhall b/benchmark/examples/normalize/ListBenchAlt.dhall
deleted file mode 100644
--- a/benchmark/examples/normalize/ListBenchAlt.dhall
+++ /dev/null
@@ -1,45 +0,0 @@
-
-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/benchmark/parser/Main.hs b/benchmark/parser/Main.hs
--- a/benchmark/parser/Main.hs
+++ b/benchmark/parser/Main.hs
@@ -1,54 +1,54 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Exception (throw)
import Control.Monad (forM)
-import Data.Map (Map, foldrWithKey, singleton, unions)
+import Data.Map (Map)
+import Data.Text (Text)
import Data.Void (Void)
-import Gauge (bench, bgroup, defaultMain, env, nf, whnf)
-
-import System.Directory
+import Test.Tasty.Bench
import qualified Data.ByteString.Lazy
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
+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 Gauge
+import qualified System.Directory as Directory
-type PreludeFiles = Map FilePath T.Text
+type PreludeFiles = Map FilePath Text
loadPreludeFiles :: IO PreludeFiles
loadPreludeFiles = loadDirectory "./dhall-lang/Prelude"
where
loadDirectory :: FilePath -> IO PreludeFiles
loadDirectory dir =
- withCurrentDirectory dir $ do
- files <- getCurrentDirectory >>= listDirectory
+ Directory.withCurrentDirectory dir $ do
+ files <- Directory.getCurrentDirectory >>= Directory.listDirectory
results <- forM files $ \file -> do
- file' <- makeAbsolute file
- doesExist <- doesFileExist file'
+ file' <- Directory.makeAbsolute file
+ doesExist <- Directory.doesFileExist file'
if doesExist
then loadFile file'
else loadDirectory file'
- pure $ unions results
+ pure $ Map.unions results
loadFile :: FilePath -> IO PreludeFiles
- loadFile path = singleton path <$> TIO.readFile path
+ loadFile path = Map.singleton path <$> Data.Text.IO.readFile path
-benchParser :: PreludeFiles -> Gauge.Benchmark
+benchParser :: PreludeFiles -> Benchmark
benchParser =
bgroup "exprFromText"
- . foldrWithKey (\name expr -> (benchExprFromText name expr :)) []
+ . Map.foldrWithKey (\name expr -> (benchExprFromText name expr :)) []
-benchExprFromText :: String -> T.Text -> Gauge.Benchmark
-benchExprFromText name expr =
+benchExprFromText :: String -> Text -> Benchmark
+benchExprFromText name !expr =
bench name $ whnf (Dhall.exprFromText "(input)") expr
-benchExprFromBytes
- :: String -> Data.ByteString.Lazy.ByteString -> Gauge.Benchmark
+benchExprFromBytes :: String -> Data.ByteString.Lazy.ByteString -> Benchmark
benchExprFromBytes name bs = bench name (nf f bs)
where
f bytes =
@@ -56,8 +56,8 @@
Left exception -> error (show exception)
Right expression -> expression :: Dhall.Expr Void Dhall.Import
-benchNfExprFromText :: String -> T.Text -> Gauge.Benchmark
-benchNfExprFromText name expr =
+benchNfExprFromText :: String -> Text -> Benchmark
+benchNfExprFromText name !expr =
bench name $ nf (either throw id . Dhall.exprFromText "(input)") expr
main :: IO ()
@@ -71,20 +71,21 @@
]
, env kubernetesExample $
benchExprFromBytes "Kubernetes/Binary"
- , benchExprFromText "Long variable names" (T.replicate 1000000 "x")
- , benchExprFromText "Large number of function arguments" (T.replicate 10000 "x ")
- , benchExprFromText "Long double-quoted strings" ("\"" <> T.replicate 1000000 "x" <> "\"")
- , benchExprFromText "Long single-quoted strings" ("''" <> T.replicate 1000000 "x" <> "''")
- , benchExprFromText "Whitespace" (T.replicate 1000000 " " <> "x")
- , benchExprFromText "Line comment" ("x -- " <> T.replicate 1000000 " ")
- , benchExprFromText "Block comment" ("x {- " <> T.replicate 1000000 " " <> "-}")
+ , 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 = TIO.readFile "benchmark/examples/cpkg.dhall"
- issue108Text = TIO.readFile "benchmark/examples/issue108.dhall"
- issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/examples/issue108.dhall.bin"
- issues = (,) <$> issue108Text <*> issue108Bytes
- kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/examples/kubernetes.dhall.bin"
+ 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-lang/Prelude/Bool/and b/dhall-lang/Prelude/Bool/and
--- a/dhall-lang/Prelude/Bool/and
+++ b/dhall-lang/Prelude/Bool/and
@@ -1,2 +1,3 @@
- ./and.dhall sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d
+ missing
+ sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d
? ./and.dhall
diff --git a/dhall-lang/Prelude/Bool/build b/dhall-lang/Prelude/Bool/build
--- a/dhall-lang/Prelude/Bool/build
+++ b/dhall-lang/Prelude/Bool/build
@@ -1,2 +1,3 @@
- ./build.dhall sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b
+ missing
+ sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b
? ./build.dhall
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
--- a/dhall-lang/Prelude/Bool/even
+++ b/dhall-lang/Prelude/Bool/even
@@ -1,2 +1,3 @@
- ./even.dhall sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5
+ missing
+ sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5
? ./even.dhall
diff --git a/dhall-lang/Prelude/Bool/fold b/dhall-lang/Prelude/Bool/fold
--- a/dhall-lang/Prelude/Bool/fold
+++ b/dhall-lang/Prelude/Bool/fold
@@ -1,2 +1,3 @@
- ./fold.dhall sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae
+ missing
+ sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae
? ./fold.dhall
diff --git a/dhall-lang/Prelude/Bool/not b/dhall-lang/Prelude/Bool/not
--- a/dhall-lang/Prelude/Bool/not
+++ b/dhall-lang/Prelude/Bool/not
@@ -1,2 +1,3 @@
- ./not.dhall sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
+ missing
+ sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
? ./not.dhall
diff --git a/dhall-lang/Prelude/Bool/odd b/dhall-lang/Prelude/Bool/odd
--- a/dhall-lang/Prelude/Bool/odd
+++ b/dhall-lang/Prelude/Bool/odd
@@ -1,2 +1,3 @@
- ./odd.dhall sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999
+ missing
+ sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999
? ./odd.dhall
diff --git a/dhall-lang/Prelude/Bool/or b/dhall-lang/Prelude/Bool/or
--- a/dhall-lang/Prelude/Bool/or
+++ b/dhall-lang/Prelude/Bool/or
@@ -1,2 +1,3 @@
- ./or.dhall sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4
+ missing
+ sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4
? ./or.dhall
diff --git a/dhall-lang/Prelude/Bool/package.dhall b/dhall-lang/Prelude/Bool/package.dhall
--- a/dhall-lang/Prelude/Bool/package.dhall
+++ b/dhall-lang/Prelude/Bool/package.dhall
@@ -1,25 +1,37 @@
{ and =
- ./and.dhall sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d
+ missing
+ sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d
? ./and.dhall
, build =
- ./build.dhall sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b
+ missing
+ sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b
? ./build.dhall
+, equal =
+ missing
+ sha256:f0dc047ca14644c2a979bb126f2a3c6659ec770c66bd7beb70ae4a9d05815709
+ ? ./equal.dhall
, even =
- ./even.dhall sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5
+ missing
+ sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5
? ./even.dhall
, fold =
- ./fold.dhall sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae
+ missing
+ sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae
? ./fold.dhall
, not =
- ./not.dhall sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
+ missing
+ sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
? ./not.dhall
, odd =
- ./odd.dhall sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999
+ missing
+ sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999
? ./odd.dhall
, or =
- ./or.dhall sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4
+ missing
+ sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4
? ./or.dhall
, show =
- ./show.dhall sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61
+ missing
+ sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61
? ./show.dhall
}
diff --git a/dhall-lang/Prelude/Bool/show b/dhall-lang/Prelude/Bool/show
--- a/dhall-lang/Prelude/Bool/show
+++ b/dhall-lang/Prelude/Bool/show
@@ -1,2 +1,3 @@
- ./show.dhall sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61
+ missing
+ sha256:f85f6d2d921c37a2122cb2e2f8a0170e305b699debd0e6df5ef3370d806b5f61
? ./show.dhall
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
--- a/dhall-lang/Prelude/Double/package.dhall
+++ b/dhall-lang/Prelude/Double/package.dhall
@@ -1,4 +1,5 @@
{ show =
- ./show.dhall sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f
+ missing
+ sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f
? ./show.dhall
}
diff --git a/dhall-lang/Prelude/Double/show b/dhall-lang/Prelude/Double/show
--- a/dhall-lang/Prelude/Double/show
+++ b/dhall-lang/Prelude/Double/show
@@ -1,2 +1,3 @@
- ./show.dhall sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f
+ missing
+ sha256:ae645813cc4d8505a265df4d7564c95482f62bb3e07fc81681959599b6cee04f
? ./show.dhall
diff --git a/dhall-lang/Prelude/Function/compose b/dhall-lang/Prelude/Function/compose
--- a/dhall-lang/Prelude/Function/compose
+++ b/dhall-lang/Prelude/Function/compose
@@ -1,2 +1,3 @@
- ./compose.dhall sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013
+ missing
+ sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013
? ./compose.dhall
diff --git a/dhall-lang/Prelude/Function/compose.dhall b/dhall-lang/Prelude/Function/compose.dhall
--- a/dhall-lang/Prelude/Function/compose.dhall
+++ b/dhall-lang/Prelude/Function/compose.dhall
@@ -1,12 +1,12 @@
--| 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) →
+ = λ(a : Type) →
+ λ(b : Type) →
+ λ(c : Type) →
+ λ(f : a → b) →
+ λ(g : b → c) →
+ λ(x : a) →
g (f x)
let example0 =
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
--- a/dhall-lang/Prelude/Function/identity
+++ b/dhall-lang/Prelude/Function/identity
@@ -1,2 +1,3 @@
- ./identity.dhall sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
+ missing
+ sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
? ./identity.dhall
diff --git a/dhall-lang/Prelude/Function/package.dhall b/dhall-lang/Prelude/Function/package.dhall
--- a/dhall-lang/Prelude/Function/package.dhall
+++ b/dhall-lang/Prelude/Function/package.dhall
@@ -1,7 +1,13 @@
{ compose =
- ./compose.dhall sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013
+ missing
+ sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013
? ./compose.dhall
+, composeList =
+ missing
+ sha256:2c6931544d8b5a5b14514098c07bd1813f67b16834588d056df3c0bc2e489937
+ ? ./composeList.dhall
, identity =
- ./identity.dhall sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
+ missing
+ sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
? ./identity.dhall
}
diff --git a/dhall-lang/Prelude/Integer/abs b/dhall-lang/Prelude/Integer/abs
--- a/dhall-lang/Prelude/Integer/abs
+++ b/dhall-lang/Prelude/Integer/abs
@@ -1,2 +1,3 @@
- ./abs.dhall sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1
+ missing
+ sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1
? ./abs.dhall
diff --git a/dhall-lang/Prelude/Integer/add b/dhall-lang/Prelude/Integer/add
--- a/dhall-lang/Prelude/Integer/add
+++ b/dhall-lang/Prelude/Integer/add
@@ -1,2 +1,3 @@
- ./add.dhall sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b
+ missing
+ sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b
? ./add.dhall
diff --git a/dhall-lang/Prelude/Integer/add.dhall b/dhall-lang/Prelude/Integer/add.dhall
--- a/dhall-lang/Prelude/Integer/add.dhall
+++ b/dhall-lang/Prelude/Integer/add.dhall
@@ -1,6 +1,7 @@
--| `add m n` computes `m + n`.
let Integer/subtract =
- ./subtract.dhall sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda
+ missing
+ sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda
? ./subtract.dhall
let add
diff --git a/dhall-lang/Prelude/Integer/clamp b/dhall-lang/Prelude/Integer/clamp
--- a/dhall-lang/Prelude/Integer/clamp
+++ b/dhall-lang/Prelude/Integer/clamp
@@ -1,2 +1,3 @@
- ./clamp.dhall sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2
+ missing
+ sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2
? ./clamp.dhall
diff --git a/dhall-lang/Prelude/Integer/equal b/dhall-lang/Prelude/Integer/equal
--- a/dhall-lang/Prelude/Integer/equal
+++ b/dhall-lang/Prelude/Integer/equal
@@ -1,2 +1,3 @@
- ./equal.dhall sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8
+ missing
+ sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8
? ./equal.dhall
diff --git a/dhall-lang/Prelude/Integer/equal.dhall b/dhall-lang/Prelude/Integer/equal.dhall
--- a/dhall-lang/Prelude/Integer/equal.dhall
+++ b/dhall-lang/Prelude/Integer/equal.dhall
@@ -1,6 +1,7 @@
--| `equal` checks if two Integers are equal.
let Natural/equal =
- ../Natural/equal.dhall sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60
+ missing
+ sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60
? ../Natural/equal.dhall
let equal
diff --git a/dhall-lang/Prelude/Integer/greaterThan b/dhall-lang/Prelude/Integer/greaterThan
--- a/dhall-lang/Prelude/Integer/greaterThan
+++ b/dhall-lang/Prelude/Integer/greaterThan
@@ -1,2 +1,3 @@
- ./greaterThan.dhall sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b
+ missing
+ sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b
? ./greaterThan.dhall
diff --git a/dhall-lang/Prelude/Integer/greaterThan.dhall b/dhall-lang/Prelude/Integer/greaterThan.dhall
--- a/dhall-lang/Prelude/Integer/greaterThan.dhall
+++ b/dhall-lang/Prelude/Integer/greaterThan.dhall
@@ -1,10 +1,12 @@
--| `greaterThan` checks if one Integer is greater than another.
let Bool/not =
- ../Bool/not.dhall sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
+ missing
+ sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
? ../Bool/not.dhall
let lessThanEqual =
- ./lessThanEqual.dhall sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
+ missing
+ sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
? ./lessThanEqual.dhall
let greaterThan
diff --git a/dhall-lang/Prelude/Integer/greaterThanEqual b/dhall-lang/Prelude/Integer/greaterThanEqual
--- a/dhall-lang/Prelude/Integer/greaterThanEqual
+++ b/dhall-lang/Prelude/Integer/greaterThanEqual
@@ -1,2 +1,3 @@
- ./greaterThanEqual.dhall sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958
+ missing
+ sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958
? ./greaterThanEqual.dhall
diff --git a/dhall-lang/Prelude/Integer/greaterThanEqual.dhall b/dhall-lang/Prelude/Integer/greaterThanEqual.dhall
--- a/dhall-lang/Prelude/Integer/greaterThanEqual.dhall
+++ b/dhall-lang/Prelude/Integer/greaterThanEqual.dhall
@@ -2,7 +2,8 @@
`greaterThanEqual` checks if one Integer is greater than or equal to another.
-}
let lessThanEqual =
- ./lessThanEqual.dhall sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
+ missing
+ sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
? ./lessThanEqual.dhall
let greaterThanEqual
diff --git a/dhall-lang/Prelude/Integer/lessThan b/dhall-lang/Prelude/Integer/lessThan
--- a/dhall-lang/Prelude/Integer/lessThan
+++ b/dhall-lang/Prelude/Integer/lessThan
@@ -1,2 +1,3 @@
- ./lessThan.dhall sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0
+ missing
+ sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0
? ./lessThan.dhall
diff --git a/dhall-lang/Prelude/Integer/lessThan.dhall b/dhall-lang/Prelude/Integer/lessThan.dhall
--- a/dhall-lang/Prelude/Integer/lessThan.dhall
+++ b/dhall-lang/Prelude/Integer/lessThan.dhall
@@ -1,6 +1,7 @@
--| `lessThan` checks if one Integer is less than another.
let greaterThan =
- ./greaterThan.dhall sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b
+ missing
+ sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b
? ./greaterThan.dhall
let lessThan
diff --git a/dhall-lang/Prelude/Integer/lessThanEqual b/dhall-lang/Prelude/Integer/lessThanEqual
--- a/dhall-lang/Prelude/Integer/lessThanEqual
+++ b/dhall-lang/Prelude/Integer/lessThanEqual
@@ -1,2 +1,3 @@
- ./lessThanEqual.dhall sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
+ missing
+ sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
? ./lessThanEqual.dhall
diff --git a/dhall-lang/Prelude/Integer/lessThanEqual.dhall b/dhall-lang/Prelude/Integer/lessThanEqual.dhall
--- a/dhall-lang/Prelude/Integer/lessThanEqual.dhall
+++ b/dhall-lang/Prelude/Integer/lessThanEqual.dhall
@@ -1,18 +1,22 @@
--| `lessThanEqual` checks if one Integer is less than or equal to another.
let Natural/greaterThanEqual =
- ../Natural/greaterThanEqual.dhall sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
+ missing
+ sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
? ../Natural/greaterThanEqual.dhall
let Natural/lessThanEqual =
- ../Natural/lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ../Natural/lessThanEqual.dhall
let nonPositive =
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
let nonNegative =
- ./nonNegative.dhall sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
+ missing
+ sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
? ./nonNegative.dhall
let lessThanEqual
diff --git a/dhall-lang/Prelude/Integer/multiply b/dhall-lang/Prelude/Integer/multiply
--- a/dhall-lang/Prelude/Integer/multiply
+++ b/dhall-lang/Prelude/Integer/multiply
@@ -1,2 +1,3 @@
- ./multiply.dhall sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d
+ missing
+ sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d
? ./multiply.dhall
diff --git a/dhall-lang/Prelude/Integer/multiply.dhall b/dhall-lang/Prelude/Integer/multiply.dhall
--- a/dhall-lang/Prelude/Integer/multiply.dhall
+++ b/dhall-lang/Prelude/Integer/multiply.dhall
@@ -1,7 +1,7 @@
--| `multiply m n` computes `m * n`.
-
let nonPositive =
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
let multiplyNonNegative =
diff --git a/dhall-lang/Prelude/Integer/negate b/dhall-lang/Prelude/Integer/negate
--- a/dhall-lang/Prelude/Integer/negate
+++ b/dhall-lang/Prelude/Integer/negate
@@ -1,2 +1,3 @@
- ./negate.dhall sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d
+ missing
+ sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d
? ./negate.dhall
diff --git a/dhall-lang/Prelude/Integer/negative b/dhall-lang/Prelude/Integer/negative
--- a/dhall-lang/Prelude/Integer/negative
+++ b/dhall-lang/Prelude/Integer/negative
@@ -1,2 +1,3 @@
- ./negative.dhall sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570
+ missing
+ sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570
? ./negative.dhall
diff --git a/dhall-lang/Prelude/Integer/negative.dhall b/dhall-lang/Prelude/Integer/negative.dhall
--- a/dhall-lang/Prelude/Integer/negative.dhall
+++ b/dhall-lang/Prelude/Integer/negative.dhall
@@ -4,7 +4,8 @@
`negative` is more efficient than `./lessThan +0` or `./lessThanEqual -1`.
-}
let positive =
- ./positive.dhall sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3
+ missing
+ sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3
? ./positive.dhall
let negative
diff --git a/dhall-lang/Prelude/Integer/nonNegative b/dhall-lang/Prelude/Integer/nonNegative
--- a/dhall-lang/Prelude/Integer/nonNegative
+++ b/dhall-lang/Prelude/Integer/nonNegative
@@ -1,2 +1,3 @@
- ./nonNegative.dhall sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
+ missing
+ sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
? ./nonNegative.dhall
diff --git a/dhall-lang/Prelude/Integer/nonNegative.dhall b/dhall-lang/Prelude/Integer/nonNegative.dhall
--- a/dhall-lang/Prelude/Integer/nonNegative.dhall
+++ b/dhall-lang/Prelude/Integer/nonNegative.dhall
@@ -4,7 +4,8 @@
`nonNegative` is more efficient than `./greaterThanEqual +0` or `./greaterThan -1`.
-}
let nonPositive =
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
let nonNegative
diff --git a/dhall-lang/Prelude/Integer/nonPositive b/dhall-lang/Prelude/Integer/nonPositive
--- a/dhall-lang/Prelude/Integer/nonPositive
+++ b/dhall-lang/Prelude/Integer/nonPositive
@@ -1,2 +1,3 @@
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
diff --git a/dhall-lang/Prelude/Integer/package.dhall b/dhall-lang/Prelude/Integer/package.dhall
--- a/dhall-lang/Prelude/Integer/package.dhall
+++ b/dhall-lang/Prelude/Integer/package.dhall
@@ -1,55 +1,73 @@
{ abs =
- ./abs.dhall sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1
+ missing
+ sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1
? ./abs.dhall
, add =
- ./add.dhall sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b
+ missing
+ sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b
? ./add.dhall
, clamp =
- ./clamp.dhall sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2
+ missing
+ sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2
? ./clamp.dhall
, equal =
- ./equal.dhall sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8
+ missing
+ sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8
? ./equal.dhall
, greaterThan =
- ./greaterThan.dhall sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b
+ missing
+ sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b
? ./greaterThan.dhall
, greaterThanEqual =
- ./greaterThanEqual.dhall sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958
+ missing
+ sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958
? ./greaterThanEqual.dhall
, lessThan =
- ./lessThan.dhall sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0
+ missing
+ sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0
? ./lessThan.dhall
, lessThanEqual =
- ./lessThanEqual.dhall sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
+ missing
+ sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc
? ./lessThanEqual.dhall
, multiply =
- ./multiply.dhall sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d
+ missing
+ sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d
? ./multiply.dhall
, negate =
- ./negate.dhall sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d
+ missing
+ sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d
? ./negate.dhall
, negative =
- ./negative.dhall sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570
+ missing
+ sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570
? ./negative.dhall
, nonNegative =
- ./nonNegative.dhall sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
+ missing
+ sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
? ./nonNegative.dhall
, nonPositive =
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
, positive =
- ./positive.dhall sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3
+ missing
+ sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3
? ./positive.dhall
, show =
- ./show.dhall sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9
+ missing
+ sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9
? ./show.dhall
, subtract =
- ./subtract.dhall sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda
+ missing
+ sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda
? ./subtract.dhall
, toDouble =
- ./toDouble.dhall sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7
+ missing
+ sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7
? ./toDouble.dhall
, toNatural =
- ./toNatural.dhall sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e
+ missing
+ sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e
? ./toNatural.dhall
}
diff --git a/dhall-lang/Prelude/Integer/positive b/dhall-lang/Prelude/Integer/positive
--- a/dhall-lang/Prelude/Integer/positive
+++ b/dhall-lang/Prelude/Integer/positive
@@ -1,2 +1,3 @@
- ./positive.dhall sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3
+ missing
+ sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3
? ./positive.dhall
diff --git a/dhall-lang/Prelude/Integer/positive.dhall b/dhall-lang/Prelude/Integer/positive.dhall
--- a/dhall-lang/Prelude/Integer/positive.dhall
+++ b/dhall-lang/Prelude/Integer/positive.dhall
@@ -4,11 +4,13 @@
`positive` is more efficient than `./greaterThan +0` or `./greaterThanEqual +1`.
-}
let not =
- ../Bool/not.dhall sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
+ missing
+ sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
? ../Bool/not.dhall
let nonPositive =
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
let positive
diff --git a/dhall-lang/Prelude/Integer/show b/dhall-lang/Prelude/Integer/show
--- a/dhall-lang/Prelude/Integer/show
+++ b/dhall-lang/Prelude/Integer/show
@@ -1,2 +1,3 @@
- ./show.dhall sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9
+ missing
+ sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9
? ./show.dhall
diff --git a/dhall-lang/Prelude/Integer/subtract b/dhall-lang/Prelude/Integer/subtract
--- a/dhall-lang/Prelude/Integer/subtract
+++ b/dhall-lang/Prelude/Integer/subtract
@@ -1,2 +1,3 @@
- ./subtract.dhall sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda
+ missing
+ sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda
? ./subtract.dhall
diff --git a/dhall-lang/Prelude/Integer/subtract.dhall b/dhall-lang/Prelude/Integer/subtract.dhall
--- a/dhall-lang/Prelude/Integer/subtract.dhall
+++ b/dhall-lang/Prelude/Integer/subtract.dhall
@@ -1,6 +1,7 @@
--| `subtract m n` computes `n - m`.
let nonPositive =
- ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
+ missing
+ sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b
? ./nonPositive.dhall
let subtractNonNegative =
diff --git a/dhall-lang/Prelude/Integer/toDouble b/dhall-lang/Prelude/Integer/toDouble
--- a/dhall-lang/Prelude/Integer/toDouble
+++ b/dhall-lang/Prelude/Integer/toDouble
@@ -1,2 +1,3 @@
- ./toDouble.dhall sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7
+ missing
+ sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7
? ./toDouble.dhall
diff --git a/dhall-lang/Prelude/Integer/toNatural b/dhall-lang/Prelude/Integer/toNatural
--- a/dhall-lang/Prelude/Integer/toNatural
+++ b/dhall-lang/Prelude/Integer/toNatural
@@ -1,2 +1,3 @@
- ./toNatural.dhall sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e
+ missing
+ sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e
? ./toNatural.dhall
diff --git a/dhall-lang/Prelude/Integer/toNatural.dhall b/dhall-lang/Prelude/Integer/toNatural.dhall
--- a/dhall-lang/Prelude/Integer/toNatural.dhall
+++ b/dhall-lang/Prelude/Integer/toNatural.dhall
@@ -2,7 +2,8 @@
Convert an `Integer` to an `Optional Natural`, with negative numbers becoming `None Natural`.
-}
let nonNegative =
- ./nonNegative.dhall sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
+ missing
+ sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
? ./nonNegative.dhall
let toNatural
diff --git a/dhall-lang/Prelude/JSON/Format b/dhall-lang/Prelude/JSON/Format
--- a/dhall-lang/Prelude/JSON/Format
+++ b/dhall-lang/Prelude/JSON/Format
@@ -1,2 +1,3 @@
- ./Format.dhall sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
+ missing
+ sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
? ./Format.dhall
diff --git a/dhall-lang/Prelude/JSON/Format.dhall b/dhall-lang/Prelude/JSON/Format.dhall
--- a/dhall-lang/Prelude/JSON/Format.dhall
+++ b/dhall-lang/Prelude/JSON/Format.dhall
@@ -4,5 +4,4 @@
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
--- a/dhall-lang/Prelude/JSON/Nesting
+++ b/dhall-lang/Prelude/JSON/Nesting
@@ -1,2 +1,3 @@
- ./Nesting.dhall sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
+ missing
+ sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
? ./Nesting.dhall
diff --git a/dhall-lang/Prelude/JSON/Tagged b/dhall-lang/Prelude/JSON/Tagged
--- a/dhall-lang/Prelude/JSON/Tagged
+++ b/dhall-lang/Prelude/JSON/Tagged
@@ -1,2 +1,3 @@
- ./Tagged.dhall sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
+ missing
+ sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
? ./Tagged.dhall
diff --git a/dhall-lang/Prelude/JSON/Tagged.dhall b/dhall-lang/Prelude/JSON/Tagged.dhall
--- a/dhall-lang/Prelude/JSON/Tagged.dhall
+++ b/dhall-lang/Prelude/JSON/Tagged.dhall
@@ -65,7 +65,8 @@
= λ(a : Type) →
{ field : Text
, nesting :
- ./Nesting.dhall sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
+ missing
+ sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
? ./Nesting.dhall
, contents : a
}
diff --git a/dhall-lang/Prelude/JSON/Type b/dhall-lang/Prelude/JSON/Type
--- a/dhall-lang/Prelude/JSON/Type
+++ b/dhall-lang/Prelude/JSON/Type
@@ -1,2 +1,3 @@
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
diff --git a/dhall-lang/Prelude/JSON/array b/dhall-lang/Prelude/JSON/array
--- a/dhall-lang/Prelude/JSON/array
+++ b/dhall-lang/Prelude/JSON/array
@@ -1,2 +1,3 @@
- ./array.dhall sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8
+ missing
+ sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8
? ./array.dhall
diff --git a/dhall-lang/Prelude/JSON/array.dhall b/dhall-lang/Prelude/JSON/array.dhall
--- a/dhall-lang/Prelude/JSON/array.dhall
+++ b/dhall-lang/Prelude/JSON/array.dhall
@@ -13,11 +13,13 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
let array
diff --git a/dhall-lang/Prelude/JSON/bool b/dhall-lang/Prelude/JSON/bool
--- a/dhall-lang/Prelude/JSON/bool
+++ b/dhall-lang/Prelude/JSON/bool
@@ -1,2 +1,3 @@
- ./bool.dhall sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39
+ missing
+ sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39
? ./bool.dhall
diff --git a/dhall-lang/Prelude/JSON/bool.dhall b/dhall-lang/Prelude/JSON/bool.dhall
--- a/dhall-lang/Prelude/JSON/bool.dhall
+++ b/dhall-lang/Prelude/JSON/bool.dhall
@@ -12,7 +12,8 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let bool
diff --git a/dhall-lang/Prelude/JSON/core.dhall b/dhall-lang/Prelude/JSON/core.dhall
--- a/dhall-lang/Prelude/JSON/core.dhall
+++ b/dhall-lang/Prelude/JSON/core.dhall
@@ -8,48 +8,63 @@
`package.dhall` to avoid import cycles.
-}
{ Type =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
, Tagged =
- ./Tagged.dhall sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
+ missing
+ sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
? ./Tagged.dhall
, Nesting =
- ./Nesting.dhall sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
+ missing
+ sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
? ./Nesting.dhall
, keyText =
- ./keyText.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ./keyText.dhall
, keyValue =
- ./keyValue.dhall sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
+ missing
+ sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
? ./keyValue.dhall
, string =
- ./string.dhall sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e
+ missing
+ sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e
? ./string.dhall
, number =
- ./number.dhall sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
+ missing
+ sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
? ./number.dhall
, double =
- ./double.dhall sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
+ missing
+ sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
? ./double.dhall
, integer =
- ./integer.dhall sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40
+ missing
+ sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40
? ./integer.dhall
, natural =
- ./natural.dhall sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5
+ missing
+ sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5
? ./natural.dhall
, object =
- ./object.dhall sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac
+ missing
+ sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac
? ./object.dhall
, array =
- ./array.dhall sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8
+ missing
+ sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8
? ./array.dhall
, bool =
- ./bool.dhall sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39
+ missing
+ sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39
? ./bool.dhall
, null =
- ./null.dhall sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8
+ missing
+ sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8
? ./null.dhall
, renderInteger =
- ./renderInteger.dhall sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c
+ missing
+ sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c
? ./renderInteger.dhall
}
diff --git a/dhall-lang/Prelude/JSON/double b/dhall-lang/Prelude/JSON/double
--- a/dhall-lang/Prelude/JSON/double
+++ b/dhall-lang/Prelude/JSON/double
@@ -1,2 +1,3 @@
- ./double.dhall sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
+ missing
+ sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
? ./double.dhall
diff --git a/dhall-lang/Prelude/JSON/double.dhall b/dhall-lang/Prelude/JSON/double.dhall
--- a/dhall-lang/Prelude/JSON/double.dhall
+++ b/dhall-lang/Prelude/JSON/double.dhall
@@ -12,7 +12,8 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let double
diff --git a/dhall-lang/Prelude/JSON/integer b/dhall-lang/Prelude/JSON/integer
--- a/dhall-lang/Prelude/JSON/integer
+++ b/dhall-lang/Prelude/JSON/integer
@@ -1,2 +1,3 @@
- ./integer.dhall sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40
+ missing
+ sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40
? ./integer.dhall
diff --git a/dhall-lang/Prelude/JSON/integer.dhall b/dhall-lang/Prelude/JSON/integer.dhall
--- a/dhall-lang/Prelude/JSON/integer.dhall
+++ b/dhall-lang/Prelude/JSON/integer.dhall
@@ -12,7 +12,8 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let integer
diff --git a/dhall-lang/Prelude/JSON/keyText b/dhall-lang/Prelude/JSON/keyText
--- a/dhall-lang/Prelude/JSON/keyText
+++ b/dhall-lang/Prelude/JSON/keyText
@@ -1,2 +1,3 @@
- ./keyText.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ./keyText.dhall
diff --git a/dhall-lang/Prelude/JSON/keyText.dhall b/dhall-lang/Prelude/JSON/keyText.dhall
--- a/dhall-lang/Prelude/JSON/keyText.dhall
+++ b/dhall-lang/Prelude/JSON/keyText.dhall
@@ -1,2 +1,3 @@
- ../Map/keyText.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ../Map/keyText.dhall
diff --git a/dhall-lang/Prelude/JSON/keyValue b/dhall-lang/Prelude/JSON/keyValue
--- a/dhall-lang/Prelude/JSON/keyValue
+++ b/dhall-lang/Prelude/JSON/keyValue
@@ -1,2 +1,3 @@
- ./keyValue.dhall sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
+ missing
+ sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
? ./keyValue.dhall
diff --git a/dhall-lang/Prelude/JSON/keyValue.dhall b/dhall-lang/Prelude/JSON/keyValue.dhall
--- a/dhall-lang/Prelude/JSON/keyValue.dhall
+++ b/dhall-lang/Prelude/JSON/keyValue.dhall
@@ -1,2 +1,3 @@
- ../Map/keyValue.dhall sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
+ missing
+ sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
? ../Map/keyValue.dhall
diff --git a/dhall-lang/Prelude/JSON/natural b/dhall-lang/Prelude/JSON/natural
--- a/dhall-lang/Prelude/JSON/natural
+++ b/dhall-lang/Prelude/JSON/natural
@@ -1,2 +1,3 @@
- ./natural.dhall sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5
+ missing
+ sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5
? ./natural.dhall
diff --git a/dhall-lang/Prelude/JSON/natural.dhall b/dhall-lang/Prelude/JSON/natural.dhall
--- a/dhall-lang/Prelude/JSON/natural.dhall
+++ b/dhall-lang/Prelude/JSON/natural.dhall
@@ -8,7 +8,8 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let natural
diff --git a/dhall-lang/Prelude/JSON/null b/dhall-lang/Prelude/JSON/null
--- a/dhall-lang/Prelude/JSON/null
+++ b/dhall-lang/Prelude/JSON/null
@@ -1,2 +1,3 @@
- ./null.dhall sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8
+ missing
+ sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8
? ./null.dhall
diff --git a/dhall-lang/Prelude/JSON/null.dhall b/dhall-lang/Prelude/JSON/null.dhall
--- a/dhall-lang/Prelude/JSON/null.dhall
+++ b/dhall-lang/Prelude/JSON/null.dhall
@@ -8,7 +8,8 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let null
diff --git a/dhall-lang/Prelude/JSON/number b/dhall-lang/Prelude/JSON/number
--- a/dhall-lang/Prelude/JSON/number
+++ b/dhall-lang/Prelude/JSON/number
@@ -1,2 +1,3 @@
- ./number.dhall sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
+ missing
+ sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
? ./number.dhall
diff --git a/dhall-lang/Prelude/JSON/number.dhall b/dhall-lang/Prelude/JSON/number.dhall
--- a/dhall-lang/Prelude/JSON/number.dhall
+++ b/dhall-lang/Prelude/JSON/number.dhall
@@ -12,11 +12,13 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let double =
- ./double.dhall sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
+ missing
+ sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32
? ./double.dhall
let number
diff --git a/dhall-lang/Prelude/JSON/object b/dhall-lang/Prelude/JSON/object
--- a/dhall-lang/Prelude/JSON/object
+++ b/dhall-lang/Prelude/JSON/object
@@ -1,2 +1,3 @@
- ./object.dhall sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac
+ missing
+ sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac
? ./object.dhall
diff --git a/dhall-lang/Prelude/JSON/object.dhall b/dhall-lang/Prelude/JSON/object.dhall
--- a/dhall-lang/Prelude/JSON/object.dhall
+++ b/dhall-lang/Prelude/JSON/object.dhall
@@ -19,11 +19,13 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
let object
diff --git a/dhall-lang/Prelude/JSON/omitNullFields b/dhall-lang/Prelude/JSON/omitNullFields
--- a/dhall-lang/Prelude/JSON/omitNullFields
+++ b/dhall-lang/Prelude/JSON/omitNullFields
@@ -1,2 +1,3 @@
- ./omitNullFields.dhall sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0
+ missing
+ sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0
? ./omitNullFields.dhall
diff --git a/dhall-lang/Prelude/JSON/omitNullFields.dhall b/dhall-lang/Prelude/JSON/omitNullFields.dhall
--- a/dhall-lang/Prelude/JSON/omitNullFields.dhall
+++ b/dhall-lang/Prelude/JSON/omitNullFields.dhall
@@ -3,15 +3,18 @@
for a configuration to encode absent fields
-}
let JSON =
- ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
+ missing
+ sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
? ./core.dhall
let List/concatMap =
- ../List/concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
+ missing
+ sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
? ../List/concatMap.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
let omitNullFields
diff --git a/dhall-lang/Prelude/JSON/package.dhall b/dhall-lang/Prelude/JSON/package.dhall
--- a/dhall-lang/Prelude/JSON/package.dhall
+++ b/dhall-lang/Prelude/JSON/package.dhall
@@ -1,19 +1,29 @@
{ render =
- ./render.dhall sha256:b5e5aee66b8fc018b50e1019a76340deafe5f8176854ea3611476d79990785da
+ missing
+ sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836
? ./render.dhall
+ , renderCompact =
+ missing
+ sha256:e6c8809fbe193fddd430f94350d69cefd45e7aaf8bd379e51b750fde75008562
+ ? ./renderCompact.dhall
, renderYAML =
- ./renderYAML.dhall sha256:dad92a120956ae852be7496d1e1955bbf3f60834ab2ad32641269098f2846477
+ missing
+ sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478
? ./renderYAML.dhall
, omitNullFields =
- ./omitNullFields.dhall sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0
+ missing
+ sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0
? ./omitNullFields.dhall
, tagInline =
- ./tagInline.dhall sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4
+ missing
+ sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4
? ./tagInline.dhall
, tagNested =
- ./tagNested.dhall sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f
+ missing
+ sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f
? ./tagNested.dhall
}
-∧ ( ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
+∧ ( missing
+ sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
? ./core.dhall
)
diff --git a/dhall-lang/Prelude/JSON/render b/dhall-lang/Prelude/JSON/render
--- a/dhall-lang/Prelude/JSON/render
+++ b/dhall-lang/Prelude/JSON/render
@@ -1,2 +1,3 @@
- ./render.dhall sha256:b5e5aee66b8fc018b50e1019a76340deafe5f8176854ea3611476d79990785da
+ missing
+ sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836
? ./render.dhall
diff --git a/dhall-lang/Prelude/JSON/render.dhall b/dhall-lang/Prelude/JSON/render.dhall
--- a/dhall-lang/Prelude/JSON/render.dhall
+++ b/dhall-lang/Prelude/JSON/render.dhall
@@ -5,15 +5,18 @@
more sophisticated you should use `dhall-to-json` or `dhall-to-yaml`
-}
let JSON =
- ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
+ missing
+ sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
? ./core.dhall
let renderAs =
- ./renderAs.dhall sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043
+ missing
+ sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471
? ./renderAs.dhall
let Format =
- ./Format.dhall sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
+ missing
+ sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
? ./Format.dhall
let render
diff --git a/dhall-lang/Prelude/JSON/renderAs b/dhall-lang/Prelude/JSON/renderAs
--- a/dhall-lang/Prelude/JSON/renderAs
+++ b/dhall-lang/Prelude/JSON/renderAs
@@ -1,2 +1,3 @@
- ./renderAs.dhall sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043
+ missing
+ sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471
? ./renderAs.dhall
diff --git a/dhall-lang/Prelude/JSON/renderAs.dhall b/dhall-lang/Prelude/JSON/renderAs.dhall
--- a/dhall-lang/Prelude/JSON/renderAs.dhall
+++ b/dhall-lang/Prelude/JSON/renderAs.dhall
@@ -1,33 +1,49 @@
--| Render a `JSON` value as `Text` in either JSON or YAML format.
-
let JSON =
- ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
+ missing
+ sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
? ./core.dhall
let Function/identity =
- ../Function/identity.dhall sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
+ missing
+ sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
? ../Function/identity.dhall
let Text/concatMap =
- ../Text/concatMap.dhall sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
+ missing
+ sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
? ../Text/concatMap.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
-let List/concatMap =
- ../List/concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
- ? ../List/concatMap.dhall
+let NonEmpty =
+ missing
+ sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f
+ ? ../NonEmpty/Type.dhall
-let NonEmpty
- : Type → Type
- = λ(a : Type) → { head : a, tail : List a }
+let NonEmpty/toList =
+ missing
+ sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5
+ ? ../NonEmpty/toList.dhall
-let NonEmpty/singleton
- : ∀(a : Type) → a → NonEmpty a
- = λ(a : Type) → λ(x : a) → { head = x, tail = [] : List a }
+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
@@ -54,28 +70,6 @@
)
(None (NonEmpty a))
-let NonEmpty/toList
- : ∀(a : Type) → NonEmpty a → List a
- = λ(a : Type) → λ(nonEmpty : NonEmpty a) → [ nonEmpty.head ] # nonEmpty.tail
-
-let NonEmpty/concat
- : ∀(a : Type) → NonEmpty (NonEmpty a) → NonEmpty a
- = λ(a : Type) →
- λ(lss : NonEmpty (NonEmpty a)) →
- { head = lss.head.head
- , tail =
- lss.head.tail
- # List/concatMap (NonEmpty a) a (NonEmpty/toList a) lss.tail
- }
-
-let NonEmpty/map
- : ∀(a : Type) → ∀(b : Type) → (a → b) → NonEmpty a → NonEmpty b
- = λ(a : Type) →
- λ(b : Type) →
- λ(fn : a → b) →
- λ(ls : NonEmpty a) →
- { head = fn ls.head, tail = List/map a b fn ls.tail }
-
let NonEmpty/mapHead
: ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a
= λ(a : Type) →
@@ -190,11 +184,28 @@
let indentTail = NonEmpty/mapTail Text addIndent
let Format =
- ./Format.dhall sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
+ 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) →
@@ -225,7 +236,7 @@
let renderObject =
λ(format : Format) →
λ(fields : NonEmpty ObjectField) →
- let keystr = λ(field : ObjectField) → "${Text/show field.mapKey}:"
+ let keystr = λ(field : ObjectField) → "\"${escape field.mapKey}\":"
let prefixKeyOnFirst =
λ(field : ObjectField) →
@@ -294,7 +305,7 @@
blockToText
( json
Block
- { string = λ(x : Text) → Block.Simple (Text/show x)
+ { 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)
@@ -424,5 +435,24 @@
''
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
--- a/dhall-lang/Prelude/JSON/renderInteger.dhall
+++ b/dhall-lang/Prelude/JSON/renderInteger.dhall
@@ -2,9 +2,9 @@
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 =
- ../Integer/nonNegative.dhall sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
+ missing
+ sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663
? ../Integer/nonNegative.dhall
let renderInteger
diff --git a/dhall-lang/Prelude/JSON/renderYAML b/dhall-lang/Prelude/JSON/renderYAML
--- a/dhall-lang/Prelude/JSON/renderYAML
+++ b/dhall-lang/Prelude/JSON/renderYAML
@@ -1,2 +1,3 @@
- ./renderYAML.dhall sha256:dad92a120956ae852be7496d1e1955bbf3f60834ab2ad32641269098f2846477
+ missing
+ sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478
? ./renderYAML.dhall
diff --git a/dhall-lang/Prelude/JSON/renderYAML.dhall b/dhall-lang/Prelude/JSON/renderYAML.dhall
--- a/dhall-lang/Prelude/JSON/renderYAML.dhall
+++ b/dhall-lang/Prelude/JSON/renderYAML.dhall
@@ -8,17 +8,19 @@
For anything more sophisticated you should use `dhall-to-json` or
`dhall-to-yaml`.
-}
-
let JSON =
- ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
+ missing
+ sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5
? ./core.dhall
let renderAs =
- ./renderAs.dhall sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043
+ missing
+ sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471
? ./renderAs.dhall
let Format =
- ./Format.dhall sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
+ missing
+ sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac
? ./Format.dhall
let renderYAML
diff --git a/dhall-lang/Prelude/JSON/string b/dhall-lang/Prelude/JSON/string
--- a/dhall-lang/Prelude/JSON/string
+++ b/dhall-lang/Prelude/JSON/string
@@ -1,2 +1,3 @@
- ./string.dhall sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e
+ missing
+ sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e
? ./string.dhall
diff --git a/dhall-lang/Prelude/JSON/string.dhall b/dhall-lang/Prelude/JSON/string.dhall
--- a/dhall-lang/Prelude/JSON/string.dhall
+++ b/dhall-lang/Prelude/JSON/string.dhall
@@ -12,7 +12,8 @@
```
-}
let JSON =
- ./Type.dhall sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
+ missing
+ sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759
? ./Type.dhall
let string
diff --git a/dhall-lang/Prelude/JSON/tagInline b/dhall-lang/Prelude/JSON/tagInline
--- a/dhall-lang/Prelude/JSON/tagInline
+++ b/dhall-lang/Prelude/JSON/tagInline
@@ -1,2 +1,3 @@
- ./tagInline.dhall sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4
+ missing
+ sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4
? ./tagInline.dhall
diff --git a/dhall-lang/Prelude/JSON/tagInline.dhall b/dhall-lang/Prelude/JSON/tagInline.dhall
--- a/dhall-lang/Prelude/JSON/tagInline.dhall
+++ b/dhall-lang/Prelude/JSON/tagInline.dhall
@@ -1,10 +1,12 @@
--| Prepare a union value for JSON- or YAML-encoding with the inline layout
let Nesting =
- ./Nesting.dhall sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
+ missing
+ sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
? ./Nesting.dhall
let Tagged =
- ./Tagged.dhall sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
+ missing
+ sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
? ./Tagged.dhall
let tagInline
diff --git a/dhall-lang/Prelude/JSON/tagNested b/dhall-lang/Prelude/JSON/tagNested
--- a/dhall-lang/Prelude/JSON/tagNested
+++ b/dhall-lang/Prelude/JSON/tagNested
@@ -1,2 +1,3 @@
- ./tagNested.dhall sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f
+ missing
+ sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f
? ./tagNested.dhall
diff --git a/dhall-lang/Prelude/JSON/tagNested.dhall b/dhall-lang/Prelude/JSON/tagNested.dhall
--- a/dhall-lang/Prelude/JSON/tagNested.dhall
+++ b/dhall-lang/Prelude/JSON/tagNested.dhall
@@ -1,10 +1,12 @@
--| Prepare a union value for JSON- or YAML-encoding with the nested layout
let Nesting =
- ./Nesting.dhall sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
+ missing
+ sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
? ./Nesting.dhall
let Tagged =
- ./Tagged.dhall sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
+ missing
+ sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194
? ./Tagged.dhall
let tagNested
diff --git a/dhall-lang/Prelude/List/all b/dhall-lang/Prelude/List/all
--- a/dhall-lang/Prelude/List/all
+++ b/dhall-lang/Prelude/List/all
@@ -1,2 +1,3 @@
- ./all.dhall sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15
+ missing
+ sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15
? ./all.dhall
diff --git a/dhall-lang/Prelude/List/any b/dhall-lang/Prelude/List/any
--- a/dhall-lang/Prelude/List/any
+++ b/dhall-lang/Prelude/List/any
@@ -1,2 +1,3 @@
- ./any.dhall sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8
+ missing
+ sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8
? ./any.dhall
diff --git a/dhall-lang/Prelude/List/build b/dhall-lang/Prelude/List/build
--- a/dhall-lang/Prelude/List/build
+++ b/dhall-lang/Prelude/List/build
@@ -1,2 +1,3 @@
- ./build.dhall sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42
+ missing
+ sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42
? ./build.dhall
diff --git a/dhall-lang/Prelude/List/concat b/dhall-lang/Prelude/List/concat
--- a/dhall-lang/Prelude/List/concat
+++ b/dhall-lang/Prelude/List/concat
@@ -1,2 +1,3 @@
- ./concat.dhall sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b
+ missing
+ sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b
? ./concat.dhall
diff --git a/dhall-lang/Prelude/List/concatMap b/dhall-lang/Prelude/List/concatMap
--- a/dhall-lang/Prelude/List/concatMap
+++ b/dhall-lang/Prelude/List/concatMap
@@ -1,2 +1,3 @@
- ./concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
+ missing
+ sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
? ./concatMap.dhall
diff --git a/dhall-lang/Prelude/List/default b/dhall-lang/Prelude/List/default
--- a/dhall-lang/Prelude/List/default
+++ b/dhall-lang/Prelude/List/default
@@ -1,2 +1,3 @@
- ./default.dhall sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379
+ missing
+ sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379
? ./default.dhall
diff --git a/dhall-lang/Prelude/List/drop b/dhall-lang/Prelude/List/drop
--- a/dhall-lang/Prelude/List/drop
+++ b/dhall-lang/Prelude/List/drop
@@ -1,2 +1,3 @@
- ./drop.dhall sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf
+ missing
+ sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf
? ./drop.dhall
diff --git a/dhall-lang/Prelude/List/drop.dhall b/dhall-lang/Prelude/List/drop.dhall
--- a/dhall-lang/Prelude/List/drop.dhall
+++ b/dhall-lang/Prelude/List/drop.dhall
@@ -1,6 +1,7 @@
--| Remove first `n` elements of a list
let Natural/greaterThanEqual =
- ../Natural/greaterThanEqual.dhall sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
+ missing
+ sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
? ../Natural/greaterThanEqual.dhall
let drop
diff --git a/dhall-lang/Prelude/List/empty b/dhall-lang/Prelude/List/empty
--- a/dhall-lang/Prelude/List/empty
+++ b/dhall-lang/Prelude/List/empty
@@ -1,2 +1,3 @@
- ./empty.dhall sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147
+ missing
+ sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147
? ./empty.dhall
diff --git a/dhall-lang/Prelude/List/filter b/dhall-lang/Prelude/List/filter
--- a/dhall-lang/Prelude/List/filter
+++ b/dhall-lang/Prelude/List/filter
@@ -1,2 +1,3 @@
- ./filter.dhall sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6
+ missing
+ sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6
? ./filter.dhall
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
--- a/dhall-lang/Prelude/List/fold
+++ b/dhall-lang/Prelude/List/fold
@@ -1,2 +1,3 @@
- ./fold.dhall sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814
+ missing
+ sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814
? ./fold.dhall
diff --git a/dhall-lang/Prelude/List/fold.dhall b/dhall-lang/Prelude/List/fold.dhall
--- a/dhall-lang/Prelude/List/fold.dhall
+++ b/dhall-lang/Prelude/List/fold.dhall
@@ -18,34 +18,26 @@
: fold
Natural
[ 2, 3, 5 ]
- Natural
- (λ(x : Natural) → λ(y : Natural) → x + y)
- 0
- ≡ 10
+ Text
+ (λ(x : Natural) → λ(y : Text) → Natural/show x ++ y)
+ "0"
+ ≡ "2350"
let example1 =
- assert
- : ( λ(nil : Natural) →
- fold
- Natural
- [ 2, 3, 5 ]
- Natural
- (λ(x : Natural) → λ(y : Natural) → x + y)
- nil
- )
- ≡ (λ(nil : Natural) → 2 + (3 + (5 + nil)))
+ λ(nil : Text) →
+ assert
+ : fold
+ Natural
+ [ 2, 3, 5 ]
+ Text
+ (λ(x : Natural) → λ(y : Text) → Natural/show x ++ y)
+ nil
+ ≡ "2" ++ ("3" ++ ("5" ++ nil))
let example2 =
- assert
- : ( λ(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))
- )
+ λ(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
--- a/dhall-lang/Prelude/List/generate
+++ b/dhall-lang/Prelude/List/generate
@@ -1,2 +1,3 @@
- ./generate.dhall sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4
+ missing
+ sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4
? ./generate.dhall
diff --git a/dhall-lang/Prelude/List/head b/dhall-lang/Prelude/List/head
--- a/dhall-lang/Prelude/List/head
+++ b/dhall-lang/Prelude/List/head
@@ -1,2 +1,3 @@
- ./head.dhall sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026
+ missing
+ sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026
? ./head.dhall
diff --git a/dhall-lang/Prelude/List/index b/dhall-lang/Prelude/List/index
--- a/dhall-lang/Prelude/List/index
+++ b/dhall-lang/Prelude/List/index
@@ -1,2 +1,3 @@
- ./index.dhall sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63
+ missing
+ sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63
? ./index.dhall
diff --git a/dhall-lang/Prelude/List/index.dhall b/dhall-lang/Prelude/List/index.dhall
--- a/dhall-lang/Prelude/List/index.dhall
+++ b/dhall-lang/Prelude/List/index.dhall
@@ -1,6 +1,7 @@
--| Retrieve an element from a `List` using its 0-based index
let drop =
- ./drop.dhall sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf
+ missing
+ sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf
? ./drop.dhall
let index
diff --git a/dhall-lang/Prelude/List/indexed b/dhall-lang/Prelude/List/indexed
--- a/dhall-lang/Prelude/List/indexed
+++ b/dhall-lang/Prelude/List/indexed
@@ -1,2 +1,3 @@
- ./indexed.dhall sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f
+ missing
+ sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f
? ./indexed.dhall
diff --git a/dhall-lang/Prelude/List/iterate b/dhall-lang/Prelude/List/iterate
--- a/dhall-lang/Prelude/List/iterate
+++ b/dhall-lang/Prelude/List/iterate
@@ -1,2 +1,3 @@
- ./iterate.dhall sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26
+ missing
+ sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26
? ./iterate.dhall
diff --git a/dhall-lang/Prelude/List/last b/dhall-lang/Prelude/List/last
--- a/dhall-lang/Prelude/List/last
+++ b/dhall-lang/Prelude/List/last
@@ -1,2 +1,3 @@
- ./last.dhall sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d
+ missing
+ sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d
? ./last.dhall
diff --git a/dhall-lang/Prelude/List/length b/dhall-lang/Prelude/List/length
--- a/dhall-lang/Prelude/List/length
+++ b/dhall-lang/Prelude/List/length
@@ -1,2 +1,3 @@
- ./length.dhall sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461
+ missing
+ sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461
? ./length.dhall
diff --git a/dhall-lang/Prelude/List/map b/dhall-lang/Prelude/List/map
--- a/dhall-lang/Prelude/List/map
+++ b/dhall-lang/Prelude/List/map
@@ -1,2 +1,3 @@
- ./map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ./map.dhall
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
--- a/dhall-lang/Prelude/List/null
+++ b/dhall-lang/Prelude/List/null
@@ -1,2 +1,3 @@
- ./null.dhall sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80
+ missing
+ sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80
? ./null.dhall
diff --git a/dhall-lang/Prelude/List/package.dhall b/dhall-lang/Prelude/List/package.dhall
--- a/dhall-lang/Prelude/List/package.dhall
+++ b/dhall-lang/Prelude/List/package.dhall
@@ -1,82 +1,125 @@
{ all =
- ./all.dhall sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15
+ missing
+ sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15
? ./all.dhall
, any =
- ./any.dhall sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8
+ missing
+ sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8
? ./any.dhall
, build =
- ./build.dhall sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42
+ missing
+ sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42
? ./build.dhall
, concat =
- ./concat.dhall sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b
+ missing
+ sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b
? ./concat.dhall
, concatMap =
- ./concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
+ missing
+ sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
? ./concatMap.dhall
, default =
- ./default.dhall sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379
+ missing
+ sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379
? ./default.dhall
, drop =
- ./drop.dhall sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf
+ missing
+ sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf
? ./drop.dhall
, empty =
- ./empty.dhall sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147
+ missing
+ sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147
? ./empty.dhall
, filter =
- ./filter.dhall sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6
+ missing
+ sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6
? ./filter.dhall
+, filterMap =
+ missing
+ sha256:94b7ed4204d1c79aaf55527ef51024e7085b8dd2896952cffbd12d8f95e16f46
+ ? ./filterMap.dhall
, fold =
- ./fold.dhall sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814
+ missing
+ sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814
? ./fold.dhall
+, foldLeft =
+ missing
+ sha256:3c6ab57950fe644906b7bbdef0b9523440b6ee17773ebb8cbd41ffacb8bfab61
+ ? ./foldLeft.dhall
, generate =
- ./generate.dhall sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4
+ missing
+ sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4
? ./generate.dhall
, head =
- ./head.dhall sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026
+ missing
+ sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026
? ./head.dhall
, index =
- ./index.dhall sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63
+ missing
+ sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63
? ./index.dhall
, indexed =
- ./indexed.dhall sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f
+ missing
+ sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f
? ./indexed.dhall
, iterate =
- ./iterate.dhall sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26
+ missing
+ sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26
? ./iterate.dhall
, last =
- ./last.dhall sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d
+ missing
+ sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d
? ./last.dhall
, length =
- ./length.dhall sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461
+ missing
+ sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461
? ./length.dhall
, map =
- ./map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ./map.dhall
+, mapMaybe =
+ missing
+ sha256:6f3c4f8c94577b46e7d30f8df7e82a269b0ad0a7e18c0f0370f243fd1127e77f
+ ? ./mapMaybe.dhall
+, mapWithIndex =
+ missing
+ sha256:98599e0b55c5d3ae75264ba90657c6f68c7ce32834bd12b215acaea711eed6eb
+ ? ./mapWithIndex.dhall
, null =
- ./null.dhall sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80
+ missing
+ sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80
? ./null.dhall
, partition =
- ./partition.dhall sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03
+ missing
+ sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03
? ./partition.dhall
, replicate =
- ./replicate.dhall sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
+ missing
+ sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
? ./replicate.dhall
, reverse =
- ./reverse.dhall sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d
+ missing
+ sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d
? ./reverse.dhall
, shifted =
- ./shifted.dhall sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe
+ missing
+ sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe
? ./shifted.dhall
, take =
- ./take.dhall sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa
+ missing
+ sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa
? ./take.dhall
, unpackOptionals =
- ./unpackOptionals.dhall sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4
+ missing
+ sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4
? ./unpackOptionals.dhall
, unzip =
- ./unzip.dhall sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9
+ missing
+ sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9
? ./unzip.dhall
, zip =
- ./zip.dhall sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da
+ missing
+ sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da
? ./zip.dhall
}
diff --git a/dhall-lang/Prelude/List/partition b/dhall-lang/Prelude/List/partition
--- a/dhall-lang/Prelude/List/partition
+++ b/dhall-lang/Prelude/List/partition
@@ -1,2 +1,3 @@
- ./partition.dhall sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03
+ missing
+ sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03
? ./partition.dhall
diff --git a/dhall-lang/Prelude/List/replicate b/dhall-lang/Prelude/List/replicate
--- a/dhall-lang/Prelude/List/replicate
+++ b/dhall-lang/Prelude/List/replicate
@@ -1,2 +1,3 @@
- ./replicate.dhall sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
+ missing
+ sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
? ./replicate.dhall
diff --git a/dhall-lang/Prelude/List/reverse b/dhall-lang/Prelude/List/reverse
--- a/dhall-lang/Prelude/List/reverse
+++ b/dhall-lang/Prelude/List/reverse
@@ -1,2 +1,3 @@
- ./reverse.dhall sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d
+ missing
+ sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d
? ./reverse.dhall
diff --git a/dhall-lang/Prelude/List/shifted b/dhall-lang/Prelude/List/shifted
--- a/dhall-lang/Prelude/List/shifted
+++ b/dhall-lang/Prelude/List/shifted
@@ -1,2 +1,3 @@
- ./shifted.dhall sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe
+ missing
+ sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe
? ./shifted.dhall
diff --git a/dhall-lang/Prelude/List/take b/dhall-lang/Prelude/List/take
--- a/dhall-lang/Prelude/List/take
+++ b/dhall-lang/Prelude/List/take
@@ -1,2 +1,3 @@
- ./take.dhall sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa
+ missing
+ sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa
? ./take.dhall
diff --git a/dhall-lang/Prelude/List/take.dhall b/dhall-lang/Prelude/List/take.dhall
--- a/dhall-lang/Prelude/List/take.dhall
+++ b/dhall-lang/Prelude/List/take.dhall
@@ -1,6 +1,7 @@
--| Truncate a list to the first `n` elements
let Natural/lessThan =
- ../Natural/lessThan.dhall sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
+ missing
+ sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
? ../Natural/lessThan.dhall
let take
diff --git a/dhall-lang/Prelude/List/unpackOptionals b/dhall-lang/Prelude/List/unpackOptionals
--- a/dhall-lang/Prelude/List/unpackOptionals
+++ b/dhall-lang/Prelude/List/unpackOptionals
@@ -1,2 +1,3 @@
- ./unpackOptionals.dhall sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4
+ missing
+ sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4
? ./unpackOptionals.dhall
diff --git a/dhall-lang/Prelude/List/unpackOptionals.dhall b/dhall-lang/Prelude/List/unpackOptionals.dhall
--- a/dhall-lang/Prelude/List/unpackOptionals.dhall
+++ b/dhall-lang/Prelude/List/unpackOptionals.dhall
@@ -1,16 +1,12 @@
--| Unpack Optionals in a List, omitting None items.
-
-let List/concatMap =
- ./concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
- ? ./concatMap.dhall
-
-let Optional/toList =
- ../Optional/toList.dhall sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4
- ? ../Optional/toList.dhall
+let List/filterMap =
+ missing
+ sha256:94b7ed4204d1c79aaf55527ef51024e7085b8dd2896952cffbd12d8f95e16f46
+ ? ./filterMap.dhall
let unpackOptionals
: ∀(a : Type) → ∀(l : List (Optional a)) → List a
- = λ(a : Type) → List/concatMap (Optional a) a (Optional/toList a)
+ = λ(a : Type) → List/filterMap (Optional a) a (λ(x : Optional a) → x)
let property1 =
λ(a : Type) → λ(x : a) → assert : unpackOptionals a [ Some x ] ≡ [ x ]
diff --git a/dhall-lang/Prelude/List/unzip b/dhall-lang/Prelude/List/unzip
--- a/dhall-lang/Prelude/List/unzip
+++ b/dhall-lang/Prelude/List/unzip
@@ -1,2 +1,3 @@
- ./unzip.dhall sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9
+ missing
+ sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9
? ./unzip.dhall
diff --git a/dhall-lang/Prelude/List/zip b/dhall-lang/Prelude/List/zip
--- a/dhall-lang/Prelude/List/zip
+++ b/dhall-lang/Prelude/List/zip
@@ -1,2 +1,3 @@
- ./zip.dhall sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da
+ missing
+ sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da
? ./zip.dhall
diff --git a/dhall-lang/Prelude/List/zip.dhall b/dhall-lang/Prelude/List/zip.dhall
--- a/dhall-lang/Prelude/List/zip.dhall
+++ b/dhall-lang/Prelude/List/zip.dhall
@@ -4,7 +4,8 @@
The resulting `List` will have the length of the shortest of its arguments.
-}
let List/index =
- ./index.dhall sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63
+ missing
+ sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63
? ./index.dhall
let zip
diff --git a/dhall-lang/Prelude/Location/Type b/dhall-lang/Prelude/Location/Type
--- a/dhall-lang/Prelude/Location/Type
+++ b/dhall-lang/Prelude/Location/Type
@@ -1,2 +1,3 @@
- ./Type.dhall sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529
+ missing
+ sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529
? ./Type.dhall
diff --git a/dhall-lang/Prelude/Location/Type.dhall b/dhall-lang/Prelude/Location/Type.dhall
--- a/dhall-lang/Prelude/Location/Type.dhall
+++ b/dhall-lang/Prelude/Location/Type.dhall
@@ -5,8 +5,7 @@
let example0 =
assert
- : missing sha256:f428188ff9d77ea15bc2bcd0da3f8ed81b304e175b07ade42a3b0fb02941b2aa as Location
- ? missing as Location
+ : missing as Location
≡ < Environment : Text
| Local : Text
| Missing
diff --git a/dhall-lang/Prelude/Location/package.dhall b/dhall-lang/Prelude/Location/package.dhall
--- a/dhall-lang/Prelude/Location/package.dhall
+++ b/dhall-lang/Prelude/Location/package.dhall
@@ -1,4 +1,5 @@
{ Type =
- ./Type.dhall sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529
+ missing
+ sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529
? ./Type.dhall
}
diff --git a/dhall-lang/Prelude/Map/Entry b/dhall-lang/Prelude/Map/Entry
--- a/dhall-lang/Prelude/Map/Entry
+++ b/dhall-lang/Prelude/Map/Entry
@@ -1,2 +1,3 @@
- ./Entry.dhall sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
+ missing
+ sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
? ./Entry.dhall
diff --git a/dhall-lang/Prelude/Map/Type b/dhall-lang/Prelude/Map/Type
--- a/dhall-lang/Prelude/Map/Type
+++ b/dhall-lang/Prelude/Map/Type
@@ -1,2 +1,3 @@
- ./Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type.dhall
diff --git a/dhall-lang/Prelude/Map/empty b/dhall-lang/Prelude/Map/empty
--- a/dhall-lang/Prelude/Map/empty
+++ b/dhall-lang/Prelude/Map/empty
@@ -1,2 +1,3 @@
- ./empty.dhall sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52
+ missing
+ sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52
? ./empty.dhall
diff --git a/dhall-lang/Prelude/Map/empty.dhall b/dhall-lang/Prelude/Map/empty.dhall
--- a/dhall-lang/Prelude/Map/empty.dhall
+++ b/dhall-lang/Prelude/Map/empty.dhall
@@ -1,6 +1,7 @@
--| An empty `Map` of the given key and value types
let Map =
- ./Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type.dhall
let empty
diff --git a/dhall-lang/Prelude/Map/keyText b/dhall-lang/Prelude/Map/keyText
--- a/dhall-lang/Prelude/Map/keyText
+++ b/dhall-lang/Prelude/Map/keyText
@@ -1,2 +1,3 @@
- ./keyText.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ./keyText.dhall
diff --git a/dhall-lang/Prelude/Map/keyValue b/dhall-lang/Prelude/Map/keyValue
--- a/dhall-lang/Prelude/Map/keyValue
+++ b/dhall-lang/Prelude/Map/keyValue
@@ -1,2 +1,3 @@
- ./keyValue.dhall sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
+ missing
+ sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
? ./keyValue.dhall
diff --git a/dhall-lang/Prelude/Map/keys b/dhall-lang/Prelude/Map/keys
--- a/dhall-lang/Prelude/Map/keys
+++ b/dhall-lang/Prelude/Map/keys
@@ -1,2 +1,3 @@
- ./keys.dhall sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7
+ missing
+ sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7
? ./keys.dhall
diff --git a/dhall-lang/Prelude/Map/keys.dhall b/dhall-lang/Prelude/Map/keys.dhall
--- a/dhall-lang/Prelude/Map/keys.dhall
+++ b/dhall-lang/Prelude/Map/keys.dhall
@@ -1,14 +1,17 @@
--| Get all of the keys of a `Map` as a `List`
let Map =
- ./Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type.dhall
let Entry =
- ./Entry.dhall sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
+ missing
+ sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
? ./Entry.dhall
let List/map =
- ../List/map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map
let keys
diff --git a/dhall-lang/Prelude/Map/map b/dhall-lang/Prelude/Map/map
--- a/dhall-lang/Prelude/Map/map
+++ b/dhall-lang/Prelude/Map/map
@@ -1,2 +1,3 @@
- ./map.dhall sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0
+ missing
+ sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0
? ./map.dhall
diff --git a/dhall-lang/Prelude/Map/map.dhall b/dhall-lang/Prelude/Map/map.dhall
--- a/dhall-lang/Prelude/Map/map.dhall
+++ b/dhall-lang/Prelude/Map/map.dhall
@@ -1,14 +1,17 @@
--| Transform a `Map` by applying a function to each value
let Map =
- ./Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type.dhall
let Entry =
- ./Entry.dhall sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
+ missing
+ sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
? ./Entry.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
let 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
--- a/dhall-lang/Prelude/Map/package.dhall
+++ b/dhall-lang/Prelude/Map/package.dhall
@@ -1,28 +1,41 @@
{ Type =
- ./Type sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type
, Entry =
- ./Entry sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
+ missing
+ sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
? ./Entry
, empty =
- ./empty sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52
+ missing
+ sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52
? ./empty
, keyText =
- ./keyText sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ./keyText
, keyValue =
- ./keyValue sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
+ missing
+ sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c
? ./keyValue
, keys =
- ./keys sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7
+ missing
+ sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7
? ./keys
, map =
- ./map sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0
+ missing
+ sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0
? ./map
+, mapMaybe =
+ missing
+ sha256:4ea58b720d7af38cef3ef07bef36e476caeed21032cd4a9dc733868a74d9a521
+ ? ./mapMaybe.dhall
, unpackOptionals =
- ./unpackOptionals.dhall sha256:66c3e6f6f81418cf99342e1dba739617c01af4b27c1ca5e2e1d7bce64a522e22
+ missing
+ sha256:66c3e6f6f81418cf99342e1dba739617c01af4b27c1ca5e2e1d7bce64a522e22
? ./unpackOptionals.dhall
, values =
- ./values sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8
+ missing
+ sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8
? ./values
}
diff --git a/dhall-lang/Prelude/Map/unpackOptionals.dhall b/dhall-lang/Prelude/Map/unpackOptionals.dhall
--- a/dhall-lang/Prelude/Map/unpackOptionals.dhall
+++ b/dhall-lang/Prelude/Map/unpackOptionals.dhall
@@ -1,16 +1,18 @@
--| Turn a `Map k (Optional v)` into a `Map k v` by dropping all
-- entries with value `None`.
-
let List/concatMap =
- ../List/concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
+ missing
+ sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64
? ../List/concatMap.dhall
let Map/Entry =
- ./Entry.dhall sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
+ missing
+ sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
? ./Entry.dhall
let Map/Type =
- ./Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type.dhall
let unpackOptionals
diff --git a/dhall-lang/Prelude/Map/values b/dhall-lang/Prelude/Map/values
--- a/dhall-lang/Prelude/Map/values
+++ b/dhall-lang/Prelude/Map/values
@@ -1,2 +1,3 @@
- ./values.dhall sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8
+ missing
+ sha256:ae02cfb06a9307cbecc06130e84fd0c7b96b7f1f11648961e1b030ec00940be8
? ./values.dhall
diff --git a/dhall-lang/Prelude/Map/values.dhall b/dhall-lang/Prelude/Map/values.dhall
--- a/dhall-lang/Prelude/Map/values.dhall
+++ b/dhall-lang/Prelude/Map/values.dhall
@@ -1,14 +1,17 @@
--| Get all of the values of a `Map` as a `List`
let Map =
- ./Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
+ missing
+ sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed
? ./Type.dhall
let Entry =
- ./Entry.dhall sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
+ missing
+ sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346
? ./Entry.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
let values
diff --git a/dhall-lang/Prelude/Monoid b/dhall-lang/Prelude/Monoid
--- a/dhall-lang/Prelude/Monoid
+++ b/dhall-lang/Prelude/Monoid
@@ -1,2 +1,3 @@
- ./Monoid.dhall sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af
+ missing
+ sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af
? ./Monoid.dhall
diff --git a/dhall-lang/Prelude/Natural/build b/dhall-lang/Prelude/Natural/build
--- a/dhall-lang/Prelude/Natural/build
+++ b/dhall-lang/Prelude/Natural/build
@@ -1,2 +1,3 @@
- ./build.dhall sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c
+ missing
+ sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c
? ./build.dhall
diff --git a/dhall-lang/Prelude/Natural/enumerate b/dhall-lang/Prelude/Natural/enumerate
--- a/dhall-lang/Prelude/Natural/enumerate
+++ b/dhall-lang/Prelude/Natural/enumerate
@@ -1,2 +1,3 @@
- ./enumerate.dhall sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3
+ missing
+ sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3
? ./enumerate.dhall
diff --git a/dhall-lang/Prelude/Natural/equal b/dhall-lang/Prelude/Natural/equal
--- a/dhall-lang/Prelude/Natural/equal
+++ b/dhall-lang/Prelude/Natural/equal
@@ -1,2 +1,3 @@
- ./equal.dhall sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60
+ missing
+ sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60
? ./equal.dhall
diff --git a/dhall-lang/Prelude/Natural/equal.dhall b/dhall-lang/Prelude/Natural/equal.dhall
--- a/dhall-lang/Prelude/Natural/equal.dhall
+++ b/dhall-lang/Prelude/Natural/equal.dhall
@@ -1,6 +1,7 @@
--| `equal` checks if two Naturals are equal.
let lessThanEqual =
- ./lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ./lessThanEqual.dhall
let equal
diff --git a/dhall-lang/Prelude/Natural/even b/dhall-lang/Prelude/Natural/even
--- a/dhall-lang/Prelude/Natural/even
+++ b/dhall-lang/Prelude/Natural/even
@@ -1,2 +1,3 @@
- ./even.dhall sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66
+ missing
+ sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66
? ./even.dhall
diff --git a/dhall-lang/Prelude/Natural/fold b/dhall-lang/Prelude/Natural/fold
--- a/dhall-lang/Prelude/Natural/fold
+++ b/dhall-lang/Prelude/Natural/fold
@@ -1,2 +1,3 @@
- ./fold.dhall sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06
+ missing
+ sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06
? ./fold.dhall
diff --git a/dhall-lang/Prelude/Natural/fold.dhall b/dhall-lang/Prelude/Natural/fold.dhall
--- a/dhall-lang/Prelude/Natural/fold.dhall
+++ b/dhall-lang/Prelude/Natural/fold.dhall
@@ -12,24 +12,17 @@
natural
= Natural/fold
-let example0 = assert : fold 3 Natural (λ(x : Natural) → 5 * x) 1 ≡ 125
+let example0 = assert : fold 3 Text (λ(x : Text) → "A" ++ x) "B" ≡ "AAAB"
let example1 =
- assert
- : (λ(zero : Natural) → fold 3 Natural (λ(x : Natural) → 5 * x) zero)
- ≡ (λ(zero : Natural) → 5 * (5 * (5 * zero)))
+ λ(zero : Text) →
+ assert
+ : fold 3 Text (λ(x : Text) → "A" ++ x) zero
+ ≡ "A" ++ ("A" ++ ("A" ++ zero))
let example2 =
- assert
- : ( λ(natural : Type) →
- λ(succ : natural → natural) →
- λ(zero : natural) →
- fold 3 natural succ zero
- )
- ≡ ( λ(natural : Type) →
- λ(succ : natural → natural) →
- λ(zero : natural) →
- succ (succ (succ zero))
- )
+ λ(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
--- a/dhall-lang/Prelude/Natural/greaterThan
+++ b/dhall-lang/Prelude/Natural/greaterThan
@@ -1,2 +1,3 @@
- ./greaterThan.dhall sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c
+ missing
+ sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c
? ./greaterThan.dhall
diff --git a/dhall-lang/Prelude/Natural/greaterThan.dhall b/dhall-lang/Prelude/Natural/greaterThan.dhall
--- a/dhall-lang/Prelude/Natural/greaterThan.dhall
+++ b/dhall-lang/Prelude/Natural/greaterThan.dhall
@@ -1,6 +1,7 @@
--| `greaterThan` checks if one Natural is strictly greater than another.
let lessThan =
- ./lessThan.dhall sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
+ missing
+ sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
? ./lessThan.dhall
let greaterThan
diff --git a/dhall-lang/Prelude/Natural/greaterThanEqual b/dhall-lang/Prelude/Natural/greaterThanEqual
--- a/dhall-lang/Prelude/Natural/greaterThanEqual
+++ b/dhall-lang/Prelude/Natural/greaterThanEqual
@@ -1,2 +1,3 @@
- ./greaterThanEqual.dhall sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
+ missing
+ sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
? ./greaterThanEqual.dhall
diff --git a/dhall-lang/Prelude/Natural/greaterThanEqual.dhall b/dhall-lang/Prelude/Natural/greaterThanEqual.dhall
--- a/dhall-lang/Prelude/Natural/greaterThanEqual.dhall
+++ b/dhall-lang/Prelude/Natural/greaterThanEqual.dhall
@@ -2,7 +2,8 @@
`greaterThanEqual` checks if one Natural is greater than or equal to another.
-}
let lessThanEqual =
- ./lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ./lessThanEqual.dhall
let greaterThanEqual
diff --git a/dhall-lang/Prelude/Natural/isZero b/dhall-lang/Prelude/Natural/isZero
--- a/dhall-lang/Prelude/Natural/isZero
+++ b/dhall-lang/Prelude/Natural/isZero
@@ -1,2 +1,3 @@
- ./isZero.dhall sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1
+ missing
+ sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1
? ./isZero.dhall
diff --git a/dhall-lang/Prelude/Natural/lessThan b/dhall-lang/Prelude/Natural/lessThan
--- a/dhall-lang/Prelude/Natural/lessThan
+++ b/dhall-lang/Prelude/Natural/lessThan
@@ -1,2 +1,3 @@
- ./lessThan.dhall sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
+ missing
+ sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
? ./lessThan.dhall
diff --git a/dhall-lang/Prelude/Natural/lessThan.dhall b/dhall-lang/Prelude/Natural/lessThan.dhall
--- a/dhall-lang/Prelude/Natural/lessThan.dhall
+++ b/dhall-lang/Prelude/Natural/lessThan.dhall
@@ -1,10 +1,12 @@
--| `lessThan` checks if one Natural is strictly less than another.
let greaterThanEqual =
- ./greaterThanEqual.dhall sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
+ missing
+ sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
? ./greaterThanEqual.dhall
let Bool/not =
- ../Bool/not.dhall sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
+ missing
+ sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4
? ../Bool/not.dhall
let lessThan
diff --git a/dhall-lang/Prelude/Natural/lessThanEqual b/dhall-lang/Prelude/Natural/lessThanEqual
--- a/dhall-lang/Prelude/Natural/lessThanEqual
+++ b/dhall-lang/Prelude/Natural/lessThanEqual
@@ -1,2 +1,3 @@
- ./lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ./lessThanEqual.dhall
diff --git a/dhall-lang/Prelude/Natural/listMax b/dhall-lang/Prelude/Natural/listMax
--- a/dhall-lang/Prelude/Natural/listMax
+++ b/dhall-lang/Prelude/Natural/listMax
@@ -1,2 +1,3 @@
- ./listMax.dhall sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472
+ missing
+ sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472
? ./listMax.dhall
diff --git a/dhall-lang/Prelude/Natural/listMax.dhall b/dhall-lang/Prelude/Natural/listMax.dhall
--- a/dhall-lang/Prelude/Natural/listMax.dhall
+++ b/dhall-lang/Prelude/Natural/listMax.dhall
@@ -3,11 +3,13 @@
`List` is empty
-}
let max =
- ./max.dhall sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7
+ missing
+ sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7
? ./max.dhall
let Optional/map =
- ../Optional/map.dhall sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
+ missing
+ sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
? ../Optional/map.dhall
let listMax
diff --git a/dhall-lang/Prelude/Natural/listMin b/dhall-lang/Prelude/Natural/listMin
--- a/dhall-lang/Prelude/Natural/listMin
+++ b/dhall-lang/Prelude/Natural/listMin
@@ -1,2 +1,3 @@
- ./listMin.dhall sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6
+ missing
+ sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6
? ./listMin.dhall
diff --git a/dhall-lang/Prelude/Natural/listMin.dhall b/dhall-lang/Prelude/Natural/listMin.dhall
--- a/dhall-lang/Prelude/Natural/listMin.dhall
+++ b/dhall-lang/Prelude/Natural/listMin.dhall
@@ -3,11 +3,13 @@
`List` is empty
-}
let min =
- ./min.dhall sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710
+ missing
+ sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710
? ./min.dhall
let Optional/map =
- ../Optional/map.dhall sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
+ missing
+ sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
? ../Optional/map.dhall
let listMin
diff --git a/dhall-lang/Prelude/Natural/max b/dhall-lang/Prelude/Natural/max
--- a/dhall-lang/Prelude/Natural/max
+++ b/dhall-lang/Prelude/Natural/max
@@ -1,2 +1,3 @@
- ./max.dhall sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7
+ missing
+ sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7
? ./max.dhall
diff --git a/dhall-lang/Prelude/Natural/max.dhall b/dhall-lang/Prelude/Natural/max.dhall
--- a/dhall-lang/Prelude/Natural/max.dhall
+++ b/dhall-lang/Prelude/Natural/max.dhall
@@ -1,6 +1,7 @@
--| `max a b` returns the larger of `a` or `b`
let lessThanEqual =
- ./lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ./lessThanEqual.dhall
let max
diff --git a/dhall-lang/Prelude/Natural/min b/dhall-lang/Prelude/Natural/min
--- a/dhall-lang/Prelude/Natural/min
+++ b/dhall-lang/Prelude/Natural/min
@@ -1,2 +1,3 @@
- ./min.dhall sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710
+ missing
+ sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710
? ./min.dhall
diff --git a/dhall-lang/Prelude/Natural/min.dhall b/dhall-lang/Prelude/Natural/min.dhall
--- a/dhall-lang/Prelude/Natural/min.dhall
+++ b/dhall-lang/Prelude/Natural/min.dhall
@@ -1,6 +1,7 @@
--| `min a b` returns the smaller of `a` or `b`
let lessThanEqual =
- ./lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ./lessThanEqual.dhall
let min
diff --git a/dhall-lang/Prelude/Natural/odd b/dhall-lang/Prelude/Natural/odd
--- a/dhall-lang/Prelude/Natural/odd
+++ b/dhall-lang/Prelude/Natural/odd
@@ -1,2 +1,3 @@
- ./odd.dhall sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5
+ missing
+ sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5
? ./odd.dhall
diff --git a/dhall-lang/Prelude/Natural/package.dhall b/dhall-lang/Prelude/Natural/package.dhall
--- a/dhall-lang/Prelude/Natural/package.dhall
+++ b/dhall-lang/Prelude/Natural/package.dhall
@@ -1,67 +1,89 @@
{ build =
- ./build.dhall sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c
+ missing
+ sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c
? ./build.dhall
, enumerate =
- ./enumerate.dhall sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3
+ missing
+ sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3
? ./enumerate.dhall
, even =
- ./even.dhall sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66
+ missing
+ sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66
? ./even.dhall
, fold =
- ./fold.dhall sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06
+ missing
+ sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06
? ./fold.dhall
, isZero =
- ./isZero.dhall sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1
+ missing
+ sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1
? ./isZero.dhall
, odd =
- ./odd.dhall sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5
+ missing
+ sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5
? ./odd.dhall
, product =
- ./product.dhall sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6
+ missing
+ sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6
? ./product.dhall
, sum =
- ./sum.dhall sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037
+ missing
+ sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037
? ./sum.dhall
, show =
- ./show.dhall sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21
+ missing
+ sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21
? ./show.dhall
, toDouble =
- ./toDouble.dhall sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81
+ missing
+ sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81
? ./toDouble.dhall
, toInteger =
- ./toInteger.dhall sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f
+ missing
+ sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f
? ./toInteger.dhall
, lessThan =
- ./lessThan.dhall sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
+ missing
+ sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c
? ./lessThan.dhall
, lessThanEqual =
- ./lessThanEqual.dhall sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
+ missing
+ sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99
? ./lessThanEqual.dhall
, equal =
- ./equal.dhall sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60
+ missing
+ sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60
? ./equal.dhall
, greaterThanEqual =
- ./greaterThanEqual.dhall sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
+ missing
+ sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
? ./greaterThanEqual.dhall
, greaterThan =
- ./greaterThan.dhall sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c
+ missing
+ sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c
? ./greaterThan.dhall
, min =
- ./min.dhall sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710
+ missing
+ sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710
? ./min.dhall
, max =
- ./max.dhall sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7
+ missing
+ sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7
? ./max.dhall
, listMin =
- ./listMin.dhall sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6
+ missing
+ sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6
? ./listMin.dhall
, listMax =
- ./listMax.dhall sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472
+ missing
+ sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472
? ./listMax.dhall
, sort =
- ./sort.dhall sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260
+ missing
+ sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260
? ./sort.dhall
, subtract =
- ./subtract.dhall sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745
+ missing
+ sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745
? ./subtract.dhall
}
diff --git a/dhall-lang/Prelude/Natural/product b/dhall-lang/Prelude/Natural/product
--- a/dhall-lang/Prelude/Natural/product
+++ b/dhall-lang/Prelude/Natural/product
@@ -1,2 +1,3 @@
- ./product.dhall sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6
+ missing
+ sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6
? ./product.dhall
diff --git a/dhall-lang/Prelude/Natural/show b/dhall-lang/Prelude/Natural/show
--- a/dhall-lang/Prelude/Natural/show
+++ b/dhall-lang/Prelude/Natural/show
@@ -1,2 +1,3 @@
- ./show.dhall sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21
+ missing
+ sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21
? ./show.dhall
diff --git a/dhall-lang/Prelude/Natural/sort b/dhall-lang/Prelude/Natural/sort
--- a/dhall-lang/Prelude/Natural/sort
+++ b/dhall-lang/Prelude/Natural/sort
@@ -1,2 +1,3 @@
- ./sort.dhall sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260
+ missing
+ sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260
? ./sort.dhall
diff --git a/dhall-lang/Prelude/Natural/sort.dhall b/dhall-lang/Prelude/Natural/sort.dhall
--- a/dhall-lang/Prelude/Natural/sort.dhall
+++ b/dhall-lang/Prelude/Natural/sort.dhall
@@ -1,14 +1,17 @@
--| `sort` sorts a `List` of `Natural`s in ascending order
let greaterThanEqual =
- ./greaterThanEqual.dhall sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
+ missing
+ sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4
? ./greaterThanEqual.dhall
let listMin =
- ./listMin.dhall sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6
+ missing
+ sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6
? ./listMin.dhall
let List/partition =
- ../List/partition.dhall sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03
+ missing
+ sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03
? ../List/partition.dhall
let Accumulator = { sorted : List Natural, rest : List Natural }
diff --git a/dhall-lang/Prelude/Natural/subtract b/dhall-lang/Prelude/Natural/subtract
--- a/dhall-lang/Prelude/Natural/subtract
+++ b/dhall-lang/Prelude/Natural/subtract
@@ -1,2 +1,3 @@
- ./subtract.dhall sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745
+ missing
+ sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745
? ./subtract.dhall
diff --git a/dhall-lang/Prelude/Natural/sum b/dhall-lang/Prelude/Natural/sum
--- a/dhall-lang/Prelude/Natural/sum
+++ b/dhall-lang/Prelude/Natural/sum
@@ -1,2 +1,3 @@
- ./sum.dhall sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037
+ missing
+ sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037
? ./sum.dhall
diff --git a/dhall-lang/Prelude/Natural/toDouble b/dhall-lang/Prelude/Natural/toDouble
--- a/dhall-lang/Prelude/Natural/toDouble
+++ b/dhall-lang/Prelude/Natural/toDouble
@@ -1,2 +1,3 @@
- ./toDouble.dhall sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81
+ missing
+ sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81
? ./toDouble.dhall
diff --git a/dhall-lang/Prelude/Natural/toInteger b/dhall-lang/Prelude/Natural/toInteger
--- a/dhall-lang/Prelude/Natural/toInteger
+++ b/dhall-lang/Prelude/Natural/toInteger
@@ -1,2 +1,3 @@
- ./toInteger.dhall sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f
+ missing
+ sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f
? ./toInteger.dhall
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
--- a/dhall-lang/Prelude/Optional/all
+++ b/dhall-lang/Prelude/Optional/all
@@ -1,2 +1,3 @@
- ./all.dhall sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695
+ missing
+ sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695
? ./all.dhall
diff --git a/dhall-lang/Prelude/Optional/any b/dhall-lang/Prelude/Optional/any
--- a/dhall-lang/Prelude/Optional/any
+++ b/dhall-lang/Prelude/Optional/any
@@ -1,2 +1,3 @@
- ./any.dhall sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435
+ missing
+ sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435
? ./any.dhall
diff --git a/dhall-lang/Prelude/Optional/build b/dhall-lang/Prelude/Optional/build
--- a/dhall-lang/Prelude/Optional/build
+++ b/dhall-lang/Prelude/Optional/build
@@ -1,2 +1,3 @@
- ./build.dhall sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1
+ missing
+ sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1
? ./build.dhall
diff --git a/dhall-lang/Prelude/Optional/concat b/dhall-lang/Prelude/Optional/concat
--- a/dhall-lang/Prelude/Optional/concat
+++ b/dhall-lang/Prelude/Optional/concat
@@ -1,2 +1,3 @@
- ./concat.dhall sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a
+ missing
+ sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a
? ./concat.dhall
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
--- a/dhall-lang/Prelude/Optional/default
+++ b/dhall-lang/Prelude/Optional/default
@@ -1,2 +1,3 @@
- ./default.dhall sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad
+ missing
+ sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad
? ./default.dhall
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
--- a/dhall-lang/Prelude/Optional/filter
+++ b/dhall-lang/Prelude/Optional/filter
@@ -1,2 +1,3 @@
- ./filter.dhall sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83
+ missing
+ sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83
? ./filter.dhall
diff --git a/dhall-lang/Prelude/Optional/fold b/dhall-lang/Prelude/Optional/fold
--- a/dhall-lang/Prelude/Optional/fold
+++ b/dhall-lang/Prelude/Optional/fold
@@ -1,2 +1,3 @@
- ./fold.dhall sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf
+ missing
+ sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf
? ./fold.dhall
diff --git a/dhall-lang/Prelude/Optional/fold.dhall b/dhall-lang/Prelude/Optional/fold.dhall
--- a/dhall-lang/Prelude/Optional/fold.dhall
+++ b/dhall-lang/Prelude/Optional/fold.dhall
@@ -13,9 +13,8 @@
λ(none : optional) →
merge { Some = some, None = none } o
-let example0 = assert : fold Natural (Some 2) Natural (λ(x : Natural) → x) 0 ≡ 2
+let example0 = assert : fold Natural (Some 2) Text Natural/show "0" ≡ "2"
-let example1 =
- assert : fold Natural (None Natural) Natural (λ(x : Natural) → x) 0 ≡ 0
+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
--- a/dhall-lang/Prelude/Optional/head
+++ b/dhall-lang/Prelude/Optional/head
@@ -1,2 +1,3 @@
- ./head.dhall sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c
+ missing
+ sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c
? ./head.dhall
diff --git a/dhall-lang/Prelude/Optional/last b/dhall-lang/Prelude/Optional/last
--- a/dhall-lang/Prelude/Optional/last
+++ b/dhall-lang/Prelude/Optional/last
@@ -1,2 +1,3 @@
- ./last.dhall sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707
+ missing
+ sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707
? ./last.dhall
diff --git a/dhall-lang/Prelude/Optional/length b/dhall-lang/Prelude/Optional/length
--- a/dhall-lang/Prelude/Optional/length
+++ b/dhall-lang/Prelude/Optional/length
@@ -1,2 +1,3 @@
- ./length.dhall sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85
+ missing
+ sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85
? ./length.dhall
diff --git a/dhall-lang/Prelude/Optional/map b/dhall-lang/Prelude/Optional/map
--- a/dhall-lang/Prelude/Optional/map
+++ b/dhall-lang/Prelude/Optional/map
@@ -1,2 +1,3 @@
- ./map.dhall sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
+ missing
+ sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
? ./map.dhall
diff --git a/dhall-lang/Prelude/Optional/null b/dhall-lang/Prelude/Optional/null
--- a/dhall-lang/Prelude/Optional/null
+++ b/dhall-lang/Prelude/Optional/null
@@ -1,2 +1,3 @@
- ./null.dhall sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc
+ missing
+ sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc
? ./null.dhall
diff --git a/dhall-lang/Prelude/Optional/package.dhall b/dhall-lang/Prelude/Optional/package.dhall
--- a/dhall-lang/Prelude/Optional/package.dhall
+++ b/dhall-lang/Prelude/Optional/package.dhall
@@ -1,43 +1,65 @@
{ all =
- ./all.dhall sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695
+ missing
+ sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695
? ./all.dhall
, any =
- ./any.dhall sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435
+ missing
+ sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435
? ./any.dhall
, build =
- ./build.dhall sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1
+ missing
+ sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1
? ./build.dhall
, concat =
- ./concat.dhall sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a
+ missing
+ sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a
? ./concat.dhall
+, concatMap =
+ missing
+ sha256:c06ae93e900a99299c9b4ec4912ca5395a0103ea88292205b08dd7e345632818
+ ? ./concatMap.dhall
, default =
- ./default.dhall sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad
+ missing
+ sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad
? ./default.dhall
+, equal =
+ missing
+ sha256:5411888399fe9c6720f7f3b59caf5eff3e8e8c30402d09f34e46a4457649a35a
+ ? ./equal.dhall
, filter =
- ./filter.dhall sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83
+ missing
+ sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83
? ./filter.dhall
, fold =
- ./fold.dhall sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf
+ missing
+ sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf
? ./fold.dhall
, head =
- ./head.dhall sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c
+ missing
+ sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c
? ./head.dhall
, last =
- ./last.dhall sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707
+ missing
+ sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707
? ./last.dhall
, length =
- ./length.dhall sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85
+ missing
+ sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85
? ./length.dhall
, map =
- ./map.dhall sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
+ missing
+ sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa
? ./map.dhall
, null =
- ./null.dhall sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc
+ missing
+ sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc
? ./null.dhall
, toList =
- ./toList.dhall sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4
+ missing
+ sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4
? ./toList.dhall
, unzip =
- ./unzip.dhall sha256:d016c01ba91657a2f35609aa29087963d0f506bab0f41d5e8b7cd289dff39708
+ missing
+ sha256:d016c01ba91657a2f35609aa29087963d0f506bab0f41d5e8b7cd289dff39708
? ./unzip.dhall
}
diff --git a/dhall-lang/Prelude/Optional/toList b/dhall-lang/Prelude/Optional/toList
--- a/dhall-lang/Prelude/Optional/toList
+++ b/dhall-lang/Prelude/Optional/toList
@@ -1,2 +1,3 @@
- ./toList.dhall sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4
+ missing
+ sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4
? ./toList.dhall
diff --git a/dhall-lang/Prelude/Optional/unzip b/dhall-lang/Prelude/Optional/unzip
--- a/dhall-lang/Prelude/Optional/unzip
+++ b/dhall-lang/Prelude/Optional/unzip
@@ -1,2 +1,3 @@
- ./unzip.dhall sha256:d016c01ba91657a2f35609aa29087963d0f506bab0f41d5e8b7cd289dff39708
+ missing
+ sha256:d016c01ba91657a2f35609aa29087963d0f506bab0f41d5e8b7cd289dff39708
? ./unzip.dhall
diff --git a/dhall-lang/Prelude/Text/concat b/dhall-lang/Prelude/Text/concat
--- a/dhall-lang/Prelude/Text/concat
+++ b/dhall-lang/Prelude/Text/concat
@@ -1,2 +1,3 @@
- ./concat.dhall sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
+ missing
+ sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
? ./concat.dhall
diff --git a/dhall-lang/Prelude/Text/concatMap b/dhall-lang/Prelude/Text/concatMap
--- a/dhall-lang/Prelude/Text/concatMap
+++ b/dhall-lang/Prelude/Text/concatMap
@@ -1,2 +1,3 @@
- ./concatMap.dhall sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
+ missing
+ sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
? ./concatMap.dhall
diff --git a/dhall-lang/Prelude/Text/concatMapSep b/dhall-lang/Prelude/Text/concatMapSep
--- a/dhall-lang/Prelude/Text/concatMapSep
+++ b/dhall-lang/Prelude/Text/concatMapSep
@@ -1,2 +1,3 @@
- ./concatMapSep.dhall sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840
+ missing
+ sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840
? ./concatMapSep.dhall
diff --git a/dhall-lang/Prelude/Text/concatSep b/dhall-lang/Prelude/Text/concatSep
--- a/dhall-lang/Prelude/Text/concatSep
+++ b/dhall-lang/Prelude/Text/concatSep
@@ -1,2 +1,3 @@
- ./concatSep.dhall sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58
+ missing
+ sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58
? ./concatSep.dhall
diff --git a/dhall-lang/Prelude/Text/default b/dhall-lang/Prelude/Text/default
--- a/dhall-lang/Prelude/Text/default
+++ b/dhall-lang/Prelude/Text/default
@@ -1,2 +1,3 @@
- ./default.dhall sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf
+ missing
+ sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf
? ./default.dhall
diff --git a/dhall-lang/Prelude/Text/defaultMap b/dhall-lang/Prelude/Text/defaultMap
--- a/dhall-lang/Prelude/Text/defaultMap
+++ b/dhall-lang/Prelude/Text/defaultMap
@@ -1,2 +1,3 @@
- ./defaultMap.dhall sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588
+ missing
+ sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588
? ./defaultMap.dhall
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
--- a/dhall-lang/Prelude/Text/package.dhall
+++ b/dhall-lang/Prelude/Text/package.dhall
@@ -1,28 +1,53 @@
{ concat =
- ./concat.dhall sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
+ missing
+ sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
? ./concat.dhall
, concatMap =
- ./concatMap.dhall sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
+ missing
+ sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
? ./concatMap.dhall
, concatMapSep =
- ./concatMapSep.dhall sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840
+ missing
+ sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840
? ./concatMapSep.dhall
, concatSep =
- ./concatSep.dhall sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58
+ missing
+ sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58
? ./concatSep.dhall
, default =
- ./default.dhall sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf
+ missing
+ sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf
? ./default.dhall
, defaultMap =
- ./defaultMap.dhall sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588
+ missing
+ sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588
? ./defaultMap.dhall
+, lowerASCII =
+ missing
+ sha256:26b076651120b907e869396bd3dc16271f2e12433062b2f26f296968a69515e7
+ ? ./lowerASCII.dhall
+, replace =
+ missing
+ sha256:7d132df0e091a43817bba8afa06d1bb487ee51c091430404ad6f8c78bc0328a6
+ ? ./replace.dhall
, replicate =
- ./replicate.dhall sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f
+ missing
+ sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f
? ./replicate.dhall
+, shell-escape =
+ missing
+ sha256:d53521b3f478cb18a7d63730bc0e3153c2124b70d6ac9a1f610ce7db67cfc7a2
+ ? ./shell-escape.dhall
, show =
- ./show.dhall sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784
+ missing
+ sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784
? ./show.dhall
, spaces =
- ./spaces.dhall sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc
+ missing
+ sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc
? ./spaces.dhall
+, upperASCII =
+ missing
+ sha256:45ae4fbd814b0474e65c28a4ee92b23b979892fa5bb73730bc99675ae790ca29
+ ? ./upperASCII.dhall
}
diff --git a/dhall-lang/Prelude/Text/replicate b/dhall-lang/Prelude/Text/replicate
--- a/dhall-lang/Prelude/Text/replicate
+++ b/dhall-lang/Prelude/Text/replicate
@@ -1,2 +1,3 @@
- ./replicate.dhall sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f
+ missing
+ sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f
? ./replicate.dhall
diff --git a/dhall-lang/Prelude/Text/replicate.dhall b/dhall-lang/Prelude/Text/replicate.dhall
--- a/dhall-lang/Prelude/Text/replicate.dhall
+++ b/dhall-lang/Prelude/Text/replicate.dhall
@@ -1,11 +1,12 @@
--| Build a Text by copying the given Text the specified number of times
-
let concat =
- ./concat.dhall sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
+ missing
+ sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
? ./concat.dhall
let List/replicate =
- ../List/replicate.dhall sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
+ missing
+ sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
? ../List/replicate.dhall
let 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
--- a/dhall-lang/Prelude/Text/show
+++ b/dhall-lang/Prelude/Text/show
@@ -1,2 +1,3 @@
- ./show.dhall sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784
+ missing
+ sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784
? ./show.dhall
diff --git a/dhall-lang/Prelude/Text/spaces b/dhall-lang/Prelude/Text/spaces
--- a/dhall-lang/Prelude/Text/spaces
+++ b/dhall-lang/Prelude/Text/spaces
@@ -1,2 +1,3 @@
- ./spaces.dhall sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc
+ missing
+ sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc
? ./spaces.dhall
diff --git a/dhall-lang/Prelude/Text/spaces.dhall b/dhall-lang/Prelude/Text/spaces.dhall
--- a/dhall-lang/Prelude/Text/spaces.dhall
+++ b/dhall-lang/Prelude/Text/spaces.dhall
@@ -4,9 +4,9 @@
This function is particularly helpful when trying to generate Text where
whitespace is significant, i.e. with nested indentation.
-}
-
let replicate =
- ./replicate.dhall sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f
+ missing
+ sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f
? ./replicate.dhall
let 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
--- a/dhall-lang/Prelude/XML/Type
+++ b/dhall-lang/Prelude/XML/Type
@@ -1,2 +1,3 @@
- ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c
+ missing
+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9
? ./Type.dhall
diff --git a/dhall-lang/Prelude/XML/Type.dhall b/dhall-lang/Prelude/XML/Type.dhall
--- a/dhall-lang/Prelude/XML/Type.dhall
+++ b/dhall-lang/Prelude/XML/Type.dhall
@@ -15,6 +15,8 @@
→ λ ( xml
: { text :
Text → XML
+ , rawText :
+ Text → XML
, element :
{ attributes :
List { mapKey : Text, mapValue : Text }
@@ -44,12 +46,12 @@
}
```
-}
-
let XML/Type
: Type
= ∀(XML : Type) →
∀ ( xml
: { text : Text → XML
+ , rawText : Text → XML
, element :
{ attributes : List { mapKey : Text, mapValue : Text }
, content : List XML
diff --git a/dhall-lang/Prelude/XML/attribute b/dhall-lang/Prelude/XML/attribute
--- a/dhall-lang/Prelude/XML/attribute
+++ b/dhall-lang/Prelude/XML/attribute
@@ -1,2 +1,3 @@
- ./attribute.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ./attribute.dhall
diff --git a/dhall-lang/Prelude/XML/attribute.dhall b/dhall-lang/Prelude/XML/attribute.dhall
--- a/dhall-lang/Prelude/XML/attribute.dhall
+++ b/dhall-lang/Prelude/XML/attribute.dhall
@@ -1,5 +1,4 @@
--| 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 }
diff --git a/dhall-lang/Prelude/XML/element b/dhall-lang/Prelude/XML/element
--- a/dhall-lang/Prelude/XML/element
+++ b/dhall-lang/Prelude/XML/element
@@ -1,2 +1,3 @@
- ./element.dhall sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b
+ missing
+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9
? ./element.dhall
diff --git a/dhall-lang/Prelude/XML/element.dhall b/dhall-lang/Prelude/XML/element.dhall
--- a/dhall-lang/Prelude/XML/element.dhall
+++ b/dhall-lang/Prelude/XML/element.dhall
@@ -18,14 +18,14 @@
= ""
```
-}
-
-
let XML =
- ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c
+ missing
+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9
? ./Type.dhall
let List/map =
- ../List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
+ missing
+ sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680
? ../List/map.dhall
let Args =
@@ -41,6 +41,7 @@
λ(XML : Type) →
λ ( xml
: { text : Text → XML
+ , rawText : Text → XML
, element :
{ attributes : List { mapKey : Text, mapValue : Text }
, content : List XML
diff --git a/dhall-lang/Prelude/XML/emptyAttributes b/dhall-lang/Prelude/XML/emptyAttributes
--- a/dhall-lang/Prelude/XML/emptyAttributes
+++ b/dhall-lang/Prelude/XML/emptyAttributes
@@ -1,2 +1,3 @@
- ./emptyAttributes.dhall sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5
+ missing
+ sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5
? ./emptyAttributes.dhall
diff --git a/dhall-lang/Prelude/XML/emptyAttributes.dhall b/dhall-lang/Prelude/XML/emptyAttributes.dhall
--- a/dhall-lang/Prelude/XML/emptyAttributes.dhall
+++ b/dhall-lang/Prelude/XML/emptyAttributes.dhall
@@ -1,3 +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
--- a/dhall-lang/Prelude/XML/leaf
+++ b/dhall-lang/Prelude/XML/leaf
@@ -1,2 +1,3 @@
- ./leaf.dhall sha256:4383e4fc4bf6a29ac2052776972eb59d5355a1cd067cded80d4ff32840969261
+ missing
+ sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506
? ./leaf.dhall
diff --git a/dhall-lang/Prelude/XML/leaf.dhall b/dhall-lang/Prelude/XML/leaf.dhall
--- a/dhall-lang/Prelude/XML/leaf.dhall
+++ b/dhall-lang/Prelude/XML/leaf.dhall
@@ -9,13 +9,14 @@
= ""
```
-}
-
let XML =
- ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c
+ missing
+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9
? ./Type.dhall
let element =
- ./element.dhall sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b
+ missing
+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9
? ./element.dhall
let leaf
diff --git a/dhall-lang/Prelude/XML/package.dhall b/dhall-lang/Prelude/XML/package.dhall
--- a/dhall-lang/Prelude/XML/package.dhall
+++ b/dhall-lang/Prelude/XML/package.dhall
@@ -1,22 +1,33 @@
{ Type =
- ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c
+ missing
+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9
? ./Type.dhall
, attribute =
- ./attribute.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
+ missing
+ sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc
? ./attribute.dhall
, render =
- ./render.dhall sha256:8d034f7f97cded14a96147565d489be840e5678480d175b962b2600d85a3230e
+ missing
+ sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66
? ./render.dhall
, element =
- ./element.dhall sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b
+ missing
+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9
? ./element.dhall
, leaf =
- ./leaf.dhall sha256:4383e4fc4bf6a29ac2052776972eb59d5355a1cd067cded80d4ff32840969261
+ missing
+ sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506
? ./leaf.dhall
, text =
- ./text.dhall sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f
+ missing
+ sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab
? ./text.dhall
+, rawText =
+ missing
+ sha256:2af9d72c151677d4110039e361b7e9faaf2947e6c9d29aa72aea351ad797e05d
+ ? ./rawText.dhall
, emptyAttributes =
- ./emptyAttributes.dhall sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5
+ 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
--- a/dhall-lang/Prelude/XML/render
+++ b/dhall-lang/Prelude/XML/render
@@ -1,2 +1,3 @@
- ./render.dhall sha256:8d034f7f97cded14a96147565d489be840e5678480d175b962b2600d85a3230e
+ missing
+ sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66
? ./render.dhall
diff --git a/dhall-lang/Prelude/XML/render.dhall b/dhall-lang/Prelude/XML/render.dhall
--- a/dhall-lang/Prelude/XML/render.dhall
+++ b/dhall-lang/Prelude/XML/render.dhall
@@ -1,10 +1,6 @@
{-|
Render an `XML` value as `Text`
-*WARNING:* rendering does not include any XML injection mitigations,
-therefore it should not be used to process arbitrary strings into
-element attributes or element data.
-
For indentation and schema validation, see the `xmllint` utility
bundled with libxml2.
@@ -12,7 +8,7 @@
let XML = ./package.dhall
in XML.render
- ( XML.node
+ ( XML.element
{ name = "foo"
, attributes = [ XML.attribute "a" "x", XML.attribute "b" (Natural/show 2) ]
, content = [ XML.leaf { name = "bar", attributes = XML.emptyAttributes } ]
@@ -22,29 +18,65 @@
```
-}
-
let XML =
- ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c
+ missing
+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9
? ./Type.dhall
let Text/concatMap =
- ../Text/concatMap.dhall sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
+ missing
+ sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f
? ../Text/concatMap.dhall
let Text/concat =
- ../Text/concat.dhall sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0
+ 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 renderAttr = λ(x : Attr) → " ${x.mapKey}=\"${x.mapValue}\""
+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 = λ(d : Text) → d
+ { text = escapeText
+ , rawText = λ(t : Text) → t
, element =
λ ( elem
: { attributes : List { mapKey : Text, mapValue : Text }
@@ -60,5 +92,49 @@
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
--- a/dhall-lang/Prelude/XML/text
+++ b/dhall-lang/Prelude/XML/text
@@ -1,2 +1,3 @@
- ./text.dhall sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f
+ missing
+ sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab
? ./text.dhall
diff --git a/dhall-lang/Prelude/XML/text.dhall b/dhall-lang/Prelude/XML/text.dhall
--- a/dhall-lang/Prelude/XML/text.dhall
+++ b/dhall-lang/Prelude/XML/text.dhall
@@ -5,7 +5,7 @@
let XML = ./package.dhall
in XML.render
- ( XML.node
+ ( XML.element
{ name = "location"
, attributes = XML.emptyAttributes
, content = [ XML.text "/foo/bar" ]
@@ -14,9 +14,9 @@
= "/foo/bar"
```
-}
-
let XML =
- ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c
+ missing
+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9
? ./Type.dhall
let text
@@ -25,6 +25,7 @@
λ(XML : Type) →
λ ( xml
: { text : Text → XML
+ , rawText : Text → XML
, element :
{ attributes : List { mapKey : Text, mapValue : Text }
, content : List XML
diff --git a/dhall-lang/Prelude/package.dhall b/dhall-lang/Prelude/package.dhall
--- a/dhall-lang/Prelude/package.dhall
+++ b/dhall-lang/Prelude/package.dhall
@@ -1,40 +1,73 @@
{ Bool =
- ./Bool/package.dhall sha256:7ee950e7c2142be5923f76d00263e536b71d96cb9c190d7743c1679501ddeb0a
+ missing
+ sha256:dde2b9b71afdd26878c06e90cd2cde4488063457d5fbe30e02baed3bec5eede6
? ./Bool/package.dhall
+, Date =
+ missing
+ sha256:fc0c5efc924fa99aa8e5dea5d78c3dc1a24cb550028342b90149ea78cb5ca873
+ ? ./Date/package.dhall
, Double =
- ./Double/package.dhall sha256:b8d20ab3216083622ae371fb42a6732bc67bb2d66e84989c8ddba7556a336cf7
+ missing
+ sha256:b8d20ab3216083622ae371fb42a6732bc67bb2d66e84989c8ddba7556a336cf7
? ./Double/package.dhall
, Function =
- ./Function/package.dhall sha256:6d17cf0fd4fabe1737fb117f87c04b8ff82b299915a5b673c0a543b134b8fffe
+ missing
+ sha256:f4ca848f69034f9d7a74e12c556c3a3396966c1de3a9427a102d1aff4580192f
? ./Function/package.dhall
, Integer =
- ./Integer/package.dhall sha256:d1a572ca3a764781496847e4921d7d9a881c18ffcfac6ae28d0e5299066938a0
+ missing
+ sha256:d1a572ca3a764781496847e4921d7d9a881c18ffcfac6ae28d0e5299066938a0
? ./Integer/package.dhall
+, JSON =
+ missing
+ sha256:5f98b7722fd13509ef448b075e02b9ff98312ae7a406cf53ed25012dbc9990ac
+ ? ./JSON/package.dhall
, List =
- ./List/package.dhall sha256:547cd881988c6c5e3673ae80491224158e93a4627690db0196cb5efbbf00d2ba
+ missing
+ sha256:26d1b4cd800219d8b67043c638926aa6e5517ea74a0bd3e371974514621bca04
? ./List/package.dhall
, Location =
- ./Location/package.dhall sha256:0eb4e4a60814018009c720f6820aaa13cf9491eb1b09afb7b832039c6ee4d470
+ missing
+ sha256:0eb4e4a60814018009c720f6820aaa13cf9491eb1b09afb7b832039c6ee4d470
? ./Location/package.dhall
, Map =
- ./Map/package.dhall sha256:c6602939eb75ddaf43e75a37e1f27ace97e03685ceb9d77605b4372547f7cfa8
+ missing
+ sha256:c5e79a9de642644a09b96a2ec3147c5d8662b7926f09610e751c0c0f6ed0b30a
? ./Map/package.dhall
, Monoid =
- ./Monoid.dhall sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af
+ missing
+ sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af
? ./Monoid.dhall
, Natural =
- ./Natural/package.dhall sha256:ee9ed2b28a417ed4e9a0c284801b928bf91b3fbdc1a68616347678c1821f1ddf
+ missing
+ sha256:ee9ed2b28a417ed4e9a0c284801b928bf91b3fbdc1a68616347678c1821f1ddf
? ./Natural/package.dhall
+, NonEmpty =
+ missing
+ sha256:c24686a230a4b3cd51e5a57cd4510b4f8242f813d7823d41bac5954e7af56f7a
+ ? ./NonEmpty/package.dhall
+, Operator =
+ missing
+ sha256:861f724704a7b4755c96f173e54d03f314492a2d046723404c31ff612b7bf2e6
+ ? ./Operator/package.dhall
, Optional =
- ./Optional/package.dhall sha256:4324b2bf84ded40f67485f14355e4cb7b237a8f173e713c791ec44cebebc552c
+ missing
+ sha256:74331dfe59c09db65edc7ec4498bff92473c8c06d92752f9470d26e25f91320c
? ./Optional/package.dhall
-, JSON =
- ./JSON/package.dhall sha256:79dfc281a05bc7b78f927e0da0c274ee5709b1c55c9e5f59499cb28e9d6f3ec0
- ? ./JSON/package.dhall
, Text =
- ./Text/package.dhall sha256:819a967038fbf6f28cc289fa2651e42835f70b326210c86e51acf48f46f913d8
+ missing
+ sha256:79b671a70ac459b799a53bbb8a383cc8b81b40421745c54bf0fb1143168cbd6f
? ./Text/package.dhall
+, Time =
+ missing
+ sha256:6715c4c71a113429fef8b94e4561a93c288942dad9dfd75ac545de96c5b5652a
+ ? ./Time/package.dhall
+, TimeZone =
+ missing
+ sha256:c17fd403c637856f34c8287168b92974e8c1a3a7331967f75276d179057084fd
+ ? ./TimeZone/package.dhall
, XML =
- ./XML/package.dhall sha256:137e7b106b2e9743970e5d37b21a165f2e40f56ab593a4dd10605c9acd686fc6
+ missing
+ sha256:2e111f0952087d42072b059f0bf4c95861a46bffa67ad4c8c39086edf405f32e
? ./XML/package.dhall
}
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/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/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/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
--- a/dhall-lang/tests/import/data/cycle.dhall
+++ b/dhall-lang/tests/import/data/cycle.dhall
@@ -1,1 +1,1 @@
-../failure/cycle.dhall
+../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/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/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/cycle.dhall b/dhall-lang/tests/import/failure/cycle.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/failure/cycle.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-../data/cycle.dhall
diff --git a/dhall-lang/tests/import/failure/hashMismatch.dhall b/dhall-lang/tests/import/failure/hashMismatch.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/failure/hashMismatch.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
diff --git a/dhall-lang/tests/import/failure/importBoundary.dhall b/dhall-lang/tests/import/failure/importBoundary.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/failure/importBoundary.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-\(x: Bool) -> ../data/importBoundary.dhall
diff --git a/dhall-lang/tests/import/failure/missing.dhall b/dhall-lang/tests/import/failure/missing.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/failure/missing.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-missing
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/referentiallyInsane.dhall b/dhall-lang/tests/import/failure/referentiallyInsane.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/failure/referentiallyInsane.dhall
+++ /dev/null
@@ -1,13 +0,0 @@
-{- 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/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/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/headerForwardingA.dhall b/dhall-lang/tests/import/success/headerForwardingA.dhall
--- a/dhall-lang/tests/import/success/headerForwardingA.dhall
+++ b/dhall-lang/tests/import/success/headerForwardingA.dhall
@@ -1,16 +1,12 @@
{- This test verifies that header-forwarding works correctly for relative
imports within the same domain
- `test.dhall-lang.org` is the same as `prelude.dhall-lang.org` except that
- `test.dhall-lang.org` rejects all requests without a `Test` header.
+ `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/Bool/package.dhall` forwards the `Test` header
- to the transitive relative imports of `https://test.dhall-lang.org/Bool/*` in
+ `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.
-
- Note: You will need to update this test whenever the `Bool` package in the
- Prelude changes (sorry)
-}
-https://test.dhall-lang.org/Bool/package.dhall
- using [ { mapKey = "Test", mapValue = "Example" } ]
+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
--- a/dhall-lang/tests/import/success/headerForwardingB.dhall
+++ b/dhall-lang/tests/import/success/headerForwardingB.dhall
@@ -1,26 +1,1 @@
-{ and =
- λ(xs : List Bool)
- → List/fold Bool xs Bool (λ(l : Bool) → λ(r : Bool) → l && r) True
-, build =
- λ(f : ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool)
- → f Bool True False
-, even =
- λ(xs : List Bool)
- → List/fold Bool xs Bool (λ(x : Bool) → λ(y : Bool) → x == y) True
-, fold =
- λ(b : Bool)
- → λ(bool : Type)
- → λ(true : bool)
- → λ(false : bool)
- → if b then true else false
-, not =
- λ(b : Bool) → b == False
-, odd =
- λ(xs : List Bool)
- → List/fold Bool xs Bool (λ(x : Bool) → λ(y : Bool) → x != y) False
-, or =
- λ(xs : List Bool)
- → List/fold Bool xs Bool (λ(l : Bool) → λ(r : Bool) → l || r) False
-, show =
- λ(b : Bool) → if b then "True" else "False"
-}
+True
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/AlternativeHashMismatchA.dhall b/dhall-lang/tests/import/success/unit/AlternativeHashMismatchA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/success/unit/AlternativeHashMismatchA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-../../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ? 42
diff --git a/dhall-lang/tests/import/success/unit/AlternativeHashMismatchB.dhall b/dhall-lang/tests/import/success/unit/AlternativeHashMismatchB.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/success/unit/AlternativeHashMismatchB.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-42
diff --git a/dhall-lang/tests/import/success/unit/AlternativeParseErrorA.dhall b/dhall-lang/tests/import/success/unit/AlternativeParseErrorA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/success/unit/AlternativeParseErrorA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-../../data/example.txt ? 42
diff --git a/dhall-lang/tests/import/success/unit/AlternativeParseErrorB.dhall b/dhall-lang/tests/import/success/unit/AlternativeParseErrorB.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/success/unit/AlternativeParseErrorB.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-42
diff --git a/dhall-lang/tests/import/success/unit/AlternativeTypeErrorA.dhall b/dhall-lang/tests/import/success/unit/AlternativeTypeErrorA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/success/unit/AlternativeTypeErrorA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-../../data/doesNotTypecheck.dhall ? 42
diff --git a/dhall-lang/tests/import/success/unit/AlternativeTypeErrorB.dhall b/dhall-lang/tests/import/success/unit/AlternativeTypeErrorB.dhall
deleted file mode 100644
--- a/dhall-lang/tests/import/success/unit/AlternativeTypeErrorB.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-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/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/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/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/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/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/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/remoteSystemsA.dhall b/dhall-lang/tests/normalization/success/remoteSystemsA.dhall
--- a/dhall-lang/tests/normalization/success/remoteSystemsA.dhall
+++ b/dhall-lang/tests/normalization/success/remoteSystemsA.dhall
@@ -1,6 +1,6 @@
-let Text/concatMap = ../../../Prelude/Text/concatMap
+let Text/concatMap = ../../../Prelude/Text/concatMap.dhall
-let Text/concatSep = ../../../Prelude/Text/concatSep
+let Text/concatSep = ../../../Prelude/Text/concatSep.dhall
let Row =
{ cores :
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/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/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/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/TextReplaceAbstractA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall
--- a/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall
+++ b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall
@@ -1,4 +1,3 @@
-{- This test verifies that an implementation correctly permits both the
- "replacement" and the "haystack" to be abstract.
+{- This test verifies that an implementation works with an abstract "replacement".
-}
-λ(x : Text) → λ(y : Text) → Text/replace "a" "-${x}-" "_a_${y}_a_"
+λ(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
--- a/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractB.dhall
+++ b/dhall-lang/tests/normalization/success/unit/TextReplaceAbstractB.dhall
@@ -1,1 +1,1 @@
-λ(x : Text) → λ(y : Text) → "_-${x}-_${y}_-${x}-_"
+λ(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/TextReplaceEmptyA.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmptyA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/normalization/success/unit/TextReplaceEmptyA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-Text/replace "" "bar" "foo"
diff --git a/dhall-lang/tests/normalization/success/unit/TextReplaceEmptyB.dhall b/dhall-lang/tests/normalization/success/unit/TextReplaceEmptyB.dhall
deleted file mode 100644
--- a/dhall-lang/tests/normalization/success/unit/TextReplaceEmptyB.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-"foo"
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/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/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/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/parser/failure/boundBuiltins.dhall b/dhall-lang/tests/parser/failure/boundBuiltins.dhall
--- a/dhall-lang/tests/parser/failure/boundBuiltins.dhall
+++ b/dhall-lang/tests/parser/failure/boundBuiltins.dhall
@@ -1,6 +1,6 @@
{-
Builtin names are disallowed in bound variables.
- The grammar doesn't explicitely disallow this, but the implementation should
+ 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/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/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/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/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/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/builtinsA.dhall b/dhall-lang/tests/parser/success/builtinsA.dhall
--- a/dhall-lang/tests/parser/success/builtinsA.dhall
+++ b/dhall-lang/tests/parser/success/builtinsA.dhall
@@ -1,36 +1,40 @@
-[ Natural/fold
-, Natural/build
-, Natural/isZero
-, Natural/even
-, Natural/odd
-, Natural/toInteger
-, Natural/show
-, Integer/toDouble
-, Integer/show
-, Integer/negate
-, Integer/clamp
-, Natural/subtract
+[ Date/show
, Double/show
+, Integer/clamp
+, Integer/negate
+, Integer/show
+, Integer/toDouble
, List/build
, List/fold
-, List/length
, List/head
-, List/last
, List/indexed
+, List/last
+, List/length
, List/reverse
-, Text/show
+, 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
-, True
+, Bytes
+, Date
+, Double
, False
-, Optional
-, None
-, Natural
, Integer
-, Double
-, Text
, List
-, Type
-, Kind
-, Sort
+, 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
--- a/dhall-lang/tests/parser/success/builtinsB.dhallb
+++ b/dhall-lang/tests/parser/success/builtinsB.dhallb
@@ -1,1 +1,1 @@
-%ölNatural/foldmNatural/buildnNatural/isZerolNatural/evenkNatural/oddqNatural/toIntegerlNatural/showpInteger/toDoublelInteger/shownInteger/negatemInteger/clamppNatural/subtractkDouble/showjList/buildiList/foldkList/lengthiList/headiList/lastlList/indexedlList/reverseiText/showlText/replacedBoolõôhOptionaldNonegNaturalgIntegerfDoubledTextdListdTypedKinddSort
+)ö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/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/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/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/preserveCommentA.dhall b/dhall-lang/tests/parser/success/text/preserveCommentA.dhall
--- a/dhall-lang/tests/parser/success/text/preserveCommentA.dhall
+++ b/dhall-lang/tests/parser/success/text/preserveCommentA.dhall
@@ -1,8 +1,1 @@
-{- 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/preserveCommentB.dhallb b/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb
--- a/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb
+++ b/dhall-lang/tests/parser/success/text/preserveCommentB.dhallb
@@ -1,2 +1,1 @@
-u-- Hello
-{- world -}
+n-- $--$--{--}$
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/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/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/DoubleLitSecretelyIntA.dhall b/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntA.dhall
+++ /dev/null
@@ -1,5 +0,0 @@
-{-
- 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/DoubleLitSecretelyIntB.dhallb b/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntB.dhallb
deleted file mode 100644
Binary files a/dhall-lang/tests/parser/success/unit/DoubleLitSecretelyIntB.dhallb and /dev/null differ
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/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/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/RecordFieldAccessA.dhall b/dhall-lang/tests/parser/success/unit/RecordFieldAccessA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/parser/success/unit/RecordFieldAccessA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-r.x
diff --git a/dhall-lang/tests/parser/success/unit/RecordFieldAccessB.dhallb b/dhall-lang/tests/parser/success/unit/RecordFieldAccessB.dhallb
deleted file mode 100644
Binary files a/dhall-lang/tests/parser/success/unit/RecordFieldAccessB.dhallb and /dev/null differ
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/RecordProjectFieldsA.dhall b/dhall-lang/tests/parser/success/unit/RecordProjectFieldsA.dhall
deleted file mode 100644
--- a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-r.{ x, y, z }
diff --git a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsB.dhallb b/dhall-lang/tests/parser/success/unit/RecordProjectFieldsB.dhallb
deleted file mode 100644
Binary files a/dhall-lang/tests/parser/success/unit/RecordProjectFieldsB.dhallb and /dev/null 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/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/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/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/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/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/RecursiveRecordMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall
--- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall
+++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeA.dhall
@@ -1,1 +1,1 @@
-x //\\ y
+x /\ y
diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall
--- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall
+++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocA.dhall
@@ -1,1 +1,1 @@
-w //\\ x //\\ y //\\ z
+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
Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeAssocB.dhallb 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
Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordMergeB.dhallb differ
diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall
--- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall
+++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeA.dhall
@@ -1,1 +1,1 @@
-x /\ y
+x //\\ y
diff --git a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall
--- a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall
+++ b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocA.dhall
@@ -1,1 +1,1 @@
-w /\ x /\ y /\ z
+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
Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeAssocB.dhallb 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
Binary files a/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.dhallb and b/dhall-lang/tests/parser/success/unit/operators/RecursiveRecordTypeMergeB.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/prelude/Bool/and/0A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0A.dhall
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/and [ True, False, True ]
+../../../../../../Prelude/Bool/and.dhall [ True, False, True ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/and/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/and ([] : List Bool)
+../../../../../../Prelude/Bool/and.dhall ([] : List Bool)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/0A.dhall
@@ -1,2 +1,2 @@
-../../../../../../Prelude/Bool/build
+../../../../../../Prelude/Bool/build.dhall
(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/build/1A.dhall
@@ -1,2 +1,2 @@
-../../../../../../Prelude/Bool/build
+../../../../../../Prelude/Bool/build.dhall
(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even [ False, True, False ]
+../../../../../../Prelude/Bool/even.dhall [ False, True, False ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even [ False, True ]
+../../../../../../Prelude/Bool/even.dhall [ False, True ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even [ False ]
+../../../../../../Prelude/Bool/even.dhall [ False ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/even/3A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even ([] : List Bool)
+../../../../../../Prelude/Bool/even.dhall ([] : List Bool)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/fold True Natural 0 1
+../../../../../../Prelude/Bool/fold.dhall True Natural 0 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/fold False Natural 0 1
+../../../../../../Prelude/Bool/fold.dhall False Natural 0 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/not True
+../../../../../../Prelude/Bool/not.dhall True
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/not/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/not False
+../../../../../../Prelude/Bool/not.dhall False
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd [ True, False, True ]
+../../../../../../Prelude/Bool/odd.dhall [ True, False, True ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd [ True, False ]
+../../../../../../Prelude/Bool/odd.dhall [ True, False ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd [ True ]
+../../../../../../Prelude/Bool/odd.dhall [ True ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/3A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd ([] : List Bool)
+../../../../../../Prelude/Bool/odd.dhall ([] : List Bool)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/or [ True, False, True ]
+../../../../../../Prelude/Bool/or.dhall [ True, False, True ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/or/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/or ([] : List Bool)
+../../../../../../Prelude/Bool/or.dhall ([] : List Bool)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/show True
+../../../../../../Prelude/Bool/show.dhall True
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Bool/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/show False
+../../../../../../Prelude/Bool/show.dhall False
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Double/show -3.1
+../../../../../../Prelude/Double/show.dhall -3.1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Double/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Double/show 0.4
+../../../../../../Prelude/Double/show.dhall 0.4
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/show -3
+../../../../../../Prelude/Integer/show.dhall -3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/show +0
+../../../../../../Prelude/Integer/show.dhall +0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/toDouble -3
+../../../../../../Prelude/Integer/toDouble.dhall -3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/toDouble +2
+../../../../../../Prelude/Integer/toDouble.dhall +2
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/all/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/all/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/all Natural Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/all.dhall Natural Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/all/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/all/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/all Natural Natural/even ([] : List Natural)
+../../../../../../Prelude/List/all.dhall Natural Natural/even ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/any/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/any/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/any Natural Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/any.dhall Natural Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/any/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/any/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/any Natural Natural/even ([] : List Natural)
+../../../../../../Prelude/List/any.dhall Natural Natural/even ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/build/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/build/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/build
+../../../../../../Prelude/List/build.dhall
Text
( λ(list : Type)
→ λ(cons : Text → list → list)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/build/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/build/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/build
+../../../../../../Prelude/List/build.dhall
Text
( λ(list : Type)
→ λ(cons : Text → list → list)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/concat Natural
+../../../../../../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/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1A.dhall
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concat/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/concat Natural
+../../../../../../Prelude/List/concat.dhall Natural
[ [] : List Natural
, [] : List Natural
, [] : List Natural
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ]
+../../../../../../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/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1A.dhall
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural)
+../../../../../../Prelude/List/concatMap.dhall Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/filter Natural Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/filter.dhall Natural Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/filter/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/filter Natural Natural/odd [ 2, 3, 5 ]
+../../../../../../Prelude/List/filter.dhall Natural Natural/odd [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/fold
+../../../../../../Prelude/List/fold.dhall
Natural
[ 2, 3, 5 ]
Natural
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/1A.dhall
@@ -1,5 +1,5 @@
λ(nil : Natural)
-→ ../../../../../../Prelude/List/fold
+→ ../../../../../../Prelude/List/fold.dhall
Natural
[ 2, 3, 5 ]
Natural
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/fold/2A.dhall
@@ -1,4 +1,4 @@
λ(list : Type)
→ λ(cons : Natural → list → list)
→ λ(nil : list)
-→ ../../../../../../Prelude/List/fold Natural [ 2, 3, 5 ] list cons nil
+→ ../../../../../../Prelude/List/fold.dhall Natural [ 2, 3, 5 ] list cons nil
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/generate 5 Bool Natural/even
+../../../../../../Prelude/List/generate.dhall 5 Bool Natural/even
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/generate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/generate 0 Bool Natural/even
+../../../../../../Prelude/List/generate.dhall 0 Bool Natural/even
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/head/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/head/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/head Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/head.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/head/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/head/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/head Natural ([] : List Natural)
+../../../../../../Prelude/List/head.dhall Natural ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/indexed Bool [ True, False, True ]
+../../../../../../Prelude/List/indexed.dhall Bool [ True, False, True ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/indexed/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/indexed Bool ([] : List Bool)
+../../../../../../Prelude/List/indexed.dhall Bool ([] : List Bool)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/iterate 10 Natural (λ(x : Natural) → x * 2) 1
+../../../../../../Prelude/List/iterate.dhall 10 Natural (λ(x : Natural) → x * 2) 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/iterate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/iterate 0 Natural (λ(x : Natural) → x * 2) 1
+../../../../../../Prelude/List/iterate.dhall 0 Natural (λ(x : Natural) → x * 2) 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/last/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/last/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/last Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/last.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/last/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/last/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/last Natural ([] : List Natural)
+../../../../../../Prelude/List/last.dhall Natural ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/length/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/length/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/length Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/length.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/length/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/length/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/length Natural ([] : List Natural)
+../../../../../../Prelude/List/length.dhall Natural ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/map/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/map/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/map Natural Bool Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/map.dhall Natural Bool Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/map/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/map/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/map Natural Bool Natural/even ([] : List Natural)
+../../../../../../Prelude/List/map.dhall Natural Bool Natural/even ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/null/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/null/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/null Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/null.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/null/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/null/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/null Natural ([] : List Natural)
+../../../../../../Prelude/List/null.dhall Natural ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/replicate 9 Natural 1
+../../../../../../Prelude/List/replicate.dhall 9 Natural 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/replicate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/replicate 0 Natural 1
+../../../../../../Prelude/List/replicate.dhall 0 Natural 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/reverse Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/reverse.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/reverse/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/reverse Natural ([] : List Natural)
+../../../../../../Prelude/List/reverse.dhall Natural ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/shifted
+../../../../../../Prelude/List/shifted.dhall
Bool
[ [ { index = 0, value = True }
, { index = 1, value = True }
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/shifted/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/shifted Bool ([] : List (List { index : Natural, value : Bool }))
+../../../../../../Prelude/List/shifted.dhall Bool ([] : List (List { index : Natural, value : Bool }))
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/unzip
+../../../../../../Prelude/List/unzip.dhall
Text
Bool
[ { _1 = "ABC", _2 = True }
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/List/unzip/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/unzip Text Bool ([] : List { _1 : Text, _2 : Bool })
+../../../../../../Prelude/List/unzip.dhall Text Bool ([] : List { _1 : Text, _2 : Bool })
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Natural/build
+../../../../../../Prelude/Natural/build.dhall
( λ(natural : Type)
→ λ(succ : natural → natural)
→ λ(zero : natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/build/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Natural/build
+../../../../../../Prelude/Natural/build.dhall
( λ(natural : Type)
→ λ(succ : natural → natural)
→ λ(zero : natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/enumerate 10
+../../../../../../Prelude/Natural/enumerate.dhall 10
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/enumerate 0
+../../../../../../Prelude/Natural/enumerate.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/even 3
+../../../../../../Prelude/Natural/even.dhall 3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/even/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/even 0
+../../../../../../Prelude/Natural/even.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) 1
+../../../../../../Prelude/Natural/fold.dhall 3 Natural (λ(x : Natural) → 5 * x) 1
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/1A.dhall
@@ -1,1 +1,1 @@
-λ(zero : Natural) → ../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) zero
+λ(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/2A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2A.dhall
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/2A.dhall
@@ -1,4 +1,4 @@
λ(natural : Type)
→ λ(succ : natural → natural)
→ λ(zero : natural)
-→ ../../../../../../Prelude/Natural/fold 3 natural succ zero
+→ ../../../../../../Prelude/Natural/fold.dhall 3 natural succ zero
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/isZero 2
+../../../../../../Prelude/Natural/isZero.dhall 2
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/isZero 0
+../../../../../../Prelude/Natural/isZero.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/odd 3
+../../../../../../Prelude/Natural/odd.dhall 3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/odd 0
+../../../../../../Prelude/Natural/odd.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/product [ 2, 3, 5 ]
+../../../../../../Prelude/Natural/product.dhall [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/product/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/product ([] : List Natural)
+../../../../../../Prelude/Natural/product.dhall ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/show 3
+../../../../../../Prelude/Natural/show.dhall 3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/show 0
+../../../../../../Prelude/Natural/show.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/sum [ 2, 3, 5 ]
+../../../../../../Prelude/Natural/sum.dhall [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/sum ([] : List Natural)
+../../../../../../Prelude/Natural/sum.dhall ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toDouble 3
+../../../../../../Prelude/Natural/toDouble.dhall 3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toDouble 0
+../../../../../../Prelude/Natural/toDouble.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toInteger 3
+../../../../../../Prelude/Natural/toInteger.dhall 3
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toInteger 0
+../../../../../../Prelude/Natural/toInteger.dhall 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/all Natural Natural/even (Some 3)
+../../../../../../Prelude/Optional/all.dhall Natural Natural/even (Some 3)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/all/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/all Natural Natural/even (None Natural)
+../../../../../../Prelude/Optional/all.dhall Natural Natural/even (None Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/any Natural Natural/even (Some 2)
+../../../../../../Prelude/Optional/any.dhall Natural Natural/even (Some 2)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/any/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/any Natural Natural/even (None Natural)
+../../../../../../Prelude/Optional/any.dhall Natural Natural/even (None Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Optional/build
+../../../../../../Prelude/Optional/build.dhall
Natural
( λ(optional : Type)
→ λ(some : Natural → optional)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/build/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Optional/build
+../../../../../../Prelude/Optional/build.dhall
Natural
( λ(optional : Type)
→ λ(some : Natural → optional)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/concat Natural (Some (Some 1))
+../../../../../../Prelude/Optional/concat.dhall Natural (Some (Some 1))
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/concat Natural (Some (None Natural))
+../../../../../../Prelude/Optional/concat.dhall Natural (Some (None Natural))
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/concat Natural (None (Optional Natural))
+../../../../../../Prelude/Optional/concat.dhall Natural (None (Optional Natural))
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/filter Natural Natural/even (Some 2)
+../../../../../../Prelude/Optional/filter.dhall Natural Natural/even (Some 2)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/filter Natural Natural/odd (Some 2)
+../../../../../../Prelude/Optional/filter.dhall Natural Natural/odd (Some 2)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/fold Natural (Some 2) Natural (λ(x : Natural) → x) 0
+../../../../../../Prelude/Optional/fold.dhall Natural (Some 2) Natural (λ(x : Natural) → x) 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/fold Natural (None Natural) Natural (λ(x : Natural) → x) 0
+../../../../../../Prelude/Optional/fold.dhall Natural (None Natural) Natural (λ(x : Natural) → x) 0
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/head Natural [ None Natural, Some 1, Some 2 ]
+../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, Some 1, Some 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/head Natural [ None Natural, None Natural ]
+../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, None Natural ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/head/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/head Natural ([] : List (Optional Natural))
+../../../../../../Prelude/Optional/head.dhall Natural ([] : List (Optional Natural))
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/last Natural [ None Natural, Some 1, Some 2 ]
+../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, Some 1, Some 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/last Natural [ None Natural, None Natural ]
+../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, None Natural ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/last/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/last Natural ([] : List (Optional Natural))
+../../../../../../Prelude/Optional/last.dhall Natural ([] : List (Optional Natural))
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/length Natural (Some 2)
+../../../../../../Prelude/Optional/length.dhall Natural (Some 2)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/length/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/length Natural (None Natural)
+../../../../../../Prelude/Optional/length.dhall Natural (None Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/map Natural Bool Natural/even (Some 3)
+../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (Some 3)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/map/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/map Natural Bool Natural/even (None Natural)
+../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (None Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/null Natural (Some 2)
+../../../../../../Prelude/Optional/null.dhall Natural (Some 2)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/null/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/null Natural (None Natural)
+../../../../../../Prelude/Optional/null.dhall Natural (None Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/toList Natural (Some 1)
+../../../../../../Prelude/Optional/toList.dhall Natural (Some 1)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/toList Natural (None Natural)
+../../../../../../Prelude/Optional/toList.dhall Natural (None Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/unzip Text Bool (Some { _1 = "ABC", _2 = True })
+../../../../../../Prelude/Optional/unzip.dhall Text Bool (Some { _1 = "ABC", _2 = True })
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/unzip Text Bool (None { _1 : Text, _2 : Bool })
+../../../../../../Prelude/Optional/unzip.dhall Text Bool (None { _1 : Text, _2 : Bool })
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concat [ "ABC", "DEF", "GHI" ]
+../../../../../../Prelude/Text/concat.dhall [ "ABC", "DEF", "GHI" ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concat/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concat ([] : List Text)
+../../../../../../Prelude/Text/concat.dhall ([] : List Text)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ]
+../../../../../../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/1A.dhall b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1A.dhall
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural)
+../../../../../../Prelude/Text/concatMap.dhall Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show [ 0, 1, 2 ]
+../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show ([] : List Natural)
+../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show ([] : List Natural)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatSep ", " [ "ABC", "DEF", "GHI" ]
+../../../../../../Prelude/Text/concatSep.dhall ", " [ "ABC", "DEF", "GHI" ]
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatSep ", " ([] : List Text)
+../../../../../../Prelude/Text/concatSep.dhall ", " ([] : List Text)
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/show "ABC"
+../../../../../../Prelude/Text/show.dhall "ABC"
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
--- a/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1A.dhall
+++ b/dhall-lang/tests/semantic-hash/success/prelude/Text/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/show "\u0000 \$ \\ \n \u263a"
+../../../../../../Prelude/Text/show.dhall "\u0000 \$ \\ \n \u263a"
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/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/prelude/Bool/and/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/and [ True, False, True ]
+../../../../../../Prelude/Bool/and.dhall [ True, False, True ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/and ([] : List Bool)
+../../../../../../Prelude/Bool/and.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall
@@ -1,2 +1,2 @@
-../../../../../../Prelude/Bool/build
+../../../../../../Prelude/Bool/build.dhall
(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall
@@ -1,2 +1,2 @@
-../../../../../../Prelude/Bool/build
+../../../../../../Prelude/Bool/build.dhall
(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even [ False, True, False ]
+../../../../../../Prelude/Bool/even.dhall [ False, True, False ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even [ False, True ]
+../../../../../../Prelude/Bool/even.dhall [ False, True ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even [ False ]
+../../../../../../Prelude/Bool/even.dhall [ False ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/even ([] : List Bool)
+../../../../../../Prelude/Bool/even.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/fold True Natural 0 1
+../../../../../../Prelude/Bool/fold.dhall True Natural 0 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/fold False Natural 0 1
+../../../../../../Prelude/Bool/fold.dhall False Natural 0 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/not True
+../../../../../../Prelude/Bool/not.dhall True
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/not False
+../../../../../../Prelude/Bool/not.dhall False
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd [ True, False, True ]
+../../../../../../Prelude/Bool/odd.dhall [ True, False, True ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd [ True, False ]
+../../../../../../Prelude/Bool/odd.dhall [ True, False ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd [ True ]
+../../../../../../Prelude/Bool/odd.dhall [ True ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/odd ([] : List Bool)
+../../../../../../Prelude/Bool/odd.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/or [ True, False, True ]
+../../../../../../Prelude/Bool/or.dhall [ True, False, True ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/or ([] : List Bool)
+../../../../../../Prelude/Bool/or.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/show True
+../../../../../../Prelude/Bool/show.dhall True
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
--- a/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Bool/show False
+../../../../../../Prelude/Bool/show.dhall False
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
--- a/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Double/show -3.1
+../../../../../../Prelude/Double/show.dhall -3.1
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
--- a/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Double/show 0.4
+../../../../../../Prelude/Double/show.dhall 0.4
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
--- a/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/show -3
+../../../../../../Prelude/Integer/show.dhall -3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/show +0
+../../../../../../Prelude/Integer/show.dhall +0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/toDouble -3
+../../../../../../Prelude/Integer/toDouble.dhall -3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Integer/toDouble +2
+../../../../../../Prelude/Integer/toDouble.dhall +2
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/all Natural Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/all.dhall Natural Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/all Natural Natural/even ([] : List Natural)
+../../../../../../Prelude/List/all.dhall Natural Natural/even ([] : List Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/any Natural Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/any.dhall Natural Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/any Natural Natural/even ([] : List Natural)
+../../../../../../Prelude/List/any.dhall Natural Natural/even ([] : List Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/build
+../../../../../../Prelude/List/build.dhall
Text
( λ(list : Type)
→ λ(cons : Text → list → list)
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/build
+../../../../../../Prelude/List/build.dhall
Text
( λ(list : Type)
→ λ(cons : Text → list → list)
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/concat Natural
+../../../../../../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/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall
--- a/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/concat Natural
+../../../../../../Prelude/List/concat.dhall Natural
[ [] : List Natural
, [] : List Natural
, [] : 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ]
+../../../../../../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/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall
--- a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural)
+../../../../../../Prelude/List/concatMap.dhall Natural Natural (λ(n : Natural) → [ n, n ]) ([] : 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/filter Natural Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/filter.dhall Natural Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/filter Natural Natural/odd [ 2, 3, 5 ]
+../../../../../../Prelude/List/filter.dhall Natural Natural/odd [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/fold
+../../../../../../Prelude/List/fold.dhall
Natural
[ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall
@@ -1,5 +1,5 @@
λ(nil : Natural)
-→ ../../../../../../Prelude/List/fold
+→ ../../../../../../Prelude/List/fold.dhall
Natural
[ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall
@@ -1,4 +1,4 @@
λ(list : Type)
→ λ(cons : Natural → list → list)
→ λ(nil : list)
-→ ../../../../../../Prelude/List/fold Natural [ 2, 3, 5 ] list cons nil
+→ ../../../../../../Prelude/List/fold.dhall Natural [ 2, 3, 5 ] list cons nil
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/generate 5 Bool Natural/even
+../../../../../../Prelude/List/generate.dhall 5 Bool Natural/even
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/generate 0 Bool Natural/even
+../../../../../../Prelude/List/generate.dhall 0 Bool Natural/even
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/head Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/head.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/head Natural ([] : List Natural)
+../../../../../../Prelude/List/head.dhall Natural ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/indexed Bool [ True, False, True ]
+../../../../../../Prelude/List/indexed.dhall Bool [ True, False, True ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/indexed Bool ([] : List Bool)
+../../../../../../Prelude/List/indexed.dhall Bool ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/iterate 10 Natural (λ(x : Natural) → x * 2) 1
+../../../../../../Prelude/List/iterate.dhall 10 Natural (λ(x : Natural) → x * 2) 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/iterate 0 Natural (λ(x : Natural) → x * 2) 1
+../../../../../../Prelude/List/iterate.dhall 0 Natural (λ(x : Natural) → x * 2) 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/last Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/last.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/last Natural ([] : List Natural)
+../../../../../../Prelude/List/last.dhall Natural ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/length Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/length.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/length Natural ([] : List Natural)
+../../../../../../Prelude/List/length.dhall Natural ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/map Natural Bool Natural/even [ 2, 3, 5 ]
+../../../../../../Prelude/List/map.dhall Natural Bool Natural/even [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/map Natural Bool Natural/even ([] : List Natural)
+../../../../../../Prelude/List/map.dhall Natural Bool Natural/even ([] : List Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/null Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/null.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/null Natural ([] : List Natural)
+../../../../../../Prelude/List/null.dhall Natural ([] : List Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/replicate 9 Natural 1
+../../../../../../Prelude/List/replicate.dhall 9 Natural 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/replicate 0 Natural 1
+../../../../../../Prelude/List/replicate.dhall 0 Natural 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/reverse Natural [ 0, 1, 2 ]
+../../../../../../Prelude/List/reverse.dhall Natural [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/reverse Natural ([] : List Natural)
+../../../../../../Prelude/List/reverse.dhall Natural ([] : 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
--- a/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/shifted
+../../../../../../Prelude/List/shifted.dhall
Bool
[ [ { index = 0, value = True }
, { index = 1, value = True }
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/shifted Bool ([] : List (List { index : Natural, value : Bool }))
+../../../../../../Prelude/List/shifted.dhall Bool ([] : List (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
--- a/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/List/unzip
+../../../../../../Prelude/List/unzip.dhall
Text
Bool
[ { _1 = "ABC", _2 = True }
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
--- a/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/List/unzip Text Bool ([] : List { _1 : Text, _2 : Bool })
+../../../../../../Prelude/List/unzip.dhall Text Bool ([] : List { _1 : Text, _2 : Bool })
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Natural/build
+../../../../../../Prelude/Natural/build.dhall
( λ(natural : Type)
→ λ(succ : natural → natural)
→ λ(zero : 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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Natural/build
+../../../../../../Prelude/Natural/build.dhall
( λ(natural : Type)
→ λ(succ : natural → natural)
→ λ(zero : 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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/enumerate 10
+../../../../../../Prelude/Natural/enumerate.dhall 10
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/enumerate 0
+../../../../../../Prelude/Natural/enumerate.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/even 3
+../../../../../../Prelude/Natural/even.dhall 3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/even 0
+../../../../../../Prelude/Natural/even.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) 1
+../../../../../../Prelude/Natural/fold.dhall 3 Natural (λ(x : Natural) → 5 * x) 1
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall
@@ -1,1 +1,1 @@
-λ(zero : Natural) → ../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) zero
+λ(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/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall
@@ -1,4 +1,4 @@
λ(natural : Type)
→ λ(succ : natural → natural)
→ λ(zero : natural)
-→ ../../../../../../Prelude/Natural/fold 3 natural succ zero
+→ ../../../../../../Prelude/Natural/fold.dhall 3 natural succ zero
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/isZero 2
+../../../../../../Prelude/Natural/isZero.dhall 2
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/isZero 0
+../../../../../../Prelude/Natural/isZero.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/odd 3
+../../../../../../Prelude/Natural/odd.dhall 3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/odd 0
+../../../../../../Prelude/Natural/odd.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/product [ 2, 3, 5 ]
+../../../../../../Prelude/Natural/product.dhall [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/product ([] : List Natural)
+../../../../../../Prelude/Natural/product.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/show 3
+../../../../../../Prelude/Natural/show.dhall 3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/show 0
+../../../../../../Prelude/Natural/show.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/sum [ 2, 3, 5 ]
+../../../../../../Prelude/Natural/sum.dhall [ 2, 3, 5 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/sum ([] : List Natural)
+../../../../../../Prelude/Natural/sum.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toDouble 3
+../../../../../../Prelude/Natural/toDouble.dhall 3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toDouble 0
+../../../../../../Prelude/Natural/toDouble.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toInteger 3
+../../../../../../Prelude/Natural/toInteger.dhall 3
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
--- a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Natural/toInteger 0
+../../../../../../Prelude/Natural/toInteger.dhall 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/all Natural Natural/even (Some 3)
+../../../../../../Prelude/Optional/all.dhall Natural Natural/even (Some 3)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/all Natural Natural/even (None Natural)
+../../../../../../Prelude/Optional/all.dhall Natural Natural/even (None Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/any Natural Natural/even (Some 2)
+../../../../../../Prelude/Optional/any.dhall Natural Natural/even (Some 2)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/any Natural Natural/even (None Natural)
+../../../../../../Prelude/Optional/any.dhall Natural Natural/even (None Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Optional/build
+../../../../../../Prelude/Optional/build.dhall
Natural
( λ(optional : Type)
→ λ(some : Natural → optional)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall
@@ -1,4 +1,4 @@
-../../../../../../Prelude/Optional/build
+../../../../../../Prelude/Optional/build.dhall
Natural
( λ(optional : Type)
→ λ(some : Natural → optional)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/concat Natural (Some (Some 1))
+../../../../../../Prelude/Optional/concat.dhall Natural (Some (Some 1))
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/concat Natural (Some (None Natural))
+../../../../../../Prelude/Optional/concat.dhall Natural (Some (None 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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/concat Natural (None (Optional Natural))
+../../../../../../Prelude/Optional/concat.dhall Natural (None (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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/filter Natural Natural/even (Some 2)
+../../../../../../Prelude/Optional/filter.dhall Natural Natural/even (Some 2)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/filter Natural Natural/odd (Some 2)
+../../../../../../Prelude/Optional/filter.dhall Natural Natural/odd (Some 2)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/fold Natural (Some 2) Natural (λ(x : Natural) → x) 0
+../../../../../../Prelude/Optional/fold.dhall Natural (Some 2) Natural (λ(x : Natural) → x) 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/fold Natural (None Natural) Natural (λ(x : Natural) → x) 0
+../../../../../../Prelude/Optional/fold.dhall Natural (None Natural) Natural (λ(x : Natural) → x) 0
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/head Natural [ None Natural, Some 1, Some 2 ]
+../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, Some 1, Some 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/head Natural [ None Natural, None Natural ]
+../../../../../../Prelude/Optional/head.dhall Natural [ None Natural, None 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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/head Natural ([] : List (Optional Natural))
+../../../../../../Prelude/Optional/head.dhall Natural ([] : List (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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/last Natural [ None Natural, Some 1, Some 2 ]
+../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, Some 1, Some 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/last Natural [ None Natural, None Natural ]
+../../../../../../Prelude/Optional/last.dhall Natural [ None Natural, None 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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/last Natural ([] : List (Optional Natural))
+../../../../../../Prelude/Optional/last.dhall Natural ([] : List (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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/length Natural (Some 2)
+../../../../../../Prelude/Optional/length.dhall Natural (Some 2)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/length Natural (None Natural)
+../../../../../../Prelude/Optional/length.dhall Natural (None 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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/map Natural Bool Natural/even (Some 3)
+../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (Some 3)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/map Natural Bool Natural/even (None Natural)
+../../../../../../Prelude/Optional/map.dhall Natural Bool Natural/even (None Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/null Natural (Some 2)
+../../../../../../Prelude/Optional/null.dhall Natural (Some 2)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/null Natural (None Natural)
+../../../../../../Prelude/Optional/null.dhall Natural (None Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/toList Natural (Some 1)
+../../../../../../Prelude/Optional/toList.dhall Natural (Some 1)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/toList Natural (None Natural)
+../../../../../../Prelude/Optional/toList.dhall Natural (None 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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/unzip Text Bool (Some { _1 = "ABC", _2 = True })
+../../../../../../Prelude/Optional/unzip.dhall Text Bool (Some { _1 = "ABC", _2 = True })
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
--- a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Optional/unzip Text Bool (None { _1 : Text, _2 : Bool })
+../../../../../../Prelude/Optional/unzip.dhall Text Bool (None { _1 : Text, _2 : 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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concat [ "ABC", "DEF", "GHI" ]
+../../../../../../Prelude/Text/concat.dhall [ "ABC", "DEF", "GHI" ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concat ([] : List Text)
+../../../../../../Prelude/Text/concat.dhall ([] : List 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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ]
+../../../../../../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/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural)
+../../../../../../Prelude/Text/concatMap.dhall Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show [ 0, 1, 2 ]
+../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show [ 0, 1, 2 ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show ([] : List Natural)
+../../../../../../Prelude/Text/concatMapSep.dhall ", " Natural Natural/show ([] : List Natural)
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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatSep ", " [ "ABC", "DEF", "GHI" ]
+../../../../../../Prelude/Text/concatSep.dhall ", " [ "ABC", "DEF", "GHI" ]
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
--- a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall
+++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall
@@ -1,1 +1,1 @@
-../../../../../../Prelude/Text/concatSep ", " ([] : List Text)
+../../../../../../Prelude/Text/concatSep.dhall ", " ([] : List Text)
diff --git a/dhall-lang/tests/type-inference/success/preludeB.dhall b/dhall-lang/tests/type-inference/success/preludeB.dhall
--- a/dhall-lang/tests/type-inference/success/preludeB.dhall
+++ b/dhall-lang/tests/type-inference/success/preludeB.dhall
@@ -2,6 +2,7 @@
{ 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
@@ -10,16 +11,18 @@
, 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
+ ∀(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 :
@@ -239,6 +242,22 @@
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
@@ -296,6 +315,12 @@
, 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 →
@@ -303,6 +328,13 @@
∀(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
@@ -311,6 +343,18 @@
, 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) →
@@ -361,6 +405,13 @@
∀(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) →
@@ -408,6 +459,102 @@
, 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
@@ -421,7 +568,19 @@
) →
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) →
@@ -459,10 +618,17 @@
, 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 :
@@ -481,6 +647,7 @@
, name : Text
} →
XML
+ , rawText : Text → XML
, text : Text → XML
}
) →
@@ -497,6 +664,7 @@
, name : Text
} →
XML
+ , rawText : Text → XML
, text : Text → XML
}
) →
@@ -516,10 +684,26 @@
, 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) →
@@ -530,6 +714,7 @@
, name : Text
} →
XML
+ , rawText : Text → XML
, text : Text → XML
}
) →
@@ -546,6 +731,7 @@
, name : Text
} →
XML
+ , rawText : Text → XML
, text : Text → XML
}
) →
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/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/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/MergeOneWithAnnotation1A.dhall b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1A.dhall
--- a/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1A.dhall
+++ b/dhall-lang/tests/type-inference/success/unit/MergeOneWithAnnotation1A.dhall
@@ -1,1 +1,1 @@
-merge { x = λ(y : Bool) → y } < x >.x : (Bool → Bool)
+merge { x = λ(y : Bool) → y } < x >.x : (∀(y : Bool) → Bool)
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/ToMapInferTypeFromRecordA.dhall b/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordA.dhall
--- a/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordA.dhall
+++ b/dhall-lang/tests/type-inference/success/unit/ToMapInferTypeFromRecordA.dhall
@@ -1,1 +1,1 @@
-toMap { x = λ(x : Bool) → x } : List { mapKey : Text, mapValue : Bool → Bool }
+toMap { x = λ(x : Bool) → x } : List { mapKey : Text, mapValue : ∀(x : Bool) → Bool }
diff --git a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall
--- a/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall
+++ b/dhall-lang/tests/type-inference/success/unit/TypeAnnotationFunctionA.dhall
@@ -1,1 +1,1 @@
-(λ(x : Bool) → x) : Bool → Bool
+(λ(x : Bool) → x) : ∀(x : Bool) → Bool
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/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.cabal b/dhall.cabal
--- a/dhall.cabal
+++ b/dhall.cabal
@@ -1,13 +1,12 @@
+Cabal-Version: 2.4
Name: dhall
-Version: 1.36.0
-Cabal-Version: >=1.10
+Version: 1.42.3
Build-Type: Simple
-Tested-With: GHC == 8.4.3, GHC == 8.6.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:
@@ -25,10 +24,10 @@
Data-Files:
man/dhall.1
Extra-Source-Files:
- benchmark/deep-nested-large-record/*.dhall
- benchmark/examples/*.dhall
- benchmark/examples/normalize/*.dhall
CHANGELOG.md
+ benchmark/**/*.dhall
+ benchmark/**/*.dhallb
+ dhall-lang/Prelude/**/*.dhall
dhall-lang/Prelude/Bool/and
dhall-lang/Prelude/Bool/build
dhall-lang/Prelude/Bool/even
@@ -36,16 +35,10 @@
dhall-lang/Prelude/Bool/not
dhall-lang/Prelude/Bool/odd
dhall-lang/Prelude/Bool/or
- dhall-lang/Prelude/Bool/package.dhall
dhall-lang/Prelude/Bool/show
- dhall-lang/Prelude/Bool/*.dhall
- dhall-lang/Prelude/Double/package.dhall
dhall-lang/Prelude/Double/show
- dhall-lang/Prelude/Double/*.dhall
dhall-lang/Prelude/Function/compose
dhall-lang/Prelude/Function/identity
- dhall-lang/Prelude/Function/package.dhall
- dhall-lang/Prelude/Function/*.dhall
dhall-lang/Prelude/Integer/abs
dhall-lang/Prelude/Integer/add
dhall-lang/Prelude/Integer/clamp
@@ -59,20 +52,17 @@
dhall-lang/Prelude/Integer/negative
dhall-lang/Prelude/Integer/nonNegative
dhall-lang/Prelude/Integer/nonPositive
- dhall-lang/Prelude/Integer/package.dhall
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/Integer/*.dhall
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/core.dhall
dhall-lang/Prelude/JSON/double
dhall-lang/Prelude/JSON/integer
dhall-lang/Prelude/JSON/keyText
@@ -82,15 +72,12 @@
dhall-lang/Prelude/JSON/number
dhall-lang/Prelude/JSON/object
dhall-lang/Prelude/JSON/omitNullFields
- dhall-lang/Prelude/JSON/package.dhall
dhall-lang/Prelude/JSON/render
dhall-lang/Prelude/JSON/renderAs
- dhall-lang/Prelude/JSON/renderInteger.dhall
dhall-lang/Prelude/JSON/renderYAML
dhall-lang/Prelude/JSON/string
dhall-lang/Prelude/JSON/tagInline
dhall-lang/Prelude/JSON/tagNested
- dhall-lang/Prelude/JSON/*.dhall
dhall-lang/Prelude/List/all
dhall-lang/Prelude/List/any
dhall-lang/Prelude/List/build
@@ -110,7 +97,6 @@
dhall-lang/Prelude/List/length
dhall-lang/Prelude/List/map
dhall-lang/Prelude/List/null
- dhall-lang/Prelude/List/package.dhall
dhall-lang/Prelude/List/partition
dhall-lang/Prelude/List/replicate
dhall-lang/Prelude/List/reverse
@@ -119,10 +105,7 @@
dhall-lang/Prelude/List/unpackOptionals
dhall-lang/Prelude/List/unzip
dhall-lang/Prelude/List/zip
- dhall-lang/Prelude/List/*.dhall
dhall-lang/Prelude/Location/Type
- dhall-lang/Prelude/Location/package.dhall
- dhall-lang/Prelude/Location/*.dhall
dhall-lang/Prelude/Map/Entry
dhall-lang/Prelude/Map/Type
dhall-lang/Prelude/Map/empty
@@ -130,9 +113,7 @@
dhall-lang/Prelude/Map/keyValue
dhall-lang/Prelude/Map/keys
dhall-lang/Prelude/Map/map
- dhall-lang/Prelude/Map/package.dhall
dhall-lang/Prelude/Map/values
- dhall-lang/Prelude/Map/*.dhall
dhall-lang/Prelude/Monoid
dhall-lang/Prelude/Natural/build
dhall-lang/Prelude/Natural/enumerate
@@ -149,7 +130,6 @@
dhall-lang/Prelude/Natural/max
dhall-lang/Prelude/Natural/min
dhall-lang/Prelude/Natural/odd
- dhall-lang/Prelude/Natural/package.dhall
dhall-lang/Prelude/Natural/product
dhall-lang/Prelude/Natural/show
dhall-lang/Prelude/Natural/sort
@@ -157,7 +137,6 @@
dhall-lang/Prelude/Natural/sum
dhall-lang/Prelude/Natural/toDouble
dhall-lang/Prelude/Natural/toInteger
- dhall-lang/Prelude/Natural/*.dhall
dhall-lang/Prelude/Optional/all
dhall-lang/Prelude/Optional/any
dhall-lang/Prelude/Optional/build
@@ -170,281 +149,34 @@
dhall-lang/Prelude/Optional/length
dhall-lang/Prelude/Optional/map
dhall-lang/Prelude/Optional/null
- dhall-lang/Prelude/Optional/package.dhall
dhall-lang/Prelude/Optional/toList
dhall-lang/Prelude/Optional/unzip
- dhall-lang/Prelude/Optional/*.dhall
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/package.dhall
dhall-lang/Prelude/Text/replicate
dhall-lang/Prelude/Text/show
dhall-lang/Prelude/Text/spaces
- dhall-lang/Prelude/Text/*.dhall
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/package.dhall
dhall-lang/Prelude/XML/render
dhall-lang/Prelude/XML/text
- dhall-lang/Prelude/XML/*.dhall
- dhall-lang/Prelude/*.dhall
- dhall-lang/Prelude/package.dhall
- dhall-lang/tests/alpha-normalization/success/unit/*.dhall
- dhall-lang/tests/alpha-normalization/success/regression/*.dhall
- dhall-lang/tests/binary-decode/failure/unit/*.dhallb
- dhall-lang/tests/binary-decode/success/unit/*.dhall
- dhall-lang/tests/binary-decode/success/unit/*.dhallb
- dhall-lang/tests/binary-decode/success/unit/imports/*.dhall
- dhall-lang/tests/binary-decode/success/unit/imports/*.dhallb
+ 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
- dhall-lang/tests/import/data/*.dhall
- dhall-lang/tests/import/data/*.txt
- dhall-lang/tests/import/failure/*.dhall
- dhall-lang/tests/import/failure/unit/*.dhall
- dhall-lang/tests/import/success/*.dhall
- dhall-lang/tests/import/success/unit/*.dhall
- dhall-lang/tests/import/success/unit/asLocation/*.dhall
- dhall-lang/tests/normalization/success/*.dhall
- dhall-lang/tests/normalization/success/haskell-tutorial/access/*.dhall
- dhall-lang/tests/normalization/success/haskell-tutorial/combineTypes/*.dhall
- dhall-lang/tests/normalization/success/haskell-tutorial/prefer/*.dhall
- dhall-lang/tests/normalization/success/haskell-tutorial/projection/*.dhall
- dhall-lang/tests/normalization/success/regression/*.dhall
- dhall-lang/tests/normalization/success/simple/*.dhall
- dhall-lang/tests/normalization/success/simplifications/*.dhall
- dhall-lang/tests/normalization/success/unit/*.dhall
- dhall-lang/tests/parser/failure/*.dhall
- dhall-lang/tests/parser/failure/spacing/*.dhall
- dhall-lang/tests/parser/failure/unit/*.dhall
- dhall-lang/tests/parser/success/*.dhall
- dhall-lang/tests/parser/success/*.dhallb
- dhall-lang/tests/parser/success/text/*.dhall
- dhall-lang/tests/parser/success/text/*.dhallb
- dhall-lang/tests/parser/success/unit/*.dhall
- dhall-lang/tests/parser/success/unit/*.dhallb
- dhall-lang/tests/parser/success/unit/operators/*.dhall
- dhall-lang/tests/parser/success/unit/operators/*.dhallb
- dhall-lang/tests/parser/success/unit/import/*.dhall
- dhall-lang/tests/parser/success/unit/import/*.dhallb
- dhall-lang/tests/parser/success/unit/import/urls/*.dhall
- dhall-lang/tests/parser/success/unit/import/urls/*.dhallb
- dhall-lang/tests/semantic-hash/success/*.dhall
- dhall-lang/tests/semantic-hash/success/*.hash
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/*.dhall
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/*.hash
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/*.dhall
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/combineTypes/*.hash
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/*.dhall
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/prefer/*.hash
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/*.dhall
- dhall-lang/tests/semantic-hash/success/haskell-tutorial/projection/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/and/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/and/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/build/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/build/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/even/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/even/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/fold/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/not/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/not/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/odd/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/or/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/or/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Bool/show/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Bool/show/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Double/show/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Double/show/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Integer/show/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Integer/show/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Integer/toDouble/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/all/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/all/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/any/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/any/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/build/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/build/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/concat/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/concat/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/concatMap/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/filter/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/filter/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/fold/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/fold/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/generate/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/generate/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/head/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/head/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/indexed/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/indexed/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/iterate/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/iterate/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/last/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/last/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/length/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/length/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/map/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/map/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/null/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/null/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/replicate/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/replicate/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/reverse/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/reverse/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/shifted/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/shifted/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/List/unzip/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/List/unzip/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/build/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/build/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/enumerate/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/even/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/even/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/fold/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/isZero/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/odd/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/product/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/product/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/show/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/show/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/sum/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/toDouble/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Natural/toInteger/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/all/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/all/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/any/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/any/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/build/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/build/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/concat/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/filter/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/fold/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/head/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/head/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/last/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/last/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/length/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/length/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/map/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/map/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/null/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/null/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/toList/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Optional/unzip/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Text/concat/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Text/concat/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Text/concatMap/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Text/concatMapSep/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Text/concatSep/*.hash
- dhall-lang/tests/semantic-hash/success/prelude/Text/show/*.dhall
- dhall-lang/tests/semantic-hash/success/prelude/Text/show/*.hash
- dhall-lang/tests/semantic-hash/success/simple/*.dhall
- dhall-lang/tests/semantic-hash/success/simple/*.hash
- dhall-lang/tests/semantic-hash/success/simplifications/*.dhall
- dhall-lang/tests/semantic-hash/success/simplifications/*.hash
- dhall-lang/tests/type-inference/failure/*.dhall
- dhall-lang/tests/type-inference/success/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/and/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/build/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/even/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/fold/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/not/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/odd/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/or/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Bool/show/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Double/show/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Integer/show/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/all/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/any/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/build/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/concat/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/concatMap/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/filter/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/fold/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/generate/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/head/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/indexed/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/iterate/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/last/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/length/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/map/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/null/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/replicate/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/reverse/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/shifted/*.dhall
- dhall-lang/tests/type-inference/success/prelude/List/unzip/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Monoid/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/build/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/even/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/fold/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/isZero/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/odd/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/product/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/show/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/sum/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/all/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/any/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/build/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/concat/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/filter/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/fold/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/head/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/last/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/length/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/map/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/null/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/toList/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Optional/unzip/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Text/concat/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Text/concatMap/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/*.dhall
- dhall-lang/tests/type-inference/success/prelude/Text/concatSep/*.dhall
- dhall-lang/tests/type-inference/success/regression/*.dhall
- dhall-lang/tests/type-inference/success/simple/*.dhall
- dhall-lang/tests/type-inference/success/simple/access/*.dhall
- dhall-lang/tests/type-inference/success/unit/*.dhall
- tests/diff/*.dhall
- tests/diff/*.txt
- tests/format/*.dhall
- tests/freeze/*.dhall
- tests/lint/success/*.dhall
- tests/recursive/*.dhall
- tests/regression/*.dhall
- tests/schemas/*.dhall
- tests/tags/*.dhall
- tests/tags/*.tags
- tests/th/*.dhall
- tests/tutorial/*.dhall
+ tests/**/*.dhall
+ tests/**/*.tags
+ tests/**/*.txt
Source-Repository head
Type: git
@@ -466,62 +198,85 @@
Default: False
Manual: True
-Library
- Hs-Source-Dirs: src
+Flag network-tests
+ Description: Enable tests which depend on an internet connection
+ Default: True
+ Manual: True
+
+Common common
Build-Depends:
base >= 4.11.0.0 && < 5 ,
- aeson >= 1.0.0.0 && < 1.6 ,
+ aeson >= 1.0.0.0 && < 2.3 ,
aeson-pretty < 0.9 ,
- ansi-terminal >= 0.6.3.1 && < 0.12,
+ ansi-terminal >= 0.6.3.1 && < 1.2 ,
atomic-write >= 0.2.0.7 && < 0.3 ,
- bytestring < 0.11,
+ 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.7 ,
+ containers >= 0.5.8.0 && < 0.9 ,
contravariant < 1.6 ,
data-fix < 0.4 ,
- deepseq < 1.5 ,
- Diff >= 0.2 && < 0.5 ,
+ 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,
- filepath >= 1.4 && < 1.5 ,
+ filepath >= 1.4 && < 1.6 ,
half >= 0.2.2.3 && < 0.4 ,
haskeline >= 0.7.2.1 && < 0.9 ,
- hashable >= 1.2 && < 1.4 ,
- lens-family-core >= 1.0.0 && < 2.2 ,
- megaparsec >= 7 && < 9.1 ,
- memory >= 0.14 && < 0.16,
- mmorph < 1.2 ,
- mtl >= 2.2.1 && < 2.3 ,
+ 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.17,
+ optparse-applicative >= 0.14.0.0 && < 0.20,
parsers >= 0.12.4 && < 0.13,
parser-combinators ,
- prettyprinter >= 1.5.1 && < 1.8 ,
- prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 ,
- pretty-simple < 4.1 ,
- profunctors >= 3.1.2 && < 5.7 ,
+ 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 ,
- template-haskell >= 2.13.0.0 && < 2.17,
- text >= 0.11.1.0 && < 1.3 ,
- text-manipulate >= 0.2.0.1 && < 0.3 ,
+ 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 ,
- transformers >= 0.2.0.0 && < 0.6 ,
- transformers-compat >= 0.6.2 && < 0.7 ,
+ 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 ,
- uri-encode < 1.6 ,
- 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:
@@ -530,7 +285,7 @@
else
Hs-Source-Dirs: ghc-src
Build-Depends:
- cryptonite >= 0.23 && < 1.0
+ cryptohash-sha256
if flag(with-http)
Build-Depends:
http-types >= 0.7.0 && < 0.13,
@@ -580,8 +335,11 @@
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
@@ -603,12 +361,39 @@
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
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:
@@ -618,118 +403,95 @@
Dhall.Import.HTTP
Dhall.Import.Manager
- GHC-Options: -Wall -fwarn-incomplete-uni-patterns
Default-Language: Haskell2010
Executable dhall
+ Import: common
Hs-Source-Dirs: dhall
Main-Is: Main.hs
- Build-Depends: base, dhall
- GHC-Options: -Wall -rtsopts
+ Build-Depends: dhall
+ GHC-Options: -rtsopts
Default-Language: Haskell2010
Test-Suite tasty
+ Import: common
Type: exitcode-stdio-1.0
Hs-Source-Dirs: tests
Main-Is: Dhall/Test/Main.hs
- GHC-Options: -Wall
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.TH
Dhall.Test.Tutorial
Dhall.Test.TypeInference
Dhall.Test.Util
+ if !flag(cross)
+ Other-Modules:
+ Dhall.Test.TH
Build-Depends:
- base >= 4 && < 5 ,
- bytestring < 0.11,
- cborg >= 0.2.0.0 && < 0.3 ,
- containers ,
- data-fix ,
- deepseq >= 1.2.0.1 && < 1.5 ,
dhall ,
- directory ,
- either ,
- filepath ,
foldl < 1.5 ,
- generic-random >= 1.3.0.0 && < 1.4 ,
+ generic-random >= 1.3.0.0 && < 1.6 ,
http-client ,
http-client-tls ,
- lens-family-core ,
- megaparsec ,
- prettyprinter ,
- QuickCheck >= 2.10 && < 2.15,
+ QuickCheck >= 2.14 && < 2.17,
quickcheck-instances >= 0.3.12 && < 0.4 ,
- scientific ,
- serialise ,
special-values < 0.2 ,
spoon < 0.4 ,
- tasty >= 0.11.2 && < 1.4 ,
+ tasty >= 0.11.2 && < 1.6 ,
tasty-expected-failure < 0.13,
tasty-hunit >= 0.10 && < 0.11,
- tasty-quickcheck >= 0.9.2 && < 0.11,
- tasty-silver < 3.2 ,
- template-haskell ,
- text >= 0.11.1.0 && < 1.3 ,
- transformers ,
- turtle < 1.6 ,
- unordered-containers ,
- vector >= 0.11.0.0 && < 0.13
- if flag(with-http)
- CPP-Options:
- -DWITH_HTTP
+ 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
Test-Suite doctest
+ Import: common
Type: exitcode-stdio-1.0
Hs-Source-Dirs: doctest
Main-Is: Main.hs
- GHC-Options: -Wall
Build-Depends:
- base ,
- directory ,
- filepath < 1.5 ,
mockery < 0.4 ,
- doctest >= 0.7.0 && < 0.18
+ doctest >= 0.7.0
+ if os(windows)
+ -- https://github.com/dhall-lang/dhall-haskell/issues/2237
+ Buildable: False
Default-Language: Haskell2010
Benchmark dhall-parser
+ Import: common
Type: exitcode-stdio-1.0
Hs-Source-Dirs: benchmark/parser
Main-Is: Main.hs
Build-Depends:
- base >= 4 && < 5 ,
- bytestring ,
- containers >= 0.5.0.0 && < 0.7,
dhall ,
- directory ,
- gauge >= 0.2.3 && < 0.3,
- text >= 0.11.1.0 && < 1.3
+ tasty-bench >= 0.4 && < 0.5,
Default-Language: Haskell2010
Other-Extensions:
TypeApplications
- ghc-options: -rtsopts -Wall
+ Ghc-Options: -rtsopts
Benchmark deep-nested-large-record
+ Import: common
Type: exitcode-stdio-1.0
Hs-Source-Dirs: benchmark/deep-nested-large-record
Main-Is: Main.hs
Build-Depends:
- base >= 4 && < 5 ,
- containers >= 0.5.0.0 && < 0.7,
dhall ,
- gauge >= 0.2.3 && < 0.3
+ tasty-bench >= 0.4 && < 0.5,
Default-Language: Haskell2010
- ghc-options: -Wall
diff --git a/doctest/Main.hs b/doctest/Main.hs
--- a/doctest/Main.hs
+++ b/doctest/Main.hs
@@ -1,22 +1,26 @@
{-# LANGUAGE CPP #-}
-module Main where
+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
- pwd <- System.Directory.getCurrentDirectory
+ 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"
@@ -31,11 +35,12 @@
, "in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person"
]
- Test.DocTest.doctest
+ Test.DocTest.doctest $
[ "-DWITH_HTTP"
, "-DUSE_HTTP_CLIENT_TLS"
, "--fast"
- , prefix "ghc-src"
+ ] <> args <>
+ [ prefix "ghc-src"
-- Unfortunately we cannot target the entire @src@ directory.
-- The reason is that src/Dhall/Version.hs depends on
@@ -44,11 +49,11 @@
-- Instead, we target a selection of modules whose combined module
-- dependency tree covers all modules that contain doctests.
- -- , prefix "src"
- , "-i" <> (prefix "src")
+ -- , src
+ , "-i" <> src
#if __GLASGOW_HASKELL__ >= 806
- , prefix "src/Dhall/Deriving.hs"
+ , src "Dhall/Deriving.hs"
#endif
- , prefix "src/Dhall/Tags.hs"
- , prefix "src/Dhall/Tutorial.hs"
+ , src "Dhall/Tags.hs"
+ , src "Dhall/Tutorial.hs"
]
diff --git a/ghc-src/Dhall/Crypto.hs b/ghc-src/Dhall/Crypto.hs
--- a/ghc-src/Dhall/Crypto.hs
+++ b/ghc-src/Dhall/Crypto.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -13,18 +14,18 @@
) where
import Control.DeepSeq (NFData)
-import Crypto.Hash (SHA256)
-import Data.ByteArray (ByteArrayAccess, convert)
-import Data.ByteArray.Encoding (Base (Base16), convertToBase)
import Data.ByteString (ByteString)
+import Data.Data (Data)
import GHC.Generics (Generic)
-import qualified Crypto.Hash
-import qualified Data.ByteString.Char8 as ByteString.Char8
+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 (Eq, Generic, Ord, NFData, ByteArrayAccess)
+ deriving (Data, Eq, Generic, Ord, NFData)
instance Show SHA256Digest where
show = toString
@@ -33,16 +34,14 @@
`Nothing` if the conversion fails
-}
sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest
-sha256DigestFromByteString bytes = SHA256Digest . convert <$> mh
- where
- mh = Crypto.Hash.digestFromByteString bytes :: Maybe (Crypto.Hash.Digest SHA256)
+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 bytes = SHA256Digest $ convert h
- where
- h = Crypto.Hash.hash bytes :: Crypto.Hash.Digest SHA256
+sha256Hash = SHA256Digest . Crypto.Hash.SHA256.hash
-- | 'String' representation of a 'SHA256Digest'
toString :: SHA256Digest -> String
-toString (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes
+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
--- a/ghc-src/Dhall/Import/HTTP.hs
+++ b/ghc-src/Dhall/Import/HTTP.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.Import.HTTP
( fetchFromHttpUrl
+ , fetchFromHttpUrlBytes
+ , originHeadersFileExpr
) where
import Control.Exception (Exception)
@@ -11,29 +14,35 @@
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
- ( Import (..)
+ ( 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 Network.HTTP.Client (HttpException (..), HttpExceptionContent (..))
import qualified Control.Exception
import qualified Control.Monad.Trans.State.Strict as State
-import qualified Data.List.NonEmpty as NonEmpty
+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 Data.Text.Lazy
-import qualified Data.Text.Lazy.Encoding
import qualified Dhall.Util
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types
@@ -65,6 +74,11 @@
<> "\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
@@ -141,7 +155,10 @@
prefixedText = Text.unlines prefixedLines
- e' -> "\n" <> show e' <> "\n"
+ e' -> "\n"
+ <> "\ESC[1;31mError\ESC[0m: " <> show e'
+ <> "\n"
+ <> "URL: " <> url <> "\n"
newManager :: StateT Status IO Manager
newManager = do
@@ -233,20 +250,36 @@
Control.Exception.throwIO (NotCORSCompliant {..})
corsCompliant _ _ _ = return ()
-type HTTPHeader = Network.HTTP.Types.Header
+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
-fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text
-fetchFromHttpUrl childURL mheaders = do
+ 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)
- request <- liftIO (HTTP.parseUrlThrow childURLString)
+ baseRequest <- liftIO (HTTP.parseUrlThrow childURLString)
- let requestWithHeaders =
- case mheaders of
- Nothing -> request
- Just headers -> request { HTTP.requestHeaders = headers }
+ let requestWithHeaders = addHeaders originHeaders mheaders baseRequest
let io = HTTP.httpLbs requestWithHeaders manager
@@ -258,14 +291,30 @@
Status {..} <- State.get
- let Chained parentImport = NonEmpty.head _stack
+ 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)
- let parentImportType = importType (importHashed parentImport)
+ corsCompliant parentImportType childURL (HTTP.responseHeaders response)
+ _ -> do
+ return ()
- corsCompliant parentImportType childURL (HTTP.responseHeaders response)
+ return (ByteString.Lazy.toStrict (HTTP.responseBody response))
- let bytes = HTTP.responseBody response
+fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text
+fetchFromHttpUrl childURL mheaders = do
+ bytes <- fetchFromHttpUrlBytes childURL mheaders
- case Data.Text.Lazy.Encoding.decodeUtf8' bytes of
+ case Data.Text.Encoding.decodeUtf8' bytes of
Left err -> liftIO (Control.Exception.throwIO err)
- Right text -> return (Data.Text.Lazy.toStrict text)
+ 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
--- a/ghc-src/Dhall/Import/Manager.hs
+++ b/ghc-src/Dhall/Import/Manager.hs
@@ -16,7 +16,7 @@
, defaultNewManager
) where
-import Network.HTTP.Client (Manager, newManager)
+import Network.HTTP.Client (Manager, newManager)
import qualified Network.HTTP.Client as HTTP
#ifdef USE_HTTP_CLIENT_TLS
diff --git a/ghcjs-src/Dhall/Crypto.hs b/ghcjs-src/Dhall/Crypto.hs
--- a/ghcjs-src/Dhall/Crypto.hs
+++ b/ghcjs-src/Dhall/Crypto.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE JavaScriptFFI #-}
+{-# LANGUAGE JavaScriptFFI #-}
{-| This module provides implementations of cryptographic utilities that only
work for GHCJS
@@ -12,32 +13,32 @@
, sha256Hash
) where
-import Control.DeepSeq (NFData)
-import Data.ByteArray (ByteArrayAccess)
-import Data.ByteArray.Encoding (Base(Base16), convertToBase)
-import Data.ByteString (ByteString)
-import GHC.Generics (Generic)
+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 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 (Eq, Generic, Ord, NFData, ByteArrayAccess)
+ deriving (Data, Eq, Generic, Ord, NFData)
instance Show SHA256Digest where
- show (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes
+ 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
+ | 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
diff --git a/ghcjs-src/Dhall/Import/HTTP.hs b/ghcjs-src/Dhall/Import/HTTP.hs
--- a/ghcjs-src/Dhall/Import/HTTP.hs
+++ b/ghcjs-src/Dhall/Import/HTTP.hs
@@ -2,17 +2,21 @@
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 (..))
-import Dhall.Import.Types (Status)
+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 as Text
+import qualified Data.Text.Encoding as Text.Encoding
import qualified JavaScript.XHR
fetchFromHttpUrl
@@ -35,3 +39,14 @@
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/man/dhall.1 b/man/dhall.1
--- a/man/dhall.1
+++ b/man/dhall.1
@@ -97,4 +97,4 @@
.SH BUGS
.PP
Please report any bugs you may come across to
-https://github.com/dhall-language/dhall-haskell/issues.
+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,2893 +1,579 @@
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# 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
- (
- -- * Input
- input
- , inputWithSettings
- , inputFile
- , inputFileWithSettings
- , inputExpr
- , inputExprWithSettings
- , rootDirectory
- , sourceName
- , startingContext
- , substitutions
- , normalizer
- , newManager
- , defaultInputSettings
- , InputSettings
- , defaultEvaluateSettings
- , EvaluateSettings
- , HasEvaluateSettings(..)
- , detailed
-
- -- * Decoders
- , Decoder (..)
- , RecordDecoder(..)
- , UnionDecoder(..)
- , Encoder(..)
- , FromDhall(..)
- , Interpret
- , InvalidDecoder(..)
- , ExtractErrors
- , ExtractError(..)
- , Extractor
- , MonadicExtractor
- , typeError
- , extractError
- , toMonadic
- , fromMonadic
- , ExpectedTypeErrors
- , ExpectedTypeError(..)
- , Expector
- , auto
- , genericAuto
- , genericAutoWith
- , InterpretOptions(..)
- , InputNormalizer(..)
- , defaultInputNormalizer
- , SingletonConstructors(..)
- , defaultInterpretOptions
- , bool
- , natural
- , integer
- , word
- , word8
- , word16
- , word32
- , word64
- , int
- , int8
- , int16
- , int32
- , int64
- , scientific
- , double
- , lazyText
- , strictText
- , maybe
- , sequence
- , list
- , vector
- , function
- , functionWith
- , setFromDistinctList
- , setIgnoringDuplicates
- , hashSetFromDistinctList
- , hashSetIgnoringDuplicates
- , Dhall.map
- , hashMap
- , pairFromMapEntry
- , unit
- , void
- , string
- , pair
- , record
- , field
- , union
- , constructor
- , GenericFromDhall(..)
- , GenericFromDhallUnion(..)
- , ToDhall(..)
- , Inject
- , inject
- , genericToDhall
- , genericToDhallWith
- , RecordEncoder(..)
- , encodeFieldWith
- , encodeField
- , recordEncoder
- , UnionEncoder(..)
- , encodeConstructorWith
- , encodeConstructor
- , unionEncoder
- , (>|<)
- , GenericToDhall(..)
-
- -- * Miscellaneous
- , DhallErrors(..)
- , showDhallErrors
- , rawInput
- , (>$<)
- , (>*<)
- , Result
-
- -- * Re-exports
- , Natural
- , Seq
- , Text
- , Vector
- , Generic
- ) where
-
-import Control.Applicative (Alternative, 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.Fix (Fix (..))
-import Data.Functor.Contravariant (Contravariant (..), Op (..), (>$<))
-import Data.Functor.Contravariant.Divisible (Divisible (..), divided)
-import Data.Hashable (Hashable)
-import Data.HashMap.Strict (HashMap)
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Map (Map)
-import Data.Scientific (Scientific)
-import Data.Sequence (Seq)
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Pretty)
-import Data.Typeable (Proxy (..), Typeable)
-import Data.Vector (Vector)
-import Data.Void (Void)
-import Data.Word (Word8, Word16, Word32, Word64)
-import Data.Int (Int8, Int16, Int32, Int64)
-import Dhall.Import (Imported (..))
-import Dhall.Parser (Src (..))
-import Dhall.Syntax
- ( Chunks (..)
- , DhallDouble (..)
- , Expr (..)
- , FunctionBinding (..)
- , RecordField (..)
- , Var (..)
- )
-import Dhall.TypeCheck (DetailedTypeError (..), TypeError)
-import GHC.Generics
-import Lens.Family (LensLike', view)
-import Numeric.Natural (Natural)
-import Prelude hiding (maybe, sequence)
-import System.FilePath (takeDirectory)
-
-import qualified Control.Applicative
-import qualified Control.Exception
-import qualified Control.Monad.Trans.State.Strict as State
-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
-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.IO
-import qualified Data.Text.Lazy
-import qualified Data.Vector
-import qualified Data.Void
-import qualified Dhall.Context
-import qualified Dhall.Core as Core
-import qualified Dhall.Import
-import qualified Dhall.Map
-import qualified Dhall.Parser
-import qualified Dhall.Pretty.Internal
-import qualified Dhall.Substitution
-import qualified Dhall.TypeCheck
-import qualified Dhall.Util
-import qualified Lens.Family
-
--- $setup
--- >>> :set -XOverloadedStrings
--- >>> :set -XRecordWildCards
--- >>> import Data.Word (Word8, Word16, Word32, Word64)
--- >>> import Dhall.Pretty.Internal (prettyExpr)
-
-{-| 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"
-
-{-| Useful synonym for the `Validation` type used when marshalling Dhall
- expressions
--}
-type Extractor s a = Validation (ExtractErrors s a)
-
-{-| Useful synonym for the equivalent `Either` type used when marshalling Dhall
- code
--}
-type MonadicExtractor s a = Either (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 `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"
-
--- | 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
-
-{-| 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
-
-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) =
- _ERROR <> ": Failed extraction \n\
- \ \n\
- \The expression type-checked successfully but the transformation to the target \n\
- \type failed with the following error: \n\
- \ \n\
- \" <> Data.Text.unpack es <> "\n\
- \ \n"
-
-instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractError s a)
-
-{-| 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 (Typeable)
-
-instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecoder s a)
-
-_ERROR :: String
-_ERROR = "\ESC[1;31mError\ESC[0m"
-
-instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where
- show InvalidDecoder { .. } =
- _ERROR <> ": Invalid Dhall.Decoder \n\
- \ \n\
- \Every Decoder must provide an extract function that succeeds if an expression \n\
- \matches the expected type. You provided a Decoder that disobeys this contract \n\
- \ \n\
- \The Decoder provided has the expected dhall type: \n\
- \ \n\
- \" <> show txt0 <> "\n\
- \ \n\
- \and it couldn't extract a value from the well-typed expression: \n\
- \ \n\
- \" <> show txt1 <> "\n\
- \ \n"
- where
- txt0 = Dhall.Util.insert invalidDecoderExpected
- txt1 = Dhall.Util.insert invalidDecoderExpression
-
--- | @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
- :: (Functor f)
- => LensLike' f InputSettings FilePath
-rootDirectory k s =
- fmap (\x -> s { _rootDirectory = x }) (k (_rootDirectory s))
-
--- | 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
- :: (Functor f)
- => LensLike' f InputSettings FilePath
-sourceName k s =
- fmap (\x -> s { _sourceName = x}) (k (_sourceName s))
-
--- | @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
- :: (Functor f, HasEvaluateSettings s)
- => LensLike' f s (Dhall.Context.Context (Expr Src Void))
-startingContext = evaluateSettings . l
- where
- l :: (Functor f)
- => LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src Void))
- l k s = fmap (\x -> s { _startingContext = x}) (k (_startingContext s))
-
--- | Access the custom substitutions.
---
--- @since 1.30
-substitutions
- :: (Functor f, HasEvaluateSettings s)
- => LensLike' f s (Dhall.Substitution.Substitutions Src Void)
-substitutions = evaluateSettings . l
- where
- l :: (Functor f)
- => LensLike' f EvaluateSettings (Dhall.Substitution.Substitutions Src Void)
- l k s = fmap (\x -> s { _substitutions = x }) (k (_substitutions s))
-
--- | Access the custom normalizer.
---
--- @since 1.16
-normalizer
- :: (Functor f, HasEvaluateSettings s)
- => LensLike' f s (Maybe (Core.ReifiedNormalizer Void))
-normalizer = evaluateSettings . l
- where
- l :: (Functor f)
- => LensLike' f EvaluateSettings (Maybe (Core.ReifiedNormalizer Void))
- l k s = fmap (\x -> s { _normalizer = x }) (k (_normalizer s))
-
--- | Access the HTTP manager initializer.
---
--- @since 1.36
-newManager
- :: (Functor f, HasEvaluateSettings s)
- => LensLike' f s (IO Dhall.Import.Manager)
-newManager = evaluateSettings . l
- where
- l :: (Functor f)
- => LensLike' f EvaluateSettings (IO Dhall.Import.Manager)
- l k s = fmap (\x -> s { _newManager = x }) (k (_newManager s))
-
--- | @since 1.16
-class HasEvaluateSettings s where
- evaluateSettings
- :: (Functor f)
- => LensLike' f s EvaluateSettings
-
-instance HasEvaluateSettings InputSettings where
- evaluateSettings k s =
- fmap (\x -> s { _evaluateSettings = x }) (k (_evaluateSettings s))
-
-instance HasEvaluateSettings EvaluateSettings where
- evaluateSettings = id
-
-{-| 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 {..}) txt = do
- expected' <- case expected of
- Success x -> return x
- Failure e -> Control.Exception.throwIO e
-
- let suffix = Dhall.Pretty.Internal.prettyToStrictText expected'
- let annotate substituted = case substituted of
- Note (Src begin end bytes) _ ->
- Note (Src begin end bytes') (Annot substituted expected')
- where
- bytes' = bytes <> " : " <> suffix
- _ ->
- Annot substituted expected'
-
- normExpr <- inputHelper annotate settings txt
-
- case extract normExpr 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 = inputHelper id
-
-{-| Helper function for the input* function family
-
-@since 1.30
--}
-inputHelper
- :: (Expr Src Void -> Expr Src Void)
- -> InputSettings
- -> Text
- -- ^ The Dhall program
- -> IO (Expr Src Void)
- -- ^ The fully normalized AST
-inputHelper annotate settings txt = do
- expr <- Core.throws (Dhall.Parser.exprFromText (view sourceName settings) txt)
-
- let InputSettings {..} = settings
-
- let EvaluateSettings {..} = _evaluateSettings
-
- let transform =
- Lens.Family.set Dhall.Import.substitutions _substitutions
- . Lens.Family.set Dhall.Import.normalizer _normalizer
- . Lens.Family.set Dhall.Import.startingContext _startingContext
-
- let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory)
-
- expr' <- State.evalStateT (Dhall.Import.loadWith expr) status
-
- let substituted = Dhall.Substitution.substitute expr' $ view substitutions settings
- let annot = annotate substituted
- _ <- Core.throws (Dhall.TypeCheck.typeWith (view startingContext settings) annot)
- pure (Core.normalizeWith (view normalizer settings) substituted)
-
--- | 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)
-
-{-| 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 `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)
-
-{-| 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`
-r
-
->>> 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 lazy `Data.Text.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 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 "_" 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 Data.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@
-
->>> input (Dhall.hashMap strictText bool) "toMap { a = True, b = False }"
-fromList [("a",True),("b",False)]
->>> input (Dhall.hashMap 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.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, @'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')]
-
-{-| Any value that implements `FromDhall` can be automatically decoded based on
- the inferred return type of `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' 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`
-
-This will eventually be removed.
--}
-type Interpret = FromDhall
-
-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 {-# OVERLAPS #-} FromDhall [Char] where
- autoWith _ = string
-
-instance FromDhall Data.Text.Lazy.Text where
- autoWith _ = lazyText
-
-instance FromDhall Text where
- autoWith _ = strictText
-
-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)
-
-{-| 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.map (autoWith inputNormalizer) (autoWith inputNormalizer)
-
-instance (Eq k, Hashable k, FromDhall k, FromDhall v) => FromDhall (HashMap k v) where
- autoWith inputNormalizer = Dhall.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)
-
-{-| Use the default input normalizer for interpreting a configuration file
-
-> auto = autoWith defaultInputNormalizer
--}
-auto :: FromDhall a => Decoder a
-auto = autoWith defaultInputNormalizer
-
-{-| This type is exactly the same as `Data.Fix.Fix` except with a different
- `FromDhall` instance. This intermediate type simplifies the implementation
- of the inner loop for the `FromDhall` instance for `Fix`
--}
-newtype Result f = Result { _unResult :: f (Result f) }
-
-resultToFix :: Functor f => Result f -> Fix f
-resultToFix (Result x) = Fix (fmap resultToFix x)
-
-instance FromDhall (f (Result f)) => FromDhall (Result f) where
- autoWith inputNormalizer = Decoder {..}
- where
- extract (App _ expr) =
- fmap Result (Dhall.extract (autoWith inputNormalizer) expr)
- extract expr = typeError expected expr
-
- expected = pure "result"
-
--- | 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.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 "result" (Const Core.Type) (Pi "Make" (Pi "_" x "result") "result"))
- <$> Dhall.expected (autoWith inputNormalizer :: Decoder (f (Result f)))
-
-{-| `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 = withProxy (\p -> fmap to (evalState (genericAutoWithNormalizer p defaultInputNormalizer options) 1))
- where
- withProxy :: (Proxy a -> Decoder a) -> Decoder a
- withProxy f = f Proxy
-
-
-{-| Use these options to tweak how Dhall derives a generic implementation of
- `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 `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
- }
-
-{-| 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
-
-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
-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))
-
-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 [])
-
-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)
-
-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 {..})
-
-{-| 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 `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' 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`
-
-This will eventually be removed.
--}
-type Inject = ToDhall
-
-{-| Use the default input normalizer for injecting a value
-
-> inject = injectWith defaultInputNormalizer
--}
-inject :: ToDhall a => Encoder a
-inject = injectWith defaultInputNormalizer
-
-{-| 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
- = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer defaultInputNormalizer options) 1)
-
-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.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
-
-{-|
-
->>> embed inject (12 :: Word)
-NaturalLit 12
--}
-
-instance ToDhall Word where
- injectWith _ = Encoder {..}
- where
- embed = NaturalLit . fromIntegral
-
- declared = Natural
-
-{-|
-
->>> embed inject (12 :: Word8)
-NaturalLit 12
--}
-
-instance ToDhall Word8 where
- injectWith _ = Encoder {..}
- where
- embed = NaturalLit . fromIntegral
-
- declared = Natural
-
-{-|
-
->>> embed inject (12 :: Word16)
-NaturalLit 12
--}
-
-instance ToDhall Word16 where
- injectWith _ = Encoder {..}
- where
- embed = NaturalLit . fromIntegral
-
- declared = Natural
-
-{-|
-
->>> embed inject (12 :: Word32)
-NaturalLit 12
--}
-
-instance ToDhall Word32 where
- injectWith _ = Encoder {..}
- where
- embed = NaturalLit . fromIntegral
-
- declared = 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
-
-{-| 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
-
->>> let x = Data.HashSet.fromList ["hi", "mom" :: Text]
->>> prettyExpr $ embed inject x
-[ "mom", "hi" ]
-
--}
-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
-
-{-| This is the underlying class that powers the `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
-
-{-| 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.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.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.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) )
-
--- | Infix 'divided'
-(>*<) :: Divisible f => f a -> f b -> f (a, b)
-(>*<) = divided
-
-infixr 5 >*<
-
-{-| 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
-
-{-| 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
-
-{-| 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
-
--- | 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
-
-{-| '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)
-
--- | 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 >|<
-
--- | 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 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 )
- )
-
-{-| 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
+{-# 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
--- a/src/Dhall/Binary.hs
+++ b/src/Dhall/Binary.hs
@@ -13,15 +13,11 @@
-}
module Dhall.Binary
- ( -- * Standard versions
- StandardVersion(..)
- , renderStandardVersion
-
- -- * Encoding and decoding
- , encodeExpression
+ ( -- * Encoding and decoding
+ encodeExpression
, decodeExpression
- -- * Exceptions
+ -- * Exceptions
, DecodingFailure(..)
) where
@@ -51,61 +47,33 @@
, Scheme (..)
, URL (..)
, Var (..)
+ , WithComponent (..)
)
import Data.Foldable (toList)
-import Data.Text (Text)
+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.ByteArray
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.Set
import qualified Dhall.Syntax as Syntax
import qualified Text.Printf as Printf
-{-| Supported version strings
-
- This exists primarily for backwards compatibility for expressions encoded
- before Dhall removed version tags from the binary encoding
--}
-data StandardVersion
- = NoVersion
- -- ^ No version string
- | V_5_0_0
- -- ^ Version "5.0.0"
- | V_4_0_0
- -- ^ Version "4.0.0"
- | V_3_0_0
- -- ^ Version "3.0.0"
- | V_2_0_0
- -- ^ Version "2.0.0"
- | V_1_0_0
- -- ^ Version "1.0.0"
- deriving (Enum, Bounded)
-
--- | Render a `StandardVersion` as `Data.Text.Text`
-renderStandardVersion :: StandardVersion -> Text
-renderStandardVersion NoVersion = "none"
-renderStandardVersion V_1_0_0 = "1.0.0"
-renderStandardVersion V_2_0_0 = "2.0.0"
-renderStandardVersion V_3_0_0 = "3.0.0"
-renderStandardVersion V_4_0_0 = "4.0.0"
-renderStandardVersion V_5_0_0 = "5.0.0"
-
{-| Convert a function applied to multiple arguments to the base function and
the list of arguments
-}
@@ -168,20 +136,26 @@
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
- 9 | sb == "List/fold" -> return ListFold
+ | 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
@@ -195,6 +169,7 @@
| 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
@@ -261,7 +236,7 @@
b <- go
- return (Lam (Syntax.makeFunctionBinding "_" _A) b)
+ return (Lam mempty (Syntax.makeFunctionBinding "_" _A) b)
4 -> do
x <- Decoding.decodeString
@@ -274,7 +249,7 @@
b <- go
- return (Lam (Syntax.makeFunctionBinding x _A) b)
+ return (Lam mempty (Syntax.makeFunctionBinding x _A) b)
_ ->
die ("Incorrect number of tokens used to encode a λ expression: " <> show len)
@@ -286,7 +261,7 @@
_B <- go
- return (Pi "_" _A _B)
+ return (Pi mempty "_" _A _B)
4 -> do
x <- Decoding.decodeString
@@ -299,7 +274,7 @@
_B <- go
- return (Pi x _A _B)
+ return (Pi mempty x _A _B)
_ ->
die ("Incorrect number of tokens used to encode a ∀ expression: " <> show len)
@@ -316,11 +291,11 @@
5 -> return NaturalTimes
6 -> return TextAppend
7 -> return ListAppend
- 8 -> return (Combine Nothing)
- 9 -> return (Prefer PreferFromSource)
- 10 -> return CombineTypes
+ 8 -> return (Combine mempty Nothing)
+ 9 -> return (Prefer mempty PreferFromSource)
+ 10 -> return (CombineTypes mempty)
11 -> return ImportAlt
- 12 -> return Equivalent
+ 12 -> return (Equivalent mempty)
13 -> return RecordCompletion
_ -> die ("Unrecognized operator code: " <> show opcode)
@@ -415,7 +390,7 @@
TypeString -> do
x <- Decoding.decodeString
- return (Left (Dhall.Set.fromList [x]))
+ return (Left [x])
_ ->
die ("Unexpected token type for projection: " <> show tokenType₂)
@@ -423,7 +398,7 @@
_ -> do
xs <- replicateDecoder (len - 2) Decoding.decodeString
- return (Left (Dhall.Set.fromList xs))
+ return (Left xs)
return (Project t xs)
@@ -589,8 +564,19 @@
n <- Decoding.decodeListLen
- ks₀ <- replicateDecoder n Decoding.decodeString
+ 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"
@@ -601,6 +587,82 @@
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)
@@ -685,6 +747,9 @@
Bool ->
Encoding.encodeUtf8ByteArray "Bool"
+ Bytes ->
+ Encoding.encodeUtf8ByteArray "Bytes"
+
Optional ->
Encoding.encodeUtf8ByteArray "Optional"
@@ -709,6 +774,24 @@
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"
@@ -731,26 +814,26 @@
where
(function, arguments) = unApply a
- Lam (FunctionBinding { functionBindingVariable = "_", functionBindingAnnotation = _A }) b ->
+ Lam _ (FunctionBinding { functionBindingVariable = "_", functionBindingAnnotation = _A }) b ->
encodeList3
(Encoding.encodeInt 1)
(go _A)
(go b)
- Lam (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A }) b ->
+ Lam _ (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A }) b ->
encodeList4
(Encoding.encodeInt 1)
(Encoding.encodeString x)
(go _A)
(go b)
- Pi "_" _A _B ->
+ Pi _ "_" _A _B ->
encodeList3
(Encoding.encodeInt 2)
(go _A)
(go _B)
- Pi x _A _B ->
+ Pi _ x _A _B ->
encodeList4
(Encoding.encodeInt 2)
(Encoding.encodeString x)
@@ -769,6 +852,11 @@
BoolNE l r ->
encodeOperator 3 l r
+ BytesLit b ->
+ encodeList2
+ (Encoding.encodeInt 33)
+ (Encoding.encodeBytes b)
+
NaturalPlus l r ->
encodeOperator 4 l r
@@ -781,19 +869,19 @@
ListAppend l r ->
encodeOperator 7 l r
- Combine _ l r ->
+ Combine _ _ l r ->
encodeOperator 8 l r
- Prefer _ l r ->
+ Prefer _ _ l r ->
encodeOperator 9 l r
- CombineTypes l r ->
+ CombineTypes _ l r ->
encodeOperator 10 l r
ImportAlt l r ->
encodeOperator 11 l r
- Equivalent l r ->
+ Equivalent _ l r ->
encodeOperator 12 l r
RecordCompletion l r ->
@@ -852,10 +940,10 @@
Project t (Left xs) ->
encodeListN
- (2 + Dhall.Set.size xs)
+ (2 + length xs)
( Encoding.encodeInt 10
: go t
- : map Encoding.encodeString (Dhall.Set.toList xs)
+ : map Encoding.encodeString xs
)
Project t (Right _T) ->
@@ -968,9 +1056,60 @@
encodeList4
(Encoding.encodeInt 29)
(go l)
- (encodeList (fmap Encoding.encodeString ks))
+ (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
@@ -1045,6 +1184,7 @@
0 -> return Code
1 -> return RawText
2 -> return Location
+ 3 -> return RawBytes
_ -> die ("Unexpected code for import mode: " <> show m)
let remote scheme = do
@@ -1181,9 +1321,13 @@
Encoding.encodeNull
Just digest ->
- Encoding.encodeBytes ("\x12\x20" <> Data.ByteArray.convert digest)
+ Encoding.encodeBytes ("\x12\x20" <> Dhall.Crypto.unSHA256Digest digest)
- m = Encoding.encodeInt (case importMode of Code -> 0; RawText -> 1; Location -> 2;)
+ m = Encoding.encodeInt (case importMode of
+ Code -> 0
+ RawText -> 1
+ Location -> 2
+ RawBytes -> 3 )
Import{..} = import_
diff --git a/src/Dhall/Core.hs b/src/Dhall/Core.hs
--- a/src/Dhall/Core.hs
+++ b/src/Dhall/Core.hs
@@ -31,6 +31,7 @@
, makeFunctionBinding
, FieldSelection (..)
, makeFieldSelection
+ , WithComponent (..)
, Expr(..)
-- * Normalization
@@ -56,6 +57,7 @@
-- * Optics
, subExpressions
+ , subExpressionsWith
, chunkExprs
, bindingExprs
, recordFieldExprs
@@ -75,24 +77,22 @@
, Eval.textShow
, censorExpression
, censorText
- , Syntax.desugarWith
) where
-import Control.Exception (Exception)
-import Control.Monad.IO.Class (MonadIO (..))
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Pretty)
+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.Src (Src (..))
import Dhall.Syntax
-import Instances.TH.Lift ()
-import Lens.Family (over)
+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
-import qualified Dhall.Syntax as Syntax
-- | Pretty-print a value
pretty :: Pretty a => a -> Text
@@ -142,6 +142,7 @@
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
diff --git a/src/Dhall/Deriving.hs b/src/Dhall/Deriving.hs
--- a/src/Dhall/Deriving.hs
+++ b/src/Dhall/Deriving.hs
@@ -1,7 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
diff --git a/src/Dhall/Diff.hs b/src/Dhall/Diff.hs
--- a/src/Dhall/Diff.hs
+++ b/src/Dhall/Diff.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-| This module provides functionality for concisely displaying the difference
@@ -16,17 +17,16 @@
, diff
) where
-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.Text.Prettyprint.Doc (Doc, Pretty)
-import Data.Void (Void)
-import Dhall.Map (Map)
-import Dhall.Pretty.Internal (Ann)
-import Dhall.Set (Set)
+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 (..)
@@ -36,19 +36,21 @@
, FunctionBinding (..)
, RecordField (..)
, Var (..)
+ , WithComponent (..)
)
-import Numeric.Natural (Natural)
+import Numeric.Natural (Natural)
+import Prettyprinter (Doc, Pretty)
-import qualified Data.Algorithm.Diff as Algo.Diff
+import qualified Data.Algorithm.Diff as Algo.Diff
import qualified Data.List.NonEmpty
import qualified Data.Set
import qualified Data.Text
-import qualified Data.Text.Prettyprint.Doc as Pretty
+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.Set
-import qualified Dhall.Syntax as Syntax
+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
@@ -123,8 +125,8 @@
equals :: Diff
equals = token Internal.equals
-forall :: Diff
-forall = token (Internal.forall Internal.Unicode)
+forall_ :: Diff
+forall_ = token (Internal.forall_ Internal.Unicode)
lambda :: Diff
lambda = token (Internal.lambda Internal.Unicode)
@@ -174,20 +176,21 @@
diffLabel :: Text -> Text -> Diff
diffLabel = diffPrimitive (token . Internal.prettyLabel)
-diffLabels :: Set Text -> Set Text -> Diff
+diffLabels :: [Text] -> [Text] -> Diff
diffLabels ksL ksR =
braced (diffFieldNames <> (if anyEqual then [ ignore ] else []))
where
- extraL = Dhall.Set.difference ksL ksR
- extraR = Dhall.Set.difference ksR ksL
+ 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
- (Dhall.Set.toSet ksL)
- (Dhall.Set.toSet ksR)))
+ anyEqual = not (Data.Set.null (Data.Set.intersection setL setR))
diffNatural :: Natural -> Natural -> Diff
diffNatural = diffPrimitive (token . Internal.prettyNatural)
@@ -195,6 +198,22 @@
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)
@@ -357,7 +376,7 @@
diffTextSkeleton = difference textSkeleton textSkeleton
- chunks = zipWith chunkDiff (toEitherList cL) (toEitherList cR)
+ chunks = zipWith chunkDiff (toEitherList cL) (toEitherList cR)
chunkDiff a b =
case (a, b) of
@@ -365,6 +384,10 @@
(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
@@ -514,6 +537,10 @@
<> keyword "else"
<> " "
<> ignore
+skeleton (BytesLit {}) =
+ "0x\""
+ <> ignore
+ <> "\""
skeleton (NaturalPlus {}) =
ignore
<> " "
@@ -619,6 +646,10 @@
keyword "toMap"
<> " "
<> ignore
+skeleton (ShowConstructor {}) =
+ keyword "showConstructor"
+ <> " "
+ <> ignore
skeleton (Field {}) =
ignore
<> dot
@@ -648,8 +679,8 @@
enclosed' " " (rarrow <> " ") (docs l r)
where
docs
- (Lam (FunctionBinding { functionBindingVariable = aL, functionBindingAnnotation = bL }) cL)
- (Lam (FunctionBinding { functionBindingVariable = aR, functionBindingAnnotation = bR }) cR) =
+ (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
@@ -708,14 +739,14 @@
diff l@(Pi {}) r@(Pi {}) =
enclosed' " " (rarrow <> " ") (docs l r)
where
- docs (Pi aL bL cL) (Pi aR bR cR) =
+ 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
+ forall_
<> lparen
<> format " " docA
<> colon
@@ -766,6 +797,15 @@
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)
@@ -902,7 +942,7 @@
diffCombineExpression l@(Combine {}) r@(Combine {}) =
enclosed' " " (operator "∧" <> " ") (docs l r)
where
- docs (Combine _ aL bL) (Combine _ aR bR) =
+ docs (Combine _ _ aL bL) (Combine _ _ aR bR) =
Data.List.NonEmpty.cons (diffPreferExpression aL aR) (docs bL bR)
docs aL aR =
pure (diffPreferExpression aL aR)
@@ -917,7 +957,7 @@
diffPreferExpression l@(Prefer {}) r@(Prefer {}) =
enclosed' " " (operator "⫽" <> " ") (docs l r)
where
- docs (Prefer _ aL bL) (Prefer _ aR bR) =
+ docs (Prefer _ _ aL bL) (Prefer _ _ aR bR) =
Data.List.NonEmpty.cons (diffCombineTypesExpression aL aR) (docs bL bR)
docs aL aR =
pure (diffCombineTypesExpression aL aR)
@@ -932,7 +972,7 @@
diffCombineTypesExpression l@(CombineTypes {}) r@(CombineTypes {}) =
enclosed' " " (operator "*" <> " ") (docs l r)
where
- docs (CombineTypes aL bL) (CombineTypes aR bR) =
+ docs (CombineTypes _ aL bL) (CombineTypes _ aR bR) =
Data.List.NonEmpty.cons (diffTimesExpression aL aR) (docs bL bR)
docs aL aR =
pure (diffTimesExpression aL aR)
@@ -993,7 +1033,7 @@
diffEquivalentExpression l@(Equivalent {}) r@(Equivalent {}) =
enclosed' " " (operator "≡" <> " ") (docs l r)
where
- docs (Equivalent aL bL) (Equivalent aR bR) =
+ docs (Equivalent _ aL bL) (Equivalent _ aR bR) =
Data.List.NonEmpty.cons (diffApplicationExpression aL aR) (docs bL bR)
docs aL aR =
pure (diffApplicationExpression aL aR)
@@ -1037,12 +1077,15 @@
( format " " (diffImportExpression eL eR)
<> "with "
<> align
- ( format " " (diffPath ksL ksR)
+ ( 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') =
@@ -1135,6 +1178,18 @@
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 =
@@ -1249,6 +1304,42 @@
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 =
@@ -1341,6 +1432,24 @@
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
diff --git a/src/Dhall/DirectoryTree.hs b/src/Dhall/DirectoryTree.hs
--- a/src/Dhall/DirectoryTree.hs
+++ b/src/Dhall/DirectoryTree.hs
@@ -1,31 +1,67 @@
+{-# 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 Data.Void (Void)
-import Dhall.Syntax (Chunks (..), Expr (..), RecordField (..))
-import System.FilePath (())
+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.Foldable as Foldable
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text.IO
-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
-import qualified Dhall.Map as Map
+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.Util as Util
-import qualified System.Directory as Directory
-import qualified System.FilePath as FilePath
+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:
@@ -37,6 +73,9 @@
* @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" }
@@ -59,8 +98,7 @@
> 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:
+ 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
@@ -81,17 +119,69 @@
> ! "bar": null
> ! "foo": "Hello"
- This utility does not take care of type-checking and normalizing the
- provided expression. This will raise a `FilesystemError` exception upon
- encountering an expression that cannot be converted as-is.
+ /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 :: FilePath -> Expr Void Void -> IO ()
-toDirectoryTree path expression = case expression of
+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 (Record [ ("mapKey", recordFieldValue -> Text), ("mapValue", _) ])) [] ->
- return ()
+ ListLit (Just (App List (Record [ ("mapKey", recordFieldValue -> Text), ("mapValue", _) ]))) [] ->
+ Directory.createDirectoryIfMissing allowSeparators path
ListLit _ records
| not (null records)
@@ -102,14 +192,22 @@
Text.IO.writeFile path text
Some value ->
- toDirectoryTree path value
+ toDirectoryTree allowSeparators path value
- App (Field (Union _) _) value ->
- toDirectoryTree 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
@@ -124,18 +222,209 @@
empty
process key value = do
- if Text.isInfixOf (Text.pack [ FilePath.pathSeparator ]) key
- then die
- else return ()
+ when (not allowSeparators && Text.isInfixOf (Text.pack [ FilePath.pathSeparator ]) key) $
+ die
- Directory.createDirectoryIfMissing False path
+ Directory.createDirectoryIfMissing allowSeparators path
- toDirectoryTree (path Text.unpack key) value
+ 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.
@@ -143,59 +432,84 @@
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. No other type of value can be translated to a \n\
- \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\
+ 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"
-instance Exception FilesystemError
+{- | 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
--- a/src/Dhall/Eval.hs
+++ b/src/Dhall/Eval.hs
@@ -10,8 +10,6 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -O #-}
-
{-| 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.
@@ -48,12 +46,18 @@
, 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.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)
@@ -70,16 +74,18 @@
, 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
+import qualified Text.Printf as Printf
data Environment a
= Empty
@@ -133,6 +139,10 @@
-- ^ 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)
@@ -143,6 +153,7 @@
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
@@ -164,6 +175,9 @@
| 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)
@@ -194,6 +208,16 @@
| 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)
@@ -216,12 +240,13 @@
| 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 Text) !(Val a)
+ | VWith !(Val a) (NonEmpty WithComponent) !(Val a)
| VEmbed a
-- | For use with "Text.Show.Functions".
@@ -363,16 +388,15 @@
singletonVRecordLit v = VRecordLit (Map.singleton k v)
{-# INLINE vField #-}
-vTextReplaceSlow :: Text -> Val a -> VChunks a -> VChunks a
-vTextReplaceSlow needle replacement haystack = go haystack
+vTextReplace :: Text -> Val a -> Text -> VChunks a
+vTextReplace needle replacement haystack = go haystack
where
- go (VChunks [] lastText) =
- if Text.null suffix
- then VChunks [] lastText
- else
+ go t
+ | Text.null suffix = VChunks [] t
+ | otherwise =
let remainder = Text.drop (Text.length needle) suffix
- rest = go (VChunks [] remainder)
+ rest = go remainder
in case replacement of
VTextLit replacementChunks ->
@@ -380,36 +404,7 @@
_ ->
VChunks [(prefix, replacement)] "" <> rest
where
- (prefix, suffix) = Text.breakOn needle lastText
- go (VChunks ((firstText, firstInterpolation) : chunks) lastText) =
- if Text.null suffix
- then
- let rest = go (VChunks chunks lastText)
-
- in VChunks [(firstText, firstInterpolation)] "" <> rest
- else
- let remainder = Text.drop (Text.length needle) suffix
-
- rest =
- go (VChunks ((remainder, firstInterpolation) : chunks) lastText)
-
- in case replacement of
- VTextLit replacementChunks ->
- VChunks [] prefix <> replacementChunks <> rest
- _ ->
- VChunks [(prefix, replacement)] "" <> rest
- where
- (prefix, suffix) = Text.breakOn needle firstText
-
-vTextReplaceFast :: Text -> Text -> VChunks a -> VChunks a
-vTextReplaceFast needle replacement (VChunks xys z) = VChunks xys' z'
- where
- xys' = do
- (x, y) <- xys
-
- return (Text.replace needle replacement x, y)
-
- z' = Text.replace needle replacement z
+ (prefix, suffix) = Text.breakOn needle t
vProjectByFields :: Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields env t ks =
@@ -434,9 +429,9 @@
t' ->
VProject t' (Left ks)
-vWith :: Val a -> NonEmpty Text -> Val a -> Val a
-vWith (VRecordLit kvs) (k :| [] ) v = VRecordLit (Map.insert k v kvs)
-vWith (VRecordLit kvs) (k₀ :| k₁ : ks) v = VRecordLit (Map.insert k₀ e₂ kvs)
+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
@@ -444,6 +439,9 @@
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
@@ -453,9 +451,9 @@
VConst k
Var v ->
vVar env v
- Lam (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = a }) t ->
+ Lam _ (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = a }) t ->
VLam (eval env a) (Closure x env t)
- Pi x a b ->
+ Pi _ x a b ->
VPi (eval env a) (Closure x env b)
App t u ->
vApp (eval env t) (eval env u)
@@ -503,6 +501,10 @@
(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 ->
@@ -525,9 +527,12 @@
-- following issue:
--
-- https://github.com/ghcjs/ghcjs/issues/782
- let go !acc 0 = acc
- go acc m = go (vApp succ acc) (m - 1)
- in go zero (fromIntegral n' :: Integer)
+ 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
@@ -631,33 +636,67 @@
t -> VTextShow t
TextReplace ->
VPrim $ \needle ->
- VPrim $ \replacement ->
- VPrim $ \haystack ->
- case haystack of
- VTextLit haystackChunks ->
- case needle of
- VTextLit (VChunks [] "") ->
- haystack
- VTextLit (VChunks [] needleText) ->
- case replacement of
- VTextLit (VChunks [] replacementText) ->
- VTextLit
- (vTextReplaceFast
- needleText
- replacementText
- haystackChunks
- )
- _ ->
- VTextLit
- (vTextReplaceSlow
- needleText
- replacement
- haystackChunks
- )
- _ ->
- VTextReplace needle replacement haystack
+ let hLamInfo0 = case needle of
+ VTextLit (VChunks [] "") -> TextReplaceEmpty
+ _ -> Prim
+
+ in VHLam hLamInfo0 $ \replacement ->
+ let hLamInfo1 = case needle of
+ VTextLit (VChunks [] "") ->
+ TextReplaceEmptyArgument replacement
_ ->
- VTextReplace needle replacement haystack
+ 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 ->
@@ -762,14 +801,14 @@
VRecordLit (Map.sort (eval env . recordFieldValue <$> kts))
Union kts ->
VUnion (Map.sort (fmap (fmap (eval env)) kts))
- Combine mk t u ->
+ Combine _ mk t u ->
vCombine mk (eval env t) (eval env u)
- CombineTypes t u ->
+ CombineTypes _ t u ->
vCombineTypes (eval env t) (eval env u)
- Prefer _ t u ->
+ Prefer _ _ t u ->
vPrefer env (eval env t) (eval env u)
RecordCompletion t u ->
- eval env (Annot (Prefer PreferFromCompletion (Field t def) u) (Field t typ))
+ eval env (Annot (Prefer mempty PreferFromCompletion (Field t def) u) (Field t typ))
where
def = Syntax.makeFieldSelection "default"
typ = Syntax.makeFieldSelection "Type"
@@ -803,19 +842,27 @@
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 ks)
+ vProjectByFields env (eval env t) (Dhall.Set.sort (Dhall.Set.fromList ks))
Project t (Right e) ->
case eval env e of
VRecord kts ->
- eval env (Project t (Left (Dhall.Set.fromSet (Map.keysSet 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 ->
+ Equivalent _ t u ->
VEquivalent (eval env t) (eval env u)
With e₀ ks v ->
vWith (eval env e₀) ks (eval env v)
@@ -873,9 +920,32 @@
f '\r' = "\\r"
f '\t' = "\\t"
f '\f' = "\\f"
- f c | c <= '\x1F' = Text.pack (Text.Printf.printf "\\u%04x" (Data.Char.ord c))
+ 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
@@ -923,6 +993,10 @@
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') ->
@@ -975,6 +1049,24 @@
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') ->
@@ -1017,6 +1109,8 @@
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')) ->
@@ -1054,6 +1148,7 @@
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
@@ -1083,21 +1178,29 @@
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
+ Lam mempty
(Syntax.makeFunctionBinding x (quote env a))
(quoteBind x (t v))
- Prim -> quote env (t VPrimVar)
- NaturalSubtractZero -> App NaturalSubtract (NaturalLit 0)
+ 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 x (quote env a) (quoteBind x (instantiate b v))
+ Pi mempty x (quote env a) (quoteBind x (instantiate b v))
VHPi (fresh -> (x, v)) a b ->
- Pi x (quote env a) (quoteBind x (b v))
+ Pi mempty x (quote env a) (quoteBind x (b v))
VBool ->
Bool
VBoolLit b ->
@@ -1112,6 +1215,10 @@
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 ->
@@ -1164,6 +1271,24 @@
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 ->
@@ -1197,23 +1322,25 @@
VUnion m ->
Union (fmap (fmap (quote env)) m)
VCombine mk t u ->
- Combine mk (quote env t) (quote env u)
+ Combine mempty mk (quote env t) (quote env u)
VCombineTypes t u ->
- CombineTypes (quote env t) (quote env u)
+ CombineTypes mempty (quote env t) (quote env u)
VPrefer t u ->
- Prefer PreferFromSource (quote env t) (quote env 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) (fmap (quote env) p)
+ Project (quote env t) (first Dhall.Set.toList (fmap (quote env) p))
VAssert t ->
Assert (quote env t)
VEquivalent t u ->
- Equivalent (quote env t) (quote env 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 ->
@@ -1253,6 +1380,7 @@
normalize :: Eq a => Expr s a -> Expr t a
normalize = nf Empty
+{-# INLINABLE normalize #-}
alphaNormalize :: Expr s a -> Expr s a
alphaNormalize = goEnv EmptyNames
@@ -1272,10 +1400,10 @@
Const k
Var (V x i) ->
goVar e0 x i
- Lam (FunctionBinding src0 x src1 src2 t) u ->
- Lam (FunctionBinding src0 "_" src1 src2 (go t)) (goBind x u)
- Pi x a b ->
- Pi "_" (go a) (goBind x b)
+ 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 ->
@@ -1296,6 +1424,10 @@
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 ->
@@ -1348,6 +1480,24 @@
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 ->
@@ -1380,26 +1530,28 @@
RecordLit (goRecordField <$> kts)
Union kts ->
Union (fmap (fmap go) kts)
- Combine m t u ->
- Combine m (go t) (go u)
- CombineTypes t u ->
- CombineTypes (go t) (go u)
- Prefer b t u ->
- Prefer b (go t) (go u)
+ 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 t u ->
- Equivalent (go t) (go u)
+ Equivalent cs t u ->
+ Equivalent cs (go t) (go u)
With e k v ->
With (go e) k (go v)
Note s e ->
diff --git a/src/Dhall/Format.hs b/src/Dhall/Format.hs
--- a/src/Dhall/Format.hs
+++ b/src/Dhall/Format.hs
@@ -9,78 +9,83 @@
, format
) where
-import Data.Foldable (for_)
-import Dhall.Pretty (CharacterSet (..), annToAnsiStyle)
-
+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 (..)
- , PossiblyTransitiveInput (..)
, Transitivity (..)
+ , handleMultipleChecksFailed
)
-import qualified Control.Exception
import qualified Data.Text.IO
-import qualified Data.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
import qualified Dhall.Import
import qualified Dhall.Pretty
import qualified Dhall.Util
-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
+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
- { characterSet :: CharacterSet
- , censor :: Censor
- , input :: PossiblyTransitiveInput
- , outputMode :: OutputMode
+ { chosenCharacterSet :: Maybe CharacterSet
+ , censor :: Censor
+ , transitivity :: Transitivity
+ , inputs :: NonEmpty Input
+ , outputMode :: OutputMode
}
-- | Implementation of the @dhall format@ subcommand
format :: Format -> IO ()
-format (Format { input = input0, ..}) = go input0
+format (Format { inputs = inputs0, transitivity = transitivity0, ..}) =
+ handleMultipleChecksFailed "format" "formatted" go inputs0
where
go input = do
let directory = case input of
- NonTransitiveStandardInput ->
+ StandardInput ->
"."
- PossiblyTransitiveInputFile file _ ->
+ 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")
- (originalText, transitivity) <- case input of
- PossiblyTransitiveInputFile file transitivity -> do
+ (inputName, originalText, transitivity) <- case input of
+ InputFile file -> do
text <- Data.Text.IO.readFile file
- return (text, transitivity)
-
- NonTransitiveStandardInput -> do
+ return (file, text, transitivity0)
+ StandardInput -> do
text <- Data.Text.IO.getContents
- return (text, NonTransitive)
+ return ("(input)", text, NonTransitive)
- headerAndExpr@(_, parsedExpression) <- Dhall.Util.getExpressionAndHeaderFromStdinText censor originalText
+ 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 (PossiblyTransitiveInputFile filepath Transitive)
+ go (InputFile filepath)
NonTransitive ->
return ()
@@ -90,16 +95,16 @@
let formattedText = Pretty.Text.renderStrict docStream
case outputMode of
- Write ->
+ Write -> do
case input of
- PossiblyTransitiveInputFile file _ ->
+ InputFile file ->
if originalText == formattedText
then return ()
else AtomicWrite.LazyText.atomicWriteFile
file
(Pretty.Text.renderLazy docStream)
- NonTransitiveStandardInput -> do
+ StandardInput -> do
supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
Pretty.Terminal.renderIO
@@ -108,12 +113,10 @@
then (fmap annToAnsiStyle docStream)
else (Pretty.unAnnotateS docStream))
- Check ->
- if originalText == formattedText
- then return ()
- else do
- let command = "format"
-
- let modified = "formatted"
+ return (Right ())
- Control.Exception.throwIO CheckFailed{..}
+ Check ->
+ return $
+ if originalText == formattedText
+ then Right ()
+ else Left CheckFailed{..}
diff --git a/src/Dhall/Freeze.hs b/src/Dhall/Freeze.hs
--- a/src/Dhall/Freeze.hs
+++ b/src/Dhall/Freeze.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
@@ -8,21 +8,32 @@
module Dhall.Freeze
( -- * Freeze
freeze
- , freezeWithManager
, freezeExpression
- , freezeExpressionWithManager
, freezeImport
- , freezeImportWithManager
, freezeRemoteImport
- , freezeRemoteImportWithManager
+ -- * Freeze with custom evaluation settings
+ , freezeWithSettings
+ , freezeExpressionWithSettings
+ , freezeImportWithSettings
+ , freezeRemoteImportWithSettings
+
-- * Types
, Scope(..)
, Intent(..)
+
+ -- * Deprecated functions
+ , freezeWithManager
+ , freezeExpressionWithManager
+ , freezeImportWithManager
+ , freezeRemoteImportWithManager
) where
import Data.Foldable (for_)
-import Dhall.Pretty (CharacterSet)
+import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe (fromMaybe)
+import Dhall (EvaluateSettings)
+import Dhall.Pretty (CharacterSet, detectCharacterSet)
import Dhall.Syntax
( Expr (..)
, Import (..)
@@ -33,35 +44,56 @@
( Censor
, CheckFailed (..)
, Header (..)
+ , Input (..)
, OutputMode (..)
- , PossiblyTransitiveInput (..)
, 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 Data.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
-import qualified Dhall.Core as Core
+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.Optics
import qualified Dhall.Pretty
import qualified Dhall.TypeCheck
-import qualified Dhall.Util as Util
-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
+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 = freezeImportWithManager Dhall.Import.defaultNewManager
+freezeImport = freezeImportWithSettings Dhall.defaultEvaluateSettings
-- | See 'freezeImport'.
freezeImportWithManager
@@ -69,7 +101,88 @@
-> FilePath
-> Import
-> IO Import
-freezeImportWithManager newManager directory import_ = do
+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 =
@@ -78,15 +191,15 @@
}
}
- let status = Dhall.Import.emptyStatusWithManager newManager directory
+ let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory
expression <- State.evalStateT (Dhall.Import.loadWith (Embed unprotectedImport)) status
- case Dhall.TypeCheck.typeOf expression of
+ case Dhall.TypeCheck.typeWith (view Dhall.startingContext settings) expression of
Left exception -> Exception.throwIO exception
Right _ -> return ()
- let normalizedExpression = Core.alphaNormalize (Core.normalize expression)
+ 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)
@@ -99,100 +212,78 @@
return newImport
--- | Freeze an import only if the import is a `Remote` import
-freezeRemoteImport
- :: FilePath
- -- ^ Current working directory
+-- | See 'freezeRemoteImport'.
+freezeRemoteImportWithSettings
+ :: EvaluateSettings
+ -> FilePath
-> Import
-> IO Import
-freezeRemoteImport = freezeRemoteImportWithManager Dhall.Import.defaultNewManager
+freezeRemoteImportWithSettings settings directory import_ =
+ case importType (importHashed import_) of
+ Remote {} -> freezeImportWithSettings settings directory import_
+ _ -> return import_
-- | See 'freezeRemoteImport'.
-freezeRemoteImportWithManager
- :: IO Dhall.Import.Manager
+freezeNonMissingImportWithSettings
+ :: EvaluateSettings
-> FilePath
-> Import
-> IO Import
-freezeRemoteImportWithManager newManager directory import_ =
+freezeNonMissingImportWithSettings settings directory import_ =
case importType (importHashed import_) of
- Remote {} -> freezeImportWithManager newManager directory import_
- _ -> return import_
-
--- | 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.
-
--- | Implementation of the @dhall freeze@ subcommand
-freeze
- :: OutputMode
- -> PossiblyTransitiveInput
- -> Scope
- -> Intent
- -> CharacterSet
- -> Censor
- -> IO ()
-freeze = freezeWithManager Dhall.Import.defaultNewManager
+ Missing -> return import_
+ _ -> freezeImportWithSettings settings directory import_
-- | See 'freeze'.
-freezeWithManager
- :: IO Dhall.Import.Manager
+freezeWithSettings
+ :: EvaluateSettings
-> OutputMode
- -> PossiblyTransitiveInput
+ -> Transitivity
+ -> NonEmpty Input
-> Scope
-> Intent
- -> CharacterSet
+ -> Maybe CharacterSet
-> Censor
-> IO ()
-freezeWithManager newManager outputMode input0 scope intent characterSet censor = go input0
+freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenCharacterSet censor =
+ handleMultipleChecksFailed "freeze" "frozen" go inputs
where
go input = do
let directory = case input of
- NonTransitiveStandardInput ->
+ StandardInput ->
"."
- PossiblyTransitiveInputFile file _ ->
+ InputFile file ->
System.FilePath.takeDirectory file
- let status = Dhall.Import.emptyStatusWithManager newManager directory
+ let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory
- (originalText, transitivity) <- case input of
- PossiblyTransitiveInputFile file transitivity -> do
+ (inputName, originalText, transitivity) <- case input of
+ InputFile file -> do
text <- Text.IO.readFile file
- return (text, transitivity)
+ return (file, text, transitivity0)
- NonTransitiveStandardInput -> do
+ StandardInput -> do
text <- Text.IO.getContents
- return (text, NonTransitive)
+ return ("(input)", text, NonTransitive)
- (Header header, parsedExpression) <- Util.getExpressionAndHeaderFromStdinText censor originalText
+ (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 (PossiblyTransitiveInputFile filepath Transitive)
+ go (InputFile filepath)
NonTransitive ->
return ()
- frozenExpression <- freezeExpressionWithManager newManager directory scope intent parsedExpression
+ frozenExpression <- freezeExpressionWithSettings settings directory scope intent parsedExpression
let doc = Pretty.pretty header
<> Dhall.Pretty.prettyCharacterSet characterSet frozenExpression
@@ -207,7 +298,7 @@
let unAnnotated = Pretty.unAnnotateS stream
case input of
- PossiblyTransitiveInputFile file _ ->
+ InputFile file ->
if originalText == modifiedText
then return ()
else
@@ -215,7 +306,7 @@
file
(Pretty.Text.renderLazy unAnnotated)
- NonTransitiveStandardInput -> do
+ StandardInput -> do
supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
if supportsANSI
then
@@ -223,45 +314,29 @@
else
Pretty.renderIO System.IO.stdout unAnnotated
- Check ->
- if originalText == modifiedText
- then return ()
- else do
- let command = "freeze"
-
- let modified = "frozen"
-
- Exception.throwIO CheckFailed{..}
-
-{-| Slightly more pure version of the `freeze` function
+ return (Right ())
- 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 = freezeExpressionWithManager Dhall.Import.defaultNewManager
+ Check ->
+ return $
+ if originalText == modifiedText
+ then Right ()
+ else Left CheckFailed{..}
-- | See 'freezeExpression'.
-freezeExpressionWithManager
- :: IO Dhall.Import.Manager
+freezeExpressionWithSettings
+ :: EvaluateSettings
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
-freezeExpressionWithManager newManager directory scope intent expression = do
+freezeExpressionWithSettings settings directory scope intent expression = do
let freezeScope =
case scope of
- AllImports -> freezeImportWithManager
- OnlyRemoteImports -> freezeRemoteImportWithManager
+ AllImports -> freezeNonMissingImportWithSettings
+ OnlyRemoteImports -> freezeRemoteImportWithSettings
- let freezeFunction = freezeScope newManager directory
+ let freezeFunction = freezeScope settings directory
let cache
-- This case is necessary because `transformOf` is a bottom-up
@@ -309,17 +384,21 @@
(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 frozenImport) (Embed 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
@@ -329,12 +408,38 @@
}
}
- return (ImportAlt (Embed frozenImport) (Embed thawedImport))
+ return (ImportAlt (Embed frozenMissing) (Embed thawedImport))
cache expression_ =
return expression_
- case intent of
+ 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 expression
+ traverse freezeFunction (transformOf Core.subExpressions uncache expression)
Cache ->
- Dhall.Optics.transformMOf Core.subExpressions cache expression
+ 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,12 +1,14 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}
@@ -105,16 +107,16 @@
load
, loadWithManager
, loadRelativeTo
- , loadRelativeToWithManager
+ , loadWithStatus
, loadWith
, localToPath
, hashExpression
, hashExpressionToCode
, writeExpressionToSemanticCache
- , warnAboutMissingCaches
, assertNoImports
, Manager
, defaultNewManager
+ , CacheWarning(..)
, Status(..)
, SemanticCacheMode(..)
, Chained
@@ -123,6 +125,11 @@
, chainedChangeMode
, emptyStatus
, emptyStatusWithManager
+ , envOriginHeaders
+ , makeEmptyStatus
+ , remoteStatus
+ , remoteStatusWithManager
+ , fetchRemote
, stack
, cache
, Depends(..)
@@ -147,26 +154,25 @@
, HashMismatch(..)
) where
-import Control.Applicative (Alternative (..), liftA2)
+import Control.Applicative (Alternative (..))
import Control.Exception
( Exception
, IOException
, SomeException
, toException
)
-import Control.Monad (when)
-import Control.Monad.Catch (MonadCatch (catch), handle, throwM)
-import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.Morph (hoist)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State.Strict (StateT)
-import Data.ByteString (ByteString)
-import Data.CaseInsensitive (CI)
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Text (Text)
-import Data.Typeable (Typeable)
-import Data.Void (Void, absurd)
-import Dhall.Binary (StandardVersion (..))
+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 (..)
@@ -185,10 +191,17 @@
)
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
@@ -197,20 +210,19 @@
, SourcedException (..)
, Src (..)
)
-import Lens.Family.State.Strict (zoom)
+import Lens.Micro.Mtl (zoom)
-import qualified Codec.CBOR.Encoding as Encoding
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 Control.Monad.Trans.State.Strict as State
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
-import qualified Data.CaseInsensitive
-import qualified Data.Foldable
import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
-import qualified Data.Text.Encoding
+import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.IO
import qualified Dhall.Binary
import qualified Dhall.Core as Core
@@ -282,7 +294,7 @@
instance Show ReferentiallyOpaque where
show (ReferentiallyOpaque import_) =
- "\nReferentially opaque import: " ++ Dhall.Pretty.Internal.prettyToString 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
@@ -351,9 +363,6 @@
throwMissingImport :: (MonadCatch m, Exception e) => e -> m a
throwMissingImport e = throwM (MissingImports [toException e])
--- | HTTP headers
-type HTTPHeader = (CI ByteString, ByteString)
-
-- | Exception thrown when a HTTP url is imported but dhall was built without
-- the @with-http@ Cabal flag.
data CannotImportHTTPURL =
@@ -497,7 +506,7 @@
-- | 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' <- normalizeHeaders url
+ url' <- normalizeHeadersIn url
let child' = child { importHashed = importHashed { importType = Remote url' } }
return (Chained (canonicalize (parent <> child')))
@@ -536,8 +545,10 @@
Status { .. } <- State.get
mCached <-
case _semanticCacheMode of
- UseSemanticCache -> liftIO $ fetchFromSemanticCache semanticHash
- IgnoreSemanticCache -> pure Nothing
+ UseSemanticCache ->
+ zoom cacheWarning (fetchFromSemanticCache semanticHash)
+ IgnoreSemanticCache ->
+ pure Nothing
case mCached of
Just bytesStrict -> do
@@ -563,24 +574,32 @@
Nothing -> fetch
where
fetch = do
- ImportSemantics { importSemantics } <- loadImportWithSemisemanticCache import_
+ ImportSemantics{ importSemantics } <- loadImportWithSemisemanticCache import_
- let variants = map (\version -> encodeExpression version (Core.alphaNormalize importSemantics))
- [ minBound .. maxBound ]
- case Data.Foldable.find ((== semanticHash). Dhall.Crypto.sha256Hash) variants of
- Just bytes -> liftIO $ writeToSemanticCache semanticHash bytes
- Nothing -> do
- let expectedHash = semanticHash
- Status { _stack } <- State.get
- let actualHash = hashExpression (Core.alphaNormalize importSemantics)
- throwMissingImport (Imported _stack (HashMismatch {..}))
+ let bytes = encodeExpression (Core.alphaNormalize importSemantics)
- return (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 :: Dhall.Crypto.SHA256Digest -> IO (Maybe Data.ByteString.ByteString)
+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)
@@ -589,12 +608,20 @@
-- | 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 = writeToSemanticCache hash bytes
+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 NoVersion expression
+ bytes = encodeExpression expression
+
hash = Dhall.Crypto.sha256Hash bytes
-writeToSemanticCache :: Dhall.Crypto.SHA256Digest -> Data.ByteString.ByteString -> IO ()
+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
@@ -637,8 +664,9 @@
-- https://github.com/dhall-lang/dhall-haskell/issues/1098 for the reasoning
-- behind semi-semantic caching.
let semisemanticHash = computeSemisemanticHash (Core.denote resolvedExpr)
- mCached <- lift $ fetchFromSemisemanticCache semisemanticHash
+ mCached <- zoom cacheWarning (fetchFromSemisemanticCache semisemanticHash)
+
importSemantics <- case mCached of
Just bytesStrict -> do
let bytesLazy = Data.ByteString.Lazy.fromStrict bytesStrict
@@ -668,23 +696,29 @@
let betaNormal =
Core.normalizeWith _normalizer substitutedExpr
- let bytes = encodeExpression NoVersion betaNormal
+ let bytes = encodeExpression betaNormal
- lift (writeToSemisemanticCache semisemanticHash bytes)
+ zoom cacheWarning (writeToSemisemanticCache semisemanticHash bytes)
return betaNormal
return (ImportSemantics {..})
--- `as Text` imports aren't cached since they are well-typed and normal by
--- construction
+-- `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
@@ -718,20 +752,27 @@
computeSemisemanticHash resolvedExpr = hashExpression resolvedExpr
-- Fetch encoded normal form from "semi-semantic cache"
-fetchFromSemisemanticCache :: Dhall.Crypto.SHA256Digest -> IO (Maybe Data.ByteString.ByteString)
+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 :: Dhall.Crypto.SHA256Digest -> Data.ByteString.ByteString -> IO ()
+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
+-- | Fetch source code directly from disk/network
fetchFresh :: ImportType -> StateT Status IO Text
fetchFresh (Local prefix file) = do
Status { _stack } <- State.get
@@ -756,7 +797,31 @@
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
@@ -775,48 +840,48 @@
fetchFromHttpUrl url' maybeHeaders
#endif
--- | 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)
+-- | 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
- 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
+ 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, MonadIO m) => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath
+ :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m)
+ => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath
getCacheFile cacheName hash = do
- cacheDirectory <- getOrCreateCacheDirectory False cacheName
+ cacheDirectory <- getOrCreateCacheDirectory cacheName
let cacheFile = cacheDirectory ("1220" <> show hash)
return cacheFile
--- | Warn if no cache directory is available
-warnAboutMissingCaches :: (MonadCatch m, Alternative m, MonadIO m) => m ()
-warnAboutMissingCaches = warn <|> return ()
- where warn = Data.Foldable.traverse_ (getOrCreateCacheDirectory True) ["dhall", "dhall-haskell"]
-
-getOrCreateCacheDirectory :: (MonadCatch m, Alternative m, MonadIO m) => Bool -> FilePath -> m FilePath
-getOrCreateCacheDirectory showWarning cacheName = do
+getOrCreateCacheDirectory
+ :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m)
+ => FilePath -> m FilePath
+getOrCreateCacheDirectory cacheName = do
let warn message = do
- when showWarning (printWarning message)
+ cacheWarningStatus <- State.get
+ case cacheWarningStatus of
+ CacheWarned -> printWarning message
+ CacheNotWarned -> return ()
+
+ State.put CacheWarned
+
empty
let handler action dir (ioex :: IOException) = do
@@ -857,14 +922,19 @@
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"
- <> show permissions <> "\n"
+ <> "\n"
+ <> "• " <> render Directory.readable <> " readable\n"
+ <> "• " <> render Directory.writable <> " writable\n"
+ <> "• " <> render Directory.searchable <> " searchable\n"
warn message
@@ -908,7 +978,7 @@
setPermissions dir
- cacheBaseDirectory <- getCacheBaseDirectory showWarning
+ cacheBaseDirectory <- getCacheBaseDirectory
let directory = cacheBaseDirectory cacheName
@@ -926,8 +996,9 @@
return directory
-getCacheBaseDirectory :: (Alternative m, MonadIO m) => Bool -> m FilePath
-getCacheBaseDirectory showWarning = alternative₀ <|> alternative₁ <|> alternative₂
+getCacheBaseDirectory
+ :: (MonadState CacheWarning m, Alternative m, MonadIO m) => m FilePath
+getCacheBaseDirectory = alternative₀ <|> alternative₁ <|> alternative₂
where
alternative₀ = do
maybeXDGCacheHome <-
@@ -957,6 +1028,8 @@
where isWindows = System.Info.os == "mingw32"
alternative₂ = do
+ cacheWarningStatus <- State.get
+
let message =
"\n"
<> "\ESC[1;33mWarning\ESC[0m: "
@@ -965,68 +1038,156 @@
<> "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"
- when showWarning (liftIO (System.IO.hPutStrLn System.IO.stderr message))
+ 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.
-normalizeHeaders :: URL -> StateT Status IO URL
-normalizeHeaders url@URL { headers = Just headersExpression } = do
+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) }
- let go key₀ key₁ = do
- let expected :: Expr Src Void
- expected =
- App List
- ( Record $ Core.makeRecordField <$>
- Dhall.Map.fromList
- [ (key₀, Text)
- , (key₁, Text)
- ]
- )
+normalizeHeadersIn url = return url
- let suffix_ = Dhall.Pretty.Internal.prettyToStrictText expected
- let annot = case loadedExpr of
- Note (Src begin end bytes) _ ->
- Note (Src begin end bytes') (Annot loadedExpr expected)
- where
- bytes' = bytes <> " : " <> suffix_
- _ ->
- Annot loadedExpr expected
+-- | 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
- _ <- case (Dhall.TypeCheck.typeOf annot) of
- Left err -> throwMissingImport (Imported _stack err)
- Right _ -> return ()
+-- | 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]"
- return (Core.normalize loadedExpr)
+-- | Load headers only from the environment (used in tests)
+envOriginHeaders :: Expr Src Import
+envOriginHeaders = Note headersSrc (Embed (Import (ImportHashed Nothing (Env "DHALL_HEADERS")) Code))
- 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) =
- throwMissingImport (Imported _stack e)
+-- | 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
- handle handler₁ (go "header" "value")
+-- | Given a headers expression, return an origin headers loader
+originHeadersLoader :: IO (Expr Src Import) -> StateT Status IO OriginHeaders
+originHeadersLoader headersExpr = do
- headersExpression' <-
- handle handler₀ (go "mapKey" "mapValue")
+ -- Load the headers using the parent stack, which should always be a local
+ -- import (we only load headers for the first remote import)
- return url { headers = Just (fmap absurd headersExpression') }
+ status <- State.get
-normalizeHeaders url = return url
+ 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 = emptyStatusWithManager defaultNewManager
+emptyStatus = makeEmptyStatus defaultNewManager defaultOriginHeaders
+-- | See 'emptyStatus'
+emptyStatusWithManager
+ :: IO Manager
+ -> FilePath
+ -> Status
+emptyStatusWithManager newManager = makeEmptyStatus newManager defaultOriginHeaders
+
-- | See 'emptyStatus'.
-emptyStatusWithManager :: IO Manager -> FilePath -> Status
-emptyStatusWithManager newManager = emptyStatusWith newManager fetchRemote
+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
@@ -1072,11 +1233,29 @@
ImportAlt a b -> loadWith a `catch` handler₀
where
- handler₀ (SourcedException (Src begin _ text₀) (MissingImports es₀)) =
- loadWith b `catch` handler₁
+ 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₁ (SourcedException (Src _ end text₁) (MissingImports es₁)) =
- throwM (SourcedException (Src begin end text₂) (MissingImports (es₀ ++ es₁)))
+ 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₁
@@ -1087,7 +1266,7 @@
Let a b -> Let <$> bindingExprs loadWith a <*> loadWith b
Record m -> Record <$> traverse (recordFieldExprs loadWith) m
RecordLit m -> RecordLit <$> traverse (recordFieldExprs loadWith) m
- Lam a b -> Lam <$> functionBindingExprs loadWith a <*> loadWith b
+ Lam cs a b -> Lam cs <$> functionBindingExprs loadWith a <*> loadWith b
Field a b -> Field <$> loadWith a <*> pure b
expression -> Syntax.unsafeSubExpressions loadWith expression
@@ -1097,61 +1276,41 @@
-- | See 'load'.
loadWithManager :: IO Manager -> Expr Src Import -> IO (Expr Src Void)
-loadWithManager newManager = loadRelativeToWithManager newManager "." UseSemanticCache
-
-printWarning :: (MonadIO m) => String -> m ()
-printWarning message = do
- let warning =
- "\n"
- <> "\ESC[1;33mWarning\ESC[0m: "
- <> message
-
- liftIO $ System.IO.hPutStrLn System.IO.stderr warning
+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 = loadRelativeToWithManager defaultNewManager
+loadRelativeTo parentDirectory = loadWithStatus
+ (makeEmptyStatus defaultNewManager defaultOriginHeaders parentDirectory)
-- | See 'loadRelativeTo'.
-loadRelativeToWithManager
- :: IO Manager
- -> FilePath
+loadWithStatus
+ :: Status
-> SemanticCacheMode
-> Expr Src Import
-> IO (Expr Src Void)
-loadRelativeToWithManager newManager rootDirectory semanticCacheMode expression =
+loadWithStatus status semanticCacheMode expression =
State.evalStateT
(loadWith expression)
- (emptyStatusWithManager newManager rootDirectory) { _semanticCacheMode = semanticCacheMode }
+ status { _semanticCacheMode = semanticCacheMode }
-encodeExpression
- :: StandardVersion
- -- ^ `NoVersion` means to encode without the version tag
- -> Expr Void Void
- -> Data.ByteString.ByteString
-encodeExpression _standardVersion expression = bytesStrict
+encodeExpression :: Expr Void Void -> Data.ByteString.ByteString
+encodeExpression expression = bytesStrict
where
intermediateExpression :: Expr Void Import
intermediateExpression = fmap absurd expression
- encoding =
- case _standardVersion of
- NoVersion ->
- Codec.Serialise.encode intermediateExpression
- s ->
- Encoding.encodeListLen 2
- <> Encoding.encodeString v
- <> Codec.Serialise.encode intermediateExpression
- where
- v = Dhall.Binary.renderStandardVersion s
+ encoding = Codec.Serialise.encode intermediateExpression
bytesStrict = Write.toStrictByteString encoding
-- | Hash a fully resolved expression
hashExpression :: Expr Void Void -> Dhall.Crypto.SHA256Digest
-hashExpression expression =
- Dhall.Crypto.sha256Hash (encodeExpression NoVersion expression)
+hashExpression = Dhall.Crypto.sha256Hash . encodeExpression
{-| Convenience utility to hash a fully resolved expression and return the
base-16 encoded hash with the @sha256:@ prefix
@@ -1173,6 +1332,7 @@
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
@@ -1205,6 +1365,9 @@
-- types are not interpreted and therefore don't need to be modified
case importMode child of
RawText ->
+ ignore
+
+ RawBytes ->
ignore
Location ->
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
--- a/src/Dhall/Import/Types.hs
+++ b/src/Dhall/Import/Types.hs
@@ -8,27 +8,23 @@
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.Text.Prettyprint.Doc (Pretty (..))
import Data.Void (Void)
import Dhall.Context (Context)
import Dhall.Core
- ( Directory (..)
- , Expr
- , File (..)
- , FilePrefix (..)
+ ( Expr
, Import (..)
- , ImportHashed (..)
- , ImportMode (..)
- , ImportType (..)
, ReifiedNormalizer (..)
, URL
)
import Dhall.Map (Map)
import Dhall.Parser (Src)
-import Lens.Family (LensLike')
-import System.FilePath (isRelative, splitDirectories)
+import Lens.Micro (Lens', lens)
+import Prettyprinter (Pretty (..))
#ifdef WITH_HTTP
import qualified Dhall.Import.Manager
@@ -54,7 +50,7 @@
pretty (Chained import_) = pretty import_
-- | An import that has been fully interpeted
-data ImportSemantics = ImportSemantics
+newtype ImportSemantics = ImportSemantics
{ importSemantics :: Expr Void Void
-- ^ The fully resolved import, typechecked and beta-normal.
}
@@ -84,7 +80,17 @@
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
@@ -104,9 +110,16 @@
-- ^ 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)
@@ -114,12 +127,23 @@
, _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' and the remote resolver,
--- importing relative to the given directory.
-emptyStatusWith :: IO Manager -> (URL -> StateT Status IO Data.Text.Text) -> FilePath -> Status
-emptyStatusWith _newManager _remote rootDirectory = Status {..}
+-- | 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)
@@ -137,53 +161,43 @@
_semanticCacheMode = UseSemanticCache
- prefix = if isRelative rootDirectory
- then Here
- else Absolute
- pathComponents =
- fmap Data.Text.pack (reverse (splitDirectories rootDirectory))
-
- dirAsFile = File (Directory pathComponents) "."
-
- -- Fake import to set the directory we're relative to.
- rootImport = Import
- { importHashed = ImportHashed
- { hash = Nothing
- , importType = Local prefix dirAsFile
- }
- , importMode = Code
- }
+ _cacheWarning = CacheNotWarned
-- | Lens from a `Status` to its `_stack` field
-stack :: Functor f => LensLike' f Status (NonEmpty Chained)
-stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))
+stack :: Lens' Status (NonEmpty Chained)
+stack = lens _stack (\s x -> s { _stack = x })
-- | Lens from a `Status` to its `_graph` field
-graph :: Functor f => LensLike' f Status [Depends]
-graph k s = fmap (\x -> s { _graph = x }) (k (_graph s))
+graph :: Lens' Status [Depends]
+graph = lens _graph (\s x -> s { _graph = x })
-- | Lens from a `Status` to its `_cache` field
-cache :: Functor f => LensLike' f Status (Map Chained ImportSemantics)
-cache k s = fmap (\x -> s { _cache = x }) (k (_cache s))
+cache :: Lens' Status (Map Chained ImportSemantics)
+cache = lens _cache (\s x -> s { _cache = x })
-- | Lens from a `Status` to its `_remote` field
-remote
- :: Functor f => LensLike' f Status (URL -> StateT Status IO Data.Text.Text)
-remote k s = fmap (\x -> s { _remote = x }) (k (_remote s))
+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 :: Functor f => LensLike' f Status (Dhall.Substitution.Substitutions Src Void)
-substitutions k s =
- fmap (\x -> s { _substitutions = x }) (k (_substitutions s))
+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 :: Functor f => LensLike' f Status (Maybe (ReifiedNormalizer Void))
-normalizer k s = fmap (\x -> s {_normalizer = x}) (k (_normalizer s))
+normalizer :: Lens' Status (Maybe (ReifiedNormalizer Void))
+normalizer = lens _normalizer (\s x -> s {_normalizer = x})
-- | Lens from a `Status` to its `_startingContext` field
-startingContext :: Functor f => LensLike' f Status (Context (Expr Src Void))
-startingContext k s =
- fmap (\x -> s { _startingContext = x }) (k (_startingContext s))
+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
diff --git a/src/Dhall/Lint.hs b/src/Dhall/Lint.hs
--- a/src/Dhall/Lint.hs
+++ b/src/Dhall/Lint.hs
@@ -39,9 +39,8 @@
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import qualified Dhall.Core as Core
-import qualified Dhall.Map as Map
-import qualified Dhall.Optics
-import qualified Lens.Family
+import qualified Dhall.Map
+import qualified Lens.Micro as Lens
{-| Automatically improve a Dhall expression
@@ -52,8 +51,8 @@
* consolidates nested @let@ bindings to use a multiple-@let@ binding with 'removeLetInLet'
* fixes paths of the form @.\/..\/foo@ to @..\/foo@
-}
-lint :: Expr s Import -> Expr s Import
-lint = Dhall.Optics.rewriteOf subExpressions rewrite
+lint :: Eq s => Expr s Import -> Expr s Import
+lint = Lens.rewriteOf subExpressions rewrite
where
rewrite e =
fixAssert e
@@ -144,7 +143,7 @@
isOrContainsAssert :: Expr s a -> Bool
isOrContainsAssert (Assert _) = True
-isOrContainsAssert e = Lens.Family.anyOf subExpressions isOrContainsAssert e
+isOrContainsAssert e = Lens.anyOf subExpressions isOrContainsAssert e
-- | The difference between
--
@@ -176,7 +175,7 @@
(Core.shallowDenote -> App
(Core.shallowDenote -> List)
(Core.shallowDenote -> Record
- (Map.sort ->
+ (Dhall.Map.sort ->
[ ("mapKey", Core.shallowDenote . Core.recordFieldValue -> Text)
, ("mapValue", _)
]
@@ -192,14 +191,14 @@
, Just keyValues' <- traverse convert keyValues =
Just
(ToMap
- (RecordLit (Map.fromList (Foldable.toList keyValues')))
+ (RecordLit (Dhall.Map.fromList (Foldable.toList keyValues')))
Nothing
)
where
convert keyValue =
case Core.shallowDenote keyValue of
RecordLit
- (Map.sort ->
+ (Dhall.Map.sort ->
[ ("mapKey" , Core.shallowDenote . Core.recordFieldValue -> TextLit (Chunks [] key))
, ("mapValue", value)
]
diff --git a/src/Dhall/Main.hs b/src/Dhall/Main.hs
--- a/src/Dhall/Main.hs
+++ b/src/Dhall/Main.hs
@@ -21,34 +21,39 @@
, main
) where
-import Control.Applicative (optional, (<|>))
-import Control.Exception (Handler (..), SomeException)
-import Control.Monad (when)
-import Data.Foldable (for_)
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Doc, Pretty)
-import Data.Void (Void)
-import Dhall.Freeze (Intent (..), Scope (..))
+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.Parser (Src)
-import Dhall.Pretty (Ann, CharacterSet (..), annToAnsiStyle)
-import Dhall.Schemas (Schemas (..))
-import Dhall.TypeCheck
- ( Censored (..)
- , DetailedTypeError (..)
- , TypeError
+import Dhall.Package (PackagingMode (..), writePackage)
+import Dhall.Parser (Src)
+import Dhall.Pretty
+ ( Ann
+ , CharacterSet (..)
+ , annToAnsiStyle
+ , detectCharacterSet
)
-import Dhall.Version (dhallVersionString)
-import Options.Applicative (Parser, ParserInfo)
-import System.Exit (ExitCode, exitFailure)
-import System.IO (Handle)
-import Text.Dot ((.->.))
+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)
@@ -65,15 +70,15 @@
, Input (..)
, Output (..)
, OutputMode (..)
- , PossiblyTransitiveInput (..)
, 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 Control.Monad.Trans.State.Strict as State
import qualified Data.Aeson
import qualified Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy
@@ -81,20 +86,18 @@
import qualified Data.Map
import qualified Data.Text
import qualified Data.Text.IO
-import qualified Data.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
import qualified Dhall
import qualified Dhall.Binary
import qualified Dhall.Core
import qualified Dhall.Diff
-import qualified Dhall.DirectoryTree as DirectoryTree
+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
@@ -103,9 +106,12 @@
import qualified Dhall.Util
import qualified GHC.IO.Encoding
import qualified Options.Applicative
-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
+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.Exit as Exit
import qualified System.FilePath
import qualified System.IO
import qualified Text.Dot
@@ -113,19 +119,13 @@
-- | Top-level program options
data Options = Options
- { mode :: Mode
- , explain :: Bool
- , plain :: Bool
- , ascii :: Bool
- , censor :: Censor
+ { mode :: Mode
+ , explain :: Bool
+ , plain :: Bool
+ , chosenCharacterSet :: Maybe CharacterSet
+ , censor :: Censor
}
-ignoreSemanticCache :: Mode -> Bool
-ignoreSemanticCache Default {..} = semanticCacheMode == IgnoreSemanticCache
-ignoreSemanticCache Resolve {..} = semanticCacheMode == IgnoreSemanticCache
-ignoreSemanticCache Type {..} = semanticCacheMode == IgnoreSemanticCache
-ignoreSemanticCache _ = False
-
-- | The subcommands for the @dhall@ executable
data Mode
= Default
@@ -149,11 +149,11 @@
}
| Normalize { file :: Input , alpha :: Bool }
| Repl
- | Format { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode }
- | Freeze { possiblyTransitiveInput :: PossiblyTransitiveInput, all_ :: Bool, cache :: Bool, outputMode :: OutputMode }
- | Hash { file :: Input }
+ | 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 { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode }
+ | Lint { deprecatedInPlace :: Bool, transitivity :: Transitivity, outputMode :: OutputMode, inputs :: NonEmpty Input }
| Tags
{ input :: Input
, output :: Output
@@ -163,9 +163,13 @@
| Encode { file :: Input, json :: Bool }
| Decode { file :: Input, json :: Bool, quiet :: Bool }
| Text { file :: Input, output :: Output }
- | DirectoryTree { file :: Input, path :: FilePath }
+ | 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
@@ -201,7 +205,7 @@
<$> parseMode
<*> switch "explain" "Explain error messages in more detail"
<*> switch "plain" "Disable syntax highlighting"
- <*> switch "ascii" "Format code using only ASCII syntax"
+ <*> parseCharacterSet
<*> parseCensor
where
switch name description =
@@ -215,6 +219,19 @@
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
@@ -235,17 +252,17 @@
Manipulate
"format"
"Standard code formatter for the Dhall language"
- (Format <$> parseInplaceTransitive <*> parseCheck "formatted")
+ (Format <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseCheck "formatted" <*> parseFiles)
<|> subcommand
Manipulate
"freeze"
"Add integrity checks to remote import statements of an expression"
- (Freeze <$> parseInplaceTransitive <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen")
+ (Freeze <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen" <*> parseFiles)
<|> subcommand
Manipulate
"lint"
"Improve Dhall code by using newer language features and removing dead code"
- (Lint <$> parseInplaceTransitive <*> parseCheck "linted")
+ (Lint <$> deprecatedInPlace <*> parseTransitiveSwitch <*> parseCheck "linted" <*> parseFiles)
<|> subcommand
Manipulate
"rewrite-with-schemas"
@@ -260,7 +277,7 @@
Generate
"to-directory-tree"
"Convert nested records of Text literals into a directory tree"
- (DirectoryTree <$> parseFile <*> parseDirectoryTreeOutput)
+ (DirectoryTree <$> parseDirectoryTreeAllowSeparators <*> parseFile <*> parseDirectoryTreeOutput)
<|> subcommand
Interpret
"resolve"
@@ -300,9 +317,14 @@
Miscellaneous
"hash"
"Compute semantic hashes for Dhall expressions"
- (Hash <$> parseFile)
+ (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)
@@ -325,6 +347,12 @@
<*> 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
@@ -342,6 +370,21 @@
<> 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
@@ -415,22 +458,15 @@
<> 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
- parseInplaceTransitive =
- fmap (\f -> PossiblyTransitiveInputFile f NonTransitive) parseInplace
- <|> fmap (\f -> PossiblyTransitiveInputFile f Transitive) parseTransitive
- <|> pure NonTransitiveStandardInput
- where
- parseTransitive = Options.Applicative.strOption
- ( Options.Applicative.long "transitive"
- <> Options.Applicative.help "Modify the specified file and its transitive relative imports in-place"
- <> Options.Applicative.metavar "FILE"
- <> Options.Applicative.action "file"
- )
-
parseInput = fmap f (optional p)
where
f Nothing = StandardInput
@@ -483,7 +519,7 @@
parseAllFlag =
Options.Applicative.switch
( Options.Applicative.long "all"
- <> Options.Applicative.help "Add integrity checks to all imports (not just remote imports)"
+ <> Options.Applicative.help "Add integrity checks to all imports (not just remote imports) except for missing imports"
)
parseCacheFlag =
@@ -510,6 +546,12 @@
<> 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"
@@ -524,6 +566,39 @@
<> 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 =
@@ -543,10 +618,6 @@
-- | Run the command specified by the `Options` type
command :: Options -> IO ()
command (Options {..}) = do
- let characterSet = case ascii of
- True -> ASCII
- False -> Unicode
-
GHC.IO.Encoding.setLocaleEncoding System.IO.utf8
let rootDirectory = \case
@@ -557,6 +628,16 @@
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
@@ -613,8 +694,8 @@
Pretty.renderIO h ansiStream
Data.Text.IO.hPutStrLn h ""
- let render :: Pretty a => Handle -> Expr Src a -> IO ()
- render h expression = do
+ 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
@@ -625,8 +706,6 @@
AtomicWrite.LazyText.atomicWriteFile file (Pretty.Text.renderLazy stream)
- when (not $ ignoreSemanticCache mode) Dhall.Import.warnAboutMissingCaches
-
handle $ case mode of
Version ->
putStrLn dhallVersionString
@@ -638,7 +717,7 @@
Exit.exitSuccess
else return ()
- expression <- getExpression file
+ (expression, characterSet) <- getExpressionAndCharacterSet file
resolvedExpression <-
Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression
@@ -658,7 +737,7 @@
else alphaNormalizedExpression
case output of
- StandardOutput -> render System.IO.stdout annotatedExpression
+ StandardOutput -> render System.IO.stdout characterSet annotatedExpression
OutputFile file_ ->
writeDocToFile
@@ -717,15 +796,15 @@
$ _cache
Resolve { resolveMode = Nothing, ..} -> do
- expression <- getExpression file
+ (expression, characterSet) <- getExpressionAndCharacterSet file
resolvedExpression <-
Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression
- render System.IO.stdout resolvedExpression
+ render System.IO.stdout characterSet resolvedExpression
Normalize {..} -> do
- expression <- getExpression file
+ (expression, characterSet) <- getExpressionAndCharacterSet file
resolvedExpression <- Dhall.Import.assertNoImports expression
@@ -738,10 +817,10 @@
then Dhall.Core.alphaNormalize normalizedExpression
else normalizedExpression
- render System.IO.stdout alphaNormalizedExpression
+ render System.IO.stdout characterSet alphaNormalizedExpression
Type {..} -> do
- expression <- getExpression file
+ (expression, characterSet) <- getExpressionAndCharacterSet file
resolvedExpression <-
Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression
@@ -750,10 +829,12 @@
if quiet
then return ()
- else render System.IO.stdout inferredType
+ else render System.IO.stdout characterSet inferredType
Repl ->
- Dhall.Repl.repl characterSet explain
+ Dhall.Repl.repl
+ (fromMaybe Unicode chosenCharacterSet) -- Default to Unicode if no characterSet specified
+ explain
Diff {..} -> do
expression1 <- Dhall.inputExpr expr1
@@ -768,16 +849,21 @@
then return ()
else Exit.exitFailure
- Format {..} ->
- Dhall.Format.format
- Dhall.Format.Format{ input = possiblyTransitiveInput, ..}
+ 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 possiblyTransitiveInput scope intent characterSet censor
+ Dhall.Freeze.freeze outputMode transitivity inputs scope intent chosenCharacterSet censor
Hash {..} -> do
expression <- getExpression file
@@ -790,37 +876,47 @@
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 { possiblyTransitiveInput = input0, ..} -> go input0
+ 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
- NonTransitiveStandardInput -> "."
- PossiblyTransitiveInputFile file _ -> System.FilePath.takeDirectory file
+ StandardInput -> "."
+ InputFile file -> System.FilePath.takeDirectory file
let status = Dhall.Import.emptyStatus directory
- (originalText, transitivity) <- case input of
- PossiblyTransitiveInputFile file transitivity -> do
+ (inputName, originalText, transitivity) <- case input of
+ InputFile file -> do
text <- Data.Text.IO.readFile file
- return (text, transitivity)
- NonTransitiveStandardInput -> do
+ return (file, text, transitivity0)
+ StandardInput -> do
text <- Data.Text.IO.getContents
- return (text, NonTransitive)
+ return ("(input)", text, NonTransitive)
(Header header, parsedExpression) <-
- Dhall.Util.getExpressionAndHeaderFromStdinText censor originalText
+ 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 (PossiblyTransitiveInputFile filepath Transitive)
+ go (InputFile filepath)
NonTransitive ->
return ()
@@ -835,23 +931,23 @@
let modifiedText = Pretty.Text.renderStrict stream <> "\n"
case outputMode of
- Write ->
+ Write -> do
case input of
- PossiblyTransitiveInputFile file _ ->
+ InputFile file ->
if originalText == modifiedText
then return ()
else writeDocToFile file doc
- NonTransitiveStandardInput ->
+ StandardInput ->
renderDoc System.IO.stdout doc
- Check ->
- if originalText == modifiedText
- then return ()
- else do
- let modified = "linted"
+ return (Right ())
- Control.Exception.throwIO CheckFailed{ command = "lint", ..}
+ Check ->
+ return $
+ if originalText == modifiedText
+ then Right ()
+ else Left CheckFailed{..}
Encode {..} -> do
expression <- getExpression file
@@ -898,7 +994,7 @@
else do
let doc =
Dhall.Pretty.prettyCharacterSet
- characterSet
+ (fromMaybe Unicode chosenCharacterSet) -- default to Unicode
(Dhall.Core.renote expression :: Expr Src Import)
renderDoc System.IO.stdout doc
@@ -947,7 +1043,7 @@
let normalizedExpression = Dhall.Core.normalize resolvedExpression
- DirectoryTree.toDirectoryTree path normalizedExpression
+ DirectoryTree.toDirectoryTree allowSeparators path normalizedExpression
Dhall.Main.Schemas{..} ->
Dhall.Schemas.schemasCommand Dhall.Schemas.Schemas{ input = file, ..}
@@ -961,6 +1057,13 @@
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 ()
diff --git a/src/Dhall/Map.hs b/src/Dhall/Map.hs
--- a/src/Dhall/Map.hs
+++ b/src/Dhall/Map.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveLift #-}
-{-# LANGUAGE ExplicitForAll #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
-- | `Map` type used to represent records and unions
@@ -33,6 +35,7 @@
-- * Deletion/Update
, delete
, filter
+ , partition
, restrictKeys
, withoutKeys
, mapMaybe
@@ -75,9 +78,12 @@
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
+import qualified Data.Map.Strict
import qualified Data.Set
+import qualified Data.Traversable.WithIndex as Traversable.WithIndex
import qualified GHC.Exts
import qualified Prelude
@@ -88,7 +94,7 @@
This is done primarily to avoid a dependency on @insert-ordered-containers@
and also to improve performance
-}
-data Map k v = Map (Data.Map.Map k v) (Keys k)
+data Map k v = Map (Data.Map.Strict.Map k v) (Keys k)
deriving (Data, Generic, Lift, NFData)
data Keys a
@@ -98,7 +104,7 @@
instance (Ord k, Eq v) => Eq (Map k v) where
m1 == m2 =
- Data.Map.size (toMap m1) == Data.Map.size (toMap m2)
+ Data.Map.Strict.size (toMap m1) == Data.Map.Strict.size (toMap m2)
&& toList m1 == toList m2
{-# INLINABLE (==) #-}
@@ -141,7 +147,7 @@
prop> \x -> mempty <> x == (x :: Map Int Int)
-}
instance Ord k => Monoid (Map k v) where
- mempty = Map Data.Map.empty (Original [])
+ mempty = Map Data.Map.Strict.empty (Original [])
{-# INLINABLE mempty #-}
instance (Show k, Show v, Ord k) => Show (Map k v) where
@@ -157,6 +163,18 @@
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
@@ -169,7 +187,7 @@
singleton :: k -> v -> Map k v
singleton k v = Map m ks
where
- m = Data.Map.singleton k v
+ m = Data.Map.Strict.singleton k v
ks = Original [k]
{-# INLINABLE singleton #-}
@@ -193,7 +211,7 @@
fromList :: Ord k => [(k, v)] -> Map k v
fromList kvs = Map m ks
where
- m = Data.Map.fromList kvs
+ m = Data.Map.Strict.fromList kvs
ks = Original (nubOrd (map fst kvs))
{-# INLINABLE fromList #-}
@@ -206,13 +224,13 @@
fromListWithKey :: Ord k => (k -> v -> v -> v) -> [(k, v)] -> Map k v
fromListWithKey f kvs = Map m ks
where
- m = Data.Map.fromListWithKey f kvs
+ m = Data.Map.Strict.fromListWithKey f kvs
ks = Original (nubOrd (map fst kvs))
{-# INLINABLE fromListWithKey #-}
--- | Create a `Map` from a @"Data.Map".`Data.Map.Map`@
-fromMap :: Data.Map.Map k v -> Map k v
+-- | 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
@@ -241,7 +259,7 @@
unorderedSingleton :: k -> v -> Map k v
unorderedSingleton k v = Map m Sorted
where
- m = Data.Map.singleton k v
+ m = Data.Map.Strict.singleton k v
{-# INLINABLE unorderedSingleton #-}
{-| Create a `Map` from a list of key-value pairs
@@ -258,7 +276,7 @@
unorderedFromList :: Ord k => [(k, v)] -> Map k v
unorderedFromList kvs = Map m Sorted
where
- m = Data.Map.fromList kvs
+ m = Data.Map.Strict.fromList kvs
{-# INLINABLE unorderedFromList #-}
{-| Sort the keys of a `Map`, forgetting the original ordering
@@ -283,7 +301,7 @@
-}
isSorted :: Eq k => Map k v -> Bool
isSorted (Map _ Sorted) = True
-isSorted (Map m (Original ks)) = Data.Map.keys m == ks -- Or shortcut to False here?
+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
@@ -297,10 +315,10 @@
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.insert k v m) Sorted
+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.insertLookupWithKey (\_k new _old -> new) k v m
+ (mayOldV, m') = Data.Map.Strict.insertLookupWithKey (\_k new _old -> new) k v m
ks' | Just _ <- mayOldV = ks
| otherwise = k : ks
@@ -315,10 +333,10 @@
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.insertWith f k v m) Sorted
+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.insertLookupWithKey (\_k new old -> f new old) k v m
+ (mayOldV, m') = Data.Map.Strict.insertLookupWithKey (\_k new old -> f new old) k v m
ks' | Just _ <- mayOldV = ks
| otherwise = k : ks
@@ -334,7 +352,7 @@
delete :: Ord k => k -> Map k v -> Map k v
delete k (Map m ks) = Map m' ks'
where
- m' = Data.Map.delete k m
+ m' = Data.Map.Strict.delete k m
ks' = case ks of
Sorted -> Sorted
@@ -351,11 +369,26 @@
filter :: Ord k => (a -> Bool) -> Map k a -> Map k a
filter predicate (Map m ks) = Map m' ks'
where
- m' = Data.Map.filter predicate m
+ m' = Data.Map.Strict.filter predicate m
- ks' = filterKeys (\k -> Data.Map.member k m') ks
+ 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"])
@@ -364,7 +397,7 @@
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.restrictKeys m s
+ m' = Data.Map.Strict.restrictKeys m s
ks' = filterKeys (\k -> Data.Set.member k s) ks
{-# INLINABLE restrictKeys #-}
@@ -377,7 +410,7 @@
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.withoutKeys m s
+ m' = Data.Map.Strict.withoutKeys m s
ks' = filterKeys (\k -> Data.Set.notMember k s) ks
{-# INLINABLE withoutKeys #-}
@@ -391,9 +424,9 @@
mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b
mapMaybe f (Map m ks) = Map m' ks'
where
- m' = Data.Map.mapMaybe f m
+ m' = Data.Map.Strict.mapMaybe f m
- ks' = filterKeys (\k -> Data.Map.member k m') ks
+ ks' = filterKeys (\k -> Data.Map.Strict.member k m') ks
{-# INLINABLE mapMaybe #-}
{-| Retrieve a key from a `Map`
@@ -408,7 +441,7 @@
Nothing
-}
lookup :: Ord k => k -> Map k v -> Maybe v
-lookup k (Map m _) = Data.Map.lookup k m
+lookup k (Map m _) = Data.Map.Strict.lookup k m
{-# INLINABLE lookup #-}
{-| Retrieve the first key, value of the 'Map', if present,
@@ -426,9 +459,9 @@
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.! k, Map (Data.Map.delete k m) (Original 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.minViewWithKey m = Just (k, v, Map m' Sorted)
+ | Just ((k, v), m') <- Data.Map.Strict.minViewWithKey m = Just (k, v, Map m' Sorted)
| otherwise = Nothing
{-# INLINABLE uncons #-}
@@ -444,7 +477,7 @@
False
-}
member :: Ord k => k -> Map k v -> Bool
-member k (Map m _) = Data.Map.member k m
+member k (Map m _) = Data.Map.Strict.member k m
{-# INLINABLE member #-}
{-|
@@ -452,7 +485,7 @@
1
-}
size :: Map k v -> Int
-size (Map m _) = Data.Map.size m
+size (Map m _) = Data.Map.Strict.size m
{-# INLINABLE size #-}
{-| Combine two `Map`s, preferring keys from the first `Map`
@@ -467,11 +500,11 @@
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.union mL mR
+ m = Data.Map.Strict.union mL mR
ks = case (ksL, ksR) of
(Original l, Original r) -> Original $
- l <|> Prelude.filter (\k -> Data.Map.notMember k mL) r
+ l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k mL) r
_ -> Sorted
{-# INLINABLE union #-}
@@ -485,11 +518,11 @@
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.unionWith combine mL mR
+ m = Data.Map.Strict.unionWith combine mL mR
ks = case (ksL, ksR) of
(Original l, Original r) -> Original $
- l <|> Prelude.filter (\k -> Data.Map.notMember k mL) r
+ l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k mL) r
_ -> Sorted
{-# INLINABLE unionWith #-}
@@ -510,7 +543,7 @@
-> Map k c
outerJoin fa fb fab (Map ma ksA) (Map mb ksB) = Map m ks
where
- m = Data.Map.mergeWithKey
+ m = Data.Map.Strict.mergeWithKey
(\k a b -> Just (fab k a b))
(fmap fa)
(fmap fb)
@@ -519,7 +552,7 @@
ks = case (ksA, ksB) of
(Original l, Original r) -> Original $
- l <|> Prelude.filter (\k -> Data.Map.notMember k ma) r
+ l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k ma) r
_ -> Sorted
{-# INLINABLE outerJoin #-}
@@ -534,10 +567,10 @@
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.intersection mL mR
+ m = Data.Map.Strict.intersection mL mR
-- Or forget order unless both maps are ordered?!
- ks = filterKeys (\k -> Data.Map.member k m) ksL
+ 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
@@ -549,10 +582,10 @@
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.intersectionWith combine mL mR
+ m = Data.Map.Strict.intersectionWith combine mL mR
-- Or forget order unless both maps are ordered?!
- ks = filterKeys (\k -> Data.Map.member k m) ksL
+ 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
@@ -564,9 +597,9 @@
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.difference mL mR
+ m = Data.Map.Strict.difference mL mR
- ks = filterKeys (\k -> Data.Map.notMember k mR) ksL
+ 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
@@ -575,7 +608,7 @@
("BA",[1,2])
-}
foldMapWithKey :: (Monoid m, Ord k) => (k -> a -> m) -> Map k a -> m
-foldMapWithKey f (Map m Sorted) = Data.Map.foldMapWithKey f m
+foldMapWithKey f (Map m Sorted) = Data.Map.Strict.foldMapWithKey f m
foldMapWithKey f m = foldMap (uncurry f) (toList m)
{-# INLINABLE foldMapWithKey #-}
@@ -595,7 +628,7 @@
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey f (Map m ks) = Map m' ks
where
- m' = Data.Map.mapWithKey f m
+ m' = Data.Map.Strict.mapWithKey f m
{-# INLINABLE mapWithKey #-}
{-| Traverse all of the key-value pairs in a `Map`, in their original order
@@ -606,9 +639,9 @@
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.traverseWithKey f m)
-traverseWithKey f m =
- fmap fromList (traverse f' (toList m))
+ 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 #-}
@@ -619,7 +652,7 @@
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.traverseWithKey f m)
+ 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
@@ -631,7 +664,7 @@
unorderedTraverseWithKey_
:: Ord k => Applicative f => (k -> a -> f ()) -> Map k a -> f ()
unorderedTraverseWithKey_ f (Map m _) =
- Data.Map.foldlWithKey' (\acc k v -> acc *> f k v) (pure ()) 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
@@ -640,22 +673,22 @@
[("B",1),("A",2)]
-}
toList :: Ord k => Map k v -> [(k, v)]
-toList (Map m Sorted) = Data.Map.toList m
-toList (Map m (Original ks)) = fmap (\k -> (k, m Data.Map.! k)) ks
+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.toAscList m
+toAscList (Map m _) = Data.Map.Strict.toAscList m
{-# INLINABLE toAscList #-}
-{-| Convert a @"Dhall.Map".`Map`@ to a @"Data.Map".`Data.Map.Map`@
+{-| 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.Map k v
+toMap :: Map k v -> Data.Map.Strict.Map k v
toMap (Map m _) = m
{-# INLINABLE toMap #-}
@@ -665,7 +698,7 @@
["B","A"]
-}
keys :: Map k v -> [k]
-keys (Map m Sorted) = Data.Map.keys m
+keys (Map m Sorted) = Data.Map.Strict.keys m
keys (Map _ (Original ks)) = ks
{-# INLINABLE keys #-}
@@ -675,8 +708,8 @@
[1,2]
-}
elems :: Ord k => Map k v -> [v]
-elems (Map m Sorted) = Data.Map.elems m
-elems (Map m (Original ks)) = fmap (\k -> m Data.Map.! k) ks
+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
@@ -685,13 +718,20 @@
fromList ["A","B"]
-}
keysSet :: Map k v -> Data.Set.Set k
-keysSet (Map m _) = Data.Map.keysSet m
+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)
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
--- a/src/Dhall/Normalize.hs
+++ b/src/Dhall/Normalize.hs
@@ -23,7 +23,7 @@
import Control.Applicative (empty)
import Data.Foldable
import Data.Functor.Identity (Identity (..))
-import Data.List.NonEmpty (NonEmpty(..))
+import Data.List.NonEmpty (NonEmpty (..))
import Data.Sequence (ViewL (..), ViewR (..))
import Data.Traversable
import Instances.TH.Lift ()
@@ -39,6 +39,7 @@
, PreferAnnotation (..)
, RecordField (..)
, Var (..)
+ , WithComponent (..)
)
import qualified Data.Sequence
@@ -46,9 +47,8 @@
import qualified Data.Text as Text
import qualified Dhall.Eval as Eval
import qualified Dhall.Map
-import qualified Dhall.Set
import qualified Dhall.Syntax as Syntax
-import qualified Lens.Family as Lens
+import qualified Lens.Micro as Lens
{-| Returns `True` if two expressions are α-equivalent and β-equivalent and
`False` otherwise
@@ -66,13 +66,13 @@
-}
subst :: Var -> Expr s a -> Expr s a -> Expr s a
subst _ _ (Const a) = Const a
-subst (V x n) e (Lam (FunctionBinding src0 y src1 src2 _A) b) =
- Lam (FunctionBinding src0 y src1 src2 _A') b'
+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 y _A _B) = Pi y _A' _B'
+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
@@ -115,8 +115,8 @@
using De Bruijn indices to distinguish them
>>> mfb = Syntax.makeFunctionBinding
->>> alphaNormalize (Lam (mfb "a" (Const Type)) (Lam (mfb "b" (Const Type)) (Lam (mfb "x" "a") (Lam (mfb "y" "b") "x"))))
-Lam (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Lam (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Var (V "_" 1)))))
+>>> 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:
@@ -161,6 +161,7 @@
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`
@@ -172,27 +173,25 @@
:: (Monad m, Eq a) => NormalizerM m a -> Expr s a -> m (Expr t a)
normalizeWithM ctx e0 = loop (Syntax.denote e0)
where
- loop = \case
- Const k -> pure (Const k)
- Var v -> pure (Var v)
- Lam (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A }) b ->
- Lam <$> (Syntax.makeFunctionBinding 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 -> do
- res <- ctx (App f a)
- case res of
- Just e1 -> loop e1
- Nothing -> do
+ 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
+ Lam _ (FunctionBinding _ x _ _ _A) b₀ -> do
let a₂ = Syntax.shift 1 (V x 0) a'
let b₁ = subst (V x 0) a₂ b₀
@@ -212,14 +211,22 @@
strict = strictLoop (fromIntegral n0 :: Integer)
lazy = loop ( lazyLoop (fromIntegral n0 :: Integer))
- strictLoop 0 = loop zero
- strictLoop !n = App succ' <$> strictLoop (n - 1) >>= loop
+ 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 (Syntax.makeFunctionBinding "n" Natural) (NaturalPlus "n" (NaturalLit 1))
+ succ = Lam mempty (Syntax.makeFunctionBinding "n" Natural) (NaturalPlus "n" (NaturalLit 1))
zero = NaturalLit 0
App NaturalIsZero (NaturalLit n) -> pure (BoolLit (n == 0))
@@ -261,8 +268,8 @@
list = App List _A₀
cons =
- Lam (Syntax.makeFunctionBinding "a" _A₀)
- (Lam
+ Lam mempty (Syntax.makeFunctionBinding "a" _A₀)
+ (Lam mempty
(Syntax.makeFunctionBinding "as" (App List _A₁))
(ListAppend (ListLit Nothing (pure "a")) "as")
)
@@ -376,326 +383,382 @@
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
- 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
+ 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
- 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) = (\e -> RecordField s0 e s1 s2) <$> loop expr
- kts' = traverse f kts
- RecordLit kvs -> RecordLit . Dhall.Map.sort <$> kvs'
- where
- f (RecordField s0 expr s1 s2) = (\e -> RecordField s0 e s1 s2) <$> loop expr
- kvs' = traverse f kvs
- Union kts -> Union . Dhall.Map.sort <$> kts'
- where
- kts' = traverse (traverse loop) kts
- Combine 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 mk l r
- CombineTypes 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 l r
- Prefer _ 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 PreferFromSource l r
- RecordCompletion x y ->
- loop (Annot (Prefer 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 ->
+ process (x, y) = do
+ y' <- loop y
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 )
- ]
- )
+ 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 keyValues = Data.Sequence.fromList (map entry (Dhall.Map.toList $ recordFieldValue <$> kvsX))
- let listType = case t' of
- Just _ | null keyValues ->
- t'
- _ ->
- Nothing
+ let listType = case t' of
+ Just _ | null keyValues ->
+ t'
+ _ ->
+ Nothing
- return (ListLit listType keyValues)
- _ ->
- return (ToMap x' t')
- Field r k@FieldSelection{fieldSelectionLabel = x} -> do
- let singletonRecordLit v = RecordLit (Dhall.Map.singleton x v)
+ 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 _ (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of
- Just v -> pure (Field (Prefer 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 m (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of
- Just v -> pure (Field (Combine m (singletonRecordLit v) r_) k)
- Nothing -> loop (Field r_ k)
- Combine m l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of
- Just v -> pure (Field (Combine m l (singletonRecordLit v)) k)
- Nothing -> loop (Field l k)
- _ -> pure (Field r' k)
- Project x (Left fields)-> do
- x' <- loop x
- let fieldsSet = Dhall.Set.toSet fields
- case x' of
- RecordLit kvs ->
- pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet))
- Project y _ ->
- loop (Project y (Left fields))
- Prefer _ l (RecordLit rKvs) -> do
- let rKs = Dhall.Map.keysSet rKvs
- let l' = Project l (Left (Dhall.Set.fromSet (Data.Set.difference fieldsSet rKs)))
- let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet)
- loop (Prefer PreferFromSource l' r')
- _ | null fields -> pure (RecordLit mempty)
- | otherwise -> pure (Project x' (Left (Dhall.Set.sort fields)))
- Project r (Right e1) -> do
- e2 <- loop e1
+ 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 (Dhall.Set.fromSet (Dhall.Map.keysSet kts))))
- _ -> do
- r' <- loop r
- pure (Project r' (Right e2))
- Assert t -> do
- t' <- loop t
+ 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 l r -> do
- l' <- loop l
- r' <- loop r
+ pure (Assert t')
+ Equivalent cs l r -> do
+ l' <- loop l
+ r' <- loop r
- pure (Equivalent l' r')
- With e ks v -> do
- e' <- loop e
- v' <- loop v
+ pure (Equivalent cs l' r')
+ With r ks v -> do
+ r' <- loop r
+ v' <- loop v
- case e' of
- RecordLit kvs ->
- case ks of
- k :| [] ->
- return (RecordLit (Dhall.Map.insert k (Syntax.makeRecordField v') kvs))
- k₀ :| k₁ : ks' -> do
- let e₁ =
- case Dhall.Map.lookup k₀ kvs of
- Nothing -> RecordLit mempty
- Just r -> Syntax.recordFieldValue r
+ 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')
+ e₂ <- loop (With e₁ (k₁ :| ks') v')
- return (RecordLit (Dhall.Map.insert k₀ (Syntax.makeRecordField e₂) kvs))
- _ ->
- return (With e' ks v')
- Note _ e' -> loop e'
- ImportAlt l _r -> loop l
- Embed a -> pure (Embed a)
+ 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.
@@ -732,17 +795,20 @@
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
+ 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 (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
@@ -797,6 +863,8 @@
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
@@ -840,6 +908,15 @@
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
@@ -867,19 +944,19 @@
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
+ 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
+ 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
+ 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
@@ -897,13 +974,25 @@
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
+ 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 &&
@@ -911,13 +1000,13 @@
Left s -> case r of
RecordLit _ -> False
Project _ _ -> False
- Prefer _ _ (RecordLit _) -> False
- _ -> not (Dhall.Set.null s) && Dhall.Set.isSorted s
+ 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
+ Equivalent _ l r -> loop l && loop r
With{} -> False
Note _ e' -> loop e'
ImportAlt _ _ -> False
@@ -929,7 +1018,7 @@
True
>>> "x" `freeIn` "y"
False
->>> "x" `freeIn` Lam (Syntax.makeFunctionBinding "x" (Const Type)) "x"
+>>> "x" `freeIn` Lam mempty (Syntax.makeFunctionBinding "x" (Const Type)) "x"
False
-}
freeIn :: Eq a => Var -> Expr s a -> Bool
@@ -941,6 +1030,7 @@
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
--- a/src/Dhall/Optics.hs
+++ b/src/Dhall/Optics.hs
@@ -3,51 +3,83 @@
for convenience
-}
-module Dhall.Optics
- ( -- * Utilities
- rewriteOf
+{-# 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 (WrappedMonad (..))
-import Data.Profunctor.Unsafe (( #. ))
-import Lens.Family (ASetter, LensLike, over)
+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 l f = go
- where
- go = transformOf l (\x -> maybe x go (f x))
+rewriteOf = Lens.Micro.rewriteOf
{-# INLINE rewriteOf #-}
-- | Identical to @"Control.Lens".`Control.Lens.transformOf`@
transformOf :: ASetter a b a b -> (b -> b) -> a -> b
-transformOf l f = go
- where
- go = f . over l go
+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 l f = go
- where
- go = transformMOf l (\x -> f x >>= maybe (return x) go)
+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 l f = go
- where
- go t = mapMOf l go t >>= f
+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 l cmd = unwrapMonad #. l (WrapMonad #. cmd)
+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,5 +1,5 @@
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
-- | This module contains Dhall's parsing logic
@@ -21,12 +21,13 @@
, Parser(..)
) where
-import Control.Exception (Exception)
-import Data.Text (Text)
-import Data.Void (Void)
-import Dhall.Src (Src (..))
+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 Text.Megaparsec (ParseErrorBundle (..), PosState (..))
import qualified Data.Text as Text
import qualified Dhall.Core as Core
@@ -123,7 +124,7 @@
Right (txt, r) -> Right (createHeader txt, r)
where
parser = do
- (bytes, _) <- Text.Megaparsec.match whitespace
+ (bytes, _) <- Text.Megaparsec.match (many shebang *> whitespace)
r <- expr
Text.Megaparsec.eof
return (bytes, r)
diff --git a/src/Dhall/Parser/Combinators.hs b/src/Dhall/Parser/Combinators.hs
--- a/src/Dhall/Parser/Combinators.hs
+++ b/src/Dhall/Parser/Combinators.hs
@@ -17,33 +17,30 @@
, satisfy
, Dhall.Parser.Combinators.takeWhile
, takeWhile1
- , noDuplicates
, 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.Text.Prettyprint.Doc (Pretty (..))
-import Data.Void (Void)
-import Dhall.Map (Map)
-import Dhall.Set (Set)
-import Dhall.Src (Src (..))
-import Text.Parser.Combinators (try, ())
-import Text.Parser.Token (TokenParsing (..))
+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
-import qualified Data.Set
+import qualified Data.Char as Char
import qualified Data.Text
-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
import qualified Dhall.Map
import qualified Dhall.Pretty
-import qualified Dhall.Set
+import qualified Prettyprinter.Render.String as Pretty
import qualified Text.Megaparsec
import qualified Text.Megaparsec.Char
import qualified Text.Parser.Char
@@ -139,14 +136,8 @@
-- {-# INLINE mplus #-}
instance Text.Megaparsec.MonadParsec Void Text Parser where
-#if MIN_VERSION_megaparsec(8, 0, 0)
parseError e = Parser (Text.Megaparsec.parseError e)
-#else
- failure u e = Parser (Text.Megaparsec.failure u e)
- fancyFailure e = Parser (Text.Megaparsec.fancyFailure e)
-#endif
-
label l (Parser p) = Parser (Text.Megaparsec.label l p)
hidden (Parser p) = Parser (Text.Megaparsec.hidden p)
@@ -178,6 +169,10 @@
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 (<>)
@@ -218,7 +213,7 @@
instance TokenParsing Parser where
someSpace =
Text.Parser.Token.Style.buildSomeSpaceParser
- (Parser (Text.Megaparsec.skipSome (Text.Megaparsec.satisfy Data.Char.isSpace)))
+ (Parser (Text.Megaparsec.skipSome (Text.Megaparsec.satisfy Char.isSpace)))
Text.Parser.Token.Style.haskellCommentStyle
highlight _ = id
@@ -264,16 +259,6 @@
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 predicate = Parser (Text.Megaparsec.takeWhile1P Nothing predicate)
--- | Construct a 'Set a' from a '[a]', failing if there was a duplicate element
-noDuplicates :: Ord a => [a] -> Parser (Set a)
-noDuplicates = go Dhall.Set.empty
- where
- go found [] = return found
- go found (x:xs) =
- if Data.Set.member x (Dhall.Set.toSet found)
- then fail "Duplicate key"
- else go (Dhall.Set.append x found) xs
-
-- | Creates a map with the given key-value pairs, failing if there was a
-- duplicate key.
toMap :: [(Text, a)] -> Parser (Map Text a)
@@ -293,3 +278,15 @@
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
--- a/src/Dhall/Parser/Expression.hs
+++ b/src/Dhall/Parser/Expression.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -8,9 +9,7 @@
module Dhall.Parser.Expression where
import Control.Applicative (Alternative (..), liftA2, optional)
-import Data.ByteArray.Encoding (Base (..))
import Data.Foldable (foldl')
-import Data.Functor (void)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import Dhall.Src (Src (..))
@@ -20,14 +19,15 @@
import qualified Control.Monad
import qualified Control.Monad.Combinators as Combinators
import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty
-import qualified Data.ByteArray.Encoding
-import qualified Data.ByteString
+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
@@ -107,14 +107,186 @@
data Parsers a = Parsers
{ completeExpression_ :: Parser (Expr Src a)
, importExpression_ :: Parser (Expr Src a)
+ , letBinding :: Parser (Binding Src a)
}
--- | Given a parser for imports,
+{-| 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 {..}
+parsers embedded = Parsers{..}
where
- completeExpression_ = whitespace *> expression <* whitespace
+ 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
@@ -128,7 +300,7 @@
) "expression"
where
alternative0 = do
- _lambda
+ cs <- _lambda
whitespace
_openParens
src0 <- src whitespace
@@ -140,10 +312,10 @@
whitespace
_closeParens
whitespace
- _arrow
+ cs' <- _arrow
whitespace
c <- expression
- return (Lam (FunctionBinding (Just src0) a (Just src1) (Just src2) b) c)
+ return (Lam (Just (cs <> cs')) (FunctionBinding (Just src0) a (Just src1) (Just src2) b) c)
alternative1 = do
try (_if *> nonemptyWhitespace)
@@ -157,35 +329,7 @@
return (BoolIf a b c)
alternative2 = do
- let binding = 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)
-
- as <- NonEmpty.some1 binding
+ as <- NonEmpty.some1 letBinding
try (_in *> nonemptyWhitespace)
@@ -211,7 +355,7 @@
return (Dhall.Syntax.wrapInLets as b)
alternative3 = do
- try (_forall *> whitespace *> _openParens)
+ cs <- try (_forall <* whitespace <* _openParens)
whitespace
a <- label
whitespace
@@ -221,10 +365,10 @@
whitespace
_closeParens
whitespace
- _arrow
+ cs' <- _arrow
whitespace
c <- expression
- return (Pi a b c)
+ return (Pi (Just (cs <> cs')) a b c)
alternative4 = do
try (_assert *> whitespace *> _colon)
@@ -244,10 +388,14 @@
_ -> empty
bs <- some (do
- try (whitespace *> _with *> nonemptyWhitespace)
+ try (nonemptyWhitespace *> _with *> nonemptyWhitespace)
- keys <- Combinators.NonEmpty.sepBy1 anyLabel (try (whitespace *> _dot) *> whitespace)
+ let withComponent =
+ fmap WithLabel anyLabelOrSome
+ <|> fmap (\_ -> WithQuestion) (text "?")
+ keys <- Combinators.NonEmpty.sepBy1 withComponent (try (whitespace *> _dot) *> whitespace)
+
whitespace
_equal
@@ -266,26 +414,26 @@
whitespace
let alternative5B0 = do
- _arrow
+ cs <- _arrow
whitespace
b <- expression
whitespace
- return (Pi "_" a b)
+ return (Pi (Just cs) "_" a b)
let alternative5B1 = do
_colon
nonemptyWhitespace
case (shallowDenote a, a0Info) of
(ListLit Nothing [], _) -> do
- b <- applicationExpression
+ b <- expression
return (ListLit (Just b) [])
(Merge c d Nothing, NakedMergeOrSomeOrToMap) -> do
- b <- applicationExpression
+ b <- expression
return (Merge c d (Just b))
(ToMap c Nothing, NakedMergeOrSomeOrToMap) -> do
- b <- applicationExpression
+ b <- expression
return (ToMap c (Just b))
_ -> do
@@ -341,20 +489,20 @@
operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers =
- [ Equivalent <$ _equivalent <* whitespace
- , ImportAlt <$ _importAlt <* nonemptyWhitespace
- , BoolOr <$ _or <* whitespace
- , NaturalPlus <$ _plus <* nonemptyWhitespace
- , TextAppend <$ _textAppend <* whitespace
- , ListAppend <$ _listAppend <* whitespace
- , BoolAnd <$ _and <* whitespace
- , Combine Nothing <$ _combine <* whitespace
- , Prefer PreferFromSource <$ _prefer <* whitespace
- , CombineTypes <$ _combineTypes <* whitespace
- , NaturalTimes <$ _times <* whitespace
+ [ 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
+ , BoolEQ <$ try (_doubleEqual <* Text.Megaparsec.notFollowedBy (char '=')) <* whitespace
+ , BoolNE <$ _notEqual <* whitespace
]
applicationExpression = snd <$> applicationExpressionWithInfo
@@ -378,10 +526,15 @@
return (\a -> ToMap a Nothing, Just "argument to ❰toMap❱")
- let alternative3 =
+ 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
+ (f, maybeMessage) <- alternative0 <|> alternative1 <|> alternative2 <|> alternative3 <|> alternative4
let adapt parser =
case maybeMessage of
@@ -437,35 +590,44 @@
selectorExpression = noted (do
a <- primitiveExpression
- let recordType = whitespace *> _openParens *> whitespace *> expression <* whitespace <* _closeParens
+ 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 fieldSelection = do
+ let alternatives = do
src0 <- src whitespace
- 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 fieldSelection = do
+ l <- anyLabel
- let alternatives =
- fmap field fieldSelection
- <|> fmap projectBySet (whitespace *> labels)
- <|> fmap projectByExpression recordType
+ 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
- [ alternative00
+ [ bytesLiteral
+ , temporalLiteral
+ , alternative00
, alternative01
, alternative02
, textLiteral
@@ -561,7 +723,9 @@
'D' ->
choice
- [ DoubleShow <$ _DoubleShow
+ [ DateShow <$ _DateShow
+ , Date <$ _Date
+ , DoubleShow <$ _DoubleShow
, Double <$ _Double
]
'L' ->
@@ -576,13 +740,21 @@
, List <$ _List
]
'O' -> Optional <$ _Optional
- 'B' -> Bool <$ _Bool
+ '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
]
@@ -671,7 +843,7 @@
let fourCharacterEscapeSequence = do
ns <- Control.Monad.replicateM 4 hexNumber
-
+
let number = toNumber ns
Control.Monad.guard (validCodepoint number)
@@ -711,7 +883,7 @@
, unescapedCharacterFast
, unescapedCharacterSlow
, tab
- , endOfLine
+ , endOfLine_
]
where
escapeSingleQuotes = do
@@ -750,7 +922,7 @@
where
predicate c = c == '$' || c == '\''
- endOfLine = do
+ endOfLine_ = do
a <- "\n" <|> "\r\n"
b <- singleQuoteContinue
return (Chunks [] a <> b)
@@ -762,17 +934,31 @@
singleQuoteLiteral = do
_ <- text "''"
+
_ <- endOfLine
+
a <- singleQuoteContinue
return (Dhall.Syntax.toDoubleQuoted a)
- where
- endOfLine = (void (char '\n') <|> void (text "\r\n")) "newline"
textLiteral = (do
- literal <- doubleQuotedLiteral <|> singleQuoteLiteral
- return (TextLit literal) ) "literal"
+ 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
@@ -876,7 +1062,7 @@
whitespace
- let combine k = liftA2 $ \rf rf' -> makeRecordField $ Combine (Just k)
+ let combine k = liftA2 $ \rf rf' -> makeRecordField $ Combine mempty (Just k)
(recordFieldValue rf')
(recordFieldValue rf)
@@ -916,8 +1102,6 @@
let emptyUnionType = do
try (optional (_bar *> whitespace) *> _closeAngle)
- _ <- optional (_bar *> whitespace)
-
return (Union mempty)
nonEmptyUnionType <|> emptyUnionType ) "literal"
@@ -1050,9 +1234,9 @@
_ <- text "sha256:"
t <- count 64 (satisfy hexdig "hex digit")
let strictBytes16 = Data.Text.Encoding.encodeUtf8 t
- strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of
+ strictBytes <- case Base16.decode strictBytes16 of
Left string -> fail string
- Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString)
+ Right strictBytes -> return strictBytes
case Dhall.Crypto.sha256DigestFromByteString strictBytes of
Nothing -> fail "Invalid sha256 hash"
Just h -> pure h
@@ -1080,7 +1264,9 @@
alternative = do
try (whitespace *> _as *> nonemptyWhitespace)
- (_Text >> pure RawText) <|> (_Location >> pure Location)
+ (_Text >> pure RawText)
+ <|> (_Location >> pure Location)
+ <|> (_Bytes >> pure RawBytes)
-- | 'ApplicationExprInfo' distinguishes certain subtypes of application
-- expressions.
diff --git a/src/Dhall/Parser/Token.hs b/src/Dhall/Parser/Token.hs
--- a/src/Dhall/Parser/Token.hs
+++ b/src/Dhall/Parser/Token.hs
@@ -4,9 +4,11 @@
-- | 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,
@@ -23,10 +25,18 @@
hexdig,
identifier,
hexNumber,
+ signPrefix,
doubleLiteral,
doubleInfinity,
naturalLiteral,
integerLiteral,
+ dateFullYear,
+ dateMonth,
+ dateMday,
+ timeHour,
+ timeMinute,
+ timeSecond,
+ timeSecFrac,
_Optional,
_if,
_then,
@@ -37,6 +47,7 @@
_using,
_merge,
_toMap,
+ _showConstructor,
_assert,
_Some,
_None,
@@ -61,12 +72,19 @@
_ListIndexed,
_ListReverse,
_Bool,
+ _Bytes,
_Natural,
_Integer,
_Double,
_Text,
_TextReplace,
_TextShow,
+ _Date,
+ _DateShow,
+ _Time,
+ _TimeShow,
+ _TimeZone,
+ _TimeZoneShow,
_List,
_True,
_False,
@@ -114,13 +132,14 @@
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.Set (Set)
import Dhall.Syntax
import Text.Parser.Combinators (choice, try, ())
-import qualified Control.Monad
+import qualified Control.Monad as Monad
import qualified Data.Char as Char
import qualified Data.Foldable
import qualified Data.HashSet
@@ -128,7 +147,6 @@
import qualified Data.List.NonEmpty
import qualified Data.Scientific as Scientific
import qualified Data.Text
-import qualified Dhall.Set
import qualified Text.Megaparsec
import qualified Text.Megaparsec.Char.Lexer
import qualified Text.Parser.Char
@@ -137,12 +155,18 @@
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
+ not (category == Char.Surrogate
+ || c .&. 0xFFFE == 0xFFFE
|| c .&. 0xFFFF == 0xFFFF)
where
category = Char.generalCategory (Char.chr c)
@@ -180,6 +204,7 @@
|| ('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 '+')
@@ -268,17 +293,20 @@
a <- naturalLiteral
return (sign (fromIntegral a)) ) "literal"
-{-| Parse a `Dhall.Syntax.Natural` literal
+{-| Parse a `Dhall.Syntax.Natural` literal
This corresponds to the @natural-literal@ rule from the official grammar
-}
naturalLiteral :: Parser Natural
naturalLiteral = (do
- a <- try (char '0' >> char 'x' >> Text.Megaparsec.Char.Lexer.hexadecimal)
+ 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
@@ -298,7 +326,100 @@
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
@@ -352,25 +473,23 @@
where
predicate c = 'a' <= c && c <= 'f'
--- | 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 = do
+-- | 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
- endOfLine
-
return ("--" <> commentText)
- where
- endOfLine =
- ( void (Text.Parser.Char.char '\n' )
- <|> void (Text.Parser.Char.text "\r\n")
- ) "newline"
+-- | 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
@@ -398,8 +517,6 @@
where
predicate c = '\x20' <= c && c <= '\x10FFFF' || c == '\n' || c == '\t'
- endOfLine = (Text.Parser.Char.text "\r\n" "newline")
-
blockCommentContinue :: Parser Text
blockCommentContinue = endOfComment <|> continue
where
@@ -417,7 +534,7 @@
let t = Data.Text.cons c rest
let isNotAKeyword = not $ t `Data.HashSet.member` reservedKeywords
let isNotAReservedIdentifier = not $ t `Data.HashSet.member` reservedIdentifiers
- Control.Monad.guard (isNotAKeyword && (allowReserved || isNotAReservedIdentifier))
+ Monad.guard (isNotAKeyword && (allowReserved || isNotAReservedIdentifier))
return t
headCharacter :: Char -> Bool
@@ -443,22 +560,18 @@
This corresponds to the @labels@ rule in the official grammar
-}
-labels :: Parser (Set Text)
+labels :: Parser [Text]
labels = do
_openBrace
whitespace
- xs <- nonEmptyLabels <|> emptyLabels
-
- _ <- optional (_comma *> whitespace)
-
- return xs
+ nonEmptyLabels <|> emptyLabels
where
emptyLabels = do
try (optional (_comma *> whitespace) *> _closeBrace)
- pure Dhall.Set.empty
+ pure []
nonEmptyLabels = do
x <- try (optional (_comma *> whitespace) *> anyLabelOrSome)
@@ -471,7 +584,7 @@
_closeBrace
- noDuplicates (x : xs)
+ return (x : xs)
{-| Parse a label (e.g. a variable\/field\/alternative name)
@@ -847,6 +960,13 @@
_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
@@ -1019,6 +1139,13 @@
_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
@@ -1068,6 +1195,48 @@
_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
@@ -1213,8 +1382,10 @@
_at = reservedChar '@' "\"@\""
-- | Parse the equivalence symbol (@===@ or @≡@)
-_equivalent :: Parser ()
-_equivalent = (void (char '≡' "\"≡\"") <|> void (text "===")) "operator"
+_equivalent :: Parser CharacterSet
+_equivalent =
+ (Unicode <$ char '≡' "\"≡\"")
+ <|> (ASCII <$ text "===" "===")
-- | Parse the @missing@ keyword
_missing :: Parser ()
@@ -1227,32 +1398,40 @@
_importAlt = operatorChar '?'
-- | Parse the record combine operator (@/\\@ or @∧@)
-_combine :: Parser ()
-_combine = (void (char '∧' "\"∧\"") <|> void (text "/\\")) "operator"
+_combine :: Parser CharacterSet
+_combine =
+ (Unicode <$ char '∧' "\"∧\"")
+ <|> (ASCII <$ text "/\\" "/\\")
-- | Parse the record type combine operator (@//\\\\@ or @⩓@)
-_combineTypes :: Parser ()
-_combineTypes = (void (char '⩓' "\"⩓\"") <|> void (text "//\\\\")) "operator"
+_combineTypes :: Parser CharacterSet
+_combineTypes =
+ (Unicode <$ char '⩓' "\"⩓\"")
+ <|> (ASCII <$ text "//\\\\" "//\\\\")
-- | Parse the record \"prefer\" operator (@//@ or @⫽@)
-_prefer :: Parser ()
-_prefer = (void (char '⫽' "\"⫽\"") <|> void (text "//")) "operator"
+_prefer :: Parser CharacterSet
+_prefer =
+ (Unicode <$ char '⫽' "\"⫽\"")
+ <|> (ASCII <$ text "//" "//")
-- | Parse a lambda (@\\@ or @λ@)
-_lambda :: Parser ()
-_lambda = void (Text.Parser.Char.satisfy predicate) "\\"
- where
- predicate 'λ' = True
- predicate '\\' = True
- predicate _ = False
+_lambda :: Parser CharacterSet
+_lambda =
+ (Unicode <$ char 'λ' "\"λ\"")
+ <|> (ASCII <$ char '\\' "\\")
-- | Parse a forall (@forall@ or @∀@)
-_forall :: Parser ()
-_forall = (void (char '∀' "\"∀\"") <|> void (text "forall")) "forall"
+_forall :: Parser CharacterSet
+_forall =
+ (Unicode <$ char '∀' "\"∀\"")
+ <|> (ASCII <$ text "forall" "forall")
-- | Parse a right arrow (@->@ or @→@)
-_arrow :: Parser ()
-_arrow = (void (char '→' "\"→\"") <|> void (text "->")) "->"
+_arrow :: Parser CharacterSet
+_arrow =
+ (Unicode <$ char '→' "\"→\"")
+ <|> (ASCII <$ text "->" "->")
-- | Parse a double colon (@::@)
_doubleColon :: Parser ()
diff --git a/src/Dhall/Pretty.hs b/src/Dhall/Pretty.hs
--- a/src/Dhall/Pretty.hs
+++ b/src/Dhall/Pretty.hs
@@ -8,13 +8,18 @@
, 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,7 +1,11 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
@@ -16,6 +20,8 @@
, prettySrcExpr
, CharacterSet(..)
+ , defaultCharacterSet
+ , detectCharacterSet
, prettyCharacterSet
, prettyImportExpression
@@ -26,6 +32,7 @@
, prettyEnvironmentVariable
, prettyConst
+ , UnescapedLabel(..)
, escapeLabel
, prettyLabel
, prettyAnyLabel
@@ -36,6 +43,7 @@
, prettyDouble
, prettyToStrictText
, prettyToString
+ , prettyBase16
, layout
, layoutOpts
@@ -50,7 +58,7 @@
, comma
, dot
, equals
- , forall
+ , forall_
, label
, lambda
, langle
@@ -63,31 +71,48 @@
, rbrace
, rbracket
, rparen
+
+ , temporalToText
) where
-import Data.Foldable
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Doc, Pretty, space)
-import Dhall.Map (Map)
-import Dhall.Set (Set)
-import Dhall.Src (Src (..))
-import Dhall.Syntax
-import Numeric.Natural (Natural)
+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
-import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Maybe
-import qualified Data.Set
-import qualified Data.Text as Text
-import qualified Data.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
-import qualified Dhall.Map as Map
-import qualified Dhall.Set
+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
@@ -113,14 +138,51 @@
annToAnsiStyle Operator = Terminal.bold <> Terminal.colorDull Terminal.Green
-- | This type determines whether to render code as `ASCII` or `Unicode`
-data CharacterSet = ASCII | Unicode deriving Show
+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 Unicode
+prettySrcExpr = prettyCharacterSet defaultCharacterSet
{-| Internal utility for pretty-printing, used when generating element lists
to supply to `enclose` or `enclose'`. This utility indicates that the
@@ -261,9 +323,9 @@
lambda Unicode = syntax "λ"
lambda ASCII = syntax "\\"
-forall :: CharacterSet -> Doc Ann
-forall Unicode = syntax "∀"
-forall ASCII = syntax "forall "
+forall_ :: CharacterSet -> Doc Ann
+forall_ Unicode = syntax "∀"
+forall_ ASCII = syntax "forall "
rarrow :: CharacterSet -> Doc Ann
rarrow Unicode = syntax "→"
@@ -348,7 +410,7 @@
arrows :: CharacterSet -> [ Doc Ann ] -> Doc Ann
arrows characterSet docs = Pretty.group (Pretty.flatAlt long short)
where
- long = Pretty.align (mconcat (Data.List.intersperse Pretty.hardline docs'))
+ long = Pretty.align (mconcat (List.intersperse Pretty.hardline docs'))
where
docs' = case unsnoc docs of
Nothing -> docs
@@ -361,7 +423,7 @@
last' = space <> space <> last_
- short = mconcat (Data.List.intersperse separator docs)
+ short = mconcat (List.intersperse separator docs)
where
separator = space <> rarrow characterSet <> space
@@ -420,7 +482,7 @@
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
+ trailing document such as nested @let@, nested lambdas, or nested @forall@s
-}
enclose'
:: Doc ann
@@ -440,7 +502,7 @@
longLines = zipWith (<>) (beginLong : repeat sepLong) docsLong
long =
- Pretty.align (mconcat (Data.List.intersperse Pretty.hardline longLines))
+ Pretty.align (mconcat (List.intersperse Pretty.hardline longLines))
short = mconcat (zipWith (<>) (beginShort : repeat sepShort) docsShort)
@@ -463,29 +525,51 @@
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 :: Bool -> Text -> Text
-escapeLabel allowReserved l =
+escapeLabel :: UnescapedLabel -> Text -> Text
+escapeLabel allowedLabel l =
case Text.uncons l of
Just (h, t)
- | headCharacter h && Text.all tailCharacter t && (notReservedIdentifier || (allowReserved && someOrNotLanguageKeyword))
+ | headCharacter h && Text.all tailCharacter t && allowed && l /= "?"
-> l
_ -> "`" <> l <> "`"
- where
- notReservedIdentifier = not (Data.HashSet.member l reservedIdentifiers)
- someOrNotLanguageKeyword = l == "Some" || not (Data.HashSet.member l reservedKeywords)
+ where
+ allowed = case allowedLabel of
+ NonReservedLabel -> notReservedIdentifier
+ AnyLabel -> notReservedKeyword
+ AnyLabelOrSome -> notReservedKeyword || l == "Some"
-prettyLabelShared :: Bool -> Text -> Doc Ann
+ 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 False
+prettyLabel = prettyLabelShared NonReservedLabel
prettyAnyLabel :: Text -> Doc Ann
-prettyAnyLabel = prettyLabelShared True
+prettyAnyLabel = prettyLabelShared AnyLabel
-prettyAnyLabels :: Foldable list => list (Maybe Src, Text, Maybe Src) -> Doc Ann
-prettyAnyLabels keys = Pretty.group (Pretty.flatAlt long short)
+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
@@ -505,16 +589,14 @@
. Pretty.punctuate Pretty.hardline
. Data.Maybe.catMaybes
$ [ renderSrcMaybe mSrc0
- , Just (prettyAnyLabel key)
+ , Just (prettyK key)
, renderSrcMaybe mSrc1
]
-prettyLabels :: Set Text -> Doc Ann
+prettyLabels :: [Text] -> Doc Ann
prettyLabels a
- | Data.Set.null (Dhall.Set.toSet a) =
- lbrace <> rbrace
- | otherwise =
- braces (map (duplicate . prettyAnyLabel) (Dhall.Set.toList a))
+ | null a = lbrace <> rbrace
+ | otherwise = braces (map (duplicate . prettyAnyLabelOrSome) a)
prettyNumber :: Integer -> Doc Ann
prettyNumber = literal . Pretty.pretty
@@ -605,10 +687,10 @@
prettyCompleteExpression expression =
Pretty.group (prettyExpression expression)
- prettyExpression a0@(Lam _ _) =
+ prettyExpression a0@(Lam _ _ _) =
arrows characterSet (docs a0)
where
- docs (Lam (FunctionBinding { functionBindingVariable = a, functionBindingAnnotation = b }) c) =
+ docs (Lam _ (FunctionBinding { functionBindingVariable = a, functionBindingAnnotation = b }) c) =
Pretty.group (Pretty.flatAlt long short) : docs c
where
long = (lambda characterSet <> space)
@@ -654,7 +736,7 @@
longLines = zipWith (<>) prefixesLong (docsLong True a0)
long =
- Pretty.align (mconcat (Data.List.intersperse Pretty.hardline longLines))
+ Pretty.align (mconcat (List.intersperse Pretty.hardline longLines))
short = mconcat (zipWith (<>) prefixesShort (docsShort a0))
@@ -697,7 +779,12 @@
where
MultiLet as b = multiLet a0 b0
- stripSpaces = Text.dropAround (\c -> c == ' ' || c == '\t')
+ 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.
@@ -736,13 +823,13 @@
( keyword "in" <> " " <> prettyExpression b
, keyword "in" <> " " <> prettyExpression b
)
- prettyExpression a0@(Pi _ _ _) =
+ 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
+ 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
+ long = forall_ characterSet <> space
<> Pretty.align
( lparen <> space
<> prettyLabel a
@@ -753,7 +840,7 @@
<> rparen
)
- short = forall characterSet <> lparen
+ short = forall_ characterSet <> lparen
<> prettyLabel a
<> space <> colon <> space
<> prettyExpression b
@@ -781,7 +868,11 @@
<> Pretty.align (keyword "with" <> " " <> update)
(update, _) =
- prettyKeyValue prettyOperatorExpression equals (makeKeyValue b c)
+ 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
@@ -813,7 +904,7 @@
<> Pretty.indent 2 (prettyImportExpression_ b)
<> Pretty.hardline
<> colon <> space
- <> prettyApplicationExpression c
+ <> prettyExpression c
)
short = keyword "merge" <> space
@@ -821,7 +912,7 @@
<> " "
<> prettyImportExpression_ b
<> space <> colon <> space
- <> prettyApplicationExpression c
+ <> prettyExpression c
prettyAnnotatedExpression (ToMap a (Just b)) =
Pretty.group (Pretty.flatAlt long short)
where
@@ -832,13 +923,13 @@
<> Pretty.indent 2 (prettyImportExpression_ a)
<> Pretty.hardline
<> colon <> space
- <> prettyApplicationExpression b
+ <> prettyExpression b
)
short = keyword "toMap" <> space
<> prettyImportExpression_ a
<> space <> colon <> space
- <> prettyApplicationExpression b
+ <> prettyExpression b
prettyAnnotatedExpression a0@(Annot _ _) =
enclose'
""
@@ -858,7 +949,7 @@
prettyAnnotatedExpression (ListLit (Just a) b) =
list (map prettyExpression (Data.Foldable.toList b))
<> " : "
- <> prettyApplicationExpression a
+ <> prettyExpression a
prettyAnnotatedExpression a
| Just doc <- preserveSource a =
doc
@@ -884,10 +975,10 @@
spacer = if Text.length op == 1 then " " else " "
prettyEquivalentExpression :: Pretty a => Expr Src a -> Doc Ann
- prettyEquivalentExpression a0@(Equivalent _ _) =
+ prettyEquivalentExpression a0@(Equivalent _ _ _) =
prettyOperator (equivalent characterSet) (docs a0)
where
- docs (Equivalent a b) = prettyImportAltExpression b : docs a
+ docs (Equivalent _ a b) = prettyImportAltExpression b : docs a
docs a
| Just doc <- preserveSource a =
[ doc ]
@@ -1024,10 +1115,10 @@
prettyCombineExpression a
prettyCombineExpression :: Pretty a => Expr Src a -> Doc Ann
- prettyCombineExpression a0@(Combine _ _ _) =
+ prettyCombineExpression a0@(Combine _ _ _ _) =
prettyOperator (combine characterSet) (docs a0)
where
- docs (Combine _ a b) = prettyPreferExpression b : docs a
+ docs (Combine _ _ a b) = prettyPreferExpression b : docs a
docs a
| Just doc <- preserveSource a =
[ doc ]
@@ -1047,7 +1138,7 @@
prettyPreferExpression a0@(Prefer {}) =
prettyOperator (prefer characterSet) (docs a0)
where
- docs (Prefer _ a b) = prettyCombineTypesExpression b : docs a
+ docs (Prefer _ _ a b) = prettyCombineTypesExpression b : docs a
docs a
| Just doc <- preserveSource a =
[ doc ]
@@ -1064,10 +1155,10 @@
prettyCombineTypesExpression a
prettyCombineTypesExpression :: Pretty a => Expr Src a -> Doc Ann
- prettyCombineTypesExpression a0@(CombineTypes _ _) =
+ prettyCombineTypesExpression a0@(CombineTypes _ _ _) =
prettyOperator (combineTypes characterSet) (docs a0)
where
- docs (CombineTypes a b) = prettyTimesExpression b : docs a
+ docs (CombineTypes _ a b) = prettyTimesExpression b : docs a
docs a
| Just doc <- preserveSource a =
[ doc ]
@@ -1151,6 +1242,7 @@
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 ->
@@ -1224,6 +1316,8 @@
prettyConst k
prettyPrimitiveExpression Bool =
builtin "Bool"
+ prettyPrimitiveExpression Bytes =
+ builtin "Bytes"
prettyPrimitiveExpression Natural =
builtin "Natural"
prettyPrimitiveExpression NaturalFold =
@@ -1262,6 +1356,57 @@
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 =
@@ -1295,6 +1440,8 @@
prettyDouble a
prettyPrimitiveExpression (TextLit a) =
prettyChunks a
+ prettyPrimitiveExpression (BytesLit a) =
+ prettyBytes a
prettyPrimitiveExpression (Record a) =
prettyRecord a
prettyPrimitiveExpression (RecordLit a) =
@@ -1319,11 +1466,12 @@
prettyKeyValue
:: Pretty a
- => (Expr Src a -> Doc Ann)
+ => (key -> Doc Ann)
+ -> (Expr Src a -> Doc Ann)
-> Doc Ann
- -> KeyValue Src a
+ -> KeyValue key Src a
-> (Doc Ann, Doc Ann)
- prettyKeyValue prettyValue separator (KeyValue key mSrc val) =
+ prettyKeyValue prettyKey prettyValue separator (KeyValue key mSrc val) =
duplicate (Pretty.group (Pretty.flatAlt long short))
where
completion _T r =
@@ -1335,7 +1483,7 @@
_ ->
prettySelectorExpression r
- short = prettyAnyLabels key
+ short = prettyKeys prettyKey key
<> " "
<> separator
<> " "
@@ -1345,7 +1493,7 @@
<> prettyValue val
long = Pretty.align
- ( prettyAnyLabels key
+ ( prettyKeys prettyKey key
<> preSeparator
)
<> separator
@@ -1387,11 +1535,23 @@
<> keyword "toMap"
<> case shallowDenote val' of
RecordCompletion _T r ->
- completion _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
@@ -1422,14 +1582,43 @@
prettyRecord :: Pretty a => Map Text (RecordField Src a) -> Doc Ann
prettyRecord =
- braces
- . map (prettyKeyValue prettyExpression colon . adapt)
+ ( 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 = prettyRecordLike braces
+ 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
@@ -1451,19 +1640,23 @@
| Var (V key' 0) <- Dhall.Syntax.shallowDenote val
, key == key'
, not (containsComment mSrc2) ->
- duplicate (prettyAnyLabels [(mSrc0, key, mSrc1)])
+ duplicate (prettyKeys prettyAnyLabelOrSome [(mSrc0, key, mSrc1)])
_ ->
- prettyKeyValue prettyExpression equals kv
+ prettyKeyValue prettyAnyLabelOrSome prettyExpression equals kv
prettyAlternative (key, Just val) =
- prettyKeyValue prettyExpression colon (makeKeyValue (pure key) val)
+ prettyKeyValue prettyAnyLabelOrSome prettyExpression colon (makeKeyValue (pure key) val)
prettyAlternative (key, Nothing) =
- duplicate (prettyAnyLabel key)
+ 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') =
@@ -1497,7 +1690,7 @@
prettyMultilineText text = mconcat docs
where
- lines_ = Text.splitOn "\n" (escapeSingleQuotedText text)
+ lines_ = Text.splitOn "\n" text
-- Annotate only non-empty lines so trailing whitespace can be
-- removed on empty ones.
@@ -1505,8 +1698,7 @@
(if Text.null line then id else literal)
(Pretty.pretty line)
- docs =
- Data.List.intersperse Pretty.hardline (map prettyLine lines_)
+ docs = List.intersperse Pretty.hardline (map prettyLine lines_)
prettyChunk (c, d) =
prettyText c
@@ -1526,8 +1718,10 @@
-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t"
multilineChunks :: Chunks s a -> Chunks s a
multilineChunks =
- escapeTrailingSingleQuote
+ escapeSingleQuotedText
+ . escapeTrailingSingleQuote
. escapeControlCharacters
+ . escapeSingleQuoteBeforeInterpolation
. escapeSharedWhitespacePrefix
-- | Escape any leading whitespace shared by all lines
@@ -1574,38 +1768,68 @@
-- >>> escapeControlCharacters (Chunks [] "\n\NUL\b\f\t")
-- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t"
escapeControlCharacters :: Chunks s a -> Chunks s a
-escapeControlCharacters (Chunks as0 b0) = Chunks as1 b1
+escapeControlCharacters = splitWith (splitOnPredicate predicate)
where
- as1 = foldr f (map toChunk bs) as0
+ predicate c = Data.Char.isControl c && c /= ' ' && c /= '\t' && c /= '\n'
- (bs, b1) = splitOnPredicate predicate b0
+-- | 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
- f (t0, e) chunks = map toChunk ts1 ++ (t1, e) : chunks
- where
- (ts1, t1) = splitOnPredicate predicate t0
+ loop head_ tail_ =
+ case tail_ of
+ [] ->
+ Chunks [] head_
+ newHead : newTail ->
+ Chunks [ (head_, TextLit (Chunks [] "'")) ] "${"
+ <> loop newHead newTail
- predicate c = Data.Char.isControl c && c /= ' ' && c /= '\t' && c /= '\n'
+{-| You can think of this as sort of like `concatMap` for `Chunks`
- toChunk (t0, t1) = (t0, TextLit (Chunks [] t1))
+ 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
--- | Split `Data.Text.Text` on a predicate, preserving all parts of the original
--- string.
+ [ 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 "
--- ([(" ","xx")]," ")
+-- Chunks [(" ",TextLit (Chunks [] "xx"))] " "
-- >>> splitOnPredicate (== 'x') "xx"
--- ([("","xx")],"")
+-- Chunks [("",TextLit (Chunks [] "xx"))] ""
--
--- prop> \(Fun _ p) s -> let {t = Text.pack s; (as, b) = splitOnPredicate p t} in foldMap (uncurry (<>)) as <> b == t
-splitOnPredicate :: (Char -> Bool) -> Text -> ([(Text, Text)], Text)
-splitOnPredicate p t = case Text.break p t of
- (a, "") -> ([], a)
- (a, b) -> case Text.span p b of
- (c, d) -> case splitOnPredicate p d of
- (e, f) -> ((a, c) : e, f)
+-- 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
@@ -1623,13 +1847,13 @@
pretty_ :: Pretty a => a -> Text
pretty_ = prettyToStrictText
-data KeyValue s a = KeyValue
- { _keyValueKeys :: NonEmpty (Maybe s, Text, Maybe s)
+data KeyValue k s a = KeyValue
+ { _keyValueKeys :: NonEmpty (Maybe s, k , Maybe s)
, _keyValueSrc :: Maybe s
, _keyValueValue :: Expr s a
}
-makeKeyValue :: NonEmpty Text -> Expr s a -> KeyValue 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)
@@ -1637,17 +1861,18 @@
{- This utility function converts
`{ x = { y = { z = 1 } } }` to `{ x.y.z = 1 }`
-}
-consolidateRecordLiteral :: Map Text (RecordField Src a) -> [KeyValue Src a]
+consolidateRecordLiteral
+ :: Map Text (RecordField Src a) -> [KeyValue Text Src a]
consolidateRecordLiteral = concatMap adapt . Map.toList
where
- adapt :: (Text, RecordField Src a) -> [KeyValue Src a]
+ 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 =
+ | Combine _ (Just _) l r <- e =
adapt (key, makeRecordField l) <> adapt (key, makeRecordField r)
| otherwise =
[ KeyValue (pure (mSrc0, key, mSrc1)) mSrc2 val ]
@@ -1656,12 +1881,13 @@
-- | Escape a `Data.Text.Text` literal using Dhall's escaping rules for
-- single-quoted @Text@
-escapeSingleQuotedText :: Text -> Text
-escapeSingleQuotedText inputText = outputText
+escapeSingleQuotedText :: Chunks s a -> Chunks s a
+escapeSingleQuotedText = splitWith f
where
- outputText = substitute "${" "''${" (substitute "''" "'''" inputText)
-
- substitute before after = Text.intercalate after . Text.splitOn before
+ f inputText = Chunks [] outputText
+ where
+ outputText =
+ Text.replace "${" "''${" (Text.replace "''" "'''" inputText)
{-| Escape a `Data.Text.Text` literal using Dhall's escaping rules
@@ -1722,6 +1948,43 @@
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,12 +1,28 @@
module Dhall.Pretty.Internal where
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Pretty, Doc)
-import Dhall.Src (Src)
+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.Syntax
+import Dhall.Syntax.Const
+import {-# SOURCE #-} Dhall.Syntax.Expr
+import Dhall.Syntax.Var
data Ann
+
+data CharacterSet = ASCII | Unicode
+
+instance Eq CharacterSet
+instance Ord CharacterSet
+instance Show CharacterSet
+instance Data CharacterSet
+instance Lift CharacterSet
+instance NFData CharacterSet
+instance Semigroup CharacterSet
+instance Monoid CharacterSet
prettyVar :: Var -> Doc Ann
diff --git a/src/Dhall/Repl.hs b/src/Dhall/Repl.hs
--- a/src/Dhall/Repl.hs
+++ b/src/Dhall/Repl.hs
@@ -18,15 +18,13 @@
, displayException
, throwIO
)
-import Control.Monad (forM_)
+import Control.Monad (forM_)
#if !(MIN_VERSION_base(4,13,0))
-import Control.Monad.Fail (MonadFail)
+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)
--- For the MonadFail instance for StateT.
-import Control.Monad.Trans.Instances ()
+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
@@ -47,35 +45,36 @@
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 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 Data.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty (renderIO)
+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
+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.Token as Parser.Token
+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.TypeCheck as Dhall
-import qualified Dhall.Version as Meta
+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.Console.Haskeline.Completion as Haskeline
+import qualified System.Console.Repline as Repline
import qualified System.IO
-import qualified Text.Megaparsec as Megaparsec
+import qualified Text.Megaparsec as Megaparsec
#if MIN_VERSION_haskeline(0,8,0)
import qualified Control.Monad.Catch
@@ -236,31 +235,51 @@
| otherwise
= Left (trim str)
-addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => Either String (String, String) -> m ()
-addBinding (Right (k, src)) = do
- varName <- case Megaparsec.parse (unParser Parser.Token.label) "(input)" (Text.pack k) of
- Left _ -> Fail.fail "Invalid variable name"
- Right varName -> return varName
+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_)
+ )
- loaded <- parseAndLoad src
+ let input = "let " <> Text.pack string
- t <- typeCheck loaded
+ 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
- expr <- normalize loaded
+ (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
- varName
- Binding { bindingType = t, bindingExpr = expr }
+ variable
+ Binding{ bindingType, bindingExpr }
( envBindings e )
}
)
- output ( Expr.Annot ( Expr.Var ( Dhall.V varName 0 ) ) t )
-
-addBinding _ = Fail.fail ":let should be of the form `:let x = y`"
+ output (Expr.Annot (Expr.Var (Dhall.V variable 0)) bindingType)
clearBindings :: (MonadFail m, MonadState Env m) => String -> m ()
clearBindings _ = modify adapt
@@ -275,7 +294,8 @@
normalizedExpression <- normalize loadedExpression
- writeOutputHandle $ hashExpressionToCode normalizedExpression
+ writeOutputHandle
+ (hashExpressionToCode (Dhall.Core.alphaNormalize normalizedExpression))
saveFilePrefix :: FilePath
saveFilePrefix = ".dhall-repl"
@@ -478,7 +498,7 @@
"let"
"IDENTIFIER = EXPRESSION"
"Assign an expression to a variable"
- (dontCrash . addBinding . parseAssignment)
+ (dontCrash . addBinding)
, HelpOption
"clear"
""
diff --git a/src/Dhall/Schemas.hs b/src/Dhall/Schemas.hs
--- a/src/Dhall/Schemas.hs
+++ b/src/Dhall/Schemas.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -17,62 +16,65 @@
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 (..))
+import Dhall.Pretty (CharacterSet (..), detectCharacterSet)
import Dhall.Src (Src)
import Dhall.Syntax (Expr (..), Import, Var (..))
import Dhall.Util
( Censor (..)
- , CheckFailed (..)
, Header (..)
, Input (..)
+ , MultipleCheckFailed (..)
, OutputMode (..)
)
-import qualified Control.Exception as Exception
+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.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
-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.Optics as Optics
-import qualified Dhall.Parser as Parser
+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 System.AtomicWrite.Writer.LazyText as AtomicWrite
-import qualified System.Console.ANSI as ANSI
-import qualified System.IO as IO
+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
- { characterSet :: CharacterSet
- , censor :: Censor
- , input :: Input
- , outputMode :: OutputMode
- , schemas :: Text
+ { 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
- originalText <- case input of
- InputFile file -> Text.IO.readFile file
- StandardInput -> Text.IO.getContents
+ (inputName, originalText) <- case input of
+ InputFile file -> (,) file <$> Text.IO.readFile file
+ StandardInput -> (,) "(input)" <$> Text.IO.getContents
- (Header header, expression) <- Util.getExpressionAndHeaderFromStdinText censor originalText
+ (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
@@ -112,8 +114,10 @@
let modified = "rewritten"
- Exception.throwIO CheckFailed{..}
+ 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
@@ -191,7 +195,7 @@
let rewrittenExpression :: Expr Src Import
rewrittenExpression =
- fmap Void.absurd (Optics.transformOf Syntax.subExpressions schemasRewrite normalizedExpression)
+ fmap Void.absurd (Lens.transformOf Syntax.subExpressions schemasRewrite normalizedExpression)
if Normalize.freeIn (V "schemas" 0) rewrittenExpression
then return (Let (Syntax.makeBinding "schemas" _schemas) rewrittenExpression)
diff --git a/src/Dhall/Src.hs b/src/Dhall/Src.hs
--- a/src/Dhall/Src.hs
+++ b/src/Dhall/Src.hs
@@ -15,10 +15,10 @@
import Control.DeepSeq (NFData)
import Data.Data (Data)
import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Pretty (..))
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
diff --git a/src/Dhall/Syntax.hs b/src/Dhall/Syntax.hs
--- a/src/Dhall/Syntax.hs
+++ b/src/Dhall/Syntax.hs
@@ -1,1448 +1,31 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveLift #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE UnicodeSyntax #-}
-
-{-| This module contains the core syntax types and optics for them.
-
-'reservedIdentifiers', 'denote' and friends are included because they are
-involved in a dependency circle with "Dhall.Pretty.Internal".
--}
-
-module Dhall.Syntax (
- -- * 'Expr'
- Const(..)
- , Var(..)
- , Binding(..)
- , makeBinding
- , Chunks(..)
- , DhallDouble(..)
- , PreferAnnotation(..)
- , Expr(..)
- , RecordField(..)
- , makeRecordField
- , FunctionBinding(..)
- , makeFunctionBinding
- , FieldSelection(..)
- , makeFieldSelection
-
- -- ** 'Let'-blocks
- , MultiLet(..)
- , multiLet
- , wrapInLets
-
- -- ** Optics
- , subExpressions
- , unsafeSubExpressions
- , chunkExprs
- , bindingExprs
- , recordFieldExprs
- , functionBindingExprs
-
- -- ** Handling 'Note's
- , denote
- , renote
- , shallowDenote
-
- -- * 'Import'
- , Directory(..)
- , File(..)
- , FilePrefix(..)
- , Import(..)
- , ImportHashed(..)
- , ImportMode(..)
- , ImportType(..)
- , URL(..)
- , Scheme(..)
- , pathCharacter
-
- -- * Reserved identifiers
- , reservedIdentifiers
- , reservedKeywords
-
- -- * `Data.Text.Text` manipulation
- , toDoubleQuoted
- , longestSharedWhitespacePrefix
- , linesLiteral
- , unlinesLiteral
-
- -- * Desugaring
- , desugarWith
-
- -- * Utilities
- , internalError
- -- `shift` should really be in `Dhall.Normalize`, but it's here to avoid a
- -- module cycle
- , shift
- ) where
-
-import Control.DeepSeq (NFData)
-import Data.Bifunctor (Bifunctor (..))
-import Data.Bits (xor)
-import Data.Data (Data)
-import Data.Foldable
-import Data.HashSet (HashSet)
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Sequence (Seq)
-import Data.String (IsString (..))
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Doc, Pretty)
-import Data.Traversable ()
-import Data.Void (Void)
-import Dhall.Map (Map)
-import {-# SOURCE #-} Dhall.Pretty.Internal
-import Dhall.Set (Set)
-import Dhall.Src (Src (..))
-import GHC.Generics (Generic)
-import Instances.TH.Lift ()
-import Language.Haskell.TH.Syntax (Lift)
-import Numeric.Natural (Natural)
-import Unsafe.Coerce (unsafeCoerce)
-
-import qualified Control.Monad
-import qualified Data.HashSet
-import qualified Data.List.NonEmpty as NonEmpty
-import qualified Data.Text
-import qualified Data.Text.Prettyprint.Doc as Pretty
-import qualified Dhall.Crypto
-import qualified Dhall.Optics as Optics
-import qualified Lens.Family as Lens
-import qualified Network.URI as URI
-
--- $setup
--- >>> import Dhall.Binary () -- For the orphan instance for `Serialise (Expr Void Import)`
-
-{-| 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 (Show, Eq, Ord, Data, Bounded, Enum, Generic, Lift, NFData)
-
-instance Pretty Const where
- pretty = Pretty.unAnnotate . prettyConst
-
-{-| 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 (Data, Generic, Eq, Ord, Show, Lift, NFData)
-
-instance IsString Var where
- fromString str = V (fromString str) 0
-
-instance Pretty Var where
- pretty = Pretty.unAnnotate . prettyVar
-
-{- | 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 (Data, Eq, Foldable, Functor, Generic, Lift, NFData, Ord, Show, Traversable)
-
-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
-
-{-| 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
-
--- | 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 (Show, Data, Lift, NFData, Generic)
-
--- | 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
-
--- | 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'
-
--- | The body of an interpolated @Text@ literal
-data Chunks s a = Chunks [(Text, Expr s a)] Text
- deriving (Functor, Foldable, Generic, Traversable, Show, Eq, Ord, Data, Lift, NFData)
-
-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
-
-instance IsString (Chunks s a) where
- fromString str = Chunks [] (fromString str)
-
--- | Used to record the origin of a @//@ operator (i.e. from source code or a
--- product of desugaring)
-data PreferAnnotation s a
- = PreferFromSource
- | PreferFromWith (Expr s a)
- -- ^ Stores the original @with@ expression
- | PreferFromCompletion
- deriving (Data, Eq, Foldable, Functor, Generic, Lift, NFData, Ord, Show, Traversable)
-
-instance Bifunctor PreferAnnotation where
- first _ PreferFromSource = PreferFromSource
- first f (PreferFromWith e ) = PreferFromWith (first f e)
- first _ PreferFromCompletion = PreferFromCompletion
-
- second = fmap
-
-{-| 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 (Data, Eq, Foldable, Functor, Generic, Lift, NFData, Ord, Show, Traversable)
-
--- | Construct a 'RecordField' with no src information
-makeRecordField :: Expr s a -> RecordField s a
-makeRecordField e = RecordField Nothing e Nothing Nothing
-
-
-instance Bifunctor RecordField where
- first k (RecordField s0 value s1 s2) =
- RecordField (k <$> s0) (first k value) (k <$> s1) (k <$> s2)
- second = fmap
-
-{-| 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 (Data, Eq, Foldable, Functor, Generic, Lift, NFData, Ord, Show, Traversable)
-
--- | 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
-
-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
-
-{-| 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 Src' (@s = 'Src'@)
-to be consistent with similar data types such as 'Binding', for example.
--}
-data FieldSelection s = FieldSelection
- { fieldSelectionSrc0 :: Maybe s
- , fieldSelectionLabel :: !Text
- , fieldSelectionSrc1 :: Maybe s
- } deriving (Data, Eq, Foldable, Functor, Generic, Lift, NFData, Ord, Show, Traversable)
-
--- | Smart constructor for 'FieldSelection' with no src information
-makeFieldSelection :: Text -> FieldSelection s
-makeFieldSelection t = FieldSelection Nothing t Nothing
-
-{-| Syntax tree for expressions
-
- The @s@ type parameter is used to track the presence or absence of `Src`
- spans:
-
- * If @s = `Src`@ then the code may contains `Src` spans (either in a `Note`
- constructor or inline within another constructor, like `Let`)
- * If @s = `Void`@ then the code has no `Src` spans
-
- The @a@ type parameter is used to track the presence or absence of imports
-
- * If @a = `Import`@ then the code may contain unresolved `Import`s
- * If @a = `Void`@ then the code has no `Import`s
--}
-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 (FunctionBinding 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 (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 '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)
- -- | > 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
- -- | > 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 Text) (Expr s a) (Expr s a)
- -- | > CombineTypes x y ~ x ⩓ y
- | CombineTypes (Expr s a) (Expr s a)
- -- | > Prefer False x y ~ x ⫽ y
- --
- -- The first field is a `True` when the `Prefer` operator is introduced as a
- -- result of desugaring a @with@ expression
- | Prefer (PreferAnnotation s a) (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))
- -- | > 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 (Set Text) (Expr s a))
- -- | > Assert e ~ assert : e
- | Assert (Expr s a)
- -- | > Equivalent x y ~ x ≡ y
- | Equivalent (Expr s a) (Expr s a)
- -- | > With x y e ~ x with y = e
- | With (Expr s a) (NonEmpty Text) (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 (Foldable, Generic, Traversable, Show, Data, Lift, NFData)
--- NB: If you add a constructor to Expr, please also update the Arbitrary
--- instance in Dhall.Test.QuickCheck.
-
--- | 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)
-
--- | Note that this 'Ord' instance inherits `DhallDouble`'s defects.
-deriving instance (Ord s, Ord a) => Ord (Expr s a)
-
--- 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 fb e) = Lam (f <$> fb) (f <$> e)
- fmap f (Field a b) = Field (f <$> a) b
- fmap f expression = Lens.over unsafeSubExpressions (fmap f) expression
- {-# INLINABLE fmap #-}
-
-instance Applicative (Expr s) where
- pure = Embed
-
- (<*>) = Control.Monad.ap
-
-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 a b -> Lam (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)
-
-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 a b ) = Lam (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
-
-instance IsString (Expr s a) where
- fromString str = Var (fromString str)
-
--- | Generates a syntactically valid Dhall program
-instance Pretty a => Pretty (Expr s a) where
- pretty = Pretty.unAnnotate . prettyExpr
-
-{-
-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.
--}
-
-{-| 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)
-
--- | 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 _ (Embed a) = pure (Embed a)
-subExpressions f (Note a b) = Note a <$> f b
-subExpressions f (Let a b) = Let <$> bindingExprs f a <*> f b
-subExpressions f (Record a) = Record <$> traverse (recordFieldExprs f) a
-subExpressions f (RecordLit a) = RecordLit <$> traverse (recordFieldExprs f) a
-subExpressions f (Lam fb e) = Lam <$> functionBindingExprs f fb <*> f e
-subExpressions f (Field a b) = Field <$> f a <*> pure b
-subExpressions f expression = unsafeSubExpressions f expression
-{-# INLINABLE subExpressions #-}
-
-{-| 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 a b c) = Pi 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 _ 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 _ 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 a b c) = Combine a <$> f b <*> f c
-unsafeSubExpressions f (CombineTypes a b) = CombineTypes <$> f a <*> f b
-unsafeSubExpressions f (Prefer a b c) = Prefer <$> a' <*> f b <*> f c
- where
- a' = case a of
- PreferFromSource -> pure PreferFromSource
- PreferFromWith d -> PreferFromWith <$> f d
- PreferFromCompletion -> pure PreferFromCompletion
-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 (Project a b) = Project <$> f a <*> traverse f b
-unsafeSubExpressions f (Assert a) = Assert <$> f a
-unsafeSubExpressions f (Equivalent a b) = Equivalent <$> 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"
- )
-
-{-| 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 #-}
-
-{-| 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
-
-{-| 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_
-
--- | 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 #-}
-
-{-| 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 (Eq, Generic, Ord, Show, NFData)
-
-instance Semigroup Directory where
- Directory components₀ <> Directory components₁ =
- Directory (components₁ <> components₀)
-
-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 <> "\""
-
-{-| A `File` is a `directory` followed by one additional path component
- representing the `file` name
--}
-data File = File
- { directory :: Directory
- , file :: Text
- } deriving (Eq, Generic, Ord, Show, NFData)
-
-instance Pretty File where
- pretty (File {..}) =
- Pretty.pretty directory
- <> prettyPathComponent file
-
-instance Semigroup File where
- File directory₀ _ <> File directory₁ file =
- File (directory₀ <> directory₁) file
-
--- | 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 (Eq, Generic, Ord, Show, NFData)
-
-instance Pretty FilePrefix where
- pretty Absolute = ""
- pretty Here = "."
- pretty Parent = ".."
- pretty Home = "~"
-
--- | The URI scheme
-data Scheme = HTTP | HTTPS deriving (Eq, Generic, Ord, Show, NFData)
-
--- | 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 (Eq, Generic, Ord, Show, NFData)
-
-instance Pretty URL where
- pretty (URL {..}) =
- schemeDoc
- <> "://"
- <> Pretty.pretty authority
- <> pathDoc
- <> queryDoc
- <> foldMap prettyHeaders headers
- where
- prettyHeaders h =
- " using " <> Pretty.unAnnotate (prettyImportExpression 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
-
--- | 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 (Eq, Generic, Ord, Show, NFData)
-
-parent :: File
-parent = File { directory = Directory { components = [ ".." ] }, file = "" }
-
-instance Semigroup ImportType where
- Local prefix file₀ <> Local Here file₁ = Local prefix (file₀ <> file₁)
-
- Remote (URL { path = path₀, ..}) <> Local Here path₁ =
- Remote (URL { path = path₀ <> path₁, ..})
-
- Local prefix file₀ <> Local Parent file₁ =
- Local prefix (file₀ <> parent <> file₁)
-
- Remote (URL { path = path₀, .. }) <> Local Parent path₁ =
- Remote (URL { path = path₀ <> parent <> path₁, .. })
-
- import₀ <> Remote (URL { headers = headers₀, .. }) =
- Remote (URL { headers = headers₁, .. })
- where
- importHashed₀ = Import (ImportHashed Nothing import₀) Code
-
- headers₁ = fmap (fmap (importHashed₀ <>)) headers₀
-
- _ <> import₁ =
- import₁
-
-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"
-
--- | How to interpret the import's contents (i.e. as Dhall code or raw text)
-data ImportMode = Code | RawText | Location
- deriving (Eq, Generic, Ord, Show, NFData)
-
--- | A `ImportType` extended with an optional hash for semantic integrity checks
-data ImportHashed = ImportHashed
- { hash :: Maybe Dhall.Crypto.SHA256Digest
- , importType :: ImportType
- } deriving (Eq, Generic, Ord, Show, NFData)
-
-instance Semigroup ImportHashed where
- ImportHashed _ importType₀ <> ImportHashed hash importType₁ =
- ImportHashed hash (importType₀ <> importType₁)
-
-instance Pretty ImportHashed where
- pretty (ImportHashed Nothing p) =
- Pretty.pretty p
- pretty (ImportHashed (Just h) p) =
- Pretty.pretty p <> " sha256:" <> Pretty.pretty (show h)
-
--- | Reference to an external resource
-data Import = Import
- { importHashed :: ImportHashed
- , importMode :: ImportMode
- } deriving (Eq, Generic, Ord, Show, NFData)
-
-instance Semigroup Import where
- Import importHashed₀ _ <> Import importHashed₁ code =
- Import (importHashed₀ <> importHashed₁) code
-
-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 -> ""
-
-{-| 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'
-
--- | Remove all `Note` constructors from an `Expr` (i.e. de-`Note`)
-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 (denote b) (denote c)
- Record a -> Record $ denoteRecordField <$> a
- RecordLit a -> RecordLit $ denoteRecordField <$> a
- Lam a b -> Lam (denoteFunctionBinding a) (denote b)
- Field a (FieldSelection _ b _) -> Field (denote a) (FieldSelection Nothing b Nothing)
- 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"
- , "Bool"
- , "True"
- , "False"
- , "Optional"
- , "None"
- , "Natural"
- , "Integer"
- , "Double"
- , "Text"
- , "List"
- , "Type"
- , "Kind"
- , "Sort"
- ]
-
--- | 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
-
-{-| `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 (FunctionBinding src0 x' src1 src2 _A) b) =
- Lam (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 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 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
-
--- | Desugar all @with@ expressions
-desugarWith :: Expr s a -> Expr s a
-desugarWith = Optics.rewriteOf subExpressions rewrite
- where
- rewrite e@(With record (key :| []) value) =
- Just
- (Prefer
- (PreferFromWith e)
- record
- (RecordLit [ (key, makeRecordField value) ])
- )
- rewrite e@(With record (key0 :| key1 : keys) value) =
- Just
- (Let
- (makeBinding "_" record)
- (Prefer (PreferFromWith e) "_"
- (RecordLit
- [ (key0, makeRecordField $ With (Field "_" (FieldSelection Nothing key0 Nothing)) (key1 :| keys) (shift 1 "_" value)) ]
- )
- )
- )
- rewrite _ = Nothing
-
-_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 <> " "
- , "``` "
- ] )
+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.hs-boot b/src/Dhall/Syntax.hs-boot
deleted file mode 100644
--- a/src/Dhall/Syntax.hs-boot
+++ /dev/null
@@ -1,7 +0,0 @@
-module Dhall.Syntax where
-
-data Var
-
-data Const
-
-data Expr s a
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
--- a/src/Dhall/TH.hs
+++ b/src/Dhall/TH.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
@@ -6,25 +8,36 @@
-- | Template Haskell utilities
module Dhall.TH
- ( -- * Template Haskell
+ ( -- * 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 Data.Text.Prettyprint.Doc (Pretty)
import Dhall (FromDhall, ToDhall)
-import Dhall.Syntax (Expr (..))
+import Dhall.Syntax (Expr (..), FunctionBinding (..), Var (..))
import GHC.Generics (Generic)
-import Language.Haskell.TH.Quote (dataToExpQ)
+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 (..)
@@ -33,20 +46,25 @@
import Language.Haskell.TH.Syntax (DerivClause (..), DerivStrategy (..))
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
-import qualified Data.Typeable as Typeable
+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.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 Syntax
+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.
@@ -73,23 +91,61 @@
-}
staticDhallExpression :: Text -> Q Exp
staticDhallExpression text = do
- Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)
+ TH.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)
- expression <- Syntax.runIO (Dhall.inputExpr text)
+ (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)) . Syntax.lift . Text.unpack
+ 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)
- => [HaskellType (Expr s a)]
+ => [Var]
+ -> [HaskellType (Expr s a)]
-- ^ All Dhall-derived data declarations
--
-- Used to replace complex types with references to one of these
@@ -97,8 +153,40 @@
-> Expr s a
-- ^ Dhall expression to convert to a simple Haskell type
-> Q Type
-toNestedHaskellType haskellTypes = loop
+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)
@@ -115,6 +203,15 @@
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
@@ -125,126 +222,168 @@
return (AppT (ConT ''Maybe) haskellElementType)
- _ | Just haskellType <- List.find predicate haskellTypes -> do
- let name = Syntax.mkName (Text.unpack (typeName haskellType))
+ App dhallAppType dhallElementType -> do
+ haskellAppType <- loop dhallAppType
+ haskellElementType <- loop dhallElementType
- return (ConT name)
- | otherwise -> do
- let document =
- 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"
- , "• ❰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"
- , " \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."
- ]
+ return (AppT haskellAppType haskellElementType)
- let message = Pretty.renderString (Dhall.Pretty.layout document)
+ Var v
+ | Just (V param index) <- List.find (v ==) typeParams -> do
+ let name = TH.mkName $ (Text.unpack param) ++ (show index)
- fail message
- where
- predicate haskellType =
- Core.judgmentallyEqual (code haskellType) dhallType
+ return (VarT name)
-derivingClauses :: [DerivClause]
-derivingClauses =
- [ DerivClause (Just StockStrategy) [ ConT ''Generic ]
- , DerivClause (Just AnyclassStrategy) [ ConT ''FromDhall, ConT ''ToDhall ]
- ]
+ | 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)
- => [HaskellType (Expr s a)]
+ => GenerateOptions
+ -> [HaskellType (Expr s a)]
-> HaskellType (Expr s a)
- -> Q Dec
-toDeclaration haskellTypes MultipleConstructors{..} =
- case code of
- Union kts -> do
- let name = Syntax.mkName (Text.unpack typeName)
+ -> 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_ []
- constructors <- traverse (toConstructor haskellTypes typeName) (Dhall.Map.toList kts )
+ getTypeParams_ acc (Lam _ (FunctionBinding _ v _ _ _) rest) = getTypeParams_ (v:acc) rest
+ getTypeParams_ acc rest = (acc, rest)
- return (DataD [] name [] Nothing constructors derivingClauses)
+ derivingClauses = [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ]
- _ -> do
- let document =
- 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 code <> "\n"
- , " \n"
- , "... which is not a union type."
- ]
+ interpretOptions = generateToInterpretOptions generateOptions typ
- let message = Pretty.renderString (Dhall.Pretty.layout document)
+#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
- fail message
-toDeclaration haskellTypes SingleConstructor{..} = do
- let name = Syntax.mkName (Text.unpack typeName)
+ toDataD typeName typeParams constructors = do
+ let name = TH.mkName (Text.unpack typeName)
- constructor <- toConstructor haskellTypes typeName (constructorName, Just code)
+ let params = fmap toTypeVar typeParams
- return (DataD [] name [] Nothing [constructor] derivingClauses)
+ 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)
- => [HaskellType (Expr s a)]
+ => [Var]
+ -> GenerateOptions
+ -> [HaskellType (Expr s a)]
-> Text
-- ^ typeName
-> (Text, Maybe (Expr s a))
-- ^ @(constructorName, fieldType)@
-> Q Con
-toConstructor haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do
- let name = Syntax.mkName (Text.unpack constructorName)
+toConstructor typeParams GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do
+ let name = TH.mkName (Text.unpack $ constructorModifier constructorName)
- let bang = Bang NoSourceUnpackedness NoSourceStrictness
+ let strictness = if makeStrict then SourceStrict else NoSourceStrictness
+ let bang = Bang NoSourceUnpackedness strictness
+
case maybeAlternativeType of
Just dhallType
| let predicate haskellType =
@@ -252,22 +391,22 @@
&& typeName haskellType /= outerTypeName
, Just haskellType <- List.find predicate haskellTypes -> do
let innerName =
- Syntax.mkName (Text.unpack (typeName haskellType))
+ TH.mkName (Text.unpack (typeName haskellType))
return (NormalC name [ (bang, ConT innerName) ])
Just (Record kts) -> do
let process (key, dhallFieldType) = do
- haskellFieldType <- toNestedHaskellType haskellTypes dhallFieldType
+ haskellFieldType <- toNestedHaskellType typeParams haskellTypes dhallFieldType
- return (Syntax.mkName (Text.unpack key), bang, haskellFieldType)
+ 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 haskellTypes dhallAlternativeType
+ haskellAlternativeType <- toNestedHaskellType typeParams haskellTypes dhallAlternativeType
return (NormalC name [ (bang, haskellAlternativeType) ])
@@ -298,17 +437,18 @@
makeHaskellTypeFromUnion typeName code =
makeHaskellTypes [ MultipleConstructors{..} ]
--- | Used by `makeHaskellTypes` to specify how to generate Haskell types
+-- | 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
+ -- 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
+ -- | 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.
@@ -322,8 +462,88 @@
}
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
+-- 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
@@ -398,9 +618,18 @@
-- > deriving instance Ord Employee
-- > deriving instance Show Employee
makeHaskellTypes :: [HaskellType Text] -> Q [Dec]
-makeHaskellTypes haskellTypes = do
- Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)
+makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions
- haskellTypes' <- traverse (traverse (Syntax.runIO . Dhall.inputExpr)) haskellTypes
+-- | 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)
- traverse (toDeclaration haskellTypes') haskellTypes'
+ haskellTypes' <- traverse (traverse (TH.runIO . Dhall.inputExpr)) haskellTypes
+
+ concat <$> traverse (toDeclaration generateOptions haskellTypes') haskellTypes'
diff --git a/src/Dhall/Tutorial.hs b/src/Dhall/Tutorial.hs
--- a/src/Dhall/Tutorial.hs
+++ b/src/Dhall/Tutorial.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# LANGUAGE CPP #-}
{-| Dhall is a programming language specialized for configuration files. This
module contains a tutorial explaining how to author configuration files
@@ -375,13 +376,23 @@
--
-- ... 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,
@@ -1619,7 +1630,7 @@
-- > let replicate = https://prelude.dhall-lang.org/List/replicate
-- > in replicate 5
-- > $
--- > $ dhall freeze --inplace ./foo.dhall
+-- > $ dhall freeze ./foo.dhall
-- > $ cat ./foo.dhall
-- > let replicate =
-- > https://prelude.dhall-lang.org/List/replicate sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347
@@ -1633,7 +1644,7 @@
-- record might be the contents of a software license:
--
-- > { package = "dhall"
--- > , author = "Gabriel Gonzalez"
+-- > , author = "Gabriella Gonzalez"
-- > , license = ./LICENSE
-- > }
--
@@ -1642,7 +1653,7 @@
--
-- > $ cat LICENSE
-- > ''
--- > Copyright (c) 2017 Gabriel Gonzalez
+-- > Copyright (c) 2017 Gabriella Gonzalez
-- > All rights reserved.
-- >
-- > ...
@@ -1657,14 +1668,14 @@
-- end of the import, like this:
--
-- > { package = "dhall"
--- > , author = "Gabriel Gonzalez"
+-- > , author = "Gabriella Gonzalez"
-- > , license = ./LICENSE as Text
-- > }
--
-- ... and then you can use the original text file unmodified:
--
-- > $ cat LICENSE
--- > Copyright (c) 2017 Gabriel Gonzalez
+-- > Copyright (c) 2017 Gabriella Gonzalez
-- > All rights reserved.
-- >
-- > ...
@@ -1744,10 +1755,9 @@
-- > (List (List Natural))
-- > (replicate 5 (List Natural) (replicate 5 Natural 1))
--
--- You can also use the formatter to modify files in place using the
--- @--inplace@ flag (i.e. for formatting source code):
+-- You can also use the formatter to modify files in place:
--
--- > $ dhall format --inplace ./unformatted
+-- > $ dhall format ./unformatted
--
-- Carefully note that the code formatter does not preserve all comments.
-- Currently, the formatter only preserves two types of comments:
@@ -1847,7 +1857,7 @@
-- You can find an up-to-date list of available built-in functions and operators
-- here:
--
---
+--
-- $caveats
--
@@ -1872,9 +1882,13 @@
-- >
-- > (input):1:1
--
--- In fact, there are no built-in functions for @Integer@s (or @Double@s) other
--- than @Integer/show@ and @Double/show@. As far as the language is concerned
--- they are opaque values that can only be shuffled around but not used in any
+-- 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
@@ -1969,6 +1983,7 @@
-- $substitutions
--
-- Substitutions are another way to extend the language.
+--
-- Suppose we have the following Haskell datatype:
--
-- > data Result = Failure Integer | Success String
@@ -1980,28 +1995,15 @@
--
-- > -- example.dhall
-- >
--- > let Result = < Failure : Integer | Success Text >
--- > in Result.Failure 1
+-- > 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?
--- Maintaining the code will get tedious. Luckily we can extract the correct Dhall type from the Haskell definition:
--
--- > resultDecoder :: Dhall.Decoder Result
--- > resultDecoder = Dhall.auto
--- >
--- > resultType :: Expr Src Void
--- > resultType = Dhall.expected resultDecoder
--- >
--- > resultTypeString :: String
--- > resultTypeString = show $ pretty resultType
---
--- Now we just have to inject that type into the Dhall code and we are done. One common way to do that is to wrap the import of example.dhall in a let expression:
---
--- > Dhall.input (Dhall.auto :: Dhall.Decoder Result) ("let Result = " ++ Data.Text.pack resultTypeString ++ " in ./example.dhall")
---
--- Now we can omit the definition of Result in our example.dhall file. While this will work perfectly Dhall provides a cleaner solution for our \"injection problem\":
+-- We can override the interpreter's @evaluateSettings@ with a custom set of
+-- substitutions, like this:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
@@ -2314,4 +2316,4 @@
-- $faq
--
---
+--
diff --git a/src/Dhall/TypeCheck.hs b/src/Dhall/TypeCheck.hs
--- a/src/Dhall/TypeCheck.hs
+++ b/src/Dhall/TypeCheck.hs
@@ -35,10 +35,9 @@
import Data.List.NonEmpty (NonEmpty (..))
import Data.Monoid (Endo (..))
import Data.Semigroup (Max (..))
-import Data.Sequence (Seq, ViewL (..))
+import Data.Sequence (ViewL (..))
import Data.Set (Set)
import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Doc, Pretty (..))
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
import Dhall.Context (Context)
@@ -48,9 +47,10 @@
, Val (..)
, (~>)
)
-import Dhall.Pretty (Ann)
+import Dhall.Pretty (Ann, UnescapedLabel (..))
import Dhall.Src (Src)
-import Lens.Family (over)
+import Lens.Micro (anyOf, over)
+import Prettyprinter (Doc, Pretty (..), vsep)
import Dhall.Syntax
( Binding (..)
@@ -61,28 +61,28 @@
, PreferAnnotation (..)
, RecordField (..)
, Var (..)
+ , WithComponent (..)
)
-import qualified Data.Foldable as Foldable
-import qualified Data.List.NonEmpty as NonEmpty
+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.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
+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.Eval as Eval
import qualified Dhall.Map
import qualified Dhall.Pretty
import qualified Dhall.Pretty.Internal
-import qualified Dhall.Set
-import qualified Dhall.Syntax as Syntax
+import qualified Dhall.Syntax as Syntax
import qualified Dhall.Util
-import qualified Lens.Family
+import qualified Prettyprinter as Pretty
+import qualified Prettyprinter.Render.String as Pretty
{-| A type synonym for `Void`
@@ -93,9 +93,6 @@
type X = Void
{-# DEPRECATED X "Use Data.Void.Void instead" #-}
-traverseWithIndex_ :: Applicative f => (Int -> a -> f b) -> Seq a -> f ()
-traverseWithIndex_ k xs = Foldable.sequenceA_ (Data.Sequence.mapWithIndex k xs)
-
axiom :: Const -> Either (TypeError s a) Const
axiom Type = return Kind
axiom Kind = return Sort
@@ -189,7 +186,7 @@
{-| `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
+ 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
@@ -229,7 +226,7 @@
go types n0
- Lam (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A}) b -> do
+ Lam _ (FunctionBinding { functionBindingVariable = x, functionBindingAnnotation = _A}) b -> do
tA' <- loop ctx _A
case tA' of
@@ -252,7 +249,7 @@
return (VHPi x _A' (\u -> Eval.eval (Extend values x u) _B''))
- Pi x _A _B -> do
+ Pi _ x _A _B -> do
tA' <- loop ctx _A
kA <- case tA' of
@@ -417,34 +414,26 @@
_R' <- loop ctx r
- tL' <- loop ctx (quote names _L')
+ _ <- loop ctx (quote names _L')
let _L'' = quote names _L'
- case tL' of
- VConst Type ->
- return ()
- _ -> do
- let tL'' = quote names tL'
- die (IfBranchMustBeTerm True l _L'' tL'')
-
- tR' <- loop ctx (quote names _R')
+ _ <- loop ctx (quote names _R')
let _R'' = quote names _R'
- case tR' of
- VConst Type ->
- return ()
- _ -> do
- let tR'' = quote names tR'
- die (IfBranchMustBeTerm True r _R'' tR'')
-
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)
@@ -593,6 +582,33 @@
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)
@@ -627,7 +643,7 @@
Left (TypeError context t₁ err)
- traverseWithIndex_ process ts₁
+ Foldable.WithIndex.itraverse_ process ts₁
return (VList _T₀')
@@ -782,14 +798,14 @@
Max c <- fmap Foldable.fold (Dhall.Map.unorderedTraverseWithKey process xTs)
return (VConst c)
- Combine mk l r -> do
+ 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 l)
+ let r'' = quote names (eval values r)
xLs' <- case _L' of
VRecord xLs' ->
@@ -831,7 +847,7 @@
combineTypes [] xLs' xRs'
- CombineTypes l r -> do
+ CombineTypes _ l r -> do
_L' <- loop ctx l
let l' = eval values l
@@ -878,7 +894,7 @@
return (VConst c)
- Prefer a l r -> do
+ Prefer _ _ l r -> do
_L' <- loop ctx l
_R' <- loop ctx r
@@ -891,11 +907,7 @@
let l'' = quote names (eval values l)
- case a of
- PreferFromWith withExpression ->
- die (MustUpdateARecord withExpression l'' _L'')
- _ ->
- die (MustCombineARecord '⫽' l'' _L'')
+ die (MustCombineARecord '⫽' l'' _L'')
xRs' <- case _R' of
VRecord xRs' -> return xRs'
@@ -913,13 +925,13 @@
_L' <- loop ctx l
case _L' of
- VRecord xLs'
+ 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 PreferFromCompletion (Field l def) r) (Field l typ))
+ -> loop ctx (Annot (Prefer mempty PreferFromCompletion (Field l def) r) (Field l typ))
_ -> die (CompletionSchemaMustBeARecord l (quote names _L'))
where
@@ -991,7 +1003,7 @@
n < 0
containsBadVar e =
- Lens.Family.anyOf
+ anyOf
Dhall.Core.subExpressions
containsBadVar
e
@@ -1127,6 +1139,14 @@
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
@@ -1154,6 +1174,12 @@
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'
@@ -1167,7 +1193,7 @@
let adapt = VRecord . Dhall.Map.unorderedFromList
- fmap adapt (traverse process (Dhall.Set.toAscList xs))
+ fmap adapt (traverse process xs)
_ -> do
let text =
@@ -1234,7 +1260,7 @@
_ ->
die (NotAnEquivalence _T)
- Equivalent x y -> do
+ Equivalent _ x y -> do
_A₀' <- loop ctx x
let _A₀'' = quote names _A₀'
@@ -1261,28 +1287,54 @@
return (VConst Type)
- With e ks v -> do
- tE' <- loop ctx e
+ With e₀ ks₀ v₀ -> do
+ tE₀' <- loop ctx e₀
- kTs' <- case tE' of
- VRecord kTs' -> return kTs'
- _ -> die (NotWithARecord e (quote names tE'))
+ -- The purpose of this inner loop is to ensure that we only need to
+ -- typecheck the record once
- case ks of
- k :| [] -> do
- tV' <- loop ctx v
+ 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'))
- k₀ :| k₁ : ks' -> do
- let e₁ =
- if Dhall.Map.member k₀ kTs'
- then Field e (Syntax.makeFieldSelection k₀)
- else RecordLit mempty
+ 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' <- loop ctx (With e₁ (k₁ :| ks') v)
+ tV' <- with _T (k₁ :| ks') v
- return (VRecord (Dhall.Map.insert k₀ tV' kTs'))
+ 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) ->
@@ -1326,23 +1378,19 @@
| 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)
| 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)
- | IfBranchMustBeTerm Bool (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)
- | MustUpdateARecord (Expr s a) (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)
- | RecordTypeMismatch Const Const (Expr s a) (Expr s a)
| DuplicateFieldCannotBeMerged (NonEmpty Text)
| FieldCollision (NonEmpty Text)
| FieldTypeCollision (NonEmpty Text)
@@ -1359,12 +1407,12 @@
| 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)
- | InvalidHandlerOutputType Text (Expr s a) (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)
@@ -1382,17 +1430,26 @@
| 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 <> "\n"
+ "\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 <> "\n"
+ "\ESC[1;31mError\ESC[0m: " <> short <> formatHints hints <> "\n"
<> "\n"
<> long
where
@@ -1404,6 +1461,8 @@
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
}
@@ -1414,6 +1473,12 @@
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 {..}
@@ -1422,6 +1487,8 @@
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\
@@ -1535,6 +1602,8 @@
where
short = "Invalid function input"
+ hints = []
+
long =
"Explanation: A function can accept an input “term” that has a given “type”, like\n\
\this: \n\
@@ -1604,6 +1673,8 @@
where
short = "Invalid function output"
+ hints = []
+
long =
"Explanation: A function can return an output “term” that has a given “type”, \n\
\like this: \n\
@@ -1683,6 +1754,8 @@
where
short = "Not a function"
+ hints = []
+
long =
"Explanation: Expressions separated by whitespace denote function application, \n\
\like this: \n\
@@ -1823,6 +1896,8 @@
<> "\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\
@@ -1956,6 +2031,9 @@
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\
@@ -2052,6 +2130,8 @@
where
short = "❰Sort❱ has no type, kind, or sort"
+ hints = []
+
long =
"Explanation: There are five levels of expressions that form a hierarchy: \n\
\ \n\
@@ -2090,6 +2170,8 @@
<> "\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\
@@ -2148,93 +2230,6 @@
txt0 = insert expr0
txt1 = insert 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 : Natural : Type │ ❰1❱ is a term with a type (❰Natural❱) 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 = insert expr0
- txt2 = insert expr1
- txt3 = insert expr2
-
prettyTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) =
ErrorMessages {..}
where
@@ -2242,6 +2237,8 @@
<> "\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\
@@ -2316,6 +2313,8 @@
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\
@@ -2331,6 +2330,8 @@
where
short = "Invalid type for ❰List❱"
+ hints = []
+
long =
"Explanation: ❰List❱s can optionally document their type with a type annotation, \n\
\like this: \n\
@@ -2393,6 +2394,8 @@
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\
@@ -2420,6 +2423,8 @@
<> "\n"
<> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2)
+ hints = []
+
long =
"Explanation: Every element in a list must have the same type \n\
\ \n\
@@ -2451,49 +2456,12 @@
txt1 = pretty i
txt3 = insert expr2
-prettyTypeMessage (InvalidListElement i expr0 _expr1 expr2) =
- ErrorMessages {..}
- where
- short = "List element has the wrong type\n"
- <> "\n"
- <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2)
-
- 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 Natural │ Every element in this ❰List❱ is an ❰Natural❱ \n\
- \ └──────────────────────────┘ \n\
- \ \n\
- \ \n\
- \.. but this is " <> _NOT <> " a valid ❰List❱: \n\
- \ \n\
- \ \n\
- \ ┌──────────────────────────────┐ \n\
- \ │ [1, \"ABC\", 3] : List Natural │ The second element is not an ❰Natural❱ \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 = 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\
@@ -2536,6 +2504,8 @@
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\
@@ -2579,6 +2549,8 @@
where
short = "Invalid alternative type"
+ hints = []
+
long =
"Explanation: Every union type specifies the type of each alternative, like this:\n\
\ \n\
@@ -2636,6 +2608,8 @@
<> "\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\
@@ -2673,11 +2647,13 @@
txt0 = insert expr0
txt1 = insert expr1
-prettyTypeMessage (CompletionSchemaMustBeARecord expr0 expr1) = ErrorMessages {..}
- where
- short = "The completion schema must be a record"
+prettyTypeMessage (CompletionSchemaMustBeARecord expr0 expr1) = ErrorMessages {..}
+ where
+ short = "The completion schema must be a record"
- long =
+ hints = []
+
+ long =
"Explanation: You can complete records using the ❰::❱ operator: \n\
\ \n\
\ ┌─────────────────────────────────────────────────────────────────────────┐ \n\
@@ -2697,11 +2673,13 @@
txt0 = insert expr0
txt1 = insert expr1
-prettyTypeMessage (InvalidRecordCompletion fieldName expr0) = ErrorMessages {..}
- where
- short = "Completion schema is missing a field: " <> pretty fieldName
+prettyTypeMessage (InvalidRecordCompletion fieldName expr0) = ErrorMessages {..}
+ where
+ short = "Completion schema is missing a field: " <> pretty fieldName
- long =
+ hints = []
+
+ long =
"Explanation: You can complete records using the ❰::❱ operator like this:\n\
\ \n\
\ ┌─────────────────────────────────────────────────────────────────────────┐ \n\
@@ -2722,55 +2700,6 @@
txt0 = insert expr0
txt1 = pretty fieldName
-prettyTypeMessage (MustUpdateARecord withExpression expression typeExpression) =
- ErrorMessages {..}
- where
- short = "You can only update records"
-
- long =
- "Explanation: You can update records using the ❰with❱ keyword, like this: \n\
- \ \n\
- \ \n\
- \ ┌────────────────────────────────┐ \n\
- \ │ { x = { y = 1 } } with x.y = 2 │ \n\
- \ └────────────────────────────────┘ \n\
- \ \n\
- \ \n\
- \ ┌────────────────────────────────────────────────────────────┐ \n\
- \ │ λ(r : { foo : { bar : Bool } }) → r with foo.bar = False } │ \n\
- \ └────────────────────────────────────────────────────────────┘ \n\
- \ \n\
- \ \n\
- \... but you cannot update values that are not records. \n\
- \ \n\
- \For example, the following expression is " <> _NOT <> " valid: \n\
- \ \n\
- \ \n\
- \ ┌─────────────────┐ \n\
- \ │ 1 with x = True │ \n\
- \ └─────────────────┘ \n\
- \ ⇧ \n\
- \ Invalid: Not a record \n\
- \ \n\
- \ \n\
- \────────────────────────────────────────────────────────────────────────────────\n\
- \ \n\
- \The following expression is not permitted: \n\
- \ \n\
- \" <> insert withExpression' <> "\n\
- \ \n\
- \... because the left argument to ❰with❱: \n\
- \ \n\
- \" <> insert expression <> "\n\
- \ \n\
- \... is not a record, but is actually a: \n\
- \ \n\
- \" <> insert typeExpression <> "\n"
- where
- withExpression' = case withExpression of
- With record keys value -> With (Dhall.Core.normalize record) keys value
- _ -> withExpression
-
prettyTypeMessage (MustCombineARecord c expression typeExpression) =
ErrorMessages {..}
where
@@ -2780,6 +2709,8 @@
short = "You can only " <> action <> " records"
+ hints = emptyRecordTypeHint expression
+
long =
"Explanation: You can " <> action <> " records using the ❰" <> op <> "❱ operator, like this:\n\
\ \n\
@@ -2837,6 +2768,8 @@
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\
@@ -2894,7 +2827,7 @@
\ \n\
\... which is not a record type \n"
where
- txt0 = insert (Dhall.Pretty.Internal.escapeLabel True k)
+ txt0 = insert (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome k)
txt1 = insert expr0
txt2 = insert expr1
@@ -2903,6 +2836,8 @@
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\
@@ -2937,61 +2872,12 @@
txt0 = insert expr0
txt1 = insert expr1
-prettyTypeMessage (RecordTypeMismatch const0 const1 expr0 expr1) =
- ErrorMessages {..}
- where
- short = "Record type mismatch"
-
- long =
- "Explanation: You can only use the ❰⩓❱ operator on record types if they are both \n\
- \ ❰Type❱s or ❰Kind❱s: \n\
- \ \n\
- \ \n\
- \ ┌─────────────────────────────────────┐ \n\
- \ │ { age : Natural } ⩓ { name : Text } │ Valid: Both arguments are ❰Type❱s \n\
- \ └─────────────────────────────────────┘ \n\
- \ \n\
- \ \n\
- \ ┌──────────────────────────────────────┐ \n\
- \ │ { Input : Type } ⩓ { Output : Type } │ Valid: Both arguments are ❰Kind❱s \n\
- \ └──────────────────────────────────────┘ \n\
- \ \n\
- \ \n\
- \... but you cannot combine a ❰Type❱ and a ❰Kind❱: \n\
- \ \n\
- \ \n\
- \ ┌────────────────────────────────────┐ \n\
- \ │ { Input : Type } ⩓ { name : Text } │ Invalid: The arguments do not match \n\
- \ └────────────────────────────────────┘ \n\
- \ \n\
- \ \n\
- \────────────────────────────────────────────────────────────────────────────────\n\
- \ \n\
- \You tried to combine the following record type: \n\
- \ \n\
- \" <> txt0 <> "\n\
- \ \n\
- \... with this record types: \n\
- \ \n\
- \" <> txt1 <> "\n\
- \ \n\
- \... but the former record type is a: \n\
- \ \n\
- \" <> txt2 <> "\n\
- \ \n\
- \... but the latter record type is a: \n\
- \ \n\
- \" <> txt3 <> "\n"
- where
- txt0 = insert expr0
- txt1 = insert expr1
- txt2 = insert const0
- txt3 = insert const1
-
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\
@@ -3046,7 +2932,7 @@
\ \n\
\" <> txt1 <> "\n"
where
- txt0 = insert (Dhall.Pretty.Internal.escapeLabel True (NonEmpty.head ks))
+ txt0 = insert (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome (NonEmpty.head ks))
txt1 = insert (toPath ks)
@@ -3054,6 +2940,8 @@
where
short = "Field collision on: " <> pretty (toPath ks)
+ hints = []
+
long =
"Explanation: You can recursively merge records using the ❰∧❱ operator: \n\
\ \n\
@@ -3118,6 +3006,8 @@
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\
@@ -3159,6 +3049,8 @@
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\
@@ -3214,6 +3106,8 @@
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\
@@ -3264,6 +3158,8 @@
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\
@@ -3304,9 +3200,11 @@
where
short = case Data.Set.toList ks of
[] -> "Missing handler: " <> Dhall.Pretty.Internal.prettyLabel exemplar
- xs@(_:_) -> "Missing handlers: " <> (Pretty.hsep . Pretty.punctuate Pretty.comma
+ 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\
@@ -3348,6 +3246,8 @@
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\
@@ -3380,6 +3280,8 @@
<> "\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\
@@ -3440,6 +3342,8 @@
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\
@@ -3481,70 +3385,6 @@
\ \n\
\" <> insert variable <> "\n"
-prettyTypeMessage (InvalidHandlerOutputType expr0 expr1 expr2) =
- ErrorMessages {..}
- where
- short = "Wrong handler output type\n"
- <> "\n"
- <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2)
-
- 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 : Bool │ \n\
- \ └─────────────────────────────────────────────────────────────────┘ \n\
- \ \n\
- \ \n\
- \... as long as the output type of each handler function matches the declared \n\
- \type 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 : Natural | Right : Bool >.Left 2 │ \n\
- \ │ 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 = insert expr0
- txt1 = insert expr1
- txt2 = insert expr2
-
prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) =
ErrorMessages {..}
where
@@ -3552,6 +3392,8 @@
<> "\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\
@@ -3606,6 +3448,8 @@
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\
@@ -3643,10 +3487,12 @@
txt0 = insert k
txt1 = insert expr0
-prettyTypeMessage (MustMapARecord _expr0 _expr1) = ErrorMessages {..}
+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\
@@ -3675,6 +3521,8 @@
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\
@@ -3701,6 +3549,8 @@
where
short = "❰toMap❱ expects a homogenous record"
+ hints = []
+
long =
"Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\
\ \n\
@@ -3728,6 +3578,8 @@
<> "\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"
@@ -3739,6 +3591,8 @@
<> "\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\
@@ -3756,6 +3610,8 @@
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\
@@ -3779,6 +3635,8 @@
where
short = "Not a record or a union"
+ hints = []
+
long =
"Explanation: You can only access fields on records or unions, like this: \n\
\ \n\
@@ -3837,6 +3695,8 @@
where
short = "Not a record"
+ hints = []
+
long =
"Explanation: You can only project fields on records, like this: \n\
\ \n\
@@ -3898,6 +3758,8 @@
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\
@@ -3953,10 +3815,44 @@
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\
@@ -3999,6 +3895,8 @@
where
short = "Missing constructor: " <> Dhall.Pretty.Internal.prettyLabel k
+ hints = []
+
long =
"Explanation: You can access constructors from unions, like this: \n\
\ \n\
@@ -4039,6 +3937,8 @@
<> "\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\
@@ -4086,6 +3986,8 @@
<> "\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\
@@ -4149,6 +4051,8 @@
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\
@@ -4202,6 +4106,8 @@
where
short = "Incomparable expression\n"
+ hints = []
+
long =
"Explanation: You can use an ❰assert❱ to compare two terms for equivalence, like \n\
\this: \n\
@@ -4233,6 +4139,8 @@
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\
@@ -4272,6 +4180,8 @@
where
short = "❰with❱ only works on records"
+ hints = []
+
long =
"Explanation: You can use ❰with❱ to update a record, like this: \n\
\ \n\
@@ -4323,6 +4233,8 @@
where
short = "You can only interpolate ❰Text❱"
+ hints = []
+
long =
"Explanation: Text interpolation only works on expressions of type ❰Text❱ \n\
\ \n\
@@ -4385,6 +4297,8 @@
where
short = "❰++❱ only works on ❰Text❱"
+ hints = []
+
long =
"Explanation: The ❰++❱ operator expects two arguments that have type ❰Text❱ \n\
\ \n\
@@ -4431,6 +4345,8 @@
where
short = "❰#❱ only works on ❰List❱s"
+ hints = []
+
long =
"Explanation: The ❰#❱ operator expects two arguments that are both ❰List❱s \n\
\ \n\
@@ -4461,11 +4377,133 @@
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\
@@ -4495,6 +4533,8 @@
where
short = "❰" <> txt2 <> "❱ only works on ❰Natural❱s"
+ hints = []
+
long =
"Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Natural❱\n\
\ \n\
@@ -4626,8 +4666,6 @@
pure MissingListType
MismatchedListElements a b c d ->
MismatchedListElements <$> pure a <*> f b <*> f c <*> f d
- InvalidListElement a b c d ->
- InvalidListElement <$> pure a <*> f b <*> f c <*> f d
InvalidListType a ->
InvalidListType <$> f a
ListLitInvariant ->
@@ -4638,8 +4676,6 @@
InvalidPredicate <$> f a <*> f b
IfBranchMismatch a b c d ->
IfBranchMismatch <$> f a <*> f b <*> f c <*> f d
- IfBranchMustBeTerm a b c d ->
- IfBranchMustBeTerm <$> pure a <*> f b <*> f c <*> f d
InvalidFieldType a b ->
InvalidFieldType <$> pure a <*> f b
InvalidAlternativeType a b ->
@@ -4648,18 +4684,14 @@
ListAppendMismatch <$> f a <*> f b
InvalidDuplicateField a b c ->
InvalidDuplicateField a <$> f b <*> f c
- MustUpdateARecord a b c ->
- MustUpdateARecord <$> f a <*> f b <*> f c
MustCombineARecord a b c ->
MustCombineARecord <$> pure a <*> f b <*> f c
- InvalidRecordCompletion a l ->
+ InvalidRecordCompletion a l ->
InvalidRecordCompletion a <$> f l
- CompletionSchemaMustBeARecord l r ->
+ CompletionSchemaMustBeARecord l r ->
CompletionSchemaMustBeARecord <$> f l <*> f r
CombineTypesRequiresRecordType a b ->
CombineTypesRequiresRecordType <$> f a <*> f b
- RecordTypeMismatch a b c d ->
- RecordTypeMismatch <$> pure a <*> pure b <*> f c <*> f d
DuplicateFieldCannotBeMerged a ->
pure (DuplicateFieldCannotBeMerged a)
FieldCollision a ->
@@ -4692,8 +4724,6 @@
DisallowedHandlerType <$> pure a <*> f b <*> f c <*> pure d
HandlerOutputTypeMismatch a b c d ->
HandlerOutputTypeMismatch <$> pure a <*> f b <*> pure c <*> f d
- InvalidHandlerOutputType a b c ->
- InvalidHandlerOutputType <$> pure a <*> f b <*> f c
MissingMergeType ->
pure MissingMergeType
HandlerNotAFunction a b ->
@@ -4704,6 +4734,8 @@
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 ->
@@ -4738,6 +4770,14 @@
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
@@ -4800,4 +4840,12 @@
toPath :: (Functor list, Foldable list) => list Text -> Text
toPath ks =
Text.intercalate "."
- (Foldable.toList (fmap (Dhall.Pretty.Internal.escapeLabel True) ks))
+ (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
--- a/src/Dhall/URL.hs
+++ b/src/Dhall/URL.hs
@@ -3,14 +3,12 @@
module Dhall.URL where
-import Data.Text (Text)
+import Data.Text (Text)
import Dhall.Syntax (Directory (..), File (..), Scheme (..), URL (..))
-import qualified Network.URI.Encode as URI.Encode
-
renderComponent :: Text -> Text
-renderComponent component = "/" <> URI.Encode.encodeText component
+renderComponent component = "/" <> component
renderQuery :: Text -> Text
renderQuery query = "?" <> query
diff --git a/src/Dhall/Util.hs b/src/Dhall/Util.hs
--- a/src/Dhall/Util.hs
+++ b/src/Dhall/Util.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -8,9 +9,10 @@
, snipDoc
, insert
, _ERROR
+ , _WARNING
+ , printWarning
, Censor(..)
, Input(..)
- , PossiblyTransitiveInput(..)
, Transitivity(..)
, OutputMode(..)
, Output(..)
@@ -19,26 +21,35 @@
, getExpressionAndHeaderFromStdinText
, Header(..)
, CheckFailed(..)
+ , MultipleCheckFailed(..)
+ , handleMultipleChecksFailed
+ , renderExpression
) where
-import Control.Exception (Exception (..))
-import Control.Monad.IO.Class (MonadIO (..))
-import Data.Bifunctor (first)
-import Data.String (IsString)
-import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Doc, Pretty)
-import Dhall.Parser (Header (..), ParseError)
-import Dhall.Pretty (Ann)
-import Dhall.Src (Src)
-import Dhall.Syntax (Expr, Import)
+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 Data.Text.Prettyprint.Doc as Pretty
-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
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
@@ -102,6 +113,21 @@
_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
@@ -112,13 +138,13 @@
case input of
Input_ (InputFile file) -> Data.Text.IO.readFile file
Input_ StandardInput -> Data.Text.IO.getContents
- StdinText text -> pure text
+ StdinText _ text -> pure text
let name =
case input of
Input_ (InputFile file) -> file
Input_ StandardInput -> "(input)"
- StdinText _ -> "(input)"
+ StdinText inputName _ -> inputName
let result = parser name inText
@@ -140,17 +166,14 @@
data Censor = NoCensor | Censor
-- | Path to input
-data Input = StandardInput | InputFile FilePath
+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 Text
-
-{-| For utilities that may want to process transitive dependencies, like
- @dhall freeze@
--}
-data PossiblyTransitiveInput
- = NonTransitiveStandardInput
- | PossiblyTransitiveInputFile FilePath Transitivity
+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.
@@ -170,15 +193,25 @@
-}
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 CheckFailed = CheckFailed { command :: Text, modified :: Text }
+data MultipleCheckFailed = MultipleCheckFailed
+ { command :: Text
+ , modified :: Text
+ , inputs :: NonEmpty Input
+ }
-instance Exception CheckFailed
+instance Exception MultipleCheckFailed
-instance Show CheckFailed where
- show CheckFailed{..} =
- _ERROR <> ": ❰dhall " <> command_ <> " --check❱ failed\n\
- \\n\
+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"
@@ -187,6 +220,32 @@
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_
@@ -199,6 +258,34 @@
-- | Convenient utility for retrieving an expression along with its header from
-- | text already read from STDIN (so it's not re-read)
getExpressionAndHeaderFromStdinText
- :: Censor -> Text -> IO (Header, Expr Src Import)
-getExpressionAndHeaderFromStdinText censor =
- get Dhall.Parser.exprAndHeaderFromText censor . StdinText
+ :: 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/tests/Dhall/Test/Dhall.hs b/tests/Dhall/Test/Dhall.hs
--- a/tests/Dhall/Test/Dhall.hs
+++ b/tests/Dhall/Test/Dhall.hs
@@ -13,21 +13,22 @@
module Dhall.Test.Dhall where
-import Control.Exception (SomeException, try)
-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 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
@@ -43,7 +44,7 @@
= LitF Natural
| AddF expr expr
| MulF expr expr
- deriving (Eq, Functor, Generic, FromDhall, Show)
+ deriving (Eq, Functor, Generic, FromDhall, ToDhall, Show)
instance Eq1 ExprF where
liftEq _ (LitF aL) (LitF aR) = aL == aR
@@ -91,14 +92,15 @@
let expectedMsg =
"\ESC[1;31mError\ESC[0m: Invalid Dhall.Decoder \n\
\ \n\
- \Every Decoder must provide an extract function that succeeds if an expression \n\
- \matches the expected type. You provided a Decoder that disobeys this contract \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 couldn't extract a value from the well-typed expression: \n\
+ \and it threw a type error during extraction from the well-typed expression: \n\
\ \n\
\↳ { bar = 0, foo = \"foo\" }\n\
\ \n"
@@ -141,6 +143,11 @@
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
diff --git a/tests/Dhall/Test/Diff.hs b/tests/Dhall/Test/Diff.hs
--- a/tests/Dhall/Test/Diff.hs
+++ b/tests/Dhall/Test/Diff.hs
@@ -2,21 +2,19 @@
module Dhall.Test.Diff where
-import Data.Text (Text)
-import Prelude hiding (FilePath)
-import Test.Tasty (TestTree)
-import Turtle (FilePath)
+import Data.Text (Text)
+import Test.Tasty (TestTree)
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text.IO
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
-import qualified Dhall.Core as Core
-import qualified Dhall.Diff as Diff
-import qualified Dhall.Parser as Parser
+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 Test.Tasty as Tasty
-import qualified Test.Tasty.HUnit as Tasty.HUnit
+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
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
--- a/tests/Dhall/Test/Format.hs
+++ b/tests/Dhall/Test/Format.hs
@@ -7,17 +7,16 @@
import Dhall.Pretty (CharacterSet (..))
import Test.Tasty (TestTree)
-import qualified Control.Monad as Monad
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text.IO
-import qualified Data.Text.Prettyprint.Doc as Doc
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text
-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 Test.Tasty as Tasty
-import qualified Test.Tasty.Silver as Tasty.Silver
+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
@@ -27,7 +26,7 @@
let skip = [ "./tests/format/asciiA.dhall" ]
- Monad.guard (path `notElem` skip)
+ path `Test.Util.pathNotIn` skip
return path
diff --git a/tests/Dhall/Test/Freeze.hs b/tests/Dhall/Test/Freeze.hs
--- a/tests/Dhall/Test/Freeze.hs
+++ b/tests/Dhall/Test/Freeze.hs
@@ -4,9 +4,7 @@
import Data.Text (Text)
import Dhall.Freeze (Intent (..), Scope (..))
-import Prelude hiding (FilePath)
import Test.Tasty (TestTree)
-import Turtle (FilePath)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
@@ -18,19 +16,30 @@
import qualified Test.Tasty.HUnit as Tasty.HUnit
import qualified Turtle
-freezeDirectory :: FilePath
-freezeDirectory = "./tests/freeze"
+freezeDirectoryCached :: FilePath
+freezeDirectoryCached = "./tests/freeze/cached"
+freezeDirectorySecure :: FilePath
+freezeDirectorySecure = "./tests/freeze/secure"
+
getTests :: IO TestTree
getTests = do
- freezeTests <- Test.Util.discover (Turtle.chars <* "A.dhall") freezeTest (Turtle.lstree freezeDirectory)
+ 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" [ freezeTests ]
+ let testTree = Tasty.testGroup "freeze tests"
+ [ Tasty.testGroup "cached" [freezeCachedTests]
+ , Tasty.testGroup "secure" [freezeSecureTests]
+ ]
return testTree
-freezeTest :: Text -> TestTree
-freezeTest prefix =
+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")
@@ -39,7 +48,7 @@
parsedInput <- Core.throws (Parser.exprFromText mempty inputText)
- actualExpression <- Freeze.freezeExpression (Turtle.encodeString freezeDirectory) AllImports Cache parsedInput
+ actualExpression <- Freeze.freezeExpression dir AllImports intent parsedInput
let actualText = Core.pretty actualExpression <> "\n"
diff --git a/tests/Dhall/Test/Import.hs b/tests/Dhall/Test/Import.hs
--- a/tests/Dhall/Test/Import.hs
+++ b/tests/Dhall/Test/Import.hs
@@ -1,17 +1,16 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
module Dhall.Test.Import where
import Control.Exception (SomeException)
import Data.Text (Text)
-import Dhall.Import (MissingImports (..))
-import Dhall.Parser (SourcedException (..))
-import Prelude hiding (FilePath)
+import Data.Void (Void)
+import System.FilePath (())
import Test.Tasty (TestTree)
-import Turtle (FilePath, ())
import qualified Control.Exception as Exception
-import qualified Control.Monad as Monad
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
@@ -19,13 +18,18 @@
import qualified Dhall.Import as Import
import qualified Dhall.Parser as Parser
import qualified Dhall.Test.Util as Test.Util
-import qualified Network.HTTP.Client as HTTP
-import qualified Network.HTTP.Client.TLS as HTTP
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"
@@ -44,17 +48,58 @@
, 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
+ successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest (do
path <- Turtle.lstree (importDirectory "success")
- Monad.guard (path `notElem` flakyTests)
+ path `Test.Util.pathNotIn` flakyTests
return path )
- failureTests <- Test.Util.discover (Turtle.chars <> ".dhall") failureTest (Turtle.lstree (importDirectory "failure"))
+ 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
@@ -64,74 +109,131 @@
return testTree
successTest :: Text -> TestTree
-successTest path = do
- let pathString = Text.unpack path
+successTest prefix = do
+ let inputPath = Text.unpack (prefix <> "A.dhall")
- let directoryString = FilePath.takeDirectory pathString
+ let expectedPath = Text.unpack (prefix <> "B.dhall")
- let expectedFailures = []
+ let directoryString = FilePath.takeDirectory inputPath
- Test.Util.testCase path expectedFailures (do
+ 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
+ ]
- text <- Text.IO.readFile pathString
+ Test.Util.testCase prefix expectedFailures (do
- actualExpr <- Core.throws (Parser.exprFromText mempty text)
+ text <- Text.IO.readFile inputPath
- let originalCache = "dhall-lang/tests/import/cache"
+ expectedText <- Text.IO.readFile expectedPath
- let setCache = Turtle.export "XDG_CACHE_HOME"
+ actualExpr <- Core.throws (Parser.exprFromText mempty text)
- let unsetCache = Turtle.unset "XDG_CACHE_HOME"
+ 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)
- (Import.emptyStatusWithManager httpManager directoryString)
+ status
- let usesCache = [ "hashFromCacheA.dhall"
- , "unit/asLocation/HashA.dhall"
- , "unit/IgnorePoisonedCacheA.dhall"]
+ let usesCache = [ "hashFromCache"
+ , "unit/asLocation/Hash"
+ , "unit/IgnorePoisonedCache"
+ , "unit/DontCacheIfHash"
+ ]
- let endsIn path' = not $ null $ Turtle.match (Turtle.ends path') path
+ let endsIn path' =
+ not (null (Turtle.match (Turtle.ends path') (Test.Util.toDhallPath prefix)))
let buildNewCache = do
- tempdir <- Turtle.mktempdir "/tmp" "dhall-cache"
- Turtle.liftIO $ Turtle.cptree originalCache tempdir
- return tempdir
+ tempdir <- Turtle.managed (Temp.withSystemTempDirectory "dhall-cache")
+ Turtle.liftIO (Turtle.cptree originalCache tempdir)
+ return tempdir
- let runTest =
+ let cacheSetup =
if any endsIn usesCache
- then Turtle.runManaged $ do
+ then do
cacheDir <- buildNewCache
- setCache $ Turtle.format Turtle.fp cacheDir
- _ <- Turtle.liftIO load
- unsetCache
- else do
- _ <- load
+
+ 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 handler :: SomeException -> IO ()
+ 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)
- Exception.handle handler runTest
+ actualResolved <- Exception.handle handler resolve
- return () )
+ 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 path = do
+failureTest prefix = do
+ let path = prefix <> ".dhall"
+
let pathString = Text.unpack path
Tasty.HUnit.testCase pathString (do
- text <- Text.IO.readFile pathString
+ actualExpr <- do
+ Core.throws (Parser.exprFromText mempty (Test.Util.toDhallPath path))
- actualExpr <- Core.throws (Parser.exprFromText mempty text)
+ let setup = Test.Util.managedTestEnvironment prefix
- Exception.catch
- (do _ <- Test.Util.load actualExpr
+ let run = Exception.catch @SomeException
+ (Test.Util.load actualExpr >> return True)
+ (\_ -> return False)
- fail "Import should have failed, but it succeeds")
- (\(SourcedException _ (MissingImports _)) -> pure ()) )
+ 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
--- a/tests/Dhall/Test/Lint.hs
+++ b/tests/Dhall/Test/Lint.hs
@@ -4,21 +4,19 @@
import Data.Text (Text)
import Dhall.Parser (Header (..))
-import Prelude hiding (FilePath)
import Test.Tasty (TestTree)
-import Turtle (FilePath)
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text.IO
-import qualified Data.Text.Prettyprint.Doc as Doc
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text
-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 Test.Tasty as Tasty
-import qualified Test.Tasty.HUnit as Tasty.HUnit
+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
diff --git a/tests/Dhall/Test/Main.hs b/tests/Dhall/Test/Main.hs
--- a/tests/Dhall/Test/Main.hs
+++ b/tests/Dhall/Test/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
module Main where
import System.FilePath (())
@@ -5,18 +6,22 @@
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
-import qualified Dhall.Test.Tags
+#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
@@ -62,11 +67,15 @@
, 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
diff --git a/tests/Dhall/Test/Normalization.hs b/tests/Dhall/Test/Normalization.hs
--- a/tests/Dhall/Test/Normalization.hs
+++ b/tests/Dhall/Test/Normalization.hs
@@ -2,12 +2,11 @@
module Dhall.Test.Normalization where
-import Data.Text (Text)
-import Data.Void (Void)
-import Dhall.Core (Expr (..), Var (..), throws)
-import Prelude hiding (FilePath)
-import Test.Tasty (TestTree)
-import Turtle (FilePath, ())
+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
@@ -17,6 +16,7 @@
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
@@ -24,32 +24,41 @@
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 <- Turtle.lstree normalizationDirectory
+ path <- FilePath.normalise <$> Turtle.lstree normalizationDirectory
- Nothing <- return (Turtle.stripPrefix (normalizationDirectory "unit/") path)
+ unitDirectory `Test.Util.pathNotPrefixOf` path
return path
betaNormalizationTests <- Test.Util.discover pattern betaNormalizationTest normalizationFiles
- alphaNormalizationTests <- do
+ alphaNormalizationTests <-
Test.Util.discover pattern alphaNormalizationTest
(Turtle.lstree "./dhall-lang/tests/alpha-normalization/success/")
- let unitTestFiles = Turtle.lstree (normalizationDirectory "unit/")
+ let unitTestFiles = Turtle.lstree unitDirectory
unitTests <- Test.Util.discover pattern unitTest unitTestFiles
let testTree =
Tasty.testGroup "normalization"
- [ betaNormalizationTests
- , unitTests
- , alphaNormalizationTests
+ [ Tasty.testGroup "beta-normalization"
+ [ betaNormalizationTests
+ ]
+ , Tasty.testGroup "unit tests"
+ [ unitTests
+ ]
+ , Tasty.testGroup "alpha-normalization"
+ [ alphaNormalizationTests
+ ]
, customization
]
@@ -67,7 +76,7 @@
let tyCtx =
Context.insert
"min"
- (Pi "_" Natural (Pi "_" Natural Natural))
+ (Pi mempty "_" Natural (Pi mempty "_" Natural Natural))
Context.empty
valCtx e =
@@ -128,7 +137,7 @@
let expectedNormalized = Core.denote expectedResolved :: Expr Void Void
let message =
- "The normalized expression did not match the expected output"
+ "The alpha-normalized expression did not match the expected output"
Tasty.HUnit.assertEqual message expectedNormalized actualNormalized
@@ -200,6 +209,6 @@
Core.alphaNormalize (Core.denote expectedResolved)
let message =
- "The normalized expression did not match the expected output"
+ "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
--- a/tests/Dhall/Test/Parser.hs
+++ b/tests/Dhall/Test/Parser.hs
@@ -2,12 +2,11 @@
module Dhall.Test.Parser where
-import Data.Text (Text)
-import Data.Void (Void)
-import Dhall.Core (Binding (..), Expr (..), Import, Var (..))
-import Prelude hiding (FilePath)
-import Test.Tasty (TestTree)
-import Turtle (FilePath, ())
+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
@@ -152,7 +151,9 @@
shouldNotParse :: Text -> TestTree
shouldNotParse path = do
- let expectedFailures = []
+ let expectedFailures =
+ [ parseDirectory "failure/spacing/LetNoSpace4.dhall"
+ ]
let pathString = Text.unpack path
diff --git a/tests/Dhall/Test/QuickCheck.hs b/tests/Dhall/Test/QuickCheck.hs
--- a/tests/Dhall/Test/QuickCheck.hs
+++ b/tests/Dhall/Test/QuickCheck.hs
@@ -1,3 +1,5 @@
+-- TODO: update because we added ShowConstructor constructor to Expr in Dhall.Syntax
+
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -50,6 +52,7 @@
, Scheme (..)
, URL (..)
, Var (..)
+ , WithComponent (..)
)
import Dhall.Map (Map)
@@ -62,7 +65,7 @@
import Dhall.Src (Src (..))
import Dhall.Test.Format (format)
import Dhall.TypeCheck (TypeError, Typer)
-import Generic.Random ((:+) (..), ConstrGen (..), W, Weights, (%))
+import Generic.Random (ConstrGen (..), W, Weights, (%), (:+) (..))
import Test.QuickCheck
( Arbitrary (..)
, Gen
@@ -90,6 +93,7 @@
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
@@ -99,7 +103,7 @@
import qualified Dhall.Set
import qualified Dhall.TypeCheck
import qualified Generic.Random
-import qualified Lens.Family as Lens
+import qualified Lens.Micro as Lens
import qualified Numeric.Natural as Nat
import qualified Test.QuickCheck
import qualified Test.Tasty
@@ -270,14 +274,14 @@
shrink = genericShrink
-instance (Arbitrary s, Arbitrary a) => Arbitrary (PreferAnnotation s a) where
- arbitrary =
- Test.QuickCheck.oneof
- [ pure PreferFromSource
- , PreferFromWith <$> arbitrary
- , pure PreferFromCompletion
- ]
+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
@@ -295,6 +299,10 @@
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
@@ -305,10 +313,10 @@
standardizedExpression
where
customGens
- :: ConstrGen "Lam" 0 (FunctionBinding s a)
- :+ ConstrGen "Pi" 0 Text
+ :: ConstrGen "Lam" 1 (FunctionBinding s a)
+ :+ ConstrGen "Pi" 1 Text
:+ ConstrGen "Field" 1 (FieldSelection s)
- :+ ConstrGen "Project" 1 (Either (Set Text) (Expr s a))
+ :+ ConstrGen "Project" 1 (Either [Text] (Expr s a))
:+ Gen Integer -- Generates all Integer fields in Expr
:+ Gen Text -- Generates all Text fields in Expr
:+ ()
@@ -326,7 +334,7 @@
projection =
Test.QuickCheck.oneof
- [ fmap (Left . Dhall.Set.fromList) (Test.QuickCheck.listOf label)
+ [ fmap Left (Test.QuickCheck.listOf label)
, arbitrary
]
@@ -350,6 +358,8 @@
% (1 :: W "BoolEQ")
% (1 :: W "BoolNE")
% (1 :: W "BoolIf")
+ % (1 :: W "Bytes")
+ % (1 :: W "BytesLit")
% (1 :: W "Natural")
% (7 :: W "NaturalLit")
% (1 :: W "NaturalFold")
@@ -376,6 +386,15 @@
% (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")
@@ -398,6 +417,7 @@
% (7 :: W "RecordCompletion")
% (1 :: W "Merge")
% (1 :: W "ToMap")
+ % (1 :: W "ShowConstructor")
% (7 :: W "Field")
% (7 :: W "Project")
% (1 :: W "Assert")
@@ -417,13 +437,11 @@
Data.Sequence.null xs
standardizedExpression (Note _ _) =
False
-standardizedExpression (Combine (Just _) _ _) =
+standardizedExpression (Combine _ (Just _) _ _) =
False
standardizedExpression With{} =
False
-standardizedExpression (Prefer PreferFromCompletion _ _) =
- False
-standardizedExpression (Prefer (PreferFromWith _) _ _) =
+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
@@ -434,16 +452,19 @@
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 =
-#if MIN_VERSION_QuickCheck(2,14,0)
- Test.QuickCheck.chooseEnum
-#else
- Test.QuickCheck.choose
-#endif
+chooseCharacter = Test.QuickCheck.chooseEnum
instance Arbitrary File where
arbitrary = lift2 File
@@ -508,7 +529,7 @@
-- 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 ]
+ arbitrary = Test.QuickCheck.elements [ Code, RawText, Location, RawBytes ]
shrink = genericShrink
diff --git a/tests/Dhall/Test/Regression.hs b/tests/Dhall/Test/Regression.hs
--- a/tests/Dhall/Test/Regression.hs
+++ b/tests/Dhall/Test/Regression.hs
@@ -7,6 +7,7 @@
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)
@@ -16,16 +17,17 @@
import qualified Control.Exception
import qualified Data.Text.IO
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.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.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
@@ -46,6 +48,9 @@
, issue1584
, issue1646
, issue1732
+ , issue1884
+ , issue2088
+ , issue2463
, parsing0
, typeChecking0
, typeChecking1
@@ -160,9 +165,9 @@
-- Verify that pretty-printing preserves string interpolation
source <- Data.Text.IO.readFile "./tests/regression/issue216b.dhall"
e <- Util.code source
- let doc = Data.Text.Prettyprint.Doc.pretty e
+ let doc = Prettyprinter.pretty e
let docStream = Dhall.Pretty.layout doc
- let text0 = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream
+ let text0 = Prettyprinter.Render.Text.renderLazy docStream
text1 <- Data.Text.Lazy.IO.readFile "./tests/regression/issue216b.dhall"
@@ -171,7 +176,7 @@
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 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
@@ -221,6 +226,31 @@
-- 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" (
diff --git a/tests/Dhall/Test/Schemas.hs b/tests/Dhall/Test/Schemas.hs
--- a/tests/Dhall/Test/Schemas.hs
+++ b/tests/Dhall/Test/Schemas.hs
@@ -4,21 +4,19 @@
import Data.Text (Text)
import Dhall.Parser (Header (..))
-import Prelude hiding (FilePath)
import Test.Tasty (TestTree)
-import Turtle (FilePath)
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text.IO
-import qualified Data.Text.Prettyprint.Doc as Doc
-import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text
-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 Test.Tasty as Tasty
-import qualified Test.Tasty.HUnit as Tasty.HUnit
+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
diff --git a/tests/Dhall/Test/SemanticHash.hs b/tests/Dhall/Test/SemanticHash.hs
--- a/tests/Dhall/Test/SemanticHash.hs
+++ b/tests/Dhall/Test/SemanticHash.hs
@@ -2,10 +2,8 @@
module Dhall.Test.SemanticHash where
-import Data.Text (Text)
-import Prelude hiding (FilePath)
-import Test.Tasty (TestTree)
-import Turtle (FilePath)
+import Data.Text (Text)
+import Test.Tasty (TestTree)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
diff --git a/tests/Dhall/Test/Substitution.hs b/tests/Dhall/Test/Substitution.hs
--- a/tests/Dhall/Test/Substitution.hs
+++ b/tests/Dhall/Test/Substitution.hs
@@ -11,7 +11,7 @@
import qualified Data.Either.Validation
import qualified Dhall
import qualified Dhall.Map
-import qualified Lens.Family as Lens
+import qualified Lens.Micro as Lens
data Result = Failure Integer | Success String
deriving (Eq, Dhall.Generic, Show)
diff --git a/tests/Dhall/Test/TH.hs b/tests/Dhall/Test/TH.hs
--- a/tests/Dhall/Test/TH.hs
+++ b/tests/Dhall/Test/TH.hs
@@ -1,15 +1,20 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Dhall.Test.TH where
-import Dhall.TH (HaskellType (..))
-import Test.Tasty (TestTree)
+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
@@ -23,6 +28,7 @@
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
@@ -31,6 +37,9 @@
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"
@@ -70,3 +79,141 @@
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
--- a/tests/Dhall/Test/Tags.hs
+++ b/tests/Dhall/Test/Tags.hs
@@ -2,11 +2,10 @@
module Dhall.Test.Tags where
-import Data.Text (Text)
-import Dhall.Util (Input (..))
-import Prelude hiding (FilePath)
-import Test.Tasty (TestTree)
-import Turtle (FilePath)
+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
@@ -30,7 +29,9 @@
tagsTest :: Text -> TestTree
tagsTest prefix =
Tasty.HUnit.testCase (Text.unpack prefix) $ do
- let inputFile = Text.unpack (prefix <> ".dhall")
+ -- 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
@@ -44,7 +45,7 @@
tagsDirTest :: TestTree
tagsDirTest =
Tasty.HUnit.testCase "all" $ do
- let outputFile = Text.unpack . Turtle.format Turtle.fp $ tagsDirectory Turtle. "all.tags"
+ let outputFile = Text.unpack . Turtle.format Turtle.fp $ tagsDirectory "all.tags"
actualTags <- fmap fixPathSeparators
(Tags.generate
diff --git a/tests/Dhall/Test/TypeInference.hs b/tests/Dhall/Test/TypeInference.hs
--- a/tests/Dhall/Test/TypeInference.hs
+++ b/tests/Dhall/Test/TypeInference.hs
@@ -5,12 +5,10 @@
import Control.Exception (SomeException (..))
import Data.Text (Text)
-import Prelude hiding (FilePath)
+import System.FilePath (())
import Test.Tasty (TestTree)
-import Turtle (FilePath, ())
import qualified Control.Exception as Exception
-import qualified Control.Monad as Monad
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Dhall.Core as Core
@@ -38,7 +36,7 @@
, typeInferenceDirectory "success/CacheImportsCanonicalizeA.dhall"
]
- Monad.guard (path `notElem` skip)
+ path `Test.Util.pathNotIn` skip
return path
@@ -59,7 +57,7 @@
successTest prefix = do
let expectedFailures =
[]
-#ifdef WITH_HTTP
+#if defined(WITH_HTTP) && defined(NETWORK_TESTS)
#else
++ [ typeInferenceDirectory "success/CacheImports"
]
@@ -97,14 +95,18 @@
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/RecordProjectionDuplicateFields"
- , typeInferenceDirectory "failure/unit/RecordTypeDuplicateFields"
+ typeInferenceDirectory "failure/unit/RecordTypeDuplicateFields"
, typeInferenceDirectory "failure/unit/UnionTypeDuplicateVariants1"
, typeInferenceDirectory "failure/unit/UnionTypeDuplicateVariants2"
]
diff --git a/tests/Dhall/Test/Util.hs b/tests/Dhall/Test/Util.hs
--- a/tests/Dhall/Test/Util.hs
+++ b/tests/Dhall/Test/Util.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
module Dhall.Test.Util
( code
@@ -18,35 +20,47 @@
, 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
- ( Expr
+ ( Chunks (..)
+ , Expr (..)
, Import
, Normalizer
, ReifiedNormalizer (..)
)
import Dhall.Import (SemanticCacheMode (..), Status (..))
import Dhall.Parser (Src)
-import Prelude hiding (FilePath)
+import System.IO.Error (isDoesNotExistError)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit
-import Turtle (FilePath, Pattern, Shell, fp)
+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
@@ -54,10 +68,12 @@
import qualified Test.Tasty.ExpectedFailure as Tasty.ExpectedFailure
import qualified Turtle
-#ifndef WITH_HTTP
-import Control.Monad.IO.Class (MonadIO (..))
-import Dhall.Core (URL (..))
-import Lens.Family.State.Strict (zoom)
+#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
@@ -94,62 +110,85 @@
(loadWith expression)
(Dhall.Import.emptyStatus rootDirectory) { _semanticCacheMode = semanticCacheMode }
-#ifdef WITH_HTTP
+#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
- let mockRemote' url = do
- liftIO . putStrLn $ "\nTesting without real HTTP support --"
- ++ " using mock HTTP client to resolve remote import."
- mockRemote url
- zoom Dhall.Import.remote (State.put mockRemote')
+ zoom Dhall.Import.remote (State.put mockRemote)
Dhall.Import.loadWith expr
mockRemote :: Dhall.Core.URL -> StateT Status IO Data.Text.Text
--- Matches anything pointing to
--- `https://raw.githubusercontent.com/dhall-lang/dhall-lang/master/`
-mockRemote (URL { authority = "raw.githubusercontent.com"
- , path = Dhall.Core.File (Dhall.Core.Directory components) file })
- | take 3 (reverse components) == ["dhall-lang", "dhall-lang", "master"] = do
- let dropEnd n ls = take (length ls - n) ls
- let localDir = dropEnd 3 components ++ ["dhall-lang"]
+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 (Dhall.Core.File (Dhall.Core.Directory localDir) file)
- liftIO $ Data.Text.IO.readFile localPath
+ localPath <- Dhall.Import.localToPath Dhall.Core.Here (File (Directory localDir) file)
--- Matches anything pointing to
--- `https://test.dhall-lang.org/Bool/package.dhall`; checks that a `test` header
--- is present and redirects to the local copy of the prelude.
-mockRemote (URL { authority = "test.dhall-lang.org"
- , path = Dhall.Core.File (Dhall.Core.Directory components) file
- , headers = Just headersExpr }) =
- case Data.Foldable.find ((== "test") . fst) hs of
- Nothing -> fail $ "(mock http) Tried to load an import from "
- ++"\"test.dhall-lang.org\""
- ++ "without setting the \"test\" header field."
- Just (_, _) -> do
- let localDir = components ++ ["Prelude", "dhall-lang"]
- localPath <- Dhall.Import.localToPath Dhall.Core.Here (Dhall.Core.File (Dhall.Core.Directory localDir) file)
- liftIO $ Data.Text.IO.readFile localPath
- where
- hs = Dhall.Import.toHeaders headersExpr
+ liftIO (Data.Text.IO.readFile localPath)
--- Emulates `https://httpbin.org/user-agent`
-mockRemote (URL { authority = "httpbin.org"
- , path = Dhall.Core.File (Dhall.Core.Directory []) "user-agent"
- , headers = Just headersExpr }) =
- case Data.Foldable.find ((== "user-agent") . fst) hs of
- Nothing -> fail $ "(mock http) Tried to read the user agent via "
- ++ "\"httpbin.com/user-agent\" without supplying one "
- ++ "in the header!"
- Just (_, userAgent) -> do
+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")
- where
- hs = Dhall.Import.toHeaders headersExpr
+ (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)
@@ -157,6 +196,57 @@
<> 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)
@@ -203,7 +293,7 @@
let shell = do
path_ <- paths
- let pathText = Turtle.format fp path_
+ let pathText = Turtle.format fp (FilePath.normalise path_)
prefix : _ <- return (Turtle.match pattern pathText)
@@ -215,15 +305,29 @@
testCase :: Text -> [ FilePath ] -> Assertion -> TestTree
testCase prefix expectedFailures assertion =
- if prefix `elem` map (Turtle.format fp) expectedFailures
+ 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 "\\" "/"
+toDhallPath = ("./" <>) . Text.replace "\\" "/"
diff --git a/tests/format/ipfsB.dhall b/tests/format/ipfsB.dhall
--- a/tests/format/ipfsB.dhall
+++ b/tests/format/ipfsB.dhall
@@ -11,7 +11,8 @@
labels.{ `app.kubernetes.io/name`, `app.kubernetes.io/instance` }
let k8s =
- https://raw.githubusercontent.com/dhall-lang/dhall-kubernetes/4ab28225a150498aef67c226d3c5f026c95b5a1e/package.dhall sha256:2c7ac35494f16b1f39afcf3467b2f3b0ab579edb0c711cddd2c93f1cbed358bd
+ https://raw.githubusercontent.com/dhall-lang/dhall-kubernetes/4ab28225a150498aef67c226d3c5f026c95b5a1e/package.dhall
+ sha256:2c7ac35494f16b1f39afcf3467b2f3b0ab579edb0c711cddd2c93f1cbed358bd
let serviceName = "ipfs"
diff --git a/tests/format/issue1400-2B.dhall b/tests/format/issue1400-2B.dhall
--- a/tests/format/issue1400-2B.dhall
+++ b/tests/format/issue1400-2B.dhall
@@ -3,7 +3,8 @@
= λ(a : Type) →
{ field : Text
, nesting :
- ./Nesting sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
+ ./Nesting
+ sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335
? ./Nesting
, contents : a
}
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/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/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/numericLiteralsA.dhall b/tests/format/numericLiteralsA.dhall
--- a/tests/format/numericLiteralsA.dhall
+++ b/tests/format/numericLiteralsA.dhall
@@ -1,1 +1,1 @@
-{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 }
+{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 }
diff --git a/tests/format/numericLiteralsB.dhall b/tests/format/numericLiteralsB.dhall
--- a/tests/format/numericLiteralsB.dhall
+++ b/tests/format/numericLiteralsB.dhall
@@ -1,1 +1,1 @@
-{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 }
+{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 }
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/sha256PrintingB.dhall b/tests/format/sha256PrintingB.dhall
--- a/tests/format/sha256PrintingB.dhall
+++ b/tests/format/sha256PrintingB.dhall
@@ -1,4 +1,5 @@
let replicate =
- https://raw.githubusercontent.com/dhall-lang/Prelude/c79c2bc3c46f129cc5b6d594ce298a381bcae92c/List/replicate sha256:cc856d59b63f7699881bdb8e4b1036ca4c0013827268040a50c1e1405f646a2c
+ https://raw.githubusercontent.com/dhall-lang/Prelude/c79c2bc3c46f129cc5b6d594ce298a381bcae92c/List/replicate
+ sha256:cc856d59b63f7699881bdb8e4b1036ca4c0013827268040a50c1e1405f646a2c
in replicate 5
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/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/True.dhall b/tests/freeze/True.dhall
deleted file mode 100644
--- a/tests/freeze/True.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-True
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/cachedA.dhall b/tests/freeze/cachedA.dhall
deleted file mode 100644
--- a/tests/freeze/cachedA.dhall
+++ /dev/null
@@ -1,2 +0,0 @@
- ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70
-? ./True.dhall
diff --git a/tests/freeze/cachedB.dhall b/tests/freeze/cachedB.dhall
deleted file mode 100644
--- a/tests/freeze/cachedB.dhall
+++ /dev/null
@@ -1,2 +0,0 @@
- ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70
-? ./True.dhall
diff --git a/tests/freeze/incorrectHashA.dhall b/tests/freeze/incorrectHashA.dhall
deleted file mode 100644
--- a/tests/freeze/incorrectHashA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-./True.dhall sha256:0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tests/freeze/incorrectHashB.dhall b/tests/freeze/incorrectHashB.dhall
deleted file mode 100644
--- a/tests/freeze/incorrectHashB.dhall
+++ /dev/null
@@ -1,2 +0,0 @@
- ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70
-? ./True.dhall
diff --git a/tests/freeze/protectedA.dhall b/tests/freeze/protectedA.dhall
deleted file mode 100644
--- a/tests/freeze/protectedA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70
diff --git a/tests/freeze/protectedB.dhall b/tests/freeze/protectedB.dhall
deleted file mode 100644
--- a/tests/freeze/protectedB.dhall
+++ /dev/null
@@ -1,2 +0,0 @@
- ./True.dhall 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/freeze/unprotectedA.dhall b/tests/freeze/unprotectedA.dhall
deleted file mode 100644
--- a/tests/freeze/unprotectedA.dhall
+++ /dev/null
@@ -1,1 +0,0 @@
-./True.dhall
diff --git a/tests/freeze/unprotectedB.dhall b/tests/freeze/unprotectedB.dhall
deleted file mode 100644
--- a/tests/freeze/unprotectedB.dhall
+++ /dev/null
@@ -1,2 +0,0 @@
- ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70
-? ./True.dhall
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/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/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/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