diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,41 @@ +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) @@ -1049,7 +1087,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 @@ -1432,7 +1470,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/dhall-lang/Prelude/Bool/and b/dhall-lang/Prelude/Bool/and --- a/dhall-lang/Prelude/Bool/and +++ b/dhall-lang/Prelude/Bool/and @@ -1,3 +1,3 @@ - ./and.dhall + 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,3 +1,3 @@ - ./build.dhall + 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,3 +1,3 @@ - ./even.dhall + 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,3 +1,3 @@ - ./fold.dhall + 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,3 +1,3 @@ - ./not.dhall + 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,3 +1,3 @@ - ./odd.dhall + 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,3 +1,3 @@ - ./or.dhall + 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,33 +1,37 @@ { and = - ./and.dhall + missing sha256:0b2114fa33cd76652e4360f012bc082718944fe4c5b28c975483178f8d9b0a6d ? ./and.dhall , build = - ./build.dhall + missing sha256:add7cb9acacac705410088d876a7e4488e046a7aded304f06c51accffd7f1b7b ? ./build.dhall +, equal = + missing + sha256:f0dc047ca14644c2a979bb126f2a3c6659ec770c66bd7beb70ae4a9d05815709 + ? ./equal.dhall , even = - ./even.dhall + missing sha256:72a05ee550636a3acb768360fa51ba0db0326763e0cf1ceb737f0f3607fc0fe5 ? ./even.dhall , fold = - ./fold.dhall + missing sha256:39f60baf3950268c2e849e91dc6279ee41cd6b81892d54020d4fcd2ce30a96ae ? ./fold.dhall , not = - ./not.dhall + missing sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 ? ./not.dhall , odd = - ./odd.dhall + missing sha256:6360fca3a745de32bd186cc7b71487a6398cd47d5119064eae491872c41d1999 ? ./odd.dhall , or = - ./or.dhall + missing sha256:5c50738e84e1c4fed8343ebd57608500e1b61ac1f502aa52d6d6edb5c20b99e4 ? ./or.dhall , show = - ./show.dhall + 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,3 +1,3 @@ - ./show.dhall + 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/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/FileEntry.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/FileEntry.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/FileEntry.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall + +in Entry Text 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/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/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/file.dhall b/dhall-lang/Prelude/DirectoryTree/Entry/file.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/DirectoryTree/Entry/file.dhall @@ -0,0 +1,6 @@ +let Entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall + +in Entry Text 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,29 @@ +{ Directory = + missing + sha256:163a4536fdd05ce122d793ceda01d03fcffb29463817ae8b7b5601bf4a06ce6e + ? ./DirectoryEntry.dhall +, File = + missing + sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 + ? ./FileEntry.dhall +, Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ./Metadata.dhall +, Type = + missing + sha256:75148ae19175750e38705e11cda8dcc775b2ac08f22518ff2ef3f33a6273ef15 + ? ./Type.dhall +, directory = + missing + sha256:0bee17310a21efa5b06f139b6731fdcee4f9e0245ef711c2b0127b8938dfed2e + ? ./directory.dhall +, entry = + missing + sha256:742610b2a13e55ae6e344b54aa8a7ee1bfec8e8b313a1132eae9286309b520e6 + ? ./entry.dhall +, file = + missing + sha256:c5d76fd43216668d03df9945183fe7b3c55486aedcc77324c3372bd63e283b78 + ? ./file.dhall +} 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,12 @@ +let Directory = + missing + sha256:163a4536fdd05ce122d793ceda01d03fcffb29463817ae8b7b5601bf4a06ce6e + ? ../Entry/DirectoryEntry.dhall + +let File = + missing + sha256:23a8cb29d96aeb623501519d9a62c5c49659e8d1c30b4ae4f2399809e3fd3a01 + ? ../Entry/FileEntry.dhall + +in \(tree : Type) -> + { directory : Directory tree -> tree, file : File -> 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:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + ? ./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:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + ? ./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:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + ? ./Make.dhall + +let Metadata = + missing + sha256:8c240a00094238a73904af63ac0924b3e6aba1655312f20a2a27f88554e2febe + ? ../Entry/Metadata.dhall + +let NonEmpty = + missing + sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f + ? ../../NonEmpty/Type.dhall + +let makeTreesFromList = + missing + sha256:34ed54a0fc4072cbcb32d0b40adc3ad4e5d978c8dcd7fece9670bf0616f4ab18 + ? ./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:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + ? ./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:235d511ed943dded33b46b1717df263037329394e27fb4b9c677eda5af924458 + ? ./Make.dhall +, Type = + missing + sha256:01820cec8324cb701b6cc99e1dbbc8aacf0115db7795c6c3a023e4f1818fea79 + ? ./Type.dhall +, makeTree = + missing + sha256:e67054bceeb8f55968d89dbaa4b60b726a4ec544e49bd0c5622d5b487610e804 + ? ./makeTree.dhall +, makeTreeFromList = + missing + sha256:ca73533264b52ed9eb29f51e7ac6dfc83c94c9051c5c52486d84b4a3ef7f0274 + ? ./makeTreeFromList.dhall +, makeTreesFromList = + missing + sha256:34ed54a0fc4072cbcb32d0b40adc3ad4e5d978c8dcd7fece9670bf0616f4ab18 + ? ./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:86da03766dbfeab3750ecd1012f6155dd904024351be20085dac3c79f27b22c7 + ? ./Entry/package.dhall +, Group = + missing + sha256:76a0d7e4606bdb91ab001b245cbd411939333b3fc3934ecbb5d41982d1ea001f + ? ./Group/package.dhall +, Mode = + missing + sha256:6687ff7703fe9abdc4af9b3404af3d1c7d21a523d10a0c0b57d102a0bd87843f + ? ./Mode/package.dhall +, Tree = + missing + sha256:d2cb84de6b084bfaeb42e6212e7085be9ee03ff2684cf9d04e0d8b4478f42aa7 + ? ./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,5 +1,5 @@ { show = - ./show.dhall + 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,3 +1,3 @@ - ./show.dhall + 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,3 +1,3 @@ - ./compose.dhall + missing sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 ? ./compose.dhall 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,3 +1,3 @@ - ./identity.dhall + 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,9 +1,9 @@ { compose = - ./compose.dhall + missing sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 ? ./compose.dhall , identity = - ./identity.dhall + 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,3 +1,3 @@ - ./abs.dhall + 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,3 +1,3 @@ - ./add.dhall + 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,6 @@ --| `add m n` computes `m + n`. let Integer/subtract = - ./subtract.dhall + missing sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda ? ./subtract.dhall 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,3 +1,3 @@ - ./clamp.dhall + 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,3 +1,3 @@ - ./equal.dhall + 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,6 @@ --| `equal` checks if two Integers are equal. let Natural/equal = - ../Natural/equal.dhall + missing sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60 ? ../Natural/equal.dhall 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,3 +1,3 @@ - ./greaterThan.dhall + 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,11 +1,11 @@ --| `greaterThan` checks if one Integer is greater than another. let Bool/not = - ../Bool/not.dhall + missing sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 ? ../Bool/not.dhall let lessThanEqual = - ./lessThanEqual.dhall + missing sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc ? ./lessThanEqual.dhall 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,3 +1,3 @@ - ./greaterThanEqual.dhall + 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,7 @@ `greaterThanEqual` checks if one Integer is greater than or equal to another. -} let lessThanEqual = - ./lessThanEqual.dhall + missing sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc ? ./lessThanEqual.dhall 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,3 +1,3 @@ - ./lessThan.dhall + 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,6 @@ --| `lessThan` checks if one Integer is less than another. let greaterThan = - ./greaterThan.dhall + missing sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b ? ./greaterThan.dhall 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,3 +1,3 @@ - ./lessThanEqual.dhall + 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,21 +1,21 @@ --| `lessThanEqual` checks if one Integer is less than or equal to another. let Natural/greaterThanEqual = - ../Natural/greaterThanEqual.dhall + missing sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 ? ../Natural/greaterThanEqual.dhall let Natural/lessThanEqual = - ../Natural/lessThanEqual.dhall + missing sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ../Natural/lessThanEqual.dhall let nonPositive = - ./nonPositive.dhall + missing sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b ? ./nonPositive.dhall let nonNegative = - ./nonNegative.dhall + missing sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 ? ./nonNegative.dhall 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,3 +1,3 @@ - ./multiply.dhall + 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,6 +1,6 @@ --| `multiply m n` computes `m * n`. let nonPositive = - ./nonPositive.dhall + missing sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b ? ./nonPositive.dhall 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,3 +1,3 @@ - ./negate.dhall + 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,3 +1,3 @@ - ./negative.dhall + 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,7 @@ `negative` is more efficient than `./lessThan +0` or `./lessThanEqual -1`. -} let positive = - ./positive.dhall + missing sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3 ? ./positive.dhall 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,3 +1,3 @@ - ./nonNegative.dhall + 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,7 @@ `nonNegative` is more efficient than `./greaterThanEqual +0` or `./greaterThan -1`. -} let nonPositive = - ./nonPositive.dhall + missing sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b ? ./nonPositive.dhall 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,3 +1,3 @@ - ./nonPositive.dhall + 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,73 +1,73 @@ { abs = - ./abs.dhall + missing sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1 ? ./abs.dhall , add = - ./add.dhall + missing sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b ? ./add.dhall , clamp = - ./clamp.dhall + missing sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2 ? ./clamp.dhall , equal = - ./equal.dhall + missing sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8 ? ./equal.dhall , greaterThan = - ./greaterThan.dhall + missing sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b ? ./greaterThan.dhall , greaterThanEqual = - ./greaterThanEqual.dhall + missing sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958 ? ./greaterThanEqual.dhall , lessThan = - ./lessThan.dhall + missing sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0 ? ./lessThan.dhall , lessThanEqual = - ./lessThanEqual.dhall + missing sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc ? ./lessThanEqual.dhall , multiply = - ./multiply.dhall + missing sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d ? ./multiply.dhall , negate = - ./negate.dhall + missing sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d ? ./negate.dhall , negative = - ./negative.dhall + missing sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570 ? ./negative.dhall , nonNegative = - ./nonNegative.dhall + missing sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 ? ./nonNegative.dhall , nonPositive = - ./nonPositive.dhall + missing sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b ? ./nonPositive.dhall , positive = - ./positive.dhall + missing sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3 ? ./positive.dhall , show = - ./show.dhall + missing sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9 ? ./show.dhall , subtract = - ./subtract.dhall + missing sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda ? ./subtract.dhall , toDouble = - ./toDouble.dhall + missing sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7 ? ./toDouble.dhall , toNatural = - ./toNatural.dhall + 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,3 +1,3 @@ - ./positive.dhall + 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,12 +4,12 @@ `positive` is more efficient than `./greaterThan +0` or `./greaterThanEqual +1`. -} let not = - ../Bool/not.dhall + missing sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 ? ../Bool/not.dhall let nonPositive = - ./nonPositive.dhall + missing sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b ? ./nonPositive.dhall 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,3 +1,3 @@ - ./show.dhall + 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,3 +1,3 @@ - ./subtract.dhall + 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,6 @@ --| `subtract m n` computes `n - m`. let nonPositive = - ./nonPositive.dhall + missing sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b ? ./nonPositive.dhall 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,3 +1,3 @@ - ./toDouble.dhall + 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,3 +1,3 @@ - ./toNatural.dhall + 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,7 @@ Convert an `Integer` to an `Optional Natural`, with negative numbers becoming `None Natural`. -} let nonNegative = - ./nonNegative.dhall + missing sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 ? ./nonNegative.dhall 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,3 +1,3 @@ - ./Format.dhall + missing sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac ? ./Format.dhall 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,3 +1,3 @@ - ./Nesting.dhall + 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,3 +1,3 @@ - ./Tagged.dhall + 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,7 @@ = λ(a : Type) → { field : Text , nesting : - ./Nesting.dhall + 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,3 +1,3 @@ - ./Type.dhall + 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,3 +1,3 @@ - ./array.dhall + 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,12 +13,12 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall 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,3 +1,3 @@ - ./bool.dhall + 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,7 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall 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,63 +8,63 @@ `package.dhall` to avoid import cycles. -} { Type = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall , Tagged = - ./Tagged.dhall + missing sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 ? ./Tagged.dhall , Nesting = - ./Nesting.dhall + missing sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 ? ./Nesting.dhall , keyText = - ./keyText.dhall + missing sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc ? ./keyText.dhall , keyValue = - ./keyValue.dhall + missing sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c ? ./keyValue.dhall , string = - ./string.dhall + missing sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e ? ./string.dhall , number = - ./number.dhall + missing sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 ? ./number.dhall , double = - ./double.dhall + missing sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 ? ./double.dhall , integer = - ./integer.dhall + missing sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40 ? ./integer.dhall , natural = - ./natural.dhall + missing sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5 ? ./natural.dhall , object = - ./object.dhall + missing sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac ? ./object.dhall , array = - ./array.dhall + missing sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8 ? ./array.dhall , bool = - ./bool.dhall + missing sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39 ? ./bool.dhall , null = - ./null.dhall + missing sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8 ? ./null.dhall , renderInteger = - ./renderInteger.dhall + 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,3 +1,3 @@ - ./double.dhall + 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,7 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall 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,3 +1,3 @@ - ./integer.dhall + 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,7 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall 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,3 +1,3 @@ - ./keyText.dhall + 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,3 +1,3 @@ - ../Map/keyText.dhall + 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,3 +1,3 @@ - ./keyValue.dhall + 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,3 +1,3 @@ - ../Map/keyValue.dhall + 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,3 +1,3 @@ - ./natural.dhall + 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,7 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall 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,3 +1,3 @@ - ./null.dhall + 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,7 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall 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,3 +1,3 @@ - ./number.dhall + 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,12 +12,12 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall let double = - ./double.dhall + missing sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 ? ./double.dhall 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,3 +1,3 @@ - ./object.dhall + 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,12 +19,12 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall 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,3 +1,3 @@ - ./omitNullFields.dhall + 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,17 +3,17 @@ for a configuration to encode absent fields -} let JSON = - ./core.dhall + missing sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let List/concatMap = - ../List/concatMap.dhall + missing sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 ? ../List/concatMap.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall 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,29 +1,29 @@ { render = - ./render.dhall + missing sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836 ? ./render.dhall , renderCompact = - ./renderCompact.dhall + missing sha256:e6c8809fbe193fddd430f94350d69cefd45e7aaf8bd379e51b750fde75008562 ? ./renderCompact.dhall , renderYAML = - ./renderYAML.dhall + missing sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478 ? ./renderYAML.dhall , omitNullFields = - ./omitNullFields.dhall + missing sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0 ? ./omitNullFields.dhall , tagInline = - ./tagInline.dhall + missing sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4 ? ./tagInline.dhall , tagNested = - ./tagNested.dhall + missing sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f ? ./tagNested.dhall } -∧ ( ./core.dhall +∧ ( 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,3 +1,3 @@ - ./render.dhall + 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,17 +5,17 @@ more sophisticated you should use `dhall-to-json` or `dhall-to-yaml` -} let JSON = - ./core.dhall + missing sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let renderAs = - ./renderAs.dhall + missing sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471 ? ./renderAs.dhall let Format = - ./Format.dhall + missing sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac ? ./Format.dhall 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,3 +1,3 @@ - ./renderAs.dhall + 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,46 +1,46 @@ --| Render a `JSON` value as `Text` in either JSON or YAML format. let JSON = - ./core.dhall + missing sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let Function/identity = - ../Function/identity.dhall + missing sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 ? ../Function/identity.dhall let Text/concatMap = - ../Text/concatMap.dhall + missing sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f ? ../Text/concatMap.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall let NonEmpty = - ../NonEmpty/Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ../NonEmpty/Type.dhall let NonEmpty/toList = - ../NonEmpty/toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ../NonEmpty/toList.dhall let NonEmpty/concat = - ../NonEmpty/concat.dhall + missing sha256:6d55181938c06c6b806877028f6a241912e9c0935d9a10dd958775bf21e0f64d ? ../NonEmpty/concat.dhall let NonEmpty/map = - ../NonEmpty/map.dhall + missing sha256:93d53afe874bb2eed946c21ca5ada3c9716b7d00e6d8edfaba6484cd9c5a00bd ? ../NonEmpty/map.dhall let NonEmpty/singleton = - ../NonEmpty/singleton.dhall + missing sha256:c9197aabe97695f7ca66f7419bf172d806b2c915594a8fc0d2ff6495db496ff2 ? ../NonEmpty/singleton.dhall @@ -184,7 +184,7 @@ let indentTail = NonEmpty/mapTail Text addIndent let Format = - ./Format.dhall + missing sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac ? ./Format.dhall diff --git a/dhall-lang/Prelude/JSON/renderCompact.dhall b/dhall-lang/Prelude/JSON/renderCompact.dhall --- a/dhall-lang/Prelude/JSON/renderCompact.dhall +++ b/dhall-lang/Prelude/JSON/renderCompact.dhall @@ -1,16 +1,16 @@ --| This renders JSON on a single line let JSON = - ./core.dhall + missing sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let Text/concatMapSep = - ../Text/concatMapSep + missing sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840 ? ../Text/concatMapSep let renderInteger = - ./renderInteger.dhall + missing sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c ? ./renderInteger.dhall 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 @@ -3,7 +3,7 @@ which a number may not start with a plus sign (`+`). -} let Integer/nonNegative = - ../Integer/nonNegative.dhall + missing sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663 ? ../Integer/nonNegative.dhall 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,3 +1,3 @@ - ./renderYAML.dhall + 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 @@ -9,17 +9,17 @@ `dhall-to-yaml`. -} let JSON = - ./core.dhall + missing sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let renderAs = - ./renderAs.dhall + missing sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471 ? ./renderAs.dhall let Format = - ./Format.dhall + missing sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac ? ./Format.dhall 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,3 +1,3 @@ - ./string.dhall + 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,7 @@ ``` -} let JSON = - ./Type.dhall + missing sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type.dhall 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,3 +1,3 @@ - ./tagInline.dhall + 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,11 +1,11 @@ --| Prepare a union value for JSON- or YAML-encoding with the inline layout let Nesting = - ./Nesting.dhall + missing sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 ? ./Nesting.dhall let Tagged = - ./Tagged.dhall + missing sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 ? ./Tagged.dhall 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,3 +1,3 @@ - ./tagNested.dhall + 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,11 +1,11 @@ --| Prepare a union value for JSON- or YAML-encoding with the nested layout let Nesting = - ./Nesting.dhall + missing sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 ? ./Nesting.dhall let Tagged = - ./Tagged.dhall + missing sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 ? ./Tagged.dhall 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,3 +1,3 @@ - ./all.dhall + 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,3 +1,3 @@ - ./any.dhall + 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,3 +1,3 @@ - ./build.dhall + 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,3 +1,3 @@ - ./concat.dhall + 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,3 +1,3 @@ - ./concatMap.dhall + 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,3 +1,3 @@ - ./default.dhall + 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,3 +1,3 @@ - ./drop.dhall + 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,6 @@ --| Remove first `n` elements of a list let Natural/greaterThanEqual = - ../Natural/greaterThanEqual.dhall + missing sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 ? ../Natural/greaterThanEqual.dhall 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,3 +1,3 @@ - ./empty.dhall + 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,3 +1,3 @@ - ./filter.dhall + 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,3 +1,3 @@ - ./fold.dhall + missing sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814 ? ./fold.dhall 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,3 +1,3 @@ - ./generate.dhall + 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,3 +1,3 @@ - ./head.dhall + 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,3 +1,3 @@ - ./index.dhall + 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,6 @@ --| Retrieve an element from a `List` using its 0-based index let drop = - ./drop.dhall + missing sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf ? ./drop.dhall 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,3 +1,3 @@ - ./indexed.dhall + 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,3 +1,3 @@ - ./iterate.dhall + 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,3 +1,3 @@ - ./last.dhall + 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,3 +1,3 @@ - ./length.dhall + 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,3 +1,3 @@ - ./map.dhall + 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,3 +1,3 @@ - ./null.dhall + 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,113 +1,125 @@ { all = - ./all.dhall + missing sha256:7ac5bb6f77e9ffe9e2356d90968d39764a9a32f75980206e6b12f815bb83dd15 ? ./all.dhall , any = - ./any.dhall + missing sha256:b8e9e13b25e799f342a81f6eda4075906eb1a19dfdcb10a0ca25925eba4033b8 ? ./any.dhall , build = - ./build.dhall + missing sha256:8cf73fc1e115cfcb79bb9cd490bfcbd45c824e93c57a0e64c86c0c72e9ebbe42 ? ./build.dhall , concat = - ./concat.dhall + missing sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b ? ./concat.dhall , concatMap = - ./concatMap.dhall + missing sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 ? ./concatMap.dhall , default = - ./default.dhall + missing sha256:fd77809e497227403f42848ffcda05a3efab442d961027c34f3e31d5d24e6379 ? ./default.dhall , drop = - ./drop.dhall + missing sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf ? ./drop.dhall , empty = - ./empty.dhall + missing sha256:b2f561f35098c457353723c93a22bd5de28d26ecc5370814bef9dfda421e0147 ? ./empty.dhall , filter = - ./filter.dhall + missing sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6 ? ./filter.dhall +, filterMap = + missing + sha256:94b7ed4204d1c79aaf55527ef51024e7085b8dd2896952cffbd12d8f95e16f46 + ? ./filterMap.dhall , fold = - ./fold.dhall + missing sha256:10bb945c25ab3943bd9df5a32e633cbfae112b7d3af38591784687e436a8d814 ? ./fold.dhall , foldLeft = - ./foldLeft.dhall + missing sha256:3c6ab57950fe644906b7bbdef0b9523440b6ee17773ebb8cbd41ffacb8bfab61 ? ./foldLeft.dhall , generate = - ./generate.dhall + missing sha256:78ff1ad96c08b88a8263eea7bc8381c078225cfcb759c496f792edb5a5e0b1a4 ? ./generate.dhall , head = - ./head.dhall + missing sha256:0d2e65ba0aea908377e46d22020dc3ad970284f4ee4eb8e6b8c51e53038c0026 ? ./head.dhall , index = - ./index.dhall + missing sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 ? ./index.dhall , indexed = - ./indexed.dhall + missing sha256:58bb44457fa81adf26f5123c1b2e8bef0c5aa22dac5fa5ebdfb7da84563b027f ? ./indexed.dhall , iterate = - ./iterate.dhall + missing sha256:e4999ccce190a2e2a6ab9cb188e3af6c40df474087827153005293f11bfe1d26 ? ./iterate.dhall , last = - ./last.dhall + missing sha256:741226b741af152a1638491cdff7f3aa74baf080ada2e63429483f3d195a984d ? ./last.dhall , length = - ./length.dhall + missing sha256:42c6812c7a9e3c6e6fad88f77c5b3849503964e071cb784e22c38c888a401461 ? ./length.dhall , map = - ./map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ./map.dhall +, mapMaybe = + missing + sha256:6f3c4f8c94577b46e7d30f8df7e82a269b0ad0a7e18c0f0370f243fd1127e77f + ? ./mapMaybe.dhall +, mapWithIndex = + missing + sha256:98599e0b55c5d3ae75264ba90657c6f68c7ce32834bd12b215acaea711eed6eb + ? ./mapWithIndex.dhall , null = - ./null.dhall + missing sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80 ? ./null.dhall , partition = - ./partition.dhall + missing sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03 ? ./partition.dhall , replicate = - ./replicate.dhall + missing sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 ? ./replicate.dhall , reverse = - ./reverse.dhall + missing sha256:ad99d224d61852de6696da5a7d04c98dbe676fe67d5e4ef4f19e9aaa27006e9d ? ./reverse.dhall , shifted = - ./shifted.dhall + missing sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe ? ./shifted.dhall , take = - ./take.dhall + missing sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa ? ./take.dhall , unpackOptionals = - ./unpackOptionals.dhall + missing sha256:0cbaa920f429cf7fc3907f8a9143203fe948883913560e6e1043223e6b3d05e4 ? ./unpackOptionals.dhall , unzip = - ./unzip.dhall + missing sha256:4d6003e9e683a289fe33f4c90f958eb1e08ea0bbb474210fcd90d1885c9660e9 ? ./unzip.dhall , zip = - ./zip.dhall + 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,3 +1,3 @@ - ./partition.dhall + 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,3 +1,3 @@ - ./replicate.dhall + 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,3 +1,3 @@ - ./reverse.dhall + 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,3 +1,3 @@ - ./shifted.dhall + 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,3 +1,3 @@ - ./take.dhall + 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,6 @@ --| Truncate a list to the first `n` elements let Natural/lessThan = - ../Natural/lessThan.dhall + missing sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c ? ../Natural/lessThan.dhall 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,3 +1,3 @@ - ./unpackOptionals.dhall + 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,17 +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,3 +1,3 @@ - ./unzip.dhall + 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,3 +1,3 @@ - ./zip.dhall + 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,7 @@ The resulting `List` will have the length of the shortest of its arguments. -} let List/index = - ./index.dhall + missing sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 ? ./index.dhall 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,3 +1,3 @@ - ./Type.dhall + 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,9 +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,5 +1,5 @@ { Type = - ./Type.dhall + 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,3 +1,3 @@ - ./Entry.dhall + 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,3 +1,3 @@ - ./Type.dhall + 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,3 +1,3 @@ - ./empty.dhall + 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,6 @@ --| An empty `Map` of the given key and value types let Map = - ./Type.dhall + missing sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed ? ./Type.dhall 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,3 +1,3 @@ - ./keyText.dhall + 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,3 +1,3 @@ - ./keyValue.dhall + 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,3 +1,3 @@ - ./keys.dhall + 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,16 +1,16 @@ --| Get all of the keys of a `Map` as a `List` let Map = - ./Type.dhall + missing sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed ? ./Type.dhall let Entry = - ./Entry.dhall + missing sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 ? ./Entry.dhall let List/map = - ../List/map + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map 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,3 +1,3 @@ - ./map.dhall + 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,16 +1,16 @@ --| Transform a `Map` by applying a function to each value let Map = - ./Type.dhall + missing sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed ? ./Type.dhall let Entry = - ./Entry.dhall + missing sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 ? ./Entry.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall 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,37 +1,41 @@ { Type = - ./Type + missing sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed ? ./Type , Entry = - ./Entry + missing sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 ? ./Entry , empty = - ./empty + missing sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52 ? ./empty , keyText = - ./keyText + missing sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc ? ./keyText , keyValue = - ./keyValue + missing sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c ? ./keyValue , keys = - ./keys + missing sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7 ? ./keys , map = - ./map + missing sha256:23e09b0b9f08649797dfe1ca39755d5e1c7cad2d0944bdd36c7a0bf804bde8d0 ? ./map +, mapMaybe = + missing + sha256:4ea58b720d7af38cef3ef07bef36e476caeed21032cd4a9dc733868a74d9a521 + ? ./mapMaybe.dhall , unpackOptionals = - ./unpackOptionals.dhall + missing sha256:66c3e6f6f81418cf99342e1dba739617c01af4b27c1ca5e2e1d7bce64a522e22 ? ./unpackOptionals.dhall , values = - ./values + 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,17 +1,17 @@ --| Turn a `Map k (Optional v)` into a `Map k v` by dropping all -- entries with value `None`. let List/concatMap = - ../List/concatMap.dhall + missing sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 ? ../List/concatMap.dhall let Map/Entry = - ./Entry.dhall + missing sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 ? ./Entry.dhall let Map/Type = - ./Type.dhall + missing sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed ? ./Type.dhall 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,3 +1,3 @@ - ./values.dhall + 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,16 +1,16 @@ --| Get all of the values of a `Map` as a `List` let Map = - ./Type.dhall + missing sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed ? ./Type.dhall let Entry = - ./Entry.dhall + missing sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 ? ./Entry.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall diff --git a/dhall-lang/Prelude/Monoid b/dhall-lang/Prelude/Monoid --- a/dhall-lang/Prelude/Monoid +++ b/dhall-lang/Prelude/Monoid @@ -1,3 +1,3 @@ - ./Monoid.dhall + 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,3 +1,3 @@ - ./build.dhall + 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,3 +1,3 @@ - ./enumerate.dhall + 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,3 +1,3 @@ - ./equal.dhall + 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,6 @@ --| `equal` checks if two Naturals are equal. let lessThanEqual = - ./lessThanEqual.dhall + missing sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ./lessThanEqual.dhall 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,3 +1,3 @@ - ./even.dhall + 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,3 +1,3 @@ - ./fold.dhall + missing sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06 ? ./fold.dhall 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,3 +1,3 @@ - ./greaterThan.dhall + 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,6 @@ --| `greaterThan` checks if one Natural is strictly greater than another. let lessThan = - ./lessThan.dhall + missing sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c ? ./lessThan.dhall 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,3 +1,3 @@ - ./greaterThanEqual.dhall + 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,7 @@ `greaterThanEqual` checks if one Natural is greater than or equal to another. -} let lessThanEqual = - ./lessThanEqual.dhall + missing sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ./lessThanEqual.dhall 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,3 +1,3 @@ - ./isZero.dhall + 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,3 +1,3 @@ - ./lessThan.dhall + 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,11 +1,11 @@ --| `lessThan` checks if one Natural is strictly less than another. let greaterThanEqual = - ./greaterThanEqual.dhall + missing sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 ? ./greaterThanEqual.dhall let Bool/not = - ../Bool/not.dhall + missing sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 ? ../Bool/not.dhall 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,3 +1,3 @@ - ./lessThanEqual.dhall + 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,3 +1,3 @@ - ./listMax.dhall + 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,12 +3,12 @@ `List` is empty -} let max = - ./max.dhall + missing sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7 ? ./max.dhall let Optional/map = - ../Optional/map.dhall + missing sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa ? ../Optional/map.dhall 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,3 +1,3 @@ - ./listMin.dhall + 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,12 +3,12 @@ `List` is empty -} let min = - ./min.dhall + missing sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710 ? ./min.dhall let Optional/map = - ../Optional/map.dhall + missing sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa ? ../Optional/map.dhall 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,3 +1,3 @@ - ./max.dhall + 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,6 @@ --| `max a b` returns the larger of `a` or `b` let lessThanEqual = - ./lessThanEqual.dhall + missing sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ./lessThanEqual.dhall 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,3 +1,3 @@ - ./min.dhall + 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,6 @@ --| `min a b` returns the smaller of `a` or `b` let lessThanEqual = - ./lessThanEqual.dhall + missing sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ./lessThanEqual.dhall 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,3 +1,3 @@ - ./odd.dhall + 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,89 +1,89 @@ { build = - ./build.dhall + missing sha256:e7e25e6c4f1d8e573606ed1bef725396ac2de5c68f7c5d329ffc5822085b984c ? ./build.dhall , enumerate = - ./enumerate.dhall + missing sha256:0cf083980a752b21ce0df9fc2222a4c139f50909e2353576e26a191002aa1ce3 ? ./enumerate.dhall , even = - ./even.dhall + missing sha256:b85b8b56892dfef881e1c0e79eade0b949528f792aac0ea42432b315ede4ee66 ? ./even.dhall , fold = - ./fold.dhall + missing sha256:fd01c931e585a8f5fd049af7b076b862ea164f1813b34800c7616a49e549ee06 ? ./fold.dhall , isZero = - ./isZero.dhall + missing sha256:1be98236800ed2d5cff44f16ca02b34b0c37dfa239d9e0d63d9d2c6eeae3d1d1 ? ./isZero.dhall , odd = - ./odd.dhall + missing sha256:ab3c729262c642ec1cdb72a81e910fcfaf2aea13e3961d0bf1bec83efea5aac5 ? ./odd.dhall , product = - ./product.dhall + missing sha256:e3e6fd76207875b81d39f79fdbc90b5e640444c04fb3d84c2c9326748f0b26e6 ? ./product.dhall , sum = - ./sum.dhall + missing sha256:33f7f4c3aff62e5ecf4848f964363133452d420dcde045784518fb59fa970037 ? ./sum.dhall , show = - ./show.dhall + missing sha256:684ed560ad86f438efdea229eca122c29e8e14f397ed32ec97148d578ca5aa21 ? ./show.dhall , toDouble = - ./toDouble.dhall + missing sha256:d5eb52143dcd35b46a6f0cdb2d3cbf31a14b6daeba56e29066f8e344c9fb6e81 ? ./toDouble.dhall , toInteger = - ./toInteger.dhall + missing sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f ? ./toInteger.dhall , lessThan = - ./lessThan.dhall + missing sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c ? ./lessThan.dhall , lessThanEqual = - ./lessThanEqual.dhall + missing sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ./lessThanEqual.dhall , equal = - ./equal.dhall + missing sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60 ? ./equal.dhall , greaterThanEqual = - ./greaterThanEqual.dhall + missing sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 ? ./greaterThanEqual.dhall , greaterThan = - ./greaterThan.dhall + missing sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c ? ./greaterThan.dhall , min = - ./min.dhall + missing sha256:f25f9c462e4dbf0eb15f9ff6ac840c6e9c82255a7f4f2ab408bdab338e028710 ? ./min.dhall , max = - ./max.dhall + missing sha256:1f3b18da330223ab039fad11693da72c7e68d516f50502c73f41a89a097b62f7 ? ./max.dhall , listMin = - ./listMin.dhall + missing sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6 ? ./listMin.dhall , listMax = - ./listMax.dhall + missing sha256:20906ffcc9970f740106d4516cb7868b43d75ff8c9f00ff8a9680ae68c48a472 ? ./listMax.dhall , sort = - ./sort.dhall + missing sha256:36ce8b3e5538454763987ca904d8d7c5ba34c2147434a19eddd51f684432b260 ? ./sort.dhall , subtract = - ./subtract.dhall + 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,3 +1,3 @@ - ./product.dhall + 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,3 +1,3 @@ - ./show.dhall + 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,3 +1,3 @@ - ./sort.dhall + 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,16 +1,16 @@ --| `sort` sorts a `List` of `Natural`s in ascending order let greaterThanEqual = - ./greaterThanEqual.dhall + missing sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 ? ./greaterThanEqual.dhall let listMin = - ./listMin.dhall + missing sha256:ee70b0d010bbca6012162e8ae1f6e9d9bd10a152675509b0f23145b98b5d43c6 ? ./listMin.dhall let List/partition = - ../List/partition.dhall + missing sha256:38147ac6d750a6492736dd90cc967bf09aa405c499de943c64fab7b86ae02f03 ? ../List/partition.dhall 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,3 +1,3 @@ - ./subtract.dhall + 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,3 +1,3 @@ - ./sum.dhall + 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,3 +1,3 @@ - ./toDouble.dhall + 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,3 +1,3 @@ - ./toInteger.dhall + missing sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f ? ./toInteger.dhall diff --git a/dhall-lang/Prelude/NonEmpty/all.dhall b/dhall-lang/Prelude/NonEmpty/all.dhall --- a/dhall-lang/Prelude/NonEmpty/all.dhall +++ b/dhall-lang/Prelude/NonEmpty/all.dhall @@ -3,12 +3,12 @@ `NonEmpty` list -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let NonEmpty/toList = - ./toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ./toList.dhall diff --git a/dhall-lang/Prelude/NonEmpty/any.dhall b/dhall-lang/Prelude/NonEmpty/any.dhall --- a/dhall-lang/Prelude/NonEmpty/any.dhall +++ b/dhall-lang/Prelude/NonEmpty/any.dhall @@ -3,12 +3,12 @@ `NonEmpty` list -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let NonEmpty/toList = - ./toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ./toList.dhall diff --git a/dhall-lang/Prelude/NonEmpty/concat.dhall b/dhall-lang/Prelude/NonEmpty/concat.dhall --- a/dhall-lang/Prelude/NonEmpty/concat.dhall +++ b/dhall-lang/Prelude/NonEmpty/concat.dhall @@ -3,17 +3,17 @@ list -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let NonEmpty/toList = - ./toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ./toList.dhall let List/concatMap = - ../List/concatMap.dhall + missing sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 ? ../List/concatMap.dhall diff --git a/dhall-lang/Prelude/NonEmpty/concatMap.dhall b/dhall-lang/Prelude/NonEmpty/concatMap.dhall --- a/dhall-lang/Prelude/NonEmpty/concatMap.dhall +++ b/dhall-lang/Prelude/NonEmpty/concatMap.dhall @@ -3,17 +3,17 @@ flattening the results -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let NonEmpty/toList = - ./toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ./toList.dhall let List/concatMap = - ../List/concatMap.dhall + missing sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 ? ../List/concatMap.dhall diff --git a/dhall-lang/Prelude/NonEmpty/head.dhall b/dhall-lang/Prelude/NonEmpty/head.dhall --- a/dhall-lang/Prelude/NonEmpty/head.dhall +++ b/dhall-lang/Prelude/NonEmpty/head.dhall @@ -1,6 +1,6 @@ --| Retrieve the first element of the `NonEmpty` list let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall diff --git a/dhall-lang/Prelude/NonEmpty/index.dhall b/dhall-lang/Prelude/NonEmpty/index.dhall --- a/dhall-lang/Prelude/NonEmpty/index.dhall +++ b/dhall-lang/Prelude/NonEmpty/index.dhall @@ -1,11 +1,11 @@ --| Retrieve an element from a `NonEmpty` list using its 0-based index let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let List/index = - ../List/index.dhall + missing sha256:e657b55ecae4d899465c3032cb1a64c6aa6dc2aa3034204f3c15ce5c96c03e63 ? ../List/index.dhall diff --git a/dhall-lang/Prelude/NonEmpty/indexed.dhall b/dhall-lang/Prelude/NonEmpty/indexed.dhall --- a/dhall-lang/Prelude/NonEmpty/indexed.dhall +++ b/dhall-lang/Prelude/NonEmpty/indexed.dhall @@ -1,11 +1,11 @@ --| Tag each element of the `NonEmpty` list with its index let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall diff --git a/dhall-lang/Prelude/NonEmpty/last.dhall b/dhall-lang/Prelude/NonEmpty/last.dhall --- a/dhall-lang/Prelude/NonEmpty/last.dhall +++ b/dhall-lang/Prelude/NonEmpty/last.dhall @@ -1,6 +1,6 @@ --| Retrieve the last element of the `NonEmpty` list let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall diff --git a/dhall-lang/Prelude/NonEmpty/length.dhall b/dhall-lang/Prelude/NonEmpty/length.dhall --- a/dhall-lang/Prelude/NonEmpty/length.dhall +++ b/dhall-lang/Prelude/NonEmpty/length.dhall @@ -1,6 +1,6 @@ --| Returns the number of elements in a `NonEmpty` list let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall diff --git a/dhall-lang/Prelude/NonEmpty/make.dhall b/dhall-lang/Prelude/NonEmpty/make.dhall --- a/dhall-lang/Prelude/NonEmpty/make.dhall +++ b/dhall-lang/Prelude/NonEmpty/make.dhall @@ -5,7 +5,7 @@ construction from the specific names of the fields. -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall diff --git a/dhall-lang/Prelude/NonEmpty/map.dhall b/dhall-lang/Prelude/NonEmpty/map.dhall --- a/dhall-lang/Prelude/NonEmpty/map.dhall +++ b/dhall-lang/Prelude/NonEmpty/map.dhall @@ -1,11 +1,11 @@ --| Transform a `NonEmpty` list by applying a function to each element let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall diff --git a/dhall-lang/Prelude/NonEmpty/package.dhall b/dhall-lang/Prelude/NonEmpty/package.dhall --- a/dhall-lang/Prelude/NonEmpty/package.dhall +++ b/dhall-lang/Prelude/NonEmpty/package.dhall @@ -1,73 +1,73 @@ { Type = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall , all = - ./all.dhall + missing sha256:f2f9389d94f4deb5b918b2e50c1093b57e00b37ddd3ab2b43959993b1cb519b6 ? ./all.dhall , any = - ./any.dhall + missing sha256:7662b665840e41b12a28190eec3aaab9201fcb90c00a8ec3666d549e1020992f ? ./any.dhall , concat = - ./concat.dhall + missing sha256:6d55181938c06c6b806877028f6a241912e9c0935d9a10dd958775bf21e0f64d ? ./concat.dhall , concatMap = - ./concatMap.dhall + missing sha256:fc33fa9449dc8f74dd8c8be379b7b7c4b0433e2b65650370d81d9a7111a590e2 ? ./concatMap.dhall , head = - ./head.dhall + missing sha256:6b9551c97b89fe666d2e03392a4af5e87abfdbdb0aa0e29fc4b3aa1b318474e7 ? ./head.dhall , index = - ./index.dhall + missing sha256:0ba2fcc9227fab10676cd61b47a18d779818a19c16727c7cc4b4c78e114fd663 ? ./index.dhall , indexed = - ./indexed.dhall + missing sha256:9dae2c1fecd142df837e98769b5bbdd0bfe25c35a93af1064b4e62f9c780ae6b ? ./indexed.dhall , last = - ./last.dhall + missing sha256:f83115492b6e408d0b662a68440620f7f3df07b56e7ed66dab77a6e65b121250 ? ./last.dhall , length = - ./length.dhall + missing sha256:eef3b857a164487cfdb960e3298c4731970b7a430011289cba35a9ad722ac989 ? ./length.dhall , make = - ./make.dhall + missing sha256:549de393673c4773c80a50ea578ea50d7f2c4c2eda31956e73fabc4e486f3b1e ? ./make.dhall , map = - ./map.dhall + missing sha256:93d53afe874bb2eed946c21ca5ada3c9716b7d00e6d8edfaba6484cd9c5a00bd ? ./map.dhall , reverse = - ./reverse.dhall + missing sha256:a6d810cdd3badffd4e7ca82091609a855cffac900c82d7ff3724463fbc2d5ff2 ? ./reverse.dhall , shifted = - ./shifted.dhall + missing sha256:36156973d6916aed10cfd8c59be7c019516bf0a2c47b499a17a8ef0611e1c189 ? ./shifted.dhall , singleton = - ./singleton.dhall + missing sha256:c9197aabe97695f7ca66f7419bf172d806b2c915594a8fc0d2ff6495db496ff2 ? ./singleton.dhall , toList = - ./toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ./toList.dhall , unzip = - ./unzip.dhall + missing sha256:d0b925bea32a29aad5cb48a84e8ef8cff750308afe1dd20b24eca19e4e999abc ? ./unzip.dhall , zip = - ./zip.dhall + missing sha256:073f8b4808b6d1db84964f772f6291e6ea193602163438db43fa282c560c01e4 ? ./zip.dhall } diff --git a/dhall-lang/Prelude/NonEmpty/reverse.dhall b/dhall-lang/Prelude/NonEmpty/reverse.dhall --- a/dhall-lang/Prelude/NonEmpty/reverse.dhall +++ b/dhall-lang/Prelude/NonEmpty/reverse.dhall @@ -1,11 +1,11 @@ --| Reverse a `NonEmpty` list let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let List/drop = - ../List/drop.dhall + missing sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf ? ../List/drop.dhall diff --git a/dhall-lang/Prelude/NonEmpty/shifted.dhall b/dhall-lang/Prelude/NonEmpty/shifted.dhall --- a/dhall-lang/Prelude/NonEmpty/shifted.dhall +++ b/dhall-lang/Prelude/NonEmpty/shifted.dhall @@ -3,22 +3,22 @@ element by the number of elements in preceding lists -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let NonEmpty/toList = - ./toList.dhall + missing sha256:0977fe14b77232a4451dcf409c43df4589c4b3cdde7b613aab8df183be1b53f5 ? ./toList.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall let List/shifted = - ../List/shifted.dhall + missing sha256:54fb22c7e952ebce1cfc0fcdd33ce4cfa817bff9d6564af268dea6685f8b5dfe ? ../List/shifted.dhall diff --git a/dhall-lang/Prelude/NonEmpty/singleton.dhall b/dhall-lang/Prelude/NonEmpty/singleton.dhall --- a/dhall-lang/Prelude/NonEmpty/singleton.dhall +++ b/dhall-lang/Prelude/NonEmpty/singleton.dhall @@ -1,6 +1,6 @@ --| Create a `NonEmpty` list with just one element let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall diff --git a/dhall-lang/Prelude/NonEmpty/toList.dhall b/dhall-lang/Prelude/NonEmpty/toList.dhall --- a/dhall-lang/Prelude/NonEmpty/toList.dhall +++ b/dhall-lang/Prelude/NonEmpty/toList.dhall @@ -1,6 +1,6 @@ --| Convert a `NonEmpty` list into the equivalent `List` let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall diff --git a/dhall-lang/Prelude/NonEmpty/unzip.dhall b/dhall-lang/Prelude/NonEmpty/unzip.dhall --- a/dhall-lang/Prelude/NonEmpty/unzip.dhall +++ b/dhall-lang/Prelude/NonEmpty/unzip.dhall @@ -1,11 +1,11 @@ --| Unzip a `NonEmpty` list into two separate `NonEmpty` lists let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let NonEmpty/map = - ./map.dhall + missing sha256:93d53afe874bb2eed946c21ca5ada3c9716b7d00e6d8edfaba6484cd9c5a00bd ? ./map.dhall diff --git a/dhall-lang/Prelude/NonEmpty/zip.dhall b/dhall-lang/Prelude/NonEmpty/zip.dhall --- a/dhall-lang/Prelude/NonEmpty/zip.dhall +++ b/dhall-lang/Prelude/NonEmpty/zip.dhall @@ -4,12 +4,12 @@ The resulting `NonEmpty` will have the length of the shortest of its arguments. -} let NonEmpty = - ./Type.dhall + missing sha256:e2e247455a858317e470e0e4affca8ac07f9f130570ece9cb7ac1f4ea3deb87f ? ./Type.dhall let List/zip = - ../List/zip.dhall + missing sha256:85ed955eabf3998767f4ad2a28e57d40cd4c68a95519d79e9b622f1d26d979da ? ../List/zip.dhall 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,3 +1,3 @@ - ./all.dhall + 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,3 +1,3 @@ - ./any.dhall + 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,3 +1,3 @@ - ./build.dhall + 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,3 +1,3 @@ - ./concat.dhall + missing sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a ? ./concat.dhall 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,3 +1,3 @@ - ./default.dhall + 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,3 +1,3 @@ - ./filter.dhall + 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,3 +1,3 @@ - ./fold.dhall + missing sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf ? ./fold.dhall 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,3 +1,3 @@ - ./head.dhall + 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,3 +1,3 @@ - ./last.dhall + 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,3 +1,3 @@ - ./length.dhall + 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,3 +1,3 @@ - ./map.dhall + 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,3 +1,3 @@ - ./null.dhall + 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,61 +1,65 @@ { all = - ./all.dhall + missing sha256:a303004b6def0a2a05bf5f0a8d54e84dd45d8bef581789186ac04924956a1695 ? ./all.dhall , any = - ./any.dhall + missing sha256:96a5cf4f31b3c598b09161dd3082f0a09f4328a4cefda6a7e09894b37b17b435 ? ./any.dhall , build = - ./build.dhall + missing sha256:28e61294bf2dd59dc57cf74f719d1568e60b5ba46c28eac586bc937eff4a2af1 ? ./build.dhall , concat = - ./concat.dhall + missing sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a ? ./concat.dhall , concatMap = - ./concatMap.dhall + missing sha256:c06ae93e900a99299c9b4ec4912ca5395a0103ea88292205b08dd7e345632818 ? ./concatMap.dhall , default = - ./default.dhall + missing sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad ? ./default.dhall +, equal = + missing + sha256:5411888399fe9c6720f7f3b59caf5eff3e8e8c30402d09f34e46a4457649a35a + ? ./equal.dhall , filter = - ./filter.dhall + missing sha256:54f0a487d578801819613fe000050c038c632edf1f9ccc57677e98ae0ef56b83 ? ./filter.dhall , fold = - ./fold.dhall + missing sha256:c5b9d72f6f62bdaa0e196ac1c742cc175cd67a717b880fb8aec1333a5a4132cf ? ./fold.dhall , head = - ./head.dhall + missing sha256:4f256c9338b60a1933f41f2a8fafd861930a1e41770a644cdbac0622676fa34c ? ./head.dhall , last = - ./last.dhall + missing sha256:50400771ae19e9b75efa6581feec318ae1ade0b6a60e215df428c66c4b052707 ? ./last.dhall , length = - ./length.dhall + missing sha256:f168337c5244ded68c05ecf32ce068b6b87158881d07e87b8cb6853fc6982a85 ? ./length.dhall , map = - ./map.dhall + missing sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa ? ./map.dhall , null = - ./null.dhall + missing sha256:3871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc ? ./null.dhall , toList = - ./toList.dhall + missing sha256:d78f160c619119ef12389e48a629ce293d69f7624c8d016b7a4767ab400344c4 ? ./toList.dhall , unzip = - ./unzip.dhall + 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,3 +1,3 @@ - ./toList.dhall + 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,3 +1,3 @@ - ./unzip.dhall + 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,3 +1,3 @@ - ./concat.dhall + 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,3 +1,3 @@ - ./concatMap.dhall + 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,3 +1,3 @@ - ./concatMapSep.dhall + 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,3 +1,3 @@ - ./concatSep.dhall + 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,3 +1,3 @@ - ./default.dhall + 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,3 +1,3 @@ - ./defaultMap.dhall + missing sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588 ? ./defaultMap.dhall 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,53 +1,53 @@ { concat = - ./concat.dhall + missing sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 ? ./concat.dhall , concatMap = - ./concatMap.dhall + missing sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f ? ./concatMap.dhall , concatMapSep = - ./concatMapSep.dhall + missing sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840 ? ./concatMapSep.dhall , concatSep = - ./concatSep.dhall + missing sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58 ? ./concatSep.dhall , default = - ./default.dhall + missing sha256:f532c8891b1e427d90a6cc07cf7e793a4c84b0765e1bfe69f186ee2ec91c1edf ? ./default.dhall , defaultMap = - ./defaultMap.dhall + missing sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588 ? ./defaultMap.dhall , lowerASCII = - ./lowerASCII.dhall + missing sha256:26b076651120b907e869396bd3dc16271f2e12433062b2f26f296968a69515e7 ? ./lowerASCII.dhall , replace = - ./replace.dhall + missing sha256:7d132df0e091a43817bba8afa06d1bb487ee51c091430404ad6f8c78bc0328a6 ? ./replace.dhall , replicate = - ./replicate.dhall + missing sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f ? ./replicate.dhall , shell-escape = - ./shell-escape.dhall + missing sha256:d53521b3f478cb18a7d63730bc0e3153c2124b70d6ac9a1f610ce7db67cfc7a2 ? ./shell-escape.dhall , show = - ./show.dhall + missing sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784 ? ./show.dhall , spaces = - ./spaces.dhall + missing sha256:fccfd4f26601e006bf6a79ca948dbd37c676cdd0db439554447320293d23b3dc ? ./spaces.dhall , upperASCII = - ./upperASCII.dhall + 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,3 +1,3 @@ - ./replicate.dhall + 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,11 @@ --| Build a Text by copying the given Text the specified number of times let concat = - ./concat.dhall + missing sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 ? ./concat.dhall let List/replicate = - ../List/replicate.dhall + missing sha256:d4250b45278f2d692302489ac3e78280acb238d27541c837ce46911ff3baa347 ? ../List/replicate.dhall 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,3 +1,3 @@ - ./show.dhall + 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,3 +1,3 @@ - ./spaces.dhall + 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 @@ -5,7 +5,7 @@ whitespace is significant, i.e. with nested indentation. -} let replicate = - ./replicate.dhall + missing sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f ? ./replicate.dhall 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,3 +1,3 @@ - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall 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,3 +1,3 @@ - ./attribute.dhall + missing sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc ? ./attribute.dhall 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,3 +1,3 @@ - ./element.dhall + 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 @@ -19,12 +19,12 @@ ``` -} let XML = - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let List/map = - ../List/map.dhall + missing sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map.dhall 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,3 +1,3 @@ - ./emptyAttributes.dhall + missing sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5 ? ./emptyAttributes.dhall 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,3 +1,3 @@ - ./leaf.dhall + 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 @@ -10,12 +10,12 @@ ``` -} let XML = - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let element = - ./element.dhall + missing sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall 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,33 +1,33 @@ { Type = - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall , attribute = - ./attribute.dhall + missing sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc ? ./attribute.dhall , render = - ./render.dhall + missing sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66 ? ./render.dhall , element = - ./element.dhall + missing sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall , leaf = - ./leaf.dhall + missing sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506 ? ./leaf.dhall , text = - ./text.dhall + missing sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab ? ./text.dhall , rawText = - ./rawText.dhall + missing sha256:2af9d72c151677d4110039e361b7e9faaf2947e6c9d29aa72aea351ad797e05d ? ./rawText.dhall , emptyAttributes = - ./emptyAttributes.dhall + missing sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5 ? ./emptyAttributes.dhall } diff --git a/dhall-lang/Prelude/XML/rawText.dhall b/dhall-lang/Prelude/XML/rawText.dhall --- a/dhall-lang/Prelude/XML/rawText.dhall +++ b/dhall-lang/Prelude/XML/rawText.dhall @@ -16,7 +16,7 @@ ``` -} let XML = - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall 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,3 +1,3 @@ - ./render.dhall + 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 @@ -19,32 +19,32 @@ -} let XML = - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let Text/concatMap = - ../Text/concatMap.dhall + missing sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f ? ../Text/concatMap.dhall let Text/concat = - ../Text/concat.dhall + missing sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0 ? ../Text/concat.dhall let element = - ./element.dhall + missing sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall let text = - ./text.dhall + missing sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab ? ./text.dhall let emptyAttributes = - ./emptyAttributes.dhall + missing sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5 ? ./emptyAttributes.dhall 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,3 +1,3 @@ - ./text.dhall + 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 @@ -15,7 +15,7 @@ ``` -} let XML = - ./Type.dhall + missing sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall 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,61 +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 + missing sha256:b8d20ab3216083622ae371fb42a6732bc67bb2d66e84989c8ddba7556a336cf7 ? ./Double/package.dhall , Function = - ./Function/package.dhall + missing sha256:6d17cf0fd4fabe1737fb117f87c04b8ff82b299915a5b673c0a543b134b8fffe ? ./Function/package.dhall , Integer = - ./Integer/package.dhall + missing sha256:d1a572ca3a764781496847e4921d7d9a881c18ffcfac6ae28d0e5299066938a0 ? ./Integer/package.dhall +, JSON = + missing + sha256:5f98b7722fd13509ef448b075e02b9ff98312ae7a406cf53ed25012dbc9990ac + ? ./JSON/package.dhall , List = - ./List/package.dhall - sha256:11081c23436cb9c5fa60d53416e62845071990b43b3c48973cb2f19f5d5adbee + missing + sha256:26d1b4cd800219d8b67043c638926aa6e5517ea74a0bd3e371974514621bca04 ? ./List/package.dhall , Location = - ./Location/package.dhall + missing sha256:0eb4e4a60814018009c720f6820aaa13cf9491eb1b09afb7b832039c6ee4d470 ? ./Location/package.dhall , Map = - ./Map/package.dhall - sha256:c6602939eb75ddaf43e75a37e1f27ace97e03685ceb9d77605b4372547f7cfa8 + missing + sha256:c5e79a9de642644a09b96a2ec3147c5d8662b7926f09610e751c0c0f6ed0b30a ? ./Map/package.dhall , Monoid = - ./Monoid.dhall + missing sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af ? ./Monoid.dhall , Natural = - ./Natural/package.dhall + missing sha256:ee9ed2b28a417ed4e9a0c284801b928bf91b3fbdc1a68616347678c1821f1ddf ? ./Natural/package.dhall , NonEmpty = - ./NonEmpty/package.dhall + missing sha256:c24686a230a4b3cd51e5a57cd4510b4f8242f813d7823d41bac5954e7af56f7a ? ./NonEmpty/package.dhall , Operator = - ./Operator/package.dhall + missing sha256:861f724704a7b4755c96f173e54d03f314492a2d046723404c31ff612b7bf2e6 ? ./Operator/package.dhall , Optional = - ./Optional/package.dhall - sha256:37b84d6fe94c591d603d7b06527a2d3439ba83361e9326bc7b72517c7dc54d4e + missing + sha256:74331dfe59c09db65edc7ec4498bff92473c8c06d92752f9470d26e25f91320c ? ./Optional/package.dhall -, JSON = - ./JSON/package.dhall - sha256:5f98b7722fd13509ef448b075e02b9ff98312ae7a406cf53ed25012dbc9990ac - ? ./JSON/package.dhall , Text = - ./Text/package.dhall + missing sha256:79b671a70ac459b799a53bbb8a383cc8b81b40421745c54bf0fb1143168cbd6f ? ./Text/package.dhall +, Time = + missing + sha256:6715c4c71a113429fef8b94e4561a93c288942dad9dfd75ac545de96c5b5652a + ? ./Time/package.dhall +, TimeZone = + missing + sha256:c17fd403c637856f34c8287168b92974e8c1a3a7331967f75276d179057084fd + ? ./TimeZone/package.dhall , XML = - ./XML/package.dhall + 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/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/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,18 +1,1 @@ -{ and = - λ(_ : List Bool) → - List/fold Bool _ Bool (λ(_ : Bool) → λ(_ : Bool) → _@1 && _) True -, build = λ(_ : Type → _ → _@1 → _@2) → _ Bool True False -, even = - λ(_ : List Bool) → - List/fold Bool _ Bool (λ(_ : Bool) → λ(_ : Bool) → _@1 == _) True -, fold = - λ(_ : Bool) → λ(_ : Type) → λ(_ : _) → λ(_ : _@1) → if _@3 then _@1 else _ -, not = λ(_ : Bool) → _ == False -, odd = - λ(_ : List Bool) → - List/fold Bool _ Bool (λ(_ : Bool) → λ(_ : Bool) → _@1 != _) False -, or = - λ(_ : List Bool) → - List/fold Bool _ Bool (λ(_ : Bool) → λ(_ : Bool) → _@1 || _) False -, show = λ(_ : Bool) → if _ then "True" else "False" -} +True 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/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/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/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/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/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/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/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/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/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/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/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/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,6 +11,7 @@ , or : ∀(xs : List Bool) → Bool , show : ∀(b : Bool) → Text } +, Date : { show : Date → Text } , Double : { show : Double → Text } , Function : { compose : @@ -312,6 +314,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 → @@ -334,6 +342,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) → @@ -384,6 +404,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) → @@ -547,6 +574,12 @@ ∀(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) → @@ -593,6 +626,8 @@ , spaces : ∀(a : Natural) → Text , upperASCII : ∀(nil : Text) → Text } +, Time : { show : Time → Text } +, TimeZone : { show : TimeZone → Text } , XML : { Type : Type , attribute : 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/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/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.cabal b/dhall.cabal --- a/dhall.cabal +++ b/dhall.cabal @@ -1,12 +1,12 @@ Cabal-Version: 2.4 Name: dhall -Version: 1.41.2 +Version: 1.42.0 Build-Type: Simple 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: @@ -170,6 +170,7 @@ dhall-lang/tests/**/*.dhallb dhall-lang/tests/**/*.hash dhall-lang/tests/**/*.txt + dhall-lang/tests/**/*.bin dhall-lang/tests/import/cache/dhall/12203871180b87ecaba8b53fffb2a8b52d3fce98098fab09a6f759358b9e8042eedc dhall-lang/tests/import/cache/dhall/1220618f785ce8f3930a9144398f576f0a992544b51212bc9108c31b4e670dc6ed21 tests/**/*.dhall @@ -231,27 +232,27 @@ -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469 megaparsec >= 8 && < 10 , mmorph < 1.3 , - mtl >= 2.2.1 && < 2.3 , + mtl >= 2.2.1 && < 2.4 , network-uri >= 2.6 && < 2.7 , optparse-applicative >= 0.14.0.0 && < 0.18, parsers >= 0.12.4 && < 0.13, parser-combinators , prettyprinter >= 1.7.0 && < 1.8 , - prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , + prettyprinter-ansi-terminal >= 1.1.2 && < 1.2 , pretty-simple < 4.2 , profunctors >= 3.1.2 && < 5.7 , 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.19, + template-haskell >= 2.13.0.0 && < 2.20, text >= 0.11.1.0 && < 2.1 , text-manipulate >= 0.2.0.1 && < 0.4 , text-short >= 0.1 && < 0.2 , th-lift-instances >= 0.1.13 && < 0.2 , - time >= 1.1.4 && < 1.13, - transformers >= 0.5.2.0 && < 0.6 , + time >= 1.9 && < 1.13, + transformers >= 0.5.2.0 && < 0.7 , + unix-compat >= 0.4.2 && < 0.7 , unordered-containers >= 0.1.3.0 && < 0.3 , - uri-encode < 1.6 , vector >= 0.11.0.0 && < 0.14 if flag(with-http) @@ -331,6 +332,7 @@ Dhall.Marshal.Encode Dhall.Map Dhall.Optics + Dhall.Package Dhall.Parser Dhall.Parser.Expression Dhall.Parser.Token @@ -352,6 +354,7 @@ Exposed-Modules: Dhall.Deriving Other-Modules: + Dhall.DirectoryTree.Types Dhall.Eval Dhall.Import.Types Dhall.Import.Headers @@ -360,6 +363,30 @@ 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: @@ -387,12 +414,14 @@ 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 @@ -413,7 +442,6 @@ quickcheck-instances >= 0.3.12 && < 0.4 , special-values < 0.2 , spoon < 0.4 , - system-filepath , tasty >= 0.11.2 && < 1.5 , tasty-expected-failure < 0.13, tasty-hunit >= 0.10 && < 0.11, 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 #-} @@ -14,6 +15,7 @@ import Control.DeepSeq (NFData) import Data.ByteString (ByteString) +import Data.Data (Data) import GHC.Generics (Generic) import qualified Crypto.Hash.SHA256 @@ -23,7 +25,7 @@ -- | A SHA256 digest newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } - deriving (Eq, Generic, Ord, NFData) + deriving (Data, Eq, Generic, Ord, NFData) instance Show SHA256Digest where show = toString 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 @@ -4,6 +4,7 @@ module Dhall.Import.HTTP ( fetchFromHttpUrl + , fetchFromHttpUrlBytes , originHeadersFileExpr ) where @@ -38,11 +39,10 @@ import qualified Control.Exception import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.ByteString.Lazy as ByteString.Lazy import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text import qualified Data.Text.Encoding -import qualified 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 @@ -266,8 +266,9 @@ matchesKey :: CI ByteString -> HTTPHeader -> Bool matchesKey key (candidate, _value) = key == candidate -fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text -fetchFromHttpUrl childURL mheaders = do +fetchFromHttpUrlBytes + :: URL -> Maybe [HTTPHeader] -> StateT Status IO ByteString +fetchFromHttpUrlBytes childURL mheaders = do Status { _loadOriginHeaders } <- State.get originHeaders <- _loadOriginHeaders @@ -300,11 +301,15 @@ _ -> do return () - let bytes = HTTP.responseBody response + return (ByteString.Lazy.toStrict (HTTP.responseBody response)) - case Data.Text.Lazy.Encoding.decodeUtf8' bytes of +fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text +fetchFromHttpUrl childURL mheaders = do + bytes <- fetchFromHttpUrlBytes childURL mheaders + + case Data.Text.Encoding.decodeUtf8' bytes of Left err -> liftIO (Control.Exception.throwIO err) - Right text -> return (Data.Text.Lazy.toStrict text) + Right text -> return text originHeadersFileExpr :: IO (Expr Src Import) originHeadersFileExpr = do 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,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE JavaScriptFFI #-} @@ -14,6 +15,7 @@ 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) @@ -25,7 +27,7 @@ -- | A SHA256 digest newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } - deriving (Eq, Generic, Ord, NFData) + deriving (Data, Eq, Generic, Ord, NFData) instance Show SHA256Digest where show (SHA256Digest bytes) = ByteString.Char8.unpack $ Base16.encode bytes 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,6 +2,7 @@ module Dhall.Import.HTTP ( fetchFromHttpUrl + , fetchFromHttpUrlBytes , originHeadersFileExpr ) where @@ -14,7 +15,8 @@ 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 @@ -37,6 +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/src/Dhall.hs b/src/Dhall.hs --- a/src/Dhall.hs +++ b/src/Dhall.hs @@ -1,15 +1,15 @@ -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# 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 diff --git a/src/Dhall/Binary.hs b/src/Dhall/Binary.hs --- a/src/Dhall/Binary.hs +++ b/src/Dhall/Binary.hs @@ -144,15 +144,18 @@ | sb == "Type" -> return (Const Type) | sb == "Kind" -> return (Const Kind) | sb == "Sort" -> return (Const Sort) + 5 | sb == "Bytes" -> return Bytes 6 | sb == "Double" -> return Double 7 | sb == "Integer" -> return Integer | sb == "Natural" -> return Natural 8 | sb == "Optional" -> return Optional | sb == "TimeZone" -> return TimeZone - 9 | sb == "List/fold" -> return ListFold + 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 @@ -166,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 @@ -650,6 +654,12 @@ 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) @@ -737,6 +747,9 @@ Bool -> Encoding.encodeUtf8ByteArray "Bool" + Bytes -> + Encoding.encodeUtf8ByteArray "Bytes" + Optional -> Encoding.encodeUtf8ByteArray "Optional" @@ -764,12 +777,21 @@ 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" @@ -830,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 @@ -1157,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 @@ -1295,7 +1323,11 @@ Just 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 @@ -92,7 +92,7 @@ import qualified Control.Exception import qualified Data.Text -import qualified Dhall.Eval as Eval +import qualified Dhall.Eval as Eval -- | Pretty-print a value pretty :: Pretty a => a -> Text diff --git a/src/Dhall/Diff.hs b/src/Dhall/Diff.hs --- a/src/Dhall/Diff.hs +++ b/src/Dhall/Diff.hs @@ -17,6 +17,7 @@ , diff ) where +import Data.ByteString (ByteString) import Data.Foldable (fold, toList) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid (Any (..)) @@ -40,16 +41,16 @@ 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.Time as Time +import qualified Data.Time as Time import qualified Dhall.Map -import qualified Dhall.Normalize as Normalize -import qualified Dhall.Pretty.Internal as Internal -import qualified Dhall.Syntax as Syntax -import qualified Prettyprinter as Pretty +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 @@ -124,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) @@ -383,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 @@ -532,6 +537,10 @@ <> keyword "else" <> " " <> ignore +skeleton (BytesLit {}) = + "0x\"" + <> ignore + <> "\"" skeleton (NaturalPlus {}) = ignore <> " " @@ -737,7 +746,7 @@ | same docA = format mempty docB | otherwise = - forall + forall_ <> lparen <> format " " docA <> colon @@ -1169,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 = @@ -1289,17 +1310,35 @@ 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 = "…" 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,61 @@ {-# 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 Dhall.Core as Core import qualified Dhall.Map as Map +import qualified Dhall.Marshal.Decode as Decode import qualified Dhall.Pretty +import qualified Dhall.TypeCheck as TypeCheck import qualified Dhall.Util as Util +import qualified Prettyprinter as Pretty import qualified Prettyprinter.Render.String as Pretty import qualified System.Directory as Directory import qualified System.FilePath as FilePath +import qualified System.PosixCompat.Files as Posix +import qualified System.PosixCompat.User as Posix {-| Attempt to transform a Dhall record into a directory tree where: @@ -37,6 +67,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 +92,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,12 +113,64 @@ > ! "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 @@ -102,14 +186,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 +216,185 @@ 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 FileEntry) + ] + 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) = Posix.userID <$> Posix.getUserEntryForName name + +-- | Resolve a `Group` to a numerical id. +getGroup :: Group -> IO GroupID +getGroup (GroupId gid) = return gid +getGroup (GroupName name) = Posix.groupID <$> Posix.getGroupEntryForName name + +-- | 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) = do + let path' = path entryName entry + when (hasMetadata entry && not isMetadataSupported) $ + Exception.throwIO $ MetadataUnsupportedError path' + Directory.createDirectoryIfMissing allowSeparators path' + processFilesystemEntryList allowSeparators path' $ entryContent entry + -- It is important that we write the metadata after we wrote the content of + -- the directories/files below this directory as we might lock ourself out + -- by changing ownership or permissions. + applyMetadata entry path' +processFilesystemEntry _ path (FileEntry entry) = do + let path' = path entryName entry + when (hasMetadata entry && not isMetadataSupported) $ + Exception.throwIO $ MetadataUnsupportedError path' + Text.IO.writeFile 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,6 +402,8 @@ newtype FilesystemError = FilesystemError { unexpectedExpression :: Expr Void Void } +instance Exception FilesystemError + instance Show FilesystemError where show FilesystemError{..} = Pretty.renderString (Dhall.Pretty.layout message) @@ -155,8 +416,11 @@ \❰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\ + \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\ @@ -198,4 +462,24 @@ \ \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,251 @@ +{-# 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 + , FileEntry + , Entry(..) + , User(..) + , Group(..) + , Mode(..) + , Access(..) + + , setFileMode + , prettyFileMode + + , isMetadataSupported + ) where + +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. +type FileEntry = Entry Text + +-- | A filesystem entry. +data FilesystemEntry + = DirectoryEntry (Entry (Seq FilesystemEntry)) + | FileEntry (Entry Text) + deriving (Eq, Generic, Ord, Show) + +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 -> + FileEntry <$> 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 @@ -46,13 +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.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) @@ -80,7 +85,7 @@ 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 @@ -170,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) @@ -202,10 +210,13 @@ | 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)) @@ -490,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 -> @@ -659,14 +674,26 @@ 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 -> @@ -890,9 +917,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 @@ -940,6 +990,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') -> @@ -996,14 +1050,20 @@ 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') -> @@ -1152,6 +1212,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 -> @@ -1208,14 +1272,20 @@ 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 -> @@ -1351,6 +1421,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 -> @@ -1407,14 +1481,20 @@ 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 -> diff --git a/src/Dhall/Freeze.hs b/src/Dhall/Freeze.hs --- a/src/Dhall/Freeze.hs +++ b/src/Dhall/Freeze.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -7,22 +8,31 @@ 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 Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe) +import Dhall (EvaluateSettings) import Dhall.Pretty (CharacterSet, detectCharacterSet) import Dhall.Syntax ( Expr (..) @@ -39,11 +49,13 @@ , Transitivity (..) , handleMultipleChecksFailed ) +import Lens.Family (set, view) import System.Console.ANSI (hSupportsANSI) import qualified Control.Exception as Exception import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Text.IO as Text.IO +import qualified Dhall import qualified Dhall.Core as Core import qualified Dhall.Import import qualified Dhall.Optics @@ -57,13 +69,31 @@ 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 @@ -71,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 = @@ -80,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) @@ -101,58 +212,31 @@ 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 - -> Transitivity - -> NonEmpty Input - -> Scope - -> Intent - -> Maybe 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 -> Transitivity -> NonEmpty Input @@ -161,7 +245,7 @@ -> Maybe CharacterSet -> Censor -> IO () -freezeWithManager newManager outputMode transitivity0 inputs scope intent chosenCharacterSet censor = +freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenCharacterSet censor = handleMultipleChecksFailed "freeze" "frozen" go inputs where go input = do @@ -171,7 +255,7 @@ InputFile file -> System.FilePath.takeDirectory file - let status = Dhall.Import.emptyStatusWithManager newManager directory + let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory (inputName, originalText, transitivity) <- case input of InputFile file -> do @@ -199,7 +283,7 @@ 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 @@ -238,41 +322,21 @@ then Right () else Left CheckFailed{..} -{-| 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 = freezeExpressionWithManager Dhall.Import.defaultNewManager - --- https://github.com/dhall-lang/dhall-haskell/issues/2347 -toMissing :: Import -> Import -toMissing import_ = - import_ { importHashed = (importHashed import_) { importType = Missing } } - - -- | 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 @@ -348,8 +412,34 @@ 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_ + + Dhall.Optics.transformOf Core.subExpressions simplify <$> case intent of Secure -> - traverse freezeFunction expression + traverse freezeFunction (Dhall.Optics.transformOf Core.subExpressions uncache expression) Cache -> Dhall.Optics.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 @@ -221,6 +221,7 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe as Maybe import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding import qualified Data.Text.IO import qualified Dhall.Binary import qualified Dhall.Core as Core @@ -235,8 +236,8 @@ import qualified System.Directory as Directory import qualified System.Environment import qualified System.FilePath as FilePath -import qualified System.IO import qualified System.Info +import qualified System.IO import qualified Text.Megaparsec import qualified Text.Parser.Combinators import qualified Text.Parser.Token @@ -702,15 +703,21 @@ 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 @@ -764,7 +771,7 @@ 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 @@ -789,6 +796,30 @@ 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 @@ -808,6 +839,25 @@ fetchFromHttpUrl url' maybeHeaders #endif +-- | Fetch the text contents of a URL +fetchRemoteBytes :: URL -> StateT Status IO Data.ByteString.ByteString +#ifndef WITH_HTTP +fetchRemoteBytes (url@URL { headers = maybeHeadersExpression }) = do + let maybeHeaders = fmap toHeaders maybeHeadersExpression + let urlString = Text.unpack (Core.pretty url) + Status { _stack } <- State.get + throwMissingImport (Imported _stack (CannotImportHTTPURL urlString maybeHeaders)) +#else +fetchRemoteBytes url = do + zoom remoteBytes (State.put fetchFromHTTP) + fetchFromHTTP url + where + fetchFromHTTP :: URL -> StateT Status IO Data.ByteString.ByteString + fetchFromHTTP (url'@URL { headers = maybeHeadersExpression }) = do + let maybeHeaders = fmap toHeaders maybeHeadersExpression + fetchFromHttpUrlBytes url' maybeHeaders +#endif + getCacheFile :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m) => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath @@ -1094,7 +1144,7 @@ -> FilePath -> Status makeEmptyStatus newManager headersExpr rootDirectory = - emptyStatusWith newManager (originHeadersLoader headersExpr) fetchRemote rootImport + emptyStatusWith newManager (originHeadersLoader headersExpr) fetchRemote fetchRemoteBytes rootImport where prefix = if FilePath.isRelative rootDirectory then Here @@ -1127,7 +1177,7 @@ -- | See `remoteStatus` remoteStatusWithManager :: IO Manager -> URL -> Status remoteStatusWithManager newManager url = - emptyStatusWith newManager (originHeadersLoader (pure emptyOriginHeaders)) fetchRemote rootImport + emptyStatusWith newManager (originHeadersLoader (pure emptyOriginHeaders)) fetchRemote fetchRemoteBytes rootImport where rootImport = Import { importHashed = ImportHashed @@ -1323,6 +1373,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 --- a/src/Dhall/Import/Headers.hs +++ b/src/Dhall/Import/Headers.hs @@ -9,26 +9,23 @@ , 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 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.HashMap.Strict as HashMap import qualified Data.Text.Encoding -import qualified Dhall.Core as Core +import qualified Dhall.Core as Core import qualified Dhall.Map -import qualified Dhall.TypeCheck 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 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 @@ -117,6 +117,9 @@ , _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) @@ -137,9 +140,10 @@ :: 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 rootImport = Status {..} +emptyStatusWith _newManager _loadOriginHeaders _remote _remoteBytes rootImport = Status {..} where _stack = pure (Chained rootImport) @@ -173,8 +177,15 @@ -- | Lens from a `Status` to its `_remote` field remote - :: Functor f => LensLike' f Status (URL -> StateT Status IO Data.Text.Text) + :: Functor f + => LensLike' f Status (URL -> StateT Status IO Data.Text.Text) remote k s = fmap (\x -> s { _remote = x }) (k (_remote s)) + +-- | Lens from a `Status` to its `_remote` field +remoteBytes + :: Functor f + => LensLike' f Status (URL -> StateT Status IO Data.ByteString.ByteString) +remoteBytes k s = fmap (\x -> s { _remoteBytes = x }) (k (_remoteBytes s)) -- | Lens from a `Status` to its `_substitutions` field substitutions :: Functor f => LensLike' f Status (Dhall.Substitution.Substitutions Src Void) diff --git a/src/Dhall/Lint.hs b/src/Dhall/Lint.hs --- a/src/Dhall/Lint.hs +++ b/src/Dhall/Lint.hs @@ -19,7 +19,6 @@ ) where import Control.Applicative ((<|>)) -import Data.List.NonEmpty (NonEmpty (..)) import Dhall.Syntax ( Binding (..) @@ -38,7 +37,6 @@ import qualified Data.Foldable as Foldable import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Map as Map import qualified Data.Text as Text import qualified Dhall.Core as Core import qualified Dhall.Map @@ -63,7 +61,6 @@ <|> fixParentPath e <|> removeLetInLet e <|> addPreludeExtensions e - <|> sortImports e -- | Remove unused `Let` bindings. removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a) @@ -212,53 +209,3 @@ Nothing useToMap _ = Nothing - --- | This sorts `let` bindings to move imports to the front if doing so does not --- change the behavior of the code. -sortImports :: Eq s => Expr s Import -> Maybe (Expr s Import) -sortImports oldExpression@(Let binding0 oldBody0) - | oldExpression == newExpression = Nothing - | otherwise = Just newExpression - where - toBool (Embed _ ) = False - toBool (Note _ e) = toBool e - toBool _ = True - - process (seen, index) Binding{..} oldBody function = (pair, pairs, newBody) - where - order = - if b then index else Map.findWithDefault (0 :: Int) variable seen - - b = toBool value - - pair = (order, function) - - ~(pairs, newBody) = - label (Map.insert variable order seen, index + 1) oldBody - - label state (Let binding oldBody) = (pair : pairs, newBody) - where - function = Let binding - - ~(pair, pairs, newBody) = process state binding oldBody function - - label state (Note src (Let binding oldBody)) = (pair : pairs, newBody) - where - function e = Note src (Let binding e) - - ~(pair, pairs, newBody) = process state binding oldBody function - - label _ body = - ([], body) - - ~(pairs0, newBody0) = (pair :| pairs, newBody) - where - function = Let binding0 - - ~(pair, pairs, newBody) = - process (Map.empty, 1) binding0 oldBody0 function - - sortedFunctions = fmap snd (NonEmpty.sortWith fst pairs0) - - newExpression = foldr id newBody0 sortedFunctions -sortImports _ = Nothing diff --git a/src/Dhall/Main.hs b/src/Dhall/Main.hs --- a/src/Dhall/Main.hs +++ b/src/Dhall/Main.hs @@ -36,6 +36,7 @@ , SemanticCacheMode (..) , _semanticCacheMode ) +import Dhall.Package (writePackage) import Dhall.Parser (Src) import Dhall.Pretty ( Ann @@ -159,9 +160,10 @@ | 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 { name :: Maybe String, files :: NonEmpty FilePath } -- | This specifies how to resolve transitive dependencies data ResolveMode @@ -269,7 +271,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" @@ -312,6 +314,11 @@ (Hash <$> parseFile <*> parseCache) <|> subcommand Miscellaneous + "package" + "Create a package.dhall referencing the provided paths" + (Package <$> parsePackageName <*> parsePackageFiles) + <|> subcommand + Miscellaneous "tags" "Generate etags file" (Tags <$> parseInput <*> parseTagsOutput <*> parseSuffixes <*> parseFollowSymlinks) @@ -506,7 +513,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 = @@ -533,6 +540,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" @@ -553,6 +566,22 @@ <> Options.Applicative.help "Cache the hashed expression" ) + parsePackageName = optional $ + Options.Applicative.strOption + ( Options.Applicative.long "name" + <> Options.Applicative.help "The filename of the package" + <> Options.Applicative.metavar "NAME" + <> Options.Applicative.action "file" + ) + + 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 = @@ -997,7 +1026,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, ..} @@ -1011,6 +1040,8 @@ let denoted :: Expr Void Import denoted = Dhall.Core.denote expression in Text.Pretty.Simple.pPrintNoColor denoted + + Package {..} -> writePackage (fromMaybe Unicode chosenCharacterSet) name files -- | Entry point for the @dhall@ executable main :: IO () diff --git a/src/Dhall/Marshal/Decode.hs b/src/Dhall/Marshal/Decode.hs --- a/src/Dhall/Marshal/Decode.hs +++ b/src/Dhall/Marshal/Decode.hs @@ -51,6 +51,10 @@ , int64 , scientific , double + -- ** Bytes + , lazyBytes + , strictBytes + , shortBytes -- ** Textual , string , lazyText @@ -146,6 +150,7 @@ , Op (..) , Predicate (..) ) +import Data.Functor.Identity (Identity (..)) import Data.Hashable (Hashable) import Data.List.NonEmpty (NonEmpty (..)) import Data.Typeable (Proxy (..), Typeable) @@ -163,6 +168,9 @@ 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 @@ -302,6 +310,15 @@ 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 @@ -314,6 +331,9 @@ 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) @@ -917,6 +937,35 @@ 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\"" @@ -925,7 +974,7 @@ shortText :: Decoder Data.Text.Short.ShortText shortText = fmap Data.Text.Short.fromText strictText -{-| Decode lazy `Data.Text.Text`. +{-| Decode lazy `Data.Text.Lazy.Text`. >>> input lazyText "\"Test\"" "Test" @@ -1550,6 +1599,7 @@ 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 @@ -1614,7 +1664,7 @@ { invalidDecoderExpected :: Expr s a , invalidDecoderExpression :: Expr s a } - deriving (Typeable) + deriving (Eq, Typeable) instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecoder s a) diff --git a/src/Dhall/Marshal/Encode.hs b/src/Dhall/Marshal/Encode.hs --- a/src/Dhall/Marshal/Encode.hs +++ b/src/Dhall/Marshal/Encode.hs @@ -74,6 +74,9 @@ 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 @@ -166,6 +169,21 @@ 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 {..} diff --git a/src/Dhall/Normalize.hs b/src/Dhall/Normalize.hs --- a/src/Dhall/Normalize.hs +++ b/src/Dhall/Normalize.hs @@ -38,8 +38,8 @@ , FunctionBinding (..) , PreferAnnotation (..) , RecordField (..) - , WithComponent (..) , Var (..) + , WithComponent (..) ) import qualified Data.Sequence @@ -173,23 +173,21 @@ :: (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 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 - 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 @@ -377,365 +375,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 - Date -> pure Date - DateLiteral d -> pure (DateLiteral d) - Time -> pure Time - TimeLiteral t p -> pure (TimeLiteral t p) - TimeZone -> pure TimeZone - TimeZoneLiteral z -> pure (TimeZoneLiteral z) - 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 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 -> + 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') - 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) + return (ListLit listType keyValues) + _ -> + return (ToMap x' t') + ShowConstructor x -> do + x' <- loop x + return $ case x' of + Field (Union ktsY) (Syntax.fieldSelectionLabel -> kY) -> + case Dhall.Map.lookup kY ktsY of + Just Nothing -> TextLit (Chunks [] kY) + _ -> ShowConstructor x' + App (Field (Union ktsY) (Syntax.fieldSelectionLabel -> kY)) _ -> + case Dhall.Map.lookup kY ktsY of + Just (Just _) -> TextLit (Chunks [] kY) + _ -> ShowConstructor x' + Some _ -> + TextLit (Chunks [] "Some") + App None _ -> + TextLit (Chunks [] "None") + _ -> ShowConstructor x' + Field r k@FieldSelection{fieldSelectionLabel = x} -> do + let singletonRecordLit v = RecordLit (Dhall.Map.singleton x v) - r' <- loop r - case r' of - RecordLit kvs -> - case Dhall.Map.lookup x kvs of - Just v -> pure $ recordFieldValue v - Nothing -> Field <$> (RecordLit <$> traverse (Syntax.recordFieldExprs loop) kvs) <*> pure k - Project r_ _ -> loop (Field r_ k) - Prefer cs _ (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of - Just v -> pure (Field (Prefer cs PreferFromSource (singletonRecordLit v) r_) k) - Nothing -> loop (Field r_ k) - Prefer _ _ l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of - Just v -> pure $ recordFieldValue v - Nothing -> loop (Field l k) - Combine cs m (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of - Just v -> pure (Field (Combine cs m (singletonRecordLit v) r_) k) - Nothing -> loop (Field r_ k) - Combine cs m l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of - Just v -> pure (Field (Combine cs m l (singletonRecordLit v)) k) - Nothing -> loop (Field l k) - _ -> pure (Field r' k) - Project x (Left fields)-> do - x' <- loop x - let fieldsSet = Data.Set.fromList fields - case x' of - RecordLit kvs -> - pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet)) - Project y _ -> - loop (Project y (Left fields)) - Prefer cs _ l (RecordLit rKvs) -> do - let rKs = Dhall.Map.keysSet rKvs - let l' = Project l (Left (Data.Set.toList (Data.Set.difference fieldsSet rKs))) - let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet) - loop (Prefer cs PreferFromSource l' r') - _ | null fields -> pure (RecordLit mempty) - | otherwise -> pure (Project x' (Left (Data.Set.toList (Data.Set.fromList fields)))) - Project r (Right e1) -> do - e2 <- loop e1 + r' <- loop r + case r' of + RecordLit kvs -> + case Dhall.Map.lookup x kvs of + Just v -> pure $ recordFieldValue v + Nothing -> Field <$> (RecordLit <$> traverse (Syntax.recordFieldExprs loop) kvs) <*> pure k + Project r_ _ -> loop (Field r_ k) + Prefer cs _ (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of + Just v -> pure (Field (Prefer cs PreferFromSource (singletonRecordLit v) r_) k) + Nothing -> loop (Field r_ k) + Prefer _ _ l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of + Just v -> pure $ recordFieldValue v + Nothing -> loop (Field l k) + Combine cs m (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of + Just v -> pure (Field (Combine cs m (singletonRecordLit v) r_) k) + Nothing -> loop (Field r_ k) + Combine cs m l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of + Just v -> pure (Field (Combine cs m l (singletonRecordLit v)) k) + Nothing -> loop (Field l k) + _ -> pure (Field r' k) + Project x (Left fields)-> do + x' <- loop x + let fieldsSet = Data.Set.fromList fields + case x' of + RecordLit kvs -> + pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet)) + Project y _ -> + loop (Project y (Left fields)) + Prefer cs _ l (RecordLit rKvs) -> do + let rKs = Dhall.Map.keysSet rKvs + let l' = Project l (Left (Data.Set.toList (Data.Set.difference fieldsSet rKs))) + let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet) + loop (Prefer cs PreferFromSource l' r') + _ | null fields -> pure (RecordLit mempty) + | otherwise -> pure (Project x' (Left (Data.Set.toList (Data.Set.fromList fields)))) + Project r (Right e1) -> do + e2 <- loop e1 - case e2 of - Record kts -> - loop (Project r (Left (Data.Set.toList (Dhall.Map.keysSet kts)))) - _ -> do - r' <- loop r - pure (Project r' (Right e2)) - Assert t -> do - t' <- loop t + case e2 of + Record kts -> + loop (Project r (Left (Data.Set.toList (Dhall.Map.keysSet kts)))) + _ -> do + r' <- loop r + pure (Project r' (Right e2)) + Assert t -> do + t' <- loop t - pure (Assert t') - Equivalent cs l r -> do - l' <- loop l - r' <- loop r + pure (Assert t') + Equivalent cs l r -> do + l' <- loop l + r' <- loop r - pure (Equivalent cs 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 - 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 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)) - WithQuestion :| _ -> do - return (With e' 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 e' ks v') - App None _T -> - case ks of - WithQuestion :| _ -> - return (App None _T) - WithLabel _ :| _ -> - return (With e' ks v') - _ -> - 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. @@ -783,6 +798,9 @@ 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 @@ -837,6 +855,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 @@ -882,10 +902,13 @@ 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 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,219 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} + +-- | Create a package.dhall from files and directory contents. + +module Dhall.Package + ( writePackage + , getPackagePathAndContent + , PackageError(..) + ) where + +import Control.Exception (Exception, throwIO) +import Control.Monad +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (fromMaybe) +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 System.Directory +import System.FilePath + +-- | Create a package.dhall from files and directory contents. +-- For a description of how the package file is constructed see +-- 'getPackagePathAndContent'. +writePackage :: CharacterSet -> Maybe String -> NonEmpty FilePath -> IO () +writePackage characterSet outputFn inputs = do + (outputPath, expr) <- getPackagePathAndContent outputFn inputs + renderExpression characterSet 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 the path points to a regular file, it is included in the package +-- unless it is the path of the package file itself. +-- +getPackagePathAndContent :: Maybe String -> NonEmpty FilePath -> IO (FilePath, Expr s Import) +getPackagePathAndContent outputFn (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 + let entries' = filter (\entry -> takeExtension entry == ".dhall") entries + go acc checkOutputDir (map (p ) entries' <> 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 + + outputFn' = fromMaybe "package.dhall" outputFn + +-- | 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/Expression.hs b/src/Dhall/Parser/Expression.hs --- a/src/Dhall/Parser/Expression.hs +++ b/src/Dhall/Parser/Expression.hs @@ -18,6 +18,7 @@ import qualified Control.Monad import qualified Control.Monad.Combinators as Combinators import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty +import qualified Data.ByteString as ByteString import qualified Data.ByteString.Base16 as Base16 import qualified Data.Char as Char import qualified Data.List @@ -623,7 +624,8 @@ primitiveExpression = noted ( choice - [ temporalLiteral + [ bytesLiteral + , temporalLiteral , alternative00 , alternative01 , alternative02 @@ -720,7 +722,8 @@ 'D' -> choice - [ Date <$ _Date + [ DateShow <$ _DateShow + , Date <$ _Date , DoubleShow <$ _DoubleShow , Double <$ _Double ] @@ -736,14 +739,20 @@ , 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 @@ -932,9 +941,23 @@ return (Dhall.Syntax.toDoubleQuoted a) 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 @@ -1240,7 +1263,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 @@ -72,6 +72,7 @@ _ListIndexed, _ListReverse, _Bool, + _Bytes, _Natural, _Integer, _Double, @@ -79,8 +80,11 @@ _TextReplace, _TextShow, _Date, + _DateShow, _Time, + _TimeShow, _TimeZone, + _TimeZoneShow, _List, _True, _False, @@ -1132,6 +1136,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 @@ -1188,6 +1199,13 @@ _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 @@ -1195,12 +1213,26 @@ _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 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 @@ -41,6 +41,7 @@ , prettyDouble , prettyToStrictText , prettyToString + , prettyBase16 , layout , layoutOpts @@ -55,7 +56,7 @@ , comma , dot , equals - , forall + , forall_ , label , lambda , langle @@ -72,30 +73,39 @@ , temporalToText ) where -import Control.DeepSeq (NFData) -import Data.Aeson (FromJSON (..), Value (String)) -import Data.Aeson.Types (typeMismatch, unexpected) -import Data.Data (Data) -import Data.Foldable -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Text (Text) -import Dhall.Map (Map) -import Dhall.Optics (cosmosOf, foldOf, to) -import Dhall.Src (Src (..)) -import Dhall.Syntax -import GHC.Generics (Generic) -import Language.Haskell.TH.Syntax (Lift) -import Numeric.Natural (Natural) -import Prettyprinter (Doc, Pretty, space) +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.Optics (cosmosOf, foldOf, to) +import Dhall.Src (Src (..)) +import Dhall.Syntax +import {-# SOURCE #-} Dhall.Syntax.Instances.Pretty () +import GHC.Generics (Generic) +import Language.Haskell.TH.Syntax (Lift) +import Numeric.Natural (Natural) +import Prettyprinter (Doc, Pretty, space) +import qualified Control.Exception as Exception +import qualified Data.ByteString.Base16 as Base16 import qualified Data.Char import qualified Data.HashSet import qualified Data.List as List import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding import qualified Data.Time as Time import qualified Dhall.Map as Map +import qualified Dhall.Syntax.Operations as Operations import qualified Prettyprinter as Pretty import qualified Prettyprinter.Render.String as Pretty import qualified Prettyprinter.Render.Terminal as Terminal @@ -306,9 +316,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 "→" @@ -465,7 +475,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 @@ -794,7 +804,7 @@ 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 @@ -805,7 +815,7 @@ <> rparen ) - short = forall characterSet <> lparen + short = forall_ characterSet <> lparen <> prettyLabel a <> space <> colon <> space <> prettyExpression b @@ -1281,6 +1291,8 @@ prettyConst k prettyPrimitiveExpression Bool = builtin "Bool" + prettyPrimitiveExpression Bytes = + builtin "Bytes" prettyPrimitiveExpression Natural = builtin "Natural" prettyPrimitiveExpression NaturalFold = @@ -1331,6 +1343,8 @@ ) where (_HHHH, _MM, _DD) = Time.toGregorian day + prettyPrimitiveExpression DateShow = + builtin "Date/show" prettyPrimitiveExpression Time = builtin "Time" prettyPrimitiveExpression (TimeLiteral (Time.TimeOfDay hh mm seconds) precision) = @@ -1350,7 +1364,9 @@ suffix | precision == 0 = "" - | otherwise = "." <> Pretty.pretty fraction + | otherwise = "." <> Pretty.pretty (Printf.printf "%0*d" precision fraction :: String) + prettyPrimitiveExpression TimeShow = + builtin "Time/show" prettyPrimitiveExpression TimeZone = builtin "TimeZone" prettyPrimitiveExpression (TimeZoneLiteral (Time.TimeZone minutes _ _)) = @@ -1364,6 +1380,8 @@ sign = if 0 <= minutes then "+" else "-" (_HH, _MM) = abs minutes `divMod` 60 + prettyPrimitiveExpression TimeZoneShow = + builtin "TimeZone/show" prettyPrimitiveExpression List = builtin "List" prettyPrimitiveExpression ListBuild = @@ -1397,6 +1415,8 @@ prettyDouble a prettyPrimitiveExpression (TextLit a) = prettyChunks a + prettyPrimitiveExpression (BytesLit a) = + prettyBytes a prettyPrimitiveExpression (Record a) = prettyRecord a prettyPrimitiveExpression (RecordLit a) = @@ -1608,6 +1628,10 @@ 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') = @@ -1927,6 +1951,15 @@ 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,13 +1,15 @@ module Dhall.Pretty.Internal where -import Control.DeepSeq (NFData) -import Data.Data (Data) -import Data.Text (Text) -import Prettyprinter (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 diff --git a/src/Dhall/Syntax.hs b/src/Dhall/Syntax.hs --- a/src/Dhall/Syntax.hs +++ b/src/Dhall/Syntax.hs @@ -1,1489 +1,31 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UnicodeSyntax #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - -{-| 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 - , CharacterSet(..) - , Chunks(..) - , DhallDouble(..) - , PreferAnnotation(..) - , Expr(..) - , RecordField(..) - , makeRecordField - , FunctionBinding(..) - , makeFunctionBinding - , FieldSelection(..) - , makeFieldSelection - , WithComponent(..) - - -- ** 'Let'-blocks - , MultiLet(..) - , multiLet - , wrapInLets - - -- ** Optics - , subExpressions - , subExpressionsWith - , 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 - - -- * 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.Traversable () -import Data.Void (Void) -import Dhall.Map (Map) -import {-# SOURCE #-} Dhall.Pretty.Internal -import Dhall.Src (Src (..)) -import GHC.Generics (Generic) -import Instances.TH.Lift () -import Language.Haskell.TH.Syntax (Lift) -import Numeric.Natural (Natural) -import Prettyprinter (Doc, Pretty) -import Unsafe.Coerce (unsafeCoerce) - -import qualified Control.Monad -import qualified Data.Fixed as Fixed -import qualified Data.HashSet -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Text -import qualified Data.Time as Time -import qualified Dhall.Crypto -import qualified Lens.Family as Lens -import qualified Network.URI as URI -import qualified Prettyprinter as Pretty - -deriving instance Lift Time.Day -deriving instance Lift Time.TimeOfDay -deriving instance Lift Time.TimeZone -deriving instance Lift (Fixed.Fixed a) - --- $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 stock (Show, Data, Lift, Generic) - deriving anyclass NFData - --- | 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 - --- | A path component for a @with@ expression -data WithComponent = WithLabel Text | WithQuestion - deriving (Data, Eq, Generic, Lift, NFData, Ord, Show) - -{-| 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 (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 '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 - -- | > Date ~ Date - | Date - -- | > DateLiteral (fromGregorian _YYYY _MM _DD) ~ YYYY-MM-DD - | DateLiteral Time.Day - -- | > Time ~ Time - | Time - -- | > TimeLiteral (TimeOfDay hh mm ss) _ ~ hh:mm:ss - | TimeLiteral - Time.TimeOfDay - Word - -- ^ Precision - -- | > TimeZone ~ TimeZone - | TimeZone - -- | > TimeZoneLiteral (TimeZone ( 60 * _HH + _MM) _ _) ~ +HH:MM - -- | > TimeZoneLiteral (TimeZone (-60 * _HH + _MM) _ _) ~ -HH:MM - | TimeZoneLiteral Time.TimeZone - -- | > 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 _ 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 (Maybe CharacterSet) (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)) - -- | > 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 (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 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 #-} - -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 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) - -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 - -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 = 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 _ 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 _ Time = pure Time -unsafeSubExpressions _ (TimeLiteral a b) = pure (TimeLiteral a b) -unsafeSubExpressions _ TimeZone = pure TimeZone -unsafeSubExpressions _ (TimeZoneLiteral a) = pure (TimeZoneLiteral a) -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 <$> 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 (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" - ) - -{-| 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 -{-# INLINABLE recordFieldExprs #-} - -{-| 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 #-} - --- | 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 stock (Eq, Generic, Ord, Show) - deriving anyclass 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 (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 - --- | 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.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) - --- | 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`) --- --- 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" - , "Bool" - , "True" - , "False" - , "Optional" - , "None" - , "Natural" - , "Integer" - , "Double" - , "Text" - , "Date" - , "Time" - , "TimeZone" - , "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 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 <> " " - , "``` " - ] ) +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,3 @@ +module Dhall.Syntax.Chunks where + +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,264 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Dhall.Syntax.Expr + ( Expr(..) + ) where + +import Data.ByteString (ByteString) +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 +-} +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,3 @@ +module Dhall.Syntax.Expr where + +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.Family 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.Family 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.Family 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,35 @@ +{-# 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) + +import qualified Data.Fixed as Fixed +import qualified Data.Time as Time + +deriving instance Lift Time.Day +deriving instance Lift Time.TimeOfDay +deriving instance Lift Time.TimeZone +deriving instance Lift (Fixed.Fixed a) +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.Family 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.Family 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,9 @@ +module Dhall.Syntax.Types where + +data DhallDouble + +data PreferAnnotation + +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,5 @@ {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} @@ -18,9 +19,10 @@ , defaultGenerateOptions ) where +import Data.Bifunctor (first) import Data.Text (Text) import Dhall (FromDhall, ToDhall) -import Dhall.Syntax (Expr (..)) +import Dhall.Syntax (Expr (..), FunctionBinding (..), Var (..)) import GHC.Generics (Generic) import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) import Prettyprinter (Pretty) @@ -42,8 +44,10 @@ import Language.Haskell.TH.Syntax (DerivClause (..), DerivStrategy (..)) import qualified Data.List as List +import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as Text +import qualified Data.Time as Time import qualified Data.Typeable as Typeable import qualified Dhall import qualified Dhall.Core as Core @@ -56,6 +60,7 @@ 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. @@ -115,7 +120,8 @@ -} 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 @@ -123,8 +129,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) @@ -141,6 +179,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 @@ -151,42 +198,26 @@ 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) + + Var v + | Just (V param index) <- List.find (v ==) typeParams -> do + let name = Syntax.mkName $ (Text.unpack param) ++ (show index) - let message = Pretty.renderString (Dhall.Pretty.layout document) + return (VarT name) - fail message - where - predicate haskellType = - Core.judgmentallyEqual (code haskellType) dhallType + | otherwise -> fail $ message v + _ | Just haskellType <- List.find (predicate dhallType) haskellTypes -> do + let name = Syntax.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 ] @@ -218,95 +249,111 @@ -> [HaskellType (Expr s a)] -> HaskellType (Expr s a) -> Q [Dec] -toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ@MultipleConstructors{..} = - case code of - Union kts -> do - let name = Syntax.mkName (Text.unpack typeName) +toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ = + case typ of + SingleConstructor{..} -> uncurry (fromSingle typeName constructorName) $ getTypeParams code + MultipleConstructors{..} -> uncurry (fromMulti typeName) $ getTypeParams code + where + getTypeParams = first numberConsecutive . getTypeParams_ [] + + getTypeParams_ acc (Lam _ (FunctionBinding _ v _ _ _) rest) = getTypeParams_ (v:acc) rest + getTypeParams_ acc rest = (acc, rest) - let derivingClauses = - [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] + derivingClauses = [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] - constructors <- traverse (toConstructor generateOptions haskellTypes typeName) (Dhall.Map.toList kts) + interpretOptions = generateToInterpretOptions generateOptions typ - let interpretOptions = generateToInterpretOptions generateOptions typ + toTypeVar (V n i) = Syntax.PlainTV $ Syntax.mkName (Text.unpack n ++ show i) + toDataD typeName typeParams constructors = do + let name = Syntax.mkName (Text.unpack typeName) + + let params = fmap toTypeVar typeParams + fmap concat . sequence $ - [pure [DataD [] name [] Nothing constructors derivingClauses]] <> + [pure [DataD [] name params Nothing constructors derivingClauses]] <> [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <> [ toDhallInstance name interpretOptions | 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." - ] - - let message = Pretty.renderString (Dhall.Pretty.layout document) - - fail message -toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ@SingleConstructor{..} = do - let name = Syntax.mkName (Text.unpack typeName) + 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) - let derivingClauses = - [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] + toDataD typeName typeParams constructors + + _ -> fail $ message dhallType - let interpretOptions = generateToInterpretOptions generateOptions typ + message dhallType = Pretty.renderString (Dhall.Pretty.layout $ document dhallType) - constructor <- toConstructor generateOptions haskellTypes typeName (constructorName, Just code) + 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." + ] - fmap concat . sequence $ - [pure [DataD [] name [] Nothing [constructor] derivingClauses]] <> - [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <> - [ toDhallInstance name interpretOptions | generateToDhallInstance ] +-- | 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) - => GenerateOptions + => [Var] + -> GenerateOptions -> [HaskellType (Expr s a)] -> Text -- ^ typeName -> (Text, Maybe (Expr s a)) -- ^ @(constructorName, fieldType)@ -> Q Con -toConstructor GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do +toConstructor typeParams GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do let name = Syntax.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 = @@ -320,7 +367,7 @@ Just (Record kts) -> do let process (key, dhallFieldType) = do - haskellFieldType <- toNestedHaskellType haskellTypes dhallFieldType + haskellFieldType <- toNestedHaskellType typeParams haskellTypes dhallFieldType return (Syntax.mkName (Text.unpack $ fieldModifier key), bang, haskellFieldType) @@ -329,7 +376,7 @@ return (RecC name varBangTypes) Just dhallAlternativeType -> do - haskellAlternativeType <- toNestedHaskellType haskellTypes dhallAlternativeType + haskellAlternativeType <- toNestedHaskellType typeParams haskellTypes dhallAlternativeType return (NormalC name [ (bang, haskellAlternativeType) ]) @@ -400,18 +447,24 @@ -- ^ 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 diff --git a/src/Dhall/Tutorial.hs b/src/Dhall/Tutorial.hs --- a/src/Dhall/Tutorial.hs +++ b/src/Dhall/Tutorial.hs @@ -1644,7 +1644,7 @@ -- record might be the contents of a software license: -- -- > { package = "dhall" --- > , author = "Gabriel Gonzalez" +-- > , author = "Gabriella Gonzalez" -- > , license = ./LICENSE -- > } -- @@ -1653,7 +1653,7 @@ -- -- > $ cat LICENSE -- > '' --- > Copyright (c) 2017 Gabriel Gonzalez +-- > Copyright (c) 2017 Gabriella Gonzalez -- > All rights reserved. -- > -- > ... @@ -1668,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. -- > -- > ... diff --git a/src/Dhall/TypeCheck.hs b/src/Dhall/TypeCheck.hs --- a/src/Dhall/TypeCheck.hs +++ b/src/Dhall/TypeCheck.hs @@ -429,6 +429,12 @@ return _L' + Bytes -> + return (VConst Type) + + BytesLit _ -> + return VBytes + Natural -> return (VConst Type) @@ -583,18 +589,27 @@ 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) @@ -880,7 +895,7 @@ return (VConst c) - Prefer _ a l r -> do + Prefer _ _ l r -> do _L' <- loop ctx l _R' <- loop ctx r @@ -893,11 +908,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' @@ -1304,16 +1315,12 @@ VOptional _O' -> do case ks of - WithQuestion :| [] -> do + WithQuestion :| _ -> do tV' <- loop ctx v if Eval.conv values _O' tV' then return (VOptional _O') else die OptionalWithTypeMismatch - WithQuestion :| k₁ : ks' -> do - tV' <- with _O' (k₁ :| ks') v - return (VOptional tV') - WithLabel k :| _ -> die (NotAQuestionPath k) _ -> die (NotWithARecord e₀ (quote names tE')) -- TODO: NotWithARecordOrOptional @@ -1475,7 +1482,7 @@ -- https://github.com/dhall-lang/dhall-haskell/pull/116 where short = "Unbound variable: " <> Pretty.pretty x - + hints = [] long = @@ -1590,7 +1597,7 @@ prettyTypeMessage (InvalidInputType expr) = ErrorMessages {..} where short = "Invalid function input" - + hints = [] long = diff --git a/src/Dhall/URL.hs b/src/Dhall/URL.hs --- a/src/Dhall/URL.hs +++ b/src/Dhall/URL.hs @@ -7,10 +7,8 @@ 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/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,134 @@ +{-# 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.Family (set) +import System.FilePath (()) +import Test.Tasty +import Test.Tasty.HUnit + +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 +#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 @?= + [ Directory outDir + , File $ outDir "file" + , Directory $ outDir "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 @?= + [ FileEntry $ Entry + { entryName = "ids" + , entryContent = "" + , entryUser = Just (UserId 0) + , entryGroup = Just (GroupId 0) + , entryMode = Nothing + } + , FileEntry $ 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 + + walkFsTree outDir + +data WalkEntry + = Directory FilePath + | File FilePath + deriving (Eq, 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/Freeze.hs b/tests/Dhall/Test/Freeze.hs --- a/tests/Dhall/Test/Freeze.hs +++ b/tests/Dhall/Test/Freeze.hs @@ -21,19 +21,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") @@ -42,7 +53,7 @@ parsedInput <- Core.throws (Parser.exprFromText mempty inputText) - actualExpression <- Freeze.freezeExpression (Turtle.encodeString freezeDirectory) AllImports Cache parsedInput + actualExpression <- Freeze.freezeExpression (Turtle.encodeString 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 @@ -105,8 +105,11 @@ 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/originHeadersImportFromEnv" , importDirectory "success/originHeadersImport" , importDirectory "success/originHeadersOverride" , importDirectory "success/unit/asLocation/RemoteChainEnv" 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 @@ -5,11 +5,13 @@ 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 @@ -62,11 +64,13 @@ , tagsTests , freezeTests , schemaTests + , Dhall.Test.DirectoryTree.tests , Dhall.Test.Regression.tests , Dhall.Test.Tutorial.tests , Dhall.Test.QuickCheck.tests , Dhall.Test.Dhall.tests , Dhall.Test.TH.tests + , Dhall.Test.Package.tests ] return testTree 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,212 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Test.Package where + +import Control.Exception (Exception, displayException, 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 System.FilePath (()) +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "Package" + [ packagePackageFile + , packageCustomPackageFile + , packageSingleFile + , packageEmptyDirectory + , packageSingleDirectory + , packageNested + , 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 Nothing ("./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 + + (output, expr) <- getPackagePathAndContent (Just "custom.dhall") ("./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 Nothing ("./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 Nothing ("./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 Nothing ("./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 Nothing + ( "./tests/package/test.dhall" :| + [ "./tests/package/dir/test.dhall" + , "./tests/package/other/package.dhall" + ]) + assertEqual "path" path output + assertEqual "content" package expr + +packageMissingFile :: TestTree +packageMissingFile = testCase "missing file" $ do + let action :: IO (FilePath, Expr Void Import) + action = getPackagePathAndContent Nothing ("./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 Nothing ("./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 Nothing ("./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 + } + +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 @@ -152,7 +152,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 @@ -274,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 @@ -358,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") @@ -386,10 +388,13 @@ % (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") @@ -438,8 +443,6 @@ False standardizedExpression (Prefer _ PreferFromCompletion _ _) = False -standardizedExpression (Prefer _ (PreferFromWith _) _ _) = - False -- The following three expressions are valid ASTs, but they can never be parsed, -- because the annotation will associate with `Merge`/`ListLit`/`ToMap` with -- higher precedence @@ -526,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) @@ -17,13 +18,14 @@ import qualified Data.Text.IO import qualified Data.Text.Lazy.IO 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.TypeCheck +import qualified Lens.Family as Lens import qualified Prettyprinter import qualified Prettyprinter.Render.Text import qualified System.Timeout @@ -48,6 +50,7 @@ , issue1732 , issue1884 , issue2088 + , issue2463 , parsing0 , typeChecking0 , typeChecking1 @@ -173,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 @@ -230,6 +233,24 @@ -- 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/TH.hs b/tests/Dhall/Test/TH.hs --- a/tests/Dhall/Test/TH.hs +++ b/tests/Dhall/Test/TH.hs @@ -1,16 +1,18 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} module Dhall.Test.TH where -import Control.Exception (throwIO) -import Data.Either.Validation (Validation(..)) -import 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 @@ -26,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 @@ -34,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" @@ -74,6 +80,16 @@ 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 @@ -83,6 +99,7 @@ , SingleConstructor "MyEmployee" "Employee" "./tests/th/Employee.dhall" ] + deriving instance Eq MyT deriving instance Eq MyDepartment deriving instance Eq MyEmployee @@ -90,6 +107,32 @@ 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 }" @@ -111,6 +154,19 @@ 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 @@ -153,3 +209,11 @@ 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/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/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,3 +0,0 @@ - missing - 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,3 +0,0 @@ - missing - 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,3 +0,0 @@ - missing - sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 -? ./True.dhall diff --git a/tests/freeze/secure/True.dhall b/tests/freeze/secure/True.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/True.dhall @@ -0,0 +1,1 @@ +True diff --git a/tests/freeze/secure/cachedA.dhall b/tests/freeze/secure/cachedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/cachedA.dhall @@ -0,0 +1,2 @@ + ./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 +? ./True.dhall diff --git a/tests/freeze/secure/cachedB.dhall b/tests/freeze/secure/cachedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/cachedB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/incorrectHashA.dhall b/tests/freeze/secure/incorrectHashA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/incorrectHashA.dhall @@ -0,0 +1,1 @@ +./True.dhall sha256:0000000000000000000000000000000000000000000000000000000000000000 diff --git a/tests/freeze/secure/incorrectHashB.dhall b/tests/freeze/secure/incorrectHashB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/incorrectHashB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/protectedA.dhall b/tests/freeze/secure/protectedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/protectedA.dhall @@ -0,0 +1,1 @@ +./True.dhall sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/protectedB.dhall b/tests/freeze/secure/protectedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/protectedB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/freeze/secure/unprotectedA.dhall b/tests/freeze/secure/unprotectedA.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/unprotectedA.dhall @@ -0,0 +1,1 @@ +./True.dhall diff --git a/tests/freeze/secure/unprotectedB.dhall b/tests/freeze/secure/unprotectedB.dhall new file mode 100644 --- /dev/null +++ b/tests/freeze/secure/unprotectedB.dhall @@ -0,0 +1,2 @@ +./True.dhall + sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 diff --git a/tests/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,3 +0,0 @@ - missing - sha256:27abdeddfe8503496adeb623466caa47da5f63abd2bc6fa19f6cfcb73ecfed70 -? ./True.dhall diff --git a/tests/lint/success/sortLetsA.dhall b/tests/lint/success/sortLetsA.dhall deleted file mode 100644 --- a/tests/lint/success/sortLetsA.dhall +++ /dev/null @@ -1,11 +0,0 @@ -let a = 1 - -let b = 2 - -let a = https://example.com - -let c = https://example.com - -let d = c - -in [ a@1, a, b, c, d ] diff --git a/tests/lint/success/sortLetsB.dhall b/tests/lint/success/sortLetsB.dhall deleted file mode 100644 --- a/tests/lint/success/sortLetsB.dhall +++ /dev/null @@ -1,11 +0,0 @@ -let c = https://example.com/ - -let a = 1 - -let a = https://example.com/ - -let b = 2 - -let d = c - -in [ a@1, a, b, c, d ] 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/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/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-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,26 @@ +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, 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,31 @@ +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 FileEntry = Entry Text + + let Make = + { directory : DirectoryEntry -> result, file : FileEntry -> result } + + in forall (make : Make) -> List result