diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,46 @@ +1.26.1 + +* TECHNICALLY BREAKING CHANGES: [Simplify `⫽` within projection](https://github.com/dhall-lang/dhall-haskell/pull/1283) / [Simplify nested record projections](https://github.com/dhall-lang/dhall-haskell/pull/1307) + * These are technically breaking changes because you will need to update + integrity checks that protect code simplified in this way + * We're not bumping the major version since the likelihood that you're + affected is quite low +* BUG FIX: [Fix performance regression](https://github.com/dhall-lang/dhall-haskell/pull/1335) + * This change fixes the performance regression introduced in the previous + release (version 1.26.0) +* BUG FIX: [Prevent REPL from inserting inferred `Sort`s into context](https://github.com/dhall-lang/dhall-haskell/pull/1318) + * This protects the REPL from getting hosed if you define an expression + using `:let` that has an inferred type of `Sort` +* NEW FEATURE: Improved `Inject`/`Interpret` support for 1-field constructors - ([#1315](https://github.com/dhall-lang/dhall-haskell/pull/1315) / [#1321](https://github.com/dhall-lang/dhall-haskell/pull/1321)) + * This adds a new `singletonConstructors` field to `InterpretOptions` that + lets you control what Dhall type 1-field Haskell constructors correspond + to + * The default (`Wrapped`) is backwards compatible with the old behavior + * The `Smart` option is probably what you want: it will strip the + Haskell constructor from the Dhall type if the constructor has one + anonymous field + * The `Bare` option always strips 1-field Haskell constructors from the + Dhall type +* NEW FEATURE: `--censor` flag that disables source code display ([#1312](https://github.com/dhall-lang/dhall-haskell/pull/1312) / [#1329](https://github.com/dhall-lang/dhall-haskell/pull/1329)) + * Use this flag when you don't want sensitive `Text` literals showing up in + parsing or type-checking error messages +* [Format record fields more compactly if they fit on 1 line](https://github.com/dhall-lang/dhall-haskell/pull/1314) + * The formatter will now format record fields on a field-by-field basis to + avoid unnecessary vertical sprawl of formatted records + * Specifically, record fields that fit on one line will now be formatted + on one line +* [Add `--quiet` option to `dhall type`](https://github.com/dhall-lang/dhall-haskell/pull/1325) + * This lets you use `dhall type` in "check only" mode (e.g. for CI for + for development feedback) +* Improved GHCJS support - ([#1311](https://github.com/dhall-lang/dhall-haskell/pull/1311) / [#1330](https://github.com/dhall-lang/dhall-haskell/pull/1330)) +* [Fix all executables to accept `--version`](https://github.com/dhall-lang/dhall-haskell/pull/1334) + * Note that the `dhall version` subcommand is still supported, too +* [New `Dhall.Version` module](https://github.com/dhall-lang/dhall-haskell/pull/1332) +* [Don't normalize inferred types](https://github.com/dhall-lang/dhall-haskell/pull/1317) + * This fixes `dhall type` to more accurately follow the standard +* [Initial changes for GHC 8.8 support](https://github.com/dhall-lang/dhall-haskell/pull/1324) +* [Fix Haddock formatting for `dhallFromJSON`](https://github.com/dhall-lang/dhall-haskell/pull/1316) + 1.26.0 * [Supports version 10.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v10.0.0) 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,4 +1,13 @@ -{ keyText = +{ Type = + ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e + ? ./Type +, Tagged = + ./Tagged sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194 + ? ./Tagged +, Nesting = + ./Nesting sha256:6284802edd41d5d725aa1ec7687e614e21ad1be7e14dd10996bfa9625105c335 + ? ./Nesting +, keyText = ./keyText sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc ? ./keyText , keyValue = diff --git a/dhall-lang/Prelude/Location/Type b/dhall-lang/Prelude/Location/Type new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Location/Type @@ -0,0 +1,21 @@ +{- This is the union type returned when you import something `as Location` +-} +let Location + : Type + = < Environment : Text | Local : Text | Missing | Remote : Text > + +let example0 = + assert + : ( missing sha256:f428188ff9d77ea15bc2bcd0da3f8ed81b304e175b07ade42a3b0fb02941b2aa as Location + ? missing as Location + ) + ≡ < Environment : + Text + | Local : + Text + | Missing + | Remote : + Text + >.Missing + +in Location diff --git a/dhall-lang/Prelude/Location/package.dhall b/dhall-lang/Prelude/Location/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Location/package.dhall @@ -0,0 +1,4 @@ +{ Type = + ./Type sha256:613ebb491aeef4ff06368058b4f0e6e3bb8a58d8c145131fc0b947aac045a529 + ? ./Type +} 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,4 +1,10 @@ -{ keys = +{ Type = + ./Type sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed + ? ./Type +, Entry = + ./Entry sha256:f334283bdd9cd88e6ea510ca914bc221fc2dab5fb424d24514b2e0df600d5346 + ? ./Entry +, keys = ./keys sha256:d13ec34e6acf7c349d82272ef09a37c7bdf37f0dab489e9df47a1ff215d9f5e7 ? ./keys , map = 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,15 +1,18 @@ {- `equal` checks if two Naturals are equal. -} +let lessThanEqual = + ./lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual + let equal : Natural → Natural → Bool - = λ(a : Natural) - → λ(b : Natural) - → Natural/isZero (Natural/subtract a b) - && Natural/isZero (Natural/subtract b a) + = λ(a : Natural) → λ(b : Natural) → lessThanEqual a b && lessThanEqual b a let example0 = assert : equal 5 5 ≡ True let example1 = assert : equal 5 6 ≡ False + +let property0 = λ(n : Natural) → assert : equal n n ≡ True in equal diff --git a/dhall-lang/Prelude/Natural/greaterThan b/dhall-lang/Prelude/Natural/greaterThan --- a/dhall-lang/Prelude/Natural/greaterThan +++ b/dhall-lang/Prelude/Natural/greaterThan @@ -1,23 +1,22 @@ {- `greaterThan` checks if one Natural is strictly greater than another. -} - -let Bool/not = - ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 - ? ../Bool/not - -let lessThanEqual = - ./lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 - ? ./lessThanEqual +let lessThan = + ./lessThan sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c + ? ./lessThan let greaterThan : Natural → Natural → Bool - = λ(x : Natural) → λ(y : Natural) → Bool/not (lessThanEqual x y) + = λ(x : Natural) → λ(y : Natural) → lessThan y x let example0 = assert : greaterThan 5 6 ≡ False let example1 = assert : greaterThan 5 5 ≡ False let example2 = assert : greaterThan 5 4 ≡ True + +let property0 = λ(n : Natural) → assert : greaterThan 0 n ≡ False + +let property1 = λ(n : Natural) → assert : greaterThan n n ≡ False in greaterThan diff --git a/dhall-lang/Prelude/Natural/greaterThanEqual b/dhall-lang/Prelude/Natural/greaterThanEqual --- a/dhall-lang/Prelude/Natural/greaterThanEqual +++ b/dhall-lang/Prelude/Natural/greaterThanEqual @@ -1,22 +1,22 @@ {- `greaterThanEqual` checks if one Natural is greater than or equal to another. -} -let Bool/not = - ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 - ? ../Bool/not - -let lessThan = - ./lessThan sha256:d8a37951fd3f88dcc3927c20b73e6c53499f5275d949eed59bb77ea748492bf0 - ? ./lessThan +let lessThanEqual = + ./lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 + ? ./lessThanEqual let greaterThanEqual : Natural → Natural → Bool - = λ(x : Natural) → λ(y : Natural) → Bool/not (lessThan x y) + = λ(x : Natural) → λ(y : Natural) → lessThanEqual y x let example0 = assert : greaterThanEqual 5 6 ≡ False let example1 = assert : greaterThanEqual 5 5 ≡ True -let example1 = assert : greaterThanEqual 5 4 ≡ True +let example2 = assert : greaterThanEqual 5 4 ≡ True + +let property0 = λ(n : Natural) → assert : greaterThanEqual n 0 ≡ True + +let property1 = λ(n : Natural) → assert : greaterThanEqual n n ≡ True in greaterThanEqual diff --git a/dhall-lang/Prelude/Natural/lessThan b/dhall-lang/Prelude/Natural/lessThan --- a/dhall-lang/Prelude/Natural/lessThan +++ b/dhall-lang/Prelude/Natural/lessThan @@ -1,23 +1,26 @@ {- `lessThan` checks if one Natural is strictly less than another. - -Examples: - -``` -``` -} -let lessThanEqual = - ./lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 - ? ./lessThanEqual +let greaterThanEqual = + ./greaterThanEqual sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 + ? ./greaterThanEqual +let Bool/not = + ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 + ? ../Bool/not + let lessThan : Natural → Natural → Bool - = λ(x : Natural) → λ(y : Natural) → lessThanEqual (x + 1) y + = λ(x : Natural) → λ(y : Natural) → Bool/not (greaterThanEqual x y) let example0 = assert : lessThan 5 6 ≡ True let example1 = assert : lessThan 5 5 ≡ False let example2 = assert : lessThan 5 4 ≡ False + +let property0 = λ(n : Natural) → assert : lessThan n 0 ≡ False + +let property1 = λ(n : Natural) → assert : lessThan n n ≡ False in lessThan diff --git a/dhall-lang/Prelude/Natural/lessThanEqual b/dhall-lang/Prelude/Natural/lessThanEqual --- a/dhall-lang/Prelude/Natural/lessThanEqual +++ b/dhall-lang/Prelude/Natural/lessThanEqual @@ -1,4 +1,3 @@ - {- `lessThanEqual` checks if one Natural is less than or equal to another. -} @@ -11,5 +10,9 @@ let example1 = assert : lessThanEqual 5 5 ≡ True let example2 = assert : lessThanEqual 5 4 ≡ False + +let property0 = λ(n : Natural) → assert : lessThanEqual 0 n ≡ True + +let property1 = λ(n : Natural) → assert : lessThanEqual n n ≡ True in lessThanEqual diff --git a/dhall-lang/Prelude/Natural/package.dhall b/dhall-lang/Prelude/Natural/package.dhall --- a/dhall-lang/Prelude/Natural/package.dhall +++ b/dhall-lang/Prelude/Natural/package.dhall @@ -32,18 +32,21 @@ ./toInteger sha256:160d2d278619f3da34a1f4f02e739a447e4f2aa5a2978c45b710515b41491e1f ? ./toInteger , lessThan = - ./lessThan sha256:d8a37951fd3f88dcc3927c20b73e6c53499f5275d949eed59bb77ea748492bf0 + ./lessThan sha256:3381b66749290769badf8855d8a3f4af62e8de52d1364d838a9d1e20c94fa70c ? ./lessThan , lessThanEqual = ./lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99 ? ./lessThanEqual , equal = - ./equal sha256:9e0e952e097a2a974ca4ed3e65bcf395cda2bb54382c8ecc3963bca50bfff124 + ./equal sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60 ? ./equal , greaterThanEqual = - ./greaterThanEqual sha256:8665ab478524416ecca7573488eb9b64c12a39f1ea86353b67735cf4d3a3bc4f + ./greaterThanEqual sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4 ? ./greaterThanEqual , greaterThan = ./greaterThan sha256:f702abcdfcd7ad73619b9285d7e41c3a1d017fb6b8d037cf40bd93bf30c09b2c ? ./greaterThan +, subtract = + ./subtract sha256:b9277ac637d09142a3a3ac79137ef5955c42f8b33b6746d59db2c9d75ccdd745 + ? ./subtract } diff --git a/dhall-lang/Prelude/Natural/subtract b/dhall-lang/Prelude/Natural/subtract new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Natural/subtract @@ -0,0 +1,18 @@ +{- +`subtract m n` computes `n - m`, truncating to `0` if `m > n` +-} +let subtract : Natural → Natural → Natural = Natural/subtract + +let example0 = assert : subtract 1 2 ≡ 1 + +let example1 = assert : subtract 1 1 ≡ 0 + +let example2 = assert : subtract 2 1 ≡ 0 + +let property0 = λ(n : Natural) → assert : subtract 0 n ≡ n + +let property1 = λ(n : Natural) → assert : subtract n 0 ≡ 0 + +let property2 = λ(n : Natural) → assert : subtract n n ≡ 0 + +in subtract diff --git a/dhall-lang/Prelude/Text/default b/dhall-lang/Prelude/Text/default new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/default @@ -0,0 +1,12 @@ +{- +Unwrap an `Optional` `Text` value, defaulting `None` to `""` +-} +let default + : Optional Text → Text + = λ(o : Optional Text) → Optional/fold Text o Text (λ(t : Text) → t) "" + +let example0 = assert : default (Some "ABC") ≡ "ABC" + +let example1 = assert : default (None Text) ≡ "" + +in default diff --git a/dhall-lang/Prelude/Text/defaultMap b/dhall-lang/Prelude/Text/defaultMap new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Text/defaultMap @@ -0,0 +1,15 @@ +{- +Transform the value in an `Optional` into `Text`, defaulting `None` to `""` +-} +let defaultMap + : ∀(a : Type) → (a → Text) → Optional a → Text + = λ(a : Type) + → λ(f : a → Text) + → λ(o : Optional a) + → Optional/fold a o Text f "" + +let example0 = assert : defaultMap Natural Natural/show (Some 0) ≡ "0" + +let example1 = assert : defaultMap Natural Natural/show (None Natural) ≡ "" + +in defaultMap diff --git a/dhall-lang/Prelude/Text/package.dhall b/dhall-lang/Prelude/Text/package.dhall --- a/dhall-lang/Prelude/Text/package.dhall +++ b/dhall-lang/Prelude/Text/package.dhall @@ -10,6 +10,12 @@ , concatSep = ./concatSep sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58 ? ./concatSep +, default = + ./default sha256:e26d120fe57a4b61259d1149d938a66d335e1eb263196c30311c117073e4f92f + ? ./default +, defaultMap = + ./defaultMap sha256:a35c0e1db25e9223223b0beba0fcefeba7cd06a0edfa3994ccc9f82f6b86ff79 + ? ./defaultMap , show = ./show sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784 ? ./show 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,7 @@ {- Builds a key-value record with a Text key and value. -} -λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } +let attribute + : Text → Text → { mapKey : Text, mapValue : Text } + = λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value } + +in attribute diff --git a/dhall-lang/Prelude/XML/package.dhall b/dhall-lang/Prelude/XML/package.dhall --- a/dhall-lang/Prelude/XML/package.dhall +++ b/dhall-lang/Prelude/XML/package.dhall @@ -1,4 +1,7 @@ -{ attribute = +{ Type = + ./Type sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c + ? ./Type +, attribute = ./attribute sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc ? ./attribute , render = 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 @@ -13,22 +13,28 @@ , List = ./List/package.dhall sha256:108be3af5ebd465f7091039f2216c433e65ae5d25556a9a71786dd84d33ef49a ? ./List/package.dhall +, Location = + ./Location/package.dhall sha256:0eb4e4a60814018009c720f6820aaa13cf9491eb1b09afb7b832039c6ee4d470 + ? ./Location/package.dhall , Map = - ./Map/package.dhall sha256:07cc274220c8bdb2c1a0c2d00d90bc1447e73e0ad2e1d72b89773e923f77e71e + ./Map/package.dhall sha256:5e378b6da12f26b64f796f9c1b61d89bcc5a591f3a3dedcf85cb4637bbb8b618 ? ./Map/package.dhall +, Monoid = + ./Monoid sha256:26fafa098600ef7a54ef9dba5ada416bbbdd21df1af306c052420c61553ad4af + ? ./Monoid , Natural = - ./Natural/package.dhall sha256:8421079b9698b765774455b63f4561f7bfa1506ed3fa39cfb5c34a4cd1c9df4b + ./Natural/package.dhall sha256:4574df29e6bb82fd894c311f6c2ad9a22574756eb62f06d475aa8306d25006fc ? ./Natural/package.dhall , Optional = ./Optional/package.dhall sha256:36a366af67a3c26cd5d196e095d3023f18953c5b5db3a03956fa554609e5442a ? ./Optional/package.dhall , JSON = - ./JSON/package.dhall sha256:34a613c89df3f314c606a813f592d1a09fedb3e5f5e63fcc0ae9c88245e8bdad + ./JSON/package.dhall sha256:0c3c40a63108f2e6ad59f23b789c18eb484d0e9aebc9416c5a4f338c6753084b ? ./JSON/package.dhall , Text = - ./Text/package.dhall sha256:3b6ed813caf2388b91056d625c6b958b72009f85a6af262d4a7b935b18caf62b + ./Text/package.dhall sha256:0a0ad9f649aed94c2680491efb384925b5b2bb5b353f1b8a7eb134955c1ffe45 ? ./Text/package.dhall , XML = - ./XML/package.dhall sha256:6aed7e845c29bc528ced19b99f860c5bcd50f24a1394631fe66f751999f85361 + ./XML/package.dhall sha256:137e7b106b2e9743970e5d37b21a165f2e40f56ab593a4dd10605c9acd686fc6 ? ./XML/package.dhall } diff --git a/dhall-lang/tests/normalization/success/simplifications/issue661A.dhall b/dhall-lang/tests/normalization/success/simplifications/issue661A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/issue661A.dhall @@ -0,0 +1,17 @@ +let T1 = { a : Natural } +let T2 = { a : Natural, b : Text } +let T3 = { z : List { a : Natural, b : Text } } +let T4 = { z : List { b : Text, c : List Natural } } + +let Prelude/List/map = ../../../../Prelude/List/map + +let f = λ(old : T1) → old ⫽ { b = "Hello" } +let g = λ(old : T2) → { z = [ old, old.{ a } ⫽ { b = "Bye" } ] : List T2 } +let h_ = λ(old : T2) → old.{ b } ⫽ { c = [ old.a ] : List Natural } +let h = + λ(old : T3) + → { z = Prelude/List/map T2 { b : Text, c : List Natural } h_ old.z } + +let k = λ(old : T1) → h (g (f old)) + +in k diff --git a/dhall-lang/tests/normalization/success/simplifications/issue661B.dhall b/dhall-lang/tests/normalization/success/simplifications/issue661B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/simplifications/issue661B.dhall @@ -0,0 +1,2 @@ + λ(old : { a : Natural }) +→ { z = [ { b = "Hello", c = [ old.a ] }, { b = "Bye", c = [ old.a ] } ] } diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionA.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionA.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a, b }.{ a } diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionB.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a } diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeA.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeA.dhall @@ -0,0 +1,2 @@ + λ(x : { a : Bool, b : Bool, c : Bool }) +→ x.({ a : Bool, b : Bool }).({ a : Bool }) diff --git a/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeB.dhall b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/NestedRecordProjectionByTypeB.dhall @@ -0,0 +1,1 @@ +λ(x : { a : Bool, b : Bool, c : Bool }) → x.{ a } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall @@ -0,0 +1,1 @@ +(x ⫽ { a = v, b = w }).{ a, c } diff --git a/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall @@ -0,0 +1,1 @@ +x.{ c } ⫽ { a = v } diff --git a/dhall-lang/tests/type-inference/data/importBoundary.dhall b/dhall-lang/tests/type-inference/data/importBoundary.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/data/importBoundary.dhall @@ -0,0 +1,3 @@ +-- This file contains a free variable. This should be a type error, even if the variable +-- is in scope in the importing expression +x diff --git a/dhall-lang/tests/type-inference/failure/customHeadersUsingBoundVariable.dhall b/dhall-lang/tests/type-inference/failure/customHeadersUsingBoundVariable.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/customHeadersUsingBoundVariable.dhall @@ -0,0 +1,15 @@ +{- This is a type error because the custom headers are type-checked with an + empty context. This is necessary because: + + * import resolution precedes β-normalization + * we also don't want custom headers to leak program state anyway + + This should fail due to the `x` within the custom header being an unbound + variable +-} + +let x = "Bar" + +in https://httpbin.org/headers + using [ { mapKey = "Foo", mapValue = x } ] + as Text diff --git a/dhall-lang/tests/type-inference/failure/hurkensParadox.dhall b/dhall-lang/tests/type-inference/failure/hurkensParadox.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/hurkensParadox.dhall @@ -0,0 +1,49 @@ + let bottom : Type = ∀(any : Type) → any + +in let not : Type → Type = λ(p : Type) → p → bottom + +in let pow = λ(X : Kind) → X → Type + +in let U = ∀(X : Kind) → (pow (pow X) → X) → pow (pow X) + +in let tau + : pow (pow U) → U + = λ(t : pow (pow U)) + → λ(X : Kind) + → λ(f : pow (pow X) → X) + → λ(p : pow X) + → t (λ(x : U) → p (f (x X f))) + +in let sigma : U → pow (pow U) = λ(s : U) → s U (λ(t : pow (pow U)) → tau t) + +in let Delta + : pow U + = λ(y : U) → not (∀(p : pow U) → sigma y p → p (tau (sigma y))) + +in let Omega : U = tau (λ(p : pow U) → ∀(x : U) → sigma x p → p x) + +in let Theta : Type = ∀(p : pow U) → (∀(x : U) → sigma x p → p x) → p Omega + +in let D : Type = ∀(p : pow U) → sigma Omega p → p (tau (sigma Omega)) + +in let lem1 + : ∀(p : pow U) → (∀(x : U) → sigma x p → p x) → p Omega + = λ(p : pow U) + → λ(t1 : ∀(x : U) → sigma x p → p x) + → t1 Omega (λ(x : U) → t1 (tau (sigma x))) + +in let lem3 : D = λ(p : pow U) → lem1 (λ(y : U) → p (tau (sigma y))) + +in let lem2 + : not D + = lem1 + Delta + ( λ(x : U) + → λ(H2 : sigma x Delta) + → λ(H3 : ∀(p : pow U) → sigma x p → p (tau (sigma x))) + → H3 Delta H2 (λ(pp : pow U) → H3 (λ(y : U) → pp (tau (sigma y)))) + ) + +in let evidence : bottom = lem2 lem3 + +in evidence diff --git a/dhall-lang/tests/type-inference/failure/importBoundary.dhall b/dhall-lang/tests/type-inference/failure/importBoundary.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/importBoundary.dhall @@ -0,0 +1,1 @@ +\(x: Bool) -> ../data/importBoundary.dhall diff --git a/dhall-lang/tests/type-inference/failure/mixedUnions.dhall b/dhall-lang/tests/type-inference/failure/mixedUnions.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/mixedUnions.dhall @@ -0,0 +1,1 @@ +< Left : Natural | Right : Type > diff --git a/dhall-lang/tests/type-inference/failure/recordOfKind.dhall b/dhall-lang/tests/type-inference/failure/recordOfKind.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/failure/recordOfKind.dhall @@ -0,0 +1,1 @@ +{ a = Kind } diff --git a/dhall-lang/tests/type-inference/success/RecordTypeMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/RecordTypeMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/RecordTypeMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x : Bool, y : Type } diff --git a/dhall-lang/tests/type-inference/success/RecordTypeMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/RecordTypeMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/RecordTypeMixedKindsB.dhall @@ -0,0 +1,1 @@ +Kind diff --git a/dhall-lang/tests/type-inference/success/accessEncodedTypeA.dhall b/dhall-lang/tests/type-inference/success/accessEncodedTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessEncodedTypeA.dhall @@ -0,0 +1,4 @@ + λ ( record + : ∀(k : Kind) → ∀(makeRecord : ∀(x : Type) → ∀(y : Type → Type) → k) → k + ) +→ record Type (λ(x : Type) → λ(y : Type → Type) → x) diff --git a/dhall-lang/tests/type-inference/success/accessEncodedTypeB.dhall b/dhall-lang/tests/type-inference/success/accessEncodedTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessEncodedTypeB.dhall @@ -0,0 +1,4 @@ + ∀ ( record + : ∀(k : Kind) → ∀(makeRecord : ∀(x : Type) → ∀(y : Type → Type) → k) → k + ) +→ Type diff --git a/dhall-lang/tests/type-inference/success/accessTypeA.dhall b/dhall-lang/tests/type-inference/success/accessTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessTypeA.dhall @@ -0,0 +1,1 @@ +λ(record : { x : Type, y : Type → Type }) → record.x diff --git a/dhall-lang/tests/type-inference/success/accessTypeB.dhall b/dhall-lang/tests/type-inference/success/accessTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/accessTypeB.dhall @@ -0,0 +1,1 @@ +∀(record : { x : Type, y : Type → Type }) → Type diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsA.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsA.dhall @@ -0,0 +1,1 @@ +{ foo = 1 } ⫽ { bar = Text } diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsB.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsB.dhall @@ -0,0 +1,1 @@ +{ bar : Type, foo : Natural } diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldA.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldA.dhall @@ -0,0 +1,1 @@ +{ a = 0 } ⫽ { a = Bool } diff --git a/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldB.dhall b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preferMixedRecordsSameFieldB.dhall @@ -0,0 +1,1 @@ +{ a : Type } diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/and [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/and ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/and/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/and/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0A.dhall @@ -0,0 +1,2 @@ +../../../../../../Prelude/Bool/build +(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1A.dhall @@ -0,0 +1,2 @@ +../../../../../../Prelude/Bool/build +(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/build/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even [ False, True, False ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even [ False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even [ False ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/2B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/even ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/even/3B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/even/3B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/fold True Natural 0 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/fold False Natural 0 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/fold/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/not True diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/not False diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/not/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/not/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd [ True, False ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd [ True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/2B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/odd ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/odd/3B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/or [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/or ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/or/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/or/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/show True diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Bool/show False diff --git a/dhall-lang/tests/type-inference/success/prelude/Bool/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Bool/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Double/show -3.1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Double/show 0.4 diff --git a/dhall-lang/tests/type-inference/success/prelude/Double/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Double/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Double/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/show -3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/show +0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/toDouble -3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/0B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Integer/toDouble +2 diff --git a/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/1B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/all Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/all Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/all/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/all/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/all/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/any Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/any Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/any/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/any/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/any/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/build +Text +( λ(list : Type) +→ λ(cons : Text → list → list) +→ λ(nil : list) +→ cons "ABC" (cons "DEF" nil) +) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/0B.dhall @@ -0,0 +1,1 @@ +List Text diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/1A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/build +Text +( λ(list : Type) +→ λ(cons : Text → list → list) +→ λ(nil : list) +→ nil +) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/build/1B.dhall @@ -0,0 +1,1 @@ +List Text diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/0A.dhall @@ -0,0 +1,5 @@ +../../../../../../Prelude/List/concat Natural +[ [ 0, 1, 2 ] +, [ 3, 4 ] +, [ 5, 6, 7, 8 ] +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/1A.dhall @@ -0,0 +1,5 @@ +../../../../../../Prelude/List/concat Natural +[ [] : List Natural +, [] : List Natural +, [] : List Natural +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concat/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concat/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concat/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/concatMap/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/filter Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/filter Natural Natural/odd [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/filter/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/filter/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/filter/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/0A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/List/fold +Natural +[ 2, 3, 5 ] +Natural +(λ(x : Natural) → λ(y : Natural) → x + y) +0 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/1A.dhall @@ -0,0 +1,7 @@ + λ(nil : Natural) +→ ../../../../../../Prelude/List/fold + Natural + [ 2, 3, 5 ] + Natural + (λ(x : Natural) → λ(y : Natural) → x + y) + nil diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/1B.dhall @@ -0,0 +1,1 @@ +∀(nil : Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/2A.dhall @@ -0,0 +1,4 @@ + λ(list : Type) +→ λ(cons : Natural → list → list) +→ λ(nil : list) +→ ../../../../../../Prelude/List/fold Natural [ 2, 3, 5 ] list cons nil diff --git a/dhall-lang/tests/type-inference/success/prelude/List/fold/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/fold/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/fold/2B.dhall @@ -0,0 +1,1 @@ +∀(list : Type) → ∀(cons : Natural → list → list) → ∀(nil : list) → list diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/generate 5 Bool Natural/even diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/0B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/generate 0 Bool Natural/even diff --git a/dhall-lang/tests/type-inference/success/prelude/List/generate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/generate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/generate/1B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/head Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/head Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/head/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/head/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/head/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/indexed Bool [ True, False, True ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/0B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/indexed Bool ([] : List Bool) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/indexed/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/indexed/1B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/iterate 10 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/iterate 0 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/iterate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/iterate/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/last Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/last Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/last/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/last/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/last/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/length Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/length Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/length/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/length/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/length/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/map Natural Bool Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/0B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/map Natural Bool Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/map/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/map/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/map/1B.dhall @@ -0,0 +1,1 @@ +List Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/null Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/null Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/null/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/null/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/null/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/replicate 9 Natural 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/replicate 0 Natural 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/List/replicate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/replicate/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/reverse Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/reverse Natural ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/reverse/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/reverse/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0A.dhall @@ -0,0 +1,15 @@ +../../../../../../Prelude/List/shifted +Bool +[ [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = False } + ] +, [ { index = 0, value = False } + , { index = 1, value = False } + ] +, [ { index = 0, value = True } + , { index = 1, value = True } + , { index = 2, value = True } + , { index = 3, value = True } + ] +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/0B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/shifted Bool ([] : List (List { index : Natural, value : Bool })) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/shifted/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/shifted/1B.dhall @@ -0,0 +1,1 @@ +List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/List/unzip +Text +Bool +[ { _1 = "ABC", _2 = True } +, { _1 = "DEF", _2 = False } +, { _1 = "GHI", _2 = True } +] diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/0B.dhall @@ -0,0 +1,1 @@ +{ _1 : List Text, _2 : List Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/List/unzip Text Bool ([] : List { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/type-inference/success/prelude/List/unzip/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/List/unzip/1B.dhall @@ -0,0 +1,1 @@ +{ _1 : List Text, _2 : List Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/00A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/00A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/00A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/and diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/00B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/00B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/00B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/01A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/01A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/01A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/or diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/01B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/01B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/01B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/02A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/02A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/02A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/even diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/02B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/02B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/02B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/03A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/03A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/03A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Bool/odd diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/03B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/03B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/03B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Bool) → Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/04A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/04A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/04A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/List/concat diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/04B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/04B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/04B.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(xss : List (List a)) → List a diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/05A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/05A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/05A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/List/shifted diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/05B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/05B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/05B.dhall @@ -0,0 +1,3 @@ + ∀(a : Type) +→ ∀(kvss : List (List { index : Natural, value : a })) +→ List { index : Natural, value : a } diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/06A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/06A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/06A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Natural/sum diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/06B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/06B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/06B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/07A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/07A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/07A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Natural/product diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/07B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/07B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/07B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/08A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/08A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/08A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Optional/head diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/08B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/08B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/08B.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(xs : List (Optional a)) → Optional a diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/09A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/09A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/09A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Optional/last diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/09B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/09B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/09B.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(xs : List (Optional a)) → Optional a diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/10A.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/10A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/10A.dhall @@ -0,0 +1,1 @@ +../../../../../Prelude/Text/concat diff --git a/dhall-lang/tests/type-inference/success/prelude/Monoid/10B.dhall b/dhall-lang/tests/type-inference/success/prelude/Monoid/10B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Monoid/10B.dhall @@ -0,0 +1,1 @@ +∀(xs : List Text) → Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/Natural/build +( λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ succ (succ (succ zero)) +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1A.dhall @@ -0,0 +1,6 @@ +../../../../../../Prelude/Natural/build +( λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ zero +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/build/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/enumerate 10 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/enumerate 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/even 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/even 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/even/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/even/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) 1 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1A.dhall @@ -0,0 +1,1 @@ +λ(zero : Natural) → ../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) zero diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/1B.dhall @@ -0,0 +1,1 @@ +∀(zero : Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2A.dhall @@ -0,0 +1,4 @@ + λ(natural : Type) +→ λ(succ : natural → natural) +→ λ(zero : natural) +→ ../../../../../../Prelude/Natural/fold 3 natural succ zero diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/fold/2B.dhall @@ -0,0 +1,1 @@ +∀(natural : Type) → ∀(succ : natural → natural) → ∀(zero : natural) → natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/isZero 2 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/isZero 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/isZero/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/odd 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/odd 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/odd/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/product [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/product ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/product/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/product/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/show 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/show 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/show/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/show/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/sum [ 2, 3, 5 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/sum ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/sum/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toDouble 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/0B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toDouble 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/1B.dhall @@ -0,0 +1,1 @@ +Double diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toInteger 3 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/0B.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Natural/toInteger 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/1B.dhall @@ -0,0 +1,1 @@ +Integer diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/all Natural Natural/even (Some 3) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/all Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/all/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/all/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/any Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/any Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/any/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/any/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/Optional/build +Natural +( λ(optional : Type) +→ λ(some : Natural → optional) +→ λ(none : optional) +→ some 1 +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1A.dhall @@ -0,0 +1,7 @@ +../../../../../../Prelude/Optional/build +Natural +( λ(optional : Type) +→ λ(some : Natural → optional) +→ λ(none : optional) +→ none +) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/build/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/build/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat Natural (Some (Some 1)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat Natural (Some (None Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/concat Natural (None (Optional Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/concat/2B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/filter Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/filter Natural Natural/odd (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/filter/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/fold Natural (Some 2) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/fold Natural (None Natural) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/fold/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/head Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/head/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/head/2B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/0B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/1B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/last Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/last/2B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/last/2B.dhall @@ -0,0 +1,1 @@ +Optional Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/length Natural (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/0B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/length Natural (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/length/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/length/1B.dhall @@ -0,0 +1,1 @@ +Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/map Natural Bool Natural/even (Some 3) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/0B.dhall @@ -0,0 +1,1 @@ +Optional Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/map Natural Bool Natural/even (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/map/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/map/1B.dhall @@ -0,0 +1,1 @@ +Optional Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/null Natural (Some 2) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/0B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/null Natural (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/null/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/null/1B.dhall @@ -0,0 +1,1 @@ +Bool diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/toList Natural (Some 1) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/0B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/toList Natural (None Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/toList/1B.dhall @@ -0,0 +1,1 @@ +List Natural diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/unzip Text Bool (Some { _1 = "ABC", _2 = True }) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/0B.dhall @@ -0,0 +1,1 @@ +{ _1 : Optional Text, _2 : Optional Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Optional/unzip Text Bool (None { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Optional/unzip/1B.dhall @@ -0,0 +1,1 @@ +{ _1 : Optional Text, _2 : Optional Bool } diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concat [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concat ([] : List Text) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concat/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concat/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMap/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show [ 0, 1, 2 ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show ([] : List Natural) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatSep ", " [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/0B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1A.dhall @@ -0,0 +1,1 @@ +../../../../../../Prelude/Text/concatSep ", " ([] : List Text) diff --git a/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1B.dhall b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/prelude/Text/concatSep/1B.dhall @@ -0,0 +1,1 @@ +Text diff --git a/dhall-lang/tests/type-inference/success/preludeA.dhall b/dhall-lang/tests/type-inference/success/preludeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preludeA.dhall @@ -0,0 +1,1 @@ +../../../Prelude/package.dhall diff --git a/dhall-lang/tests/type-inference/success/preludeB.dhall b/dhall-lang/tests/type-inference/success/preludeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/preludeB.dhall @@ -0,0 +1,528 @@ +{ Bool : + { and : + ∀(xs : List Bool) → Bool + , build : + ∀(f : ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) → Bool + , even : + ∀(xs : List Bool) → Bool + , fold : + ∀(b : Bool) → ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool + , not : + ∀(b : Bool) → Bool + , odd : + ∀(xs : List Bool) → Bool + , or : + ∀(xs : List Bool) → Bool + , show : + ∀(b : Bool) → Text + } +, Double : + { show : Double → Text } +, Function : + { compose : + ∀(A : Type) + → ∀(B : Type) + → ∀(C : Type) + → ∀(f : A → B) + → ∀(g : B → C) + → ∀(x : A) + → C + } +, Integer : + { show : Integer → Text, toDouble : Integer → Double } +, JSON : + { Nesting : + Type + , Tagged : + ∀(a : Type) → Type + , Type : + Type + , array : + ∀ ( x + : List + ( ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + ) + ) + → ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + , bool : + ∀(x : Bool) + → ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + , keyText : + ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } + , keyValue : + ∀(v : Type) + → ∀(key : Text) + → ∀(value : v) + → { mapKey : Text, mapValue : v } + , null : + ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + , number : + ∀(x : Double) + → ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + , object : + ∀ ( x + : List + { mapKey : + Text + , mapValue : + ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + } + ) + → ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + , render : + ∀ ( j + : ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + ) + → Text + , string : + ∀(x : Text) + → ∀(JSON : Type) + → ∀ ( json + : { array : + List JSON → JSON + , bool : + Bool → JSON + , null : + JSON + , number : + Double → JSON + , object : + List { mapKey : Text, mapValue : JSON } → JSON + , string : + Text → JSON + } + ) + → JSON + } +, List : + { all : + ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → Bool + , any : + ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → Bool + , build : + ∀(a : Type) + → (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) + → List a + , concat : + ∀(a : Type) → ∀(xss : List (List a)) → List a + , concatMap : + ∀(a : Type) → ∀(b : Type) → ∀(f : a → List b) → ∀(xs : List a) → List b + , filter : + ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → List a + , fold : + ∀(a : Type) + → List a + → ∀(list : Type) + → ∀(cons : a → list → list) + → ∀(nil : list) + → list + , generate : + ∀(n : Natural) → ∀(a : Type) → ∀(f : Natural → a) → List a + , head : + ∀(a : Type) → List a → Optional a + , indexed : + ∀(a : Type) → List a → List { index : Natural, value : a } + , iterate : + ∀(n : Natural) → ∀(a : Type) → ∀(f : a → a) → ∀(x : a) → List a + , last : + ∀(a : Type) → List a → Optional a + , length : + ∀(a : Type) → List a → Natural + , map : + ∀(a : Type) → ∀(b : Type) → ∀(f : a → b) → ∀(xs : List a) → List b + , null : + ∀(a : Type) → ∀(xs : List a) → Bool + , replicate : + ∀(n : Natural) → ∀(a : Type) → ∀(x : a) → List a + , reverse : + ∀(a : Type) → List a → List a + , shifted : + ∀(a : Type) + → ∀(kvss : List (List { index : Natural, value : a })) + → List { index : Natural, value : a } + , unzip : + ∀(a : Type) + → ∀(b : Type) + → ∀(xs : List { _1 : a, _2 : b }) + → { _1 : List a, _2 : List b } + } +, Location : + { Type : Type } +, Map : + { Entry : + ∀(k : Type) → ∀(v : Type) → Type + , Type : + ∀(k : Type) → ∀(v : Type) → Type + , keys : + ∀(k : Type) + → ∀(v : Type) + → ∀(xs : List { mapKey : k, mapValue : v }) + → List k + , map : + ∀(k : Type) + → ∀(a : Type) + → ∀(b : Type) + → ∀(f : a → b) + → ∀(m : List { mapKey : k, mapValue : a }) + → List { mapKey : k, mapValue : b } + , values : + ∀(k : Type) + → ∀(v : Type) + → ∀(xs : List { mapKey : k, mapValue : v }) + → List v + } +, Monoid : + ∀(m : Type) → Type +, Natural : + { build : + ( ∀(natural : Type) + → ∀(succ : natural → natural) + → ∀(zero : natural) + → natural + ) + → Natural + , enumerate : + ∀(n : Natural) → List Natural + , equal : + ∀(a : Natural) → ∀(b : Natural) → Bool + , even : + Natural → Bool + , fold : + Natural + → ∀(natural : Type) + → ∀(succ : natural → natural) + → ∀(zero : natural) + → natural + , greaterThan : + ∀(x : Natural) → ∀(y : Natural) → Bool + , greaterThanEqual : + ∀(x : Natural) → ∀(y : Natural) → Bool + , isZero : + Natural → Bool + , lessThan : + ∀(x : Natural) → ∀(y : Natural) → Bool + , lessThanEqual : + ∀(x : Natural) → ∀(y : Natural) → Bool + , odd : + Natural → Bool + , product : + ∀(xs : List Natural) → Natural + , show : + Natural → Text + , subtract : + Natural → Natural → Natural + , sum : + ∀(xs : List Natural) → Natural + , toDouble : + ∀(n : Natural) → Double + , toInteger : + Natural → Integer + } +, Optional : + { all : + ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool + , any : + ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool + , build : + ∀(a : Type) + → ( ∀(optional : Type) + → ∀(just : a → optional) + → ∀(nothing : optional) + → optional + ) + → Optional a + , concat : + ∀(a : Type) → ∀(x : Optional (Optional a)) → Optional a + , filter : + ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Optional a + , fold : + ∀(a : Type) + → Optional a + → ∀(optional : Type) + → ∀(just : a → optional) + → ∀(nothing : optional) + → optional + , head : + ∀(a : Type) → ∀(xs : List (Optional a)) → Optional a + , last : + ∀(a : Type) → ∀(xs : List (Optional a)) → Optional a + , length : + ∀(a : Type) → ∀(xs : Optional a) → Natural + , map : + ∀(a : Type) + → ∀(b : Type) + → ∀(f : a → b) + → ∀(o : Optional a) + → Optional b + , null : + ∀(a : Type) → ∀(xs : Optional a) → Bool + , toList : + ∀(a : Type) → ∀(o : Optional a) → List a + , unzip : + ∀(a : Type) + → ∀(b : Type) + → ∀(xs : Optional { _1 : a, _2 : b }) + → { _1 : Optional a, _2 : Optional b } + } +, Text : + { concat : + ∀(xs : List Text) → Text + , concatMap : + ∀(a : Type) → ∀(f : a → Text) → ∀(xs : List a) → Text + , concatMapSep : + ∀(separator : Text) + → ∀(a : Type) + → ∀(f : a → Text) + → ∀(elements : List a) + → Text + , concatSep : + ∀(separator : Text) → ∀(elements : List Text) → Text + , default : + ∀(o : Optional Text) → Text + , defaultMap : + ∀(a : Type) → ∀(f : a → Text) → ∀(o : Optional a) → Text + , show : + Text → Text + } +, XML : + { Type : + Type + , attribute : + ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } + , element : + ∀ ( elem + : { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List + ( ∀(XML : Type) + → ∀ ( xml + : { element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + , text : + Text → XML + } + ) + → XML + ) + , name : + Text + } + ) + → ∀(XML : Type) + → ∀ ( xml + : { element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + , text : + Text → XML + } + ) + → XML + , emptyAttributes : + List { mapKey : Text, mapValue : Text } + , leaf : + ∀ ( elem + : { attributes : + List { mapKey : Text, mapValue : Text } + , name : + Text + } + ) + → ∀(XML : Type) + → ∀ ( xml + : { element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + , text : + Text → XML + } + ) + → XML + , render : + ∀ ( x + : ∀(XML : Type) + → ∀ ( xml + : { element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + , text : + Text → XML + } + ) + → XML + ) + → Text + , text : + ∀(d : Text) + → ∀(XML : Type) + → ∀ ( xml + : { element : + { attributes : + List { mapKey : Text, mapValue : Text } + , content : + List XML + , name : + Text + } + → XML + , text : + Text → XML + } + ) + → XML + } +} diff --git a/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesA.dhall b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesA.dhall @@ -0,0 +1,5 @@ +let types = { Scopes = < Public | Private > } + +let prelude = { types = types } + +in prelude.types.Scopes.Public diff --git a/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesB.dhall b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfRecordOfTypesB.dhall @@ -0,0 +1,1 @@ +< Private | Public > diff --git a/dhall-lang/tests/type-inference/success/recordOfTypesA.dhall b/dhall-lang/tests/type-inference/success/recordOfTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfTypesA.dhall @@ -0,0 +1,1 @@ +{ x = Text, y = List } diff --git a/dhall-lang/tests/type-inference/success/recordOfTypesB.dhall b/dhall-lang/tests/type-inference/success/recordOfTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/recordOfTypesB.dhall @@ -0,0 +1,1 @@ +{ x : Type, y : Type → Type } diff --git a/dhall-lang/tests/type-inference/success/simple/RecordMixedKinds2A.dhall b/dhall-lang/tests/type-inference/success/simple/RecordMixedKinds2A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RecordMixedKinds2A.dhall @@ -0,0 +1,1 @@ +{ x = Type, y = {} } diff --git a/dhall-lang/tests/type-inference/success/simple/RecordMixedKinds2B.dhall b/dhall-lang/tests/type-inference/success/simple/RecordMixedKinds2B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RecordMixedKinds2B.dhall @@ -0,0 +1,1 @@ +{ x : Kind, y : Type } diff --git a/dhall-lang/tests/type-inference/success/simple/RecordMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/simple/RecordMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RecordMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x = {=}, y = Bool } diff --git a/dhall-lang/tests/type-inference/success/simple/RecordMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/simple/RecordMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RecordMixedKindsB.dhall @@ -0,0 +1,1 @@ +{ x : {}, y : Type } diff --git a/dhall-lang/tests/type-inference/success/simple/RecursiveRecordMergeMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/simple/RecursiveRecordMergeMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RecursiveRecordMergeMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x = True } ∧ { y = Bool } diff --git a/dhall-lang/tests/type-inference/success/simple/RecursiveRecordMergeMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/simple/RecursiveRecordMergeMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RecursiveRecordMergeMixedKindsB.dhall @@ -0,0 +1,1 @@ +{ x : Bool, y : Type } diff --git a/dhall-lang/tests/type-inference/success/simple/RightBiasedRecordMergeMixedKindsA.dhall b/dhall-lang/tests/type-inference/success/simple/RightBiasedRecordMergeMixedKindsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RightBiasedRecordMergeMixedKindsA.dhall @@ -0,0 +1,1 @@ +{ x = {=} } ⫽ { x = Bool } diff --git a/dhall-lang/tests/type-inference/success/simple/RightBiasedRecordMergeMixedKindsB.dhall b/dhall-lang/tests/type-inference/success/simple/RightBiasedRecordMergeMixedKindsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/RightBiasedRecordMergeMixedKindsB.dhall @@ -0,0 +1,1 @@ +{ x : Type } diff --git a/dhall-lang/tests/type-inference/success/simple/access/0A.dhall b/dhall-lang/tests/type-inference/success/simple/access/0A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/0A.dhall @@ -0,0 +1,1 @@ +{ x = Text }.x diff --git a/dhall-lang/tests/type-inference/success/simple/access/0B.dhall b/dhall-lang/tests/type-inference/success/simple/access/0B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/0B.dhall @@ -0,0 +1,1 @@ +Type diff --git a/dhall-lang/tests/type-inference/success/simple/access/1A.dhall b/dhall-lang/tests/type-inference/success/simple/access/1A.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/1A.dhall @@ -0,0 +1,1 @@ +< Foo : Text | Bar : Natural >.Foo diff --git a/dhall-lang/tests/type-inference/success/simple/access/1B.dhall b/dhall-lang/tests/type-inference/success/simple/access/1B.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/access/1B.dhall @@ -0,0 +1,1 @@ +∀(Foo : Text) → < Bar : Natural | Foo : Text > diff --git a/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesA.dhall b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesA.dhall @@ -0,0 +1,5 @@ + let anonymousFunction = λ(a : Type) → List a + +in λ(HigherOrderType : (Type → Type) → Type) + → λ(x : HigherOrderType anonymousFunction) + → (x : HigherOrderType anonymousFunction) diff --git a/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesB.dhall b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/anonymousFunctionsInTypesB.dhall @@ -0,0 +1,3 @@ + ∀(HigherOrderType : (Type → Type) → Type) +→ ∀(x : HigherOrderType (λ(a : Type) → List a)) +→ HigherOrderType (λ(a : Type) → List a) diff --git a/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsA.dhall b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsA.dhall @@ -0,0 +1,1 @@ +{ foo = 1 } ∧ { bar = Text } diff --git a/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsB.dhall b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/combineMixedRecordsB.dhall @@ -0,0 +1,1 @@ +{ bar : Type, foo : Natural } diff --git a/dhall-lang/tests/type-inference/success/simple/complexShadowingA.dhall b/dhall-lang/tests/type-inference/success/simple/complexShadowingA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/complexShadowingA.dhall @@ -0,0 +1,6 @@ +let x = Bool +let x = Natural +in \(x: x@1 {- Bool -}) + -> \(x: x@1 {- Natural -}) + -> let x = if x@1 then 0 else 1 + in (x + x@1) : x@3 diff --git a/dhall-lang/tests/type-inference/success/simple/complexShadowingB.dhall b/dhall-lang/tests/type-inference/success/simple/complexShadowingB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/complexShadowingB.dhall @@ -0,0 +1,1 @@ +∀(x : Bool) → ∀(x : Natural) → Natural diff --git a/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesA.dhall b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesA.dhall @@ -0,0 +1,1 @@ +{ x = Bool, y = Text, z = List } diff --git a/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesB.dhall b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/fieldsAreTypesB.dhall @@ -0,0 +1,1 @@ +{ x : Type, y : Type, z : Type → Type } diff --git a/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceA.dhall b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceA.dhall @@ -0,0 +1,6 @@ +let Foo = < Bar : Natural | Baz : Natural > + +in λ(a : Type) + → λ(f : Natural → a) + → λ(ts : Foo) + → merge { Bar = λ(a : Natural) → f a, Baz = f } ts diff --git a/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceB.dhall b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mergeEquivalenceB.dhall @@ -0,0 +1,1 @@ +∀(a : Type) → ∀(f : Natural → a) → ∀(ts : < Bar : Natural | Baz : Natural >) → a diff --git a/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessA.dhall b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessA.dhall @@ -0,0 +1,9 @@ +-- Verify that users can use `.` to both access a record field and a union +-- constructor within the same expression. This is a common idiom if a user +-- provides a types package. + +let Scope = < Public | Private > + +let types = { Scope = Scope } + +in types.Scope.Public diff --git a/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessB.dhall b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/mixedFieldAccessB.dhall @@ -0,0 +1,1 @@ +< Private | Public > diff --git a/dhall-lang/tests/type-inference/success/simple/unionsOfTypesA.dhall b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesA.dhall @@ -0,0 +1,1 @@ +< Left : Type → Type | Right : Type >.Left List diff --git a/dhall-lang/tests/type-inference/success/simple/unionsOfTypesB.dhall b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/simple/unionsOfTypesB.dhall @@ -0,0 +1,1 @@ +< Left : Type → Type | Right : Type > diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeA.dhall @@ -0,0 +1,1 @@ +{ x = True : { t = Bool }.t } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitNormalizeFieldTypeB.dhall @@ -0,0 +1,1 @@ +{ x : Bool } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsA.dhall @@ -0,0 +1,1 @@ +{ b = 1, a = 2 } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordLitSortFieldsB.dhall @@ -0,0 +1,1 @@ +{ a : Natural, b : Natural } diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindA.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindA.dhall @@ -0,0 +1,1 @@ +{ x = Type }.{} diff --git a/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindB.dhall b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindB.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/type-inference/success/unit/RecordProjectionEmptyKindB.dhall @@ -0,0 +1,1 @@ +{} diff --git a/dhall-lang/tests/typecheck/data/importBoundary.dhall b/dhall-lang/tests/typecheck/data/importBoundary.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/data/importBoundary.dhall +++ /dev/null @@ -1,3 +0,0 @@ --- This file contains a free variable. This should be a type error, even if the variable --- is in scope in the importing expression -x diff --git a/dhall-lang/tests/typecheck/failure/customHeadersUsingBoundVariable.dhall b/dhall-lang/tests/typecheck/failure/customHeadersUsingBoundVariable.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/failure/customHeadersUsingBoundVariable.dhall +++ /dev/null @@ -1,15 +0,0 @@ -{- This is a type error because the custom headers are type-checked with an - empty context. This is necessary because: - - * import resolution precedes β-normalization - * we also don't want custom headers to leak program state anyway - - This should fail due to the `x` within the custom header being an unbound - variable --} - -let x = "Bar" - -in https://httpbin.org/headers - using [ { mapKey = "Foo", mapValue = x } ] - as Text diff --git a/dhall-lang/tests/typecheck/failure/hurkensParadox.dhall b/dhall-lang/tests/typecheck/failure/hurkensParadox.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/failure/hurkensParadox.dhall +++ /dev/null @@ -1,49 +0,0 @@ - let bottom : Type = ∀(any : Type) → any - -in let not : Type → Type = λ(p : Type) → p → bottom - -in let pow = λ(X : Kind) → X → Type - -in let U = ∀(X : Kind) → (pow (pow X) → X) → pow (pow X) - -in let tau - : pow (pow U) → U - = λ(t : pow (pow U)) - → λ(X : Kind) - → λ(f : pow (pow X) → X) - → λ(p : pow X) - → t (λ(x : U) → p (f (x X f))) - -in let sigma : U → pow (pow U) = λ(s : U) → s U (λ(t : pow (pow U)) → tau t) - -in let Delta - : pow U - = λ(y : U) → not (∀(p : pow U) → sigma y p → p (tau (sigma y))) - -in let Omega : U = tau (λ(p : pow U) → ∀(x : U) → sigma x p → p x) - -in let Theta : Type = ∀(p : pow U) → (∀(x : U) → sigma x p → p x) → p Omega - -in let D : Type = ∀(p : pow U) → sigma Omega p → p (tau (sigma Omega)) - -in let lem1 - : ∀(p : pow U) → (∀(x : U) → sigma x p → p x) → p Omega - = λ(p : pow U) - → λ(t1 : ∀(x : U) → sigma x p → p x) - → t1 Omega (λ(x : U) → t1 (tau (sigma x))) - -in let lem3 : D = λ(p : pow U) → lem1 (λ(y : U) → p (tau (sigma y))) - -in let lem2 - : not D - = lem1 - Delta - ( λ(x : U) - → λ(H2 : sigma x Delta) - → λ(H3 : ∀(p : pow U) → sigma x p → p (tau (sigma x))) - → H3 Delta H2 (λ(pp : pow U) → H3 (λ(y : U) → pp (tau (sigma y)))) - ) - -in let evidence : bottom = lem2 lem3 - -in evidence diff --git a/dhall-lang/tests/typecheck/failure/importBoundary.dhall b/dhall-lang/tests/typecheck/failure/importBoundary.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/failure/importBoundary.dhall +++ /dev/null @@ -1,1 +0,0 @@ -\(x: Bool) -> ../data/importBoundary.dhall diff --git a/dhall-lang/tests/typecheck/failure/mixedUnions.dhall b/dhall-lang/tests/typecheck/failure/mixedUnions.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/failure/mixedUnions.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Left : Natural | Right : Type > diff --git a/dhall-lang/tests/typecheck/failure/recordOfKind.dhall b/dhall-lang/tests/typecheck/failure/recordOfKind.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/failure/recordOfKind.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ a = Kind } diff --git a/dhall-lang/tests/typecheck/success/RecordTypeMixedKindsA.dhall b/dhall-lang/tests/typecheck/success/RecordTypeMixedKindsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/RecordTypeMixedKindsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Bool, y : Type } diff --git a/dhall-lang/tests/typecheck/success/RecordTypeMixedKindsB.dhall b/dhall-lang/tests/typecheck/success/RecordTypeMixedKindsB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/RecordTypeMixedKindsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Kind diff --git a/dhall-lang/tests/typecheck/success/accessEncodedTypeA.dhall b/dhall-lang/tests/typecheck/success/accessEncodedTypeA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/accessEncodedTypeA.dhall +++ /dev/null @@ -1,4 +0,0 @@ - λ ( record - : ∀(k : Kind) → ∀(makeRecord : ∀(x : Type) → ∀(y : Type → Type) → k) → k - ) -→ record Type (λ(x : Type) → λ(y : Type → Type) → x) diff --git a/dhall-lang/tests/typecheck/success/accessEncodedTypeB.dhall b/dhall-lang/tests/typecheck/success/accessEncodedTypeB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/accessEncodedTypeB.dhall +++ /dev/null @@ -1,4 +0,0 @@ - ∀ ( record - : ∀(k : Kind) → ∀(makeRecord : ∀(x : Type) → ∀(y : Type → Type) → k) → k - ) -→ Type diff --git a/dhall-lang/tests/typecheck/success/accessTypeA.dhall b/dhall-lang/tests/typecheck/success/accessTypeA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/accessTypeA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(record : { x : Type, y : Type → Type }) → record.x diff --git a/dhall-lang/tests/typecheck/success/accessTypeB.dhall b/dhall-lang/tests/typecheck/success/accessTypeB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/accessTypeB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(record : { x : Type, y : Type → Type }) → Type diff --git a/dhall-lang/tests/typecheck/success/preferMixedRecordsA.dhall b/dhall-lang/tests/typecheck/success/preferMixedRecordsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/preferMixedRecordsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ foo = 1 } ⫽ { bar = Text } diff --git a/dhall-lang/tests/typecheck/success/preferMixedRecordsB.dhall b/dhall-lang/tests/typecheck/success/preferMixedRecordsB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/preferMixedRecordsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ foo : Natural, bar : Type } diff --git a/dhall-lang/tests/typecheck/success/preferMixedRecordsSameFieldA.dhall b/dhall-lang/tests/typecheck/success/preferMixedRecordsSameFieldA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/preferMixedRecordsSameFieldA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ a = 0 } ⫽ { a = Bool } diff --git a/dhall-lang/tests/typecheck/success/preferMixedRecordsSameFieldB.dhall b/dhall-lang/tests/typecheck/success/preferMixedRecordsSameFieldB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/preferMixedRecordsSameFieldB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ a : Type } diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/and/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/and/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/and/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/and [ True, False, True ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/and/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/and/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/and/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/and/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/and/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/and/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/and ([] : List Bool) diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/and/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/and/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/and/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/build/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/build/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/build/0A.dhall +++ /dev/null @@ -1,2 +0,0 @@ -../../../../../../Prelude/Bool/build -(λ(bool : Type) → λ(true : bool) → λ(false : bool) → true) diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/build/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/build/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/build/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/build/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/build/1A.dhall +++ /dev/null @@ -1,2 +0,0 @@ -../../../../../../Prelude/Bool/build -(λ(bool : Type) → λ(true : bool) → λ(false : bool) → false) diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/build/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/build/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/even [ False, True, False ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/even [ False, True ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/even [ False ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/3A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/3A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/3A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/even ([] : List Bool) diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/even/3B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/even/3B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/even/3B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/fold/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/fold True Natural 0 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/fold/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/fold/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/fold False Natural 0 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/fold/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/not/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/not/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/not/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/not True diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/not/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/not/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/not/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/not/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/not/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/not/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/not False diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/not/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/not/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/not/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/odd [ True, False, True ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/odd [ True, False ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/odd [ True ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/3A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/3A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/3A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/odd ([] : List Bool) diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/3B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/odd/3B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/odd/3B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/or/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/or/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/or/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/or [ True, False, True ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/or/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/or/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/or/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/or/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/or/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/or/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/or ([] : List Bool) diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/or/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/or/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/or/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/show/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/show/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/show True diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/show/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/show/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/show/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/show/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Bool/show False diff --git a/dhall-lang/tests/typecheck/success/prelude/Bool/show/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Bool/show/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Bool/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Double/show/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Double/show/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Double/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Double/show -3.1 diff --git a/dhall-lang/tests/typecheck/success/prelude/Double/show/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Double/show/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Double/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Double/show/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Double/show/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Double/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Double/show 0.4 diff --git a/dhall-lang/tests/typecheck/success/prelude/Double/show/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Double/show/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Double/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/show/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/show/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Integer/show -3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/show/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/show/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/show/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/show/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Integer/show +0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/show/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/show/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Integer/toDouble -3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Double diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Integer/toDouble +2 diff --git a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Double diff --git a/dhall-lang/tests/typecheck/success/prelude/List/all/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/all/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/all/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/all Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/all/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/all/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/all/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/all/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/all/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/all/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/all Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/all/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/all/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/all/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/any/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/any/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/any/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/any Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/any/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/any/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/any/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/any/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/any/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/any/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/any Natural Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/any/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/any/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/any/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/build/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/build/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/build/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../../Prelude/List/build -Text -( λ(list : Type) -→ λ(cons : Text → list → list) -→ λ(nil : list) -→ cons "ABC" (cons "DEF" nil) -) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/build/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/build/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Text diff --git a/dhall-lang/tests/typecheck/success/prelude/List/build/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/build/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/build/1A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../../Prelude/List/build -Text -( λ(list : Type) -→ λ(cons : Text → list → list) -→ λ(nil : list) -→ nil -) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/build/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/build/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Text diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concat/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concat/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concat/0A.dhall +++ /dev/null @@ -1,5 +0,0 @@ -../../../../../../Prelude/List/concat Natural -[ [ 0, 1, 2 ] -, [ 3, 4 ] -, [ 5, 6, 7, 8 ] -] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concat/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concat/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concat/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concat/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concat/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concat/1A.dhall +++ /dev/null @@ -1,5 +0,0 @@ -../../../../../../Prelude/List/concat Natural -[ [] : List Natural -, [] : List Natural -, [] : List Natural -] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concat/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concat/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concat/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concatMap/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concatMap/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concatMap/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/concatMap Natural Natural (λ(n : Natural) → [ n, n ]) ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/concatMap/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/concatMap/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/filter/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/filter/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/filter/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/filter Natural Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/filter/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/filter/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/filter/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/filter/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/filter/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/filter/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/filter Natural Natural/odd [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/filter/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/filter/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/filter/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/fold/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/fold/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/fold/0A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../../Prelude/List/fold -Natural -[ 2, 3, 5 ] -Natural -(λ(x : Natural) → λ(y : Natural) → x + y) -0 diff --git a/dhall-lang/tests/typecheck/success/prelude/List/fold/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/fold/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/fold/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/fold/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/fold/1A.dhall +++ /dev/null @@ -1,7 +0,0 @@ - λ(nil : Natural) -→ ../../../../../../Prelude/List/fold - Natural - [ 2, 3, 5 ] - Natural - (λ(x : Natural) → λ(y : Natural) → x + y) - nil diff --git a/dhall-lang/tests/typecheck/success/prelude/List/fold/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/fold/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(nil : Natural) → Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/fold/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/fold/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/fold/2A.dhall +++ /dev/null @@ -1,4 +0,0 @@ - λ(list : Type) -→ λ(cons : Natural → list → list) -→ λ(nil : list) -→ ../../../../../../Prelude/List/fold Natural [ 2, 3, 5 ] list cons nil diff --git a/dhall-lang/tests/typecheck/success/prelude/List/fold/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/fold/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/fold/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(list : Type) → ∀(cons : Natural → list → list) → ∀(nil : list) → list diff --git a/dhall-lang/tests/typecheck/success/prelude/List/generate/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/generate/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/generate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/generate 5 Bool Natural/even diff --git a/dhall-lang/tests/typecheck/success/prelude/List/generate/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/generate/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/generate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/generate/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/generate/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/generate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/generate 0 Bool Natural/even diff --git a/dhall-lang/tests/typecheck/success/prelude/List/generate/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/generate/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/generate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/head/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/head/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/head/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/head Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/head/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/head/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/head/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/head/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/head/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/head/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/head Natural ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/head/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/head/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/head/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/indexed/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/indexed/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/indexed/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/indexed Bool [ True, False, True ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/indexed/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/indexed/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/indexed/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/List/indexed/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/indexed/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/indexed/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/indexed Bool ([] : List Bool) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/indexed/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/indexed/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/indexed/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/List/iterate/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/iterate/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/iterate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/iterate 10 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/List/iterate/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/iterate/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/iterate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/iterate/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/iterate/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/iterate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/iterate 0 Natural (λ(x : Natural) → x * 2) 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/List/iterate/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/iterate/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/iterate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/last/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/last/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/last/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/last Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/last/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/last/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/last/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/last/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/last/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/last/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/last Natural ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/last/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/last/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/last/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/length/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/length/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/length/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/length Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/length/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/length/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/length/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/length/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/length/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/length/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/length Natural ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/length/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/length/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/length/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/map/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/map/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/map/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/map Natural Bool Natural/even [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/map/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/map/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/map/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/map/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/map/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/map/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/map Natural Bool Natural/even ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/map/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/map/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/map/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/null/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/null/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/null/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/null Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/null/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/null/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/null/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/null/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/null/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/null/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/null Natural ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/null/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/null/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/null/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/List/replicate/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/replicate/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/replicate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/replicate 9 Natural 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/List/replicate/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/replicate/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/replicate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/replicate/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/replicate/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/replicate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/replicate 0 Natural 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/List/replicate/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/replicate/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/replicate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/reverse/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/reverse/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/reverse/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/reverse Natural [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/reverse/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/reverse/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/reverse/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/reverse/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/reverse/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/reverse/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/reverse Natural ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/reverse/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/reverse/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/reverse/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/List/shifted/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/shifted/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/shifted/0A.dhall +++ /dev/null @@ -1,15 +0,0 @@ -../../../../../../Prelude/List/shifted -Bool -[ [ { index = 0, value = True } - , { index = 1, value = True } - , { index = 2, value = False } - ] -, [ { index = 0, value = False } - , { index = 1, value = False } - ] -, [ { index = 0, value = True } - , { index = 1, value = True } - , { index = 2, value = True } - , { index = 3, value = True } - ] -] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/shifted/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/shifted/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/shifted/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/List/shifted/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/shifted/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/shifted/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/shifted Bool ([] : List (List { index : Natural, value : Bool })) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/shifted/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/shifted/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/shifted/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List { index : Natural, value : Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/List/unzip/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/unzip/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/unzip/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../../Prelude/List/unzip -Text -Bool -[ { _1 = "ABC", _2 = True } -, { _1 = "DEF", _2 = False } -, { _1 = "GHI", _2 = True } -] diff --git a/dhall-lang/tests/typecheck/success/prelude/List/unzip/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/unzip/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/unzip/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 : List Text, _2 : List Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/List/unzip/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/List/unzip/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/unzip/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/List/unzip Text Bool ([] : List { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/typecheck/success/prelude/List/unzip/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/List/unzip/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/List/unzip/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 : List Text, _2 : List Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/00A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/00A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/00A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/and diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/00B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/00B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/00B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/01A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/01A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/01A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/or diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/01B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/01B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/01B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/02A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/02A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/02A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/even diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/02B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/02B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/02B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/03A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/03A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/03A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Bool/odd diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/03B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/03B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/03B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/04A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/04A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/04A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/concat diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/04B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/04B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/04B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../../Prelude/Monoid (List a) diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/05A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/05A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/05A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/List/shifted diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/05B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/05B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/05B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../../Prelude/Monoid (List { index : Natural, value : a }) diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/06A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/06A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/06A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/sum diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/06B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/06B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/06B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/07A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/07A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/07A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Natural/product diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/07B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/07B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/07B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/08A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/08A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/08A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/head diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/08B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/08B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/08B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../../Prelude/Monoid (Optional a) diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/09A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/09A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/09A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Optional/last diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/09B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/09B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/09B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ../../../../../Prelude/Monoid (Optional a) diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/10A.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/10A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/10A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Text/concat diff --git a/dhall-lang/tests/typecheck/success/prelude/Monoid/10B.dhall b/dhall-lang/tests/typecheck/success/prelude/Monoid/10B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Monoid/10B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../Prelude/Monoid Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/build/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/build/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/build/0A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../../Prelude/Natural/build -( λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ succ (succ (succ zero)) -) diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/build/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/build/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/build/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/build/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/build/1A.dhall +++ /dev/null @@ -1,6 +0,0 @@ -../../../../../../Prelude/Natural/build -( λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ zero -) diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/build/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/build/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/enumerate 10 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/enumerate 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/even/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/even/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/even/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/even 3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/even/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/even/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/even/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/even/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/even/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/even/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/even 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/even/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/even/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/even/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/fold/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) 1 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/fold/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/fold/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(zero : Natural) → ../../../../../../Prelude/Natural/fold 3 Natural (λ(x : Natural) → 5 * x) zero diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/fold/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(zero : Natural) → Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/fold/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/2A.dhall +++ /dev/null @@ -1,4 +0,0 @@ - λ(natural : Type) -→ λ(succ : natural → natural) -→ λ(zero : natural) -→ ../../../../../../Prelude/Natural/fold 3 natural succ zero diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/fold/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/fold/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(natural : Type) → ∀(succ : natural → natural) → ∀(zero : natural) → natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/isZero 2 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/isZero 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/isZero/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/odd/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/odd 3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/odd/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/odd/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/odd 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/odd/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/odd/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/product/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/product/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/product/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/product [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/product/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/product/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/product/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/product/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/product/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/product/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/product ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/product/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/product/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/product/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/show/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/show/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/show/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/show 3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/show/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/show/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/show/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/show/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/show/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/show/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/show 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/show/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/show/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/show/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/sum/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/sum [ 2, 3, 5 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/sum/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/sum/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/sum ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/sum/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/sum/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/toDouble 3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Double diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/toDouble 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Double diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/toInteger 3 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Integer diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Natural/toInteger 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Integer diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/all/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/all/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/all/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/all Natural Natural/even (Some 3) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/all/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/all/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/all/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/all/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/all/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/all/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/all Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/all/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/all/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/all/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/any/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/any/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/any/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/any Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/any/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/any/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/any/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/any/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/any/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/any/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/any Natural Natural/even (None Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/any/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/any/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/any/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/build/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/build/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/build/0A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../../Prelude/Optional/build -Natural -( λ(optional : Type) -→ λ(some : Natural → optional) -→ λ(none : optional) -→ some 1 -) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/build/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/build/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/build/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/build/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/build/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/build/1A.dhall +++ /dev/null @@ -1,7 +0,0 @@ -../../../../../../Prelude/Optional/build -Natural -( λ(optional : Type) -→ λ(some : Natural → optional) -→ λ(none : optional) -→ none -) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/build/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/build/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/build/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/concat/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/concat Natural (Some (Some 1)) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/concat/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/concat/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/concat Natural (Some (None Natural)) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/concat/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/concat/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/concat Natural (None (Optional Natural)) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/concat/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/concat/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/filter/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/filter Natural Natural/even (Some 2) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/filter/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/filter/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/filter Natural Natural/odd (Some 2) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/filter/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/filter/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/fold/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/fold Natural (Some 2) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/fold/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/fold/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/fold Natural (None Natural) Natural (λ(x : Natural) → x) 0 diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/fold/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/fold/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/head/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/head/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/head/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/head Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/head/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/head/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/head/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/head/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/head/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/head/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/head Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/head/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/head/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/head/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/head/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/head/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/head/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/head Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/head/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/head/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/head/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/last/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/last/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/last/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/last Natural [ None Natural, Some 1, Some 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/last/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/last/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/last/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/last/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/last/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/last/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/last Natural [ None Natural, None Natural ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/last/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/last/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/last/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/last/2A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/last/2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/last/2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/last Natural ([] : List (Optional Natural)) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/last/2B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/last/2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/last/2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/length/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/length/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/length/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/length Natural (Some 2) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/length/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/length/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/length/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/length/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/length/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/length/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/length Natural (None Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/length/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/length/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/length/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/map/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/map/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/map/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/map Natural Bool Natural/even (Some 3) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/map/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/map/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/map/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/map/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/map/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/map/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/map Natural Bool Natural/even (None Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/map/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/map/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/map/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Optional Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/null/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/null/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/null/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/null Natural (Some 2) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/null/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/null/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/null/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/null/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/null/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/null/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/null Natural (None Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/null/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/null/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/null/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Bool diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/toList/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/toList Natural (Some 1) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/toList/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/toList/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/toList Natural (None Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/toList/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/toList/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -List Natural diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/unzip Text Bool (Some { _1 = "ABC", _2 = True }) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 : Optional Text, _2 : Optional Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Optional/unzip Text Bool (None { _1 : Text, _2 : Bool }) diff --git a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Optional/unzip/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ _1 : Optional Text, _2 : Optional Bool } diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concat/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concat/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concat/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concat [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concat/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concat/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concat/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concat/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concat/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concat/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concat ([] : List Text) diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concat/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concat/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concat/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concatMap Natural (λ(n : Natural) → "${Natural/show n} ") ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMap/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show [ 0, 1, 2 ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concatMapSep ", " Natural Natural/show ([] : List Natural) diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/0A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concatSep ", " [ "ABC", "DEF", "GHI" ] diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/0B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/1A.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../../../../Prelude/Text/concatSep ", " ([] : List Text) diff --git a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/1B.dhall b/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/prelude/Text/concatSep/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Text diff --git a/dhall-lang/tests/typecheck/success/preludeA.dhall b/dhall-lang/tests/typecheck/success/preludeA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/preludeA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -../../../Prelude/package.dhall diff --git a/dhall-lang/tests/typecheck/success/preludeB.dhall b/dhall-lang/tests/typecheck/success/preludeB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/preludeB.dhall +++ /dev/null @@ -1,506 +0,0 @@ -{ Bool : - { and : - ∀(xs : List Bool) → Bool - , build : - ∀(f : ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool) → Bool - , even : - ∀(xs : List Bool) → Bool - , fold : - ∀(b : Bool) → ∀(bool : Type) → ∀(true : bool) → ∀(false : bool) → bool - , not : - ∀(b : Bool) → Bool - , odd : - ∀(xs : List Bool) → Bool - , or : - ∀(xs : List Bool) → Bool - , show : - ∀(b : Bool) → Text - } -, Double : - { show : Double → Text } -, Function : - { compose : - ∀(A : Type) - → ∀(B : Type) - → ∀(C : Type) - → ∀(f : A → B) - → ∀(g : B → C) - → ∀(x : A) - → C - } -, Integer : - { show : Integer → Text, toDouble : Integer → Double } -, JSON : - { array : - ∀ ( x - : List - ( ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - ) - ) - → ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - , bool : - ∀(x : Bool) - → ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - , keyText : - ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } - , keyValue : - ∀(v : Type) - → ∀(key : Text) - → ∀(value : v) - → { mapKey : Text, mapValue : v } - , null : - ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - , number : - ∀(x : Double) - → ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - , object : - ∀ ( x - : List - { mapKey : - Text - , mapValue : - ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - } - ) - → ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - , render : - ∀ ( j - : ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - ) - → Text - , string : - ∀(x : Text) - → ∀(JSON : Type) - → ∀ ( json - : { array : - List JSON → JSON - , bool : - Bool → JSON - , null : - JSON - , number : - Double → JSON - , object : - List { mapKey : Text, mapValue : JSON } → JSON - , string : - Text → JSON - } - ) - → JSON - } -, List : - { all : - ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → Bool - , any : - ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → Bool - , build : - ∀(a : Type) - → (∀(list : Type) → ∀(cons : a → list → list) → ∀(nil : list) → list) - → List a - , concat : - ∀(a : Type) → ∀(xss : List (List a)) → List a - , concatMap : - ∀(a : Type) → ∀(b : Type) → ∀(f : a → List b) → ∀(xs : List a) → List b - , filter : - ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : List a) → List a - , fold : - ∀(a : Type) - → List a - → ∀(list : Type) - → ∀(cons : a → list → list) - → ∀(nil : list) - → list - , generate : - ∀(n : Natural) → ∀(a : Type) → ∀(f : Natural → a) → List a - , head : - ∀(a : Type) → List a → Optional a - , indexed : - ∀(a : Type) → List a → List { index : Natural, value : a } - , iterate : - ∀(n : Natural) → ∀(a : Type) → ∀(f : a → a) → ∀(x : a) → List a - , last : - ∀(a : Type) → List a → Optional a - , length : - ∀(a : Type) → List a → Natural - , map : - ∀(a : Type) → ∀(b : Type) → ∀(f : a → b) → ∀(xs : List a) → List b - , null : - ∀(a : Type) → ∀(xs : List a) → Bool - , replicate : - ∀(n : Natural) → ∀(a : Type) → ∀(x : a) → List a - , reverse : - ∀(a : Type) → List a → List a - , shifted : - ∀(a : Type) - → ∀(kvss : List (List { index : Natural, value : a })) - → List { index : Natural, value : a } - , unzip : - ∀(a : Type) - → ∀(b : Type) - → ∀(xs : List { _1 : a, _2 : b }) - → { _1 : List a, _2 : List b } - } -, Map : - { keys : - ∀(k : Type) - → ∀(v : Type) - → ∀(xs : List { mapKey : k, mapValue : v }) - → List k - , map : - ∀(k : Type) - → ∀(a : Type) - → ∀(b : Type) - → ∀(f : a → b) - → ∀(m : List { mapKey : k, mapValue : a }) - → List { mapKey : k, mapValue : b } - , values : - ∀(k : Type) - → ∀(v : Type) - → ∀(xs : List { mapKey : k, mapValue : v }) - → List v - } -, Natural : - { build : - ( ∀(natural : Type) - → ∀(succ : natural → natural) - → ∀(zero : natural) - → natural - ) - → Natural - , enumerate : - ∀(n : Natural) → List Natural - , even : - Natural → Bool - , fold : - Natural - → ∀(natural : Type) - → ∀(succ : natural → natural) - → ∀(zero : natural) - → natural - , isZero : - Natural → Bool - , odd : - Natural → Bool - , product : - ∀(xs : List Natural) → Natural - , show : - Natural → Text - , sum : - ∀(xs : List Natural) → Natural - , toDouble : - ∀(n : Natural) → Double - , toInteger : - Natural → Integer - , lessThan : - Natural → Natural → Bool - , lessThanEqual : - Natural → Natural → Bool - , equal : - Natural → Natural → Bool - , greaterThan : - Natural → Natural → Bool - , greaterThanEqual : - Natural → Natural → Bool - } -, Optional : - { all : - ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool - , any : - ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool - , build : - ∀(a : Type) - → ( ∀(optional : Type) - → ∀(just : a → optional) - → ∀(nothing : optional) - → optional - ) - → Optional a - , concat : - ∀(a : Type) → ∀(x : Optional (Optional a)) → Optional a - , filter : - ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Optional a - , fold : - ∀(a : Type) - → Optional a - → ∀(optional : Type) - → ∀(just : a → optional) - → ∀(nothing : optional) - → optional - , head : - ∀(a : Type) → ∀(xs : List (Optional a)) → Optional a - , last : - ∀(a : Type) → ∀(xs : List (Optional a)) → Optional a - , length : - ∀(a : Type) → ∀(xs : Optional a) → Natural - , map : - ∀(a : Type) - → ∀(b : Type) - → ∀(f : a → b) - → ∀(o : Optional a) - → Optional b - , null : - ∀(a : Type) → ∀(xs : Optional a) → Bool - , toList : - ∀(a : Type) → ∀(o : Optional a) → List a - , unzip : - ∀(a : Type) - → ∀(b : Type) - → ∀(xs : Optional { _1 : a, _2 : b }) - → { _1 : Optional a, _2 : Optional b } - } -, Text : - { concat : - ∀(xs : List Text) → Text - , concatMap : - ∀(a : Type) → ∀(f : a → Text) → ∀(xs : List a) → Text - , concatMapSep : - ∀(separator : Text) - → ∀(a : Type) - → ∀(f : a → Text) - → ∀(elements : List a) - → Text - , concatSep : - ∀(separator : Text) → ∀(elements : List Text) → Text - , show : - Text → Text - } -, XML : - { attribute : - ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } - , element : - ∀ ( elem - : { attributes : - List { mapKey : Text, mapValue : Text } - , content : - List - ( ∀(XML : Type) - → ∀ ( xml - : { element : - { attributes : - List { mapKey : Text, mapValue : Text } - , content : - List XML - , name : - Text - } - → XML - , text : - Text → XML - } - ) - → XML - ) - , name : - Text - } - ) - → ∀(XML : Type) - → ∀ ( xml - : { element : - { attributes : - List { mapKey : Text, mapValue : Text } - , content : - List XML - , name : - Text - } - → XML - , text : - Text → XML - } - ) - → XML - , emptyAttributes : - List { mapKey : Text, mapValue : Text } - , leaf : - ∀ ( elem - : { attributes : - List { mapKey : Text, mapValue : Text } - , name : - Text - } - ) - → ∀(XML : Type) - → ∀ ( xml - : { element : - { attributes : - List { mapKey : Text, mapValue : Text } - , content : - List XML - , name : - Text - } - → XML - , text : - Text → XML - } - ) - → XML - , render : - ∀ ( x - : ∀(XML : Type) - → ∀ ( xml - : { element : - { attributes : - List { mapKey : Text, mapValue : Text } - , content : - List XML - , name : - Text - } - → XML - , text : - Text → XML - } - ) - → XML - ) - → Text - , text : - ∀(d : Text) - → ∀(XML : Type) - → ∀ ( xml - : { element : - { attributes : - List { mapKey : Text, mapValue : Text } - , content : - List XML - , name : - Text - } - → XML - , text : - Text → XML - } - ) - → XML - } -} diff --git a/dhall-lang/tests/typecheck/success/recordOfRecordOfTypesA.dhall b/dhall-lang/tests/typecheck/success/recordOfRecordOfTypesA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/recordOfRecordOfTypesA.dhall +++ /dev/null @@ -1,5 +0,0 @@ -let types = { Scopes = < Public | Private > } - -let prelude = { types = types } - -in prelude.types.Scopes.Public diff --git a/dhall-lang/tests/typecheck/success/recordOfRecordOfTypesB.dhall b/dhall-lang/tests/typecheck/success/recordOfRecordOfTypesB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/recordOfRecordOfTypesB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Public | Private > diff --git a/dhall-lang/tests/typecheck/success/recordOfTypesA.dhall b/dhall-lang/tests/typecheck/success/recordOfTypesA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/recordOfTypesA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = Text, y = List } diff --git a/dhall-lang/tests/typecheck/success/recordOfTypesB.dhall b/dhall-lang/tests/typecheck/success/recordOfTypesB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/recordOfTypesB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Type, y : Type → Type } diff --git a/dhall-lang/tests/typecheck/success/simple/RecordMixedKinds2A.dhall b/dhall-lang/tests/typecheck/success/simple/RecordMixedKinds2A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RecordMixedKinds2A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = Type, y = {} } diff --git a/dhall-lang/tests/typecheck/success/simple/RecordMixedKinds2B.dhall b/dhall-lang/tests/typecheck/success/simple/RecordMixedKinds2B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RecordMixedKinds2B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Kind, y : Type } diff --git a/dhall-lang/tests/typecheck/success/simple/RecordMixedKindsA.dhall b/dhall-lang/tests/typecheck/success/simple/RecordMixedKindsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RecordMixedKindsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = {=}, y = Bool } diff --git a/dhall-lang/tests/typecheck/success/simple/RecordMixedKindsB.dhall b/dhall-lang/tests/typecheck/success/simple/RecordMixedKindsB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RecordMixedKindsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : {}, y : Type } diff --git a/dhall-lang/tests/typecheck/success/simple/RecursiveRecordMergeMixedKindsA.dhall b/dhall-lang/tests/typecheck/success/simple/RecursiveRecordMergeMixedKindsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RecursiveRecordMergeMixedKindsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = True } ∧ { y = Bool } diff --git a/dhall-lang/tests/typecheck/success/simple/RecursiveRecordMergeMixedKindsB.dhall b/dhall-lang/tests/typecheck/success/simple/RecursiveRecordMergeMixedKindsB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RecursiveRecordMergeMixedKindsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Bool, y : Type } diff --git a/dhall-lang/tests/typecheck/success/simple/RightBiasedRecordMergeMixedKindsA.dhall b/dhall-lang/tests/typecheck/success/simple/RightBiasedRecordMergeMixedKindsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RightBiasedRecordMergeMixedKindsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = {=} } ⫽ { x = Bool } diff --git a/dhall-lang/tests/typecheck/success/simple/RightBiasedRecordMergeMixedKindsB.dhall b/dhall-lang/tests/typecheck/success/simple/RightBiasedRecordMergeMixedKindsB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/RightBiasedRecordMergeMixedKindsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Type } diff --git a/dhall-lang/tests/typecheck/success/simple/access/0A.dhall b/dhall-lang/tests/typecheck/success/simple/access/0A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/access/0A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = Text }.x diff --git a/dhall-lang/tests/typecheck/success/simple/access/0B.dhall b/dhall-lang/tests/typecheck/success/simple/access/0B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/access/0B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -Type diff --git a/dhall-lang/tests/typecheck/success/simple/access/1A.dhall b/dhall-lang/tests/typecheck/success/simple/access/1A.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/access/1A.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Foo : Text | Bar : Natural >.Foo diff --git a/dhall-lang/tests/typecheck/success/simple/access/1B.dhall b/dhall-lang/tests/typecheck/success/simple/access/1B.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/access/1B.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(Foo : Text) → < Bar : Natural | Foo : Text > diff --git a/dhall-lang/tests/typecheck/success/simple/anonymousFunctionsInTypesA.dhall b/dhall-lang/tests/typecheck/success/simple/anonymousFunctionsInTypesA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/anonymousFunctionsInTypesA.dhall +++ /dev/null @@ -1,5 +0,0 @@ - let anonymousFunction = λ(a : Type) → List a - -in λ(HigherOrderType : (Type → Type) → Type) - → λ(x : HigherOrderType anonymousFunction) - → (x : HigherOrderType anonymousFunction) diff --git a/dhall-lang/tests/typecheck/success/simple/anonymousFunctionsInTypesB.dhall b/dhall-lang/tests/typecheck/success/simple/anonymousFunctionsInTypesB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/anonymousFunctionsInTypesB.dhall +++ /dev/null @@ -1,4 +0,0 @@ - ∀(HigherOrderType : (Type → Type) → Type) -→ ∀(x : HigherOrderType (λ(a : Type) → List a)) -→ HigherOrderType (λ(a : Type) → List a) - diff --git a/dhall-lang/tests/typecheck/success/simple/combineMixedRecordsA.dhall b/dhall-lang/tests/typecheck/success/simple/combineMixedRecordsA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/combineMixedRecordsA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ foo = 1 } ∧ { bar = Text } diff --git a/dhall-lang/tests/typecheck/success/simple/combineMixedRecordsB.dhall b/dhall-lang/tests/typecheck/success/simple/combineMixedRecordsB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/combineMixedRecordsB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ foo : Natural, bar : Type } diff --git a/dhall-lang/tests/typecheck/success/simple/complexShadowingA.dhall b/dhall-lang/tests/typecheck/success/simple/complexShadowingA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/complexShadowingA.dhall +++ /dev/null @@ -1,6 +0,0 @@ -let x = Bool -let x = Natural -in \(x: x@1 {- Bool -}) - -> \(x: x@1 {- Natural -}) - -> let x = if x@1 then 0 else 1 - in (x + x@1) : x@3 diff --git a/dhall-lang/tests/typecheck/success/simple/complexShadowingB.dhall b/dhall-lang/tests/typecheck/success/simple/complexShadowingB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/complexShadowingB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(x : Bool) → ∀(x : Natural) → Natural diff --git a/dhall-lang/tests/typecheck/success/simple/fieldsAreTypesA.dhall b/dhall-lang/tests/typecheck/success/simple/fieldsAreTypesA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/fieldsAreTypesA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x = Bool, y = Text, z = List } diff --git a/dhall-lang/tests/typecheck/success/simple/fieldsAreTypesB.dhall b/dhall-lang/tests/typecheck/success/simple/fieldsAreTypesB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/fieldsAreTypesB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -{ x : Type, y : Type, z : Type → Type } diff --git a/dhall-lang/tests/typecheck/success/simple/kindParameterA.dhall b/dhall-lang/tests/typecheck/success/simple/kindParameterA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/kindParameterA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -λ(k : Kind) → λ(a : k → k → Type) → λ(x : k) → a x diff --git a/dhall-lang/tests/typecheck/success/simple/kindParameterB.dhall b/dhall-lang/tests/typecheck/success/simple/kindParameterB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/kindParameterB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(k : Kind) → (k → k → Type) → k → k → Type diff --git a/dhall-lang/tests/typecheck/success/simple/mergeEquivalenceA.dhall b/dhall-lang/tests/typecheck/success/simple/mergeEquivalenceA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/mergeEquivalenceA.dhall +++ /dev/null @@ -1,6 +0,0 @@ -let Foo = < Bar : Natural | Baz : Natural > - -in λ(a : Type) - → λ(f : Natural → a) - → λ(ts : Foo) - → merge { Bar = λ(a : Natural) → f a, Baz = f } ts diff --git a/dhall-lang/tests/typecheck/success/simple/mergeEquivalenceB.dhall b/dhall-lang/tests/typecheck/success/simple/mergeEquivalenceB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/mergeEquivalenceB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -∀(a : Type) → ∀(f : Natural → a) → ∀(ts : < Bar : Natural | Baz : Natural >) → a diff --git a/dhall-lang/tests/typecheck/success/simple/mixedFieldAccessA.dhall b/dhall-lang/tests/typecheck/success/simple/mixedFieldAccessA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/mixedFieldAccessA.dhall +++ /dev/null @@ -1,9 +0,0 @@ --- Verify that users can use `.` to both access a record field and a union --- constructor within the same expression. This is a common idiom if a user --- provides a types package. - -let Scope = < Public | Private > - -let types = { Scope = Scope } - -in types.Scope.Public diff --git a/dhall-lang/tests/typecheck/success/simple/mixedFieldAccessB.dhall b/dhall-lang/tests/typecheck/success/simple/mixedFieldAccessB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/mixedFieldAccessB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Private | Public > diff --git a/dhall-lang/tests/typecheck/success/simple/unionsOfTypesA.dhall b/dhall-lang/tests/typecheck/success/simple/unionsOfTypesA.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/unionsOfTypesA.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Left : Type → Type | Right : Type >.Left List diff --git a/dhall-lang/tests/typecheck/success/simple/unionsOfTypesB.dhall b/dhall-lang/tests/typecheck/success/simple/unionsOfTypesB.dhall deleted file mode 100644 --- a/dhall-lang/tests/typecheck/success/simple/unionsOfTypesB.dhall +++ /dev/null @@ -1,1 +0,0 @@ -< Left : Type → Type | Right : Type > diff --git a/dhall.cabal b/dhall.cabal --- a/dhall.cabal +++ b/dhall.cabal @@ -1,5 +1,5 @@ Name: dhall -Version: 1.26.0 +Version: 1.26.1 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 7.10.3, GHC == 8.4.3, GHC == 8.6.1 @@ -76,6 +76,8 @@ dhall-lang/Prelude/List/reverse dhall-lang/Prelude/List/shifted dhall-lang/Prelude/List/unzip + dhall-lang/Prelude/Location/package.dhall + dhall-lang/Prelude/Location/Type dhall-lang/Prelude/Map/Entry dhall-lang/Prelude/Map/keys dhall-lang/Prelude/Map/map @@ -97,6 +99,7 @@ dhall-lang/Prelude/Natural/package.dhall dhall-lang/Prelude/Natural/product dhall-lang/Prelude/Natural/show + dhall-lang/Prelude/Natural/subtract dhall-lang/Prelude/Natural/sum dhall-lang/Prelude/Natural/toDouble dhall-lang/Prelude/Natural/toInteger @@ -119,6 +122,8 @@ dhall-lang/Prelude/Text/concatMap dhall-lang/Prelude/Text/concatMapSep dhall-lang/Prelude/Text/concatSep + dhall-lang/Prelude/Text/default + dhall-lang/Prelude/Text/defaultMap dhall-lang/Prelude/Text/package.dhall dhall-lang/Prelude/Text/show dhall-lang/Prelude/XML/attribute @@ -290,128 +295,69 @@ dhall-lang/tests/semantic-hash/success/simple/*.hash dhall-lang/tests/semantic-hash/success/simplifications/*.dhall dhall-lang/tests/semantic-hash/success/simplifications/*.hash - dhall-lang/tests/typecheck/data/*.dhall - dhall-lang/tests/typecheck/failure/*.dhall - dhall-lang/tests/typecheck/success/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/and/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/and/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/even/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/even/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/not/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/not/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/odd/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/odd/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/or/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/or/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Bool/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Double/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Double/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Integer/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Integer/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/*.dhall - dhall-lang/tests/typecheck/success/prelude/Integer/toDouble/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/all/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/all/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/any/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/any/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/concat/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/concat/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/concatMap/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/concatMap/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/filter/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/filter/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/generate/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/generate/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/head/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/head/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/indexed/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/indexed/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/iterate/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/iterate/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/last/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/last/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/length/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/length/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/map/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/map/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/null/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/null/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/replicate/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/replicate/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/reverse/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/reverse/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/shifted/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/shifted/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/unzip/*.dhall - dhall-lang/tests/typecheck/success/prelude/List/unzip/*.dhall - dhall-lang/tests/typecheck/success/prelude/Monoid/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/enumerate/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/even/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/even/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/isZero/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/isZero/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/odd/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/odd/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/product/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/product/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/show/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/sum/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/sum/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/toDouble/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/*.dhall - dhall-lang/tests/typecheck/success/prelude/Natural/toInteger/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/all/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/all/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/any/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/any/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/build/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/concat/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/concat/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/filter/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/filter/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/fold/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/head/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/head/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/last/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/last/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/length/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/length/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/map/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/map/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/null/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/null/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/toList/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/toList/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/unzip/*.dhall - dhall-lang/tests/typecheck/success/prelude/Optional/unzip/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concat/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concat/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concatMap/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concatMap/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concatMapSep/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concatSep/*.dhall - dhall-lang/tests/typecheck/success/prelude/Text/concatSep/*.dhall - dhall-lang/tests/typecheck/success/simple/access/*.dhall - dhall-lang/tests/typecheck/success/simple/*.dhall + dhall-lang/tests/type-inference/data/*.dhall + dhall-lang/tests/type-inference/failure/*.dhall + dhall-lang/tests/type-inference/success/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/and/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/build/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/even/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/fold/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/not/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/odd/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/or/*.dhall + dhall-lang/tests/type-inference/success/prelude/Bool/show/*.dhall + dhall-lang/tests/type-inference/success/prelude/Double/show/*.dhall + dhall-lang/tests/type-inference/success/prelude/Integer/show/*.dhall + dhall-lang/tests/type-inference/success/prelude/Integer/toDouble/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/all/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/any/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/build/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/concat/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/concatMap/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/filter/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/fold/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/generate/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/head/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/indexed/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/iterate/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/last/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/length/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/map/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/null/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/replicate/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/reverse/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/shifted/*.dhall + dhall-lang/tests/type-inference/success/prelude/List/unzip/*.dhall + dhall-lang/tests/type-inference/success/prelude/Monoid/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/build/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/enumerate/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/even/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/fold/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/isZero/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/odd/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/product/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/show/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/sum/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/toDouble/*.dhall + dhall-lang/tests/type-inference/success/prelude/Natural/toInteger/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/all/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/any/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/build/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/concat/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/filter/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/fold/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/head/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/last/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/length/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/map/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/null/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/toList/*.dhall + dhall-lang/tests/type-inference/success/prelude/Optional/unzip/*.dhall + dhall-lang/tests/type-inference/success/prelude/Text/concat/*.dhall + dhall-lang/tests/type-inference/success/prelude/Text/concatMap/*.dhall + dhall-lang/tests/type-inference/success/prelude/Text/concatMapSep/*.dhall + dhall-lang/tests/type-inference/success/prelude/Text/concatSep/*.dhall + dhall-lang/tests/type-inference/success/simple/access/*.dhall dhall-lang/tests/type-inference/success/simple/*.dhall dhall-lang/tests/type-inference/success/unit/*.dhall tests/format/*.dhall @@ -449,10 +395,9 @@ cborg-json < 0.3 , containers >= 0.5.0.0 && < 0.7 , contravariant < 1.6 , - cryptonite >= 0.23 && < 1.0 , data-fix < 0.3 , deepseq < 1.5 , - Diff >= 0.2 && < 0.4 , + Diff >= 0.2 && < 0.5 , directory >= 1.2.2.0 && < 1.4 , dotgen >= 0.4.2 && < 0.5 , either >= 5 && < 5.1, @@ -466,13 +411,13 @@ network-uri >= 2.6 && < 2.7 , optparse-applicative >= 0.14.0.0 && < 0.16, parsers >= 0.12.4 && < 0.13, - prettyprinter >= 1.2.0.1 && < 1.3 , + prettyprinter >= 1.2.0.1 && < 1.4 , prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , profunctors >= 3.1.2 && < 5.6 , repline >= 0.2.1.0 && < 0.3 , serialise >= 0.2.0.0 && < 0.3 , scientific >= 0.3.0.0 && < 0.4 , - template-haskell < 2.15, + template-haskell < 2.16, text >= 0.11.1.0 && < 1.3 , th-lift-instances >= 0.1.13 && < 0.2 , transformers >= 0.2.0.0 && < 0.6 , @@ -480,17 +425,27 @@ unordered-containers >= 0.1.3.0 && < 0.3 , uri-encode < 1.6 , vector >= 0.11.0.0 && < 0.13 - if flag(with-http) - Build-Depends: - http-types >= 0.7.0 && < 0.13, - http-client >= 0.4.30 && < 0.7 , - http-client-tls >= 0.2.0 && < 0.4 if !impl(ghc >= 8.0) && !impl(eta >= 0.8.4) Build-Depends: semigroups == 0.18.* Build-Depends: transformers == 0.4.2.* Build-Depends: fail == 4.9.* + if flag(with-http) + CPP-Options: + -DWITH_HTTP if impl(ghcjs) - Build-Depends: ghcjs-xhr + Hs-Source-Dirs: ghcjs-src + Build-Depends: + ghcjs-base , + ghcjs-xhr + else + Hs-Source-Dirs: ghc-src + Build-Depends: + cryptonite >= 0.23 && < 1.0 + if flag(with-http) + Build-Depends: + http-types >= 0.7.0 && < 0.13, + http-client >= 0.4.30 && < 0.7 , + http-client-tls >= 0.2.0 && < 0.4 Other-Extensions: BangPatterns @@ -525,6 +480,7 @@ Dhall.Binary, Dhall.Context, Dhall.Core, + Dhall.Crypto, Dhall.Diff, Dhall.Format, Dhall.Freeze, @@ -544,15 +500,19 @@ Dhall.Tutorial, Dhall.TypeCheck, Dhall.Util + Dhall.Version if !flag(cross) Exposed-Modules: Dhall.TH Other-Modules: Dhall.Pretty.Internal, Dhall.Parser.Combinators, + Dhall.URL, Dhall.Import.Types, Dhall.Eval, Paths_dhall + Autogen-Modules: + Paths_dhall if flag(with-http) Other-Modules: Dhall.Import.HTTP @@ -584,7 +544,6 @@ Dhall.Test.Regression Dhall.Test.SemanticHash Dhall.Test.Tutorial - Dhall.Test.TypeCheck Dhall.Test.TypeInference Dhall.Test.Util Build-Depends: diff --git a/doctest/Main.hs b/doctest/Main.hs --- a/doctest/Main.hs +++ b/doctest/Main.hs @@ -25,8 +25,10 @@ writeFile "file1" "./file2" Test.DocTest.doctest - [ "--fast" + [ "-DWITH_HTTP" + , "--fast" , "-i" <> (prefix "src") + , "-i" <> (prefix "ghc-src") , prefix "src/Dhall.hs" , prefix "src/Dhall/Import.hs" , prefix "src/Dhall/Tutorial.hs" diff --git a/ghc-src/Dhall/Crypto.hs b/ghc-src/Dhall/Crypto.hs new file mode 100644 --- /dev/null +++ b/ghc-src/Dhall/Crypto.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Dhall.Crypto ( + SHA256Digest(..) + , sha256DigestFromByteString + , sha256Hash + ) where + +import Control.DeepSeq (NFData) +import Crypto.Hash (SHA256) +import Data.ByteArray (ByteArrayAccess, convert) +import Data.ByteArray.Encoding (Base(Base16), convertToBase) +import Data.ByteString (ByteString) +import GHC.Generics (Generic) + +import qualified Crypto.Hash +import qualified Data.ByteString.Char8 as ByteString.Char8 + +newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } + deriving (Eq, Generic, Ord, NFData, ByteArrayAccess) + +instance Show SHA256Digest where + show (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes + +sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest +sha256DigestFromByteString bytes = SHA256Digest . convert <$> mh + where + mh = Crypto.Hash.digestFromByteString bytes :: Maybe (Crypto.Hash.Digest SHA256) + +sha256Hash :: ByteString -> SHA256Digest +sha256Hash bytes = SHA256Digest $ convert h + where + h = Crypto.Hash.hash bytes :: Crypto.Hash.Digest SHA256 diff --git a/ghc-src/Dhall/Import/HTTP.hs b/ghc-src/Dhall/Import/HTTP.hs new file mode 100644 --- /dev/null +++ b/ghc-src/Dhall/Import/HTTP.hs @@ -0,0 +1,294 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.Import.HTTP where + +import Control.Exception (Exception) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Trans.State.Strict (StateT) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) +import Data.Dynamic (toDyn) +import Data.Semigroup ((<>)) + +import Dhall.Core + ( Import(..) + , ImportHashed(..) + , ImportType(..) + , Scheme(..) + , URL(..) + ) +import Dhall.URL (renderURL) + +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Text as Text +import qualified Data.Text.Encoding +import qualified Dhall.Util + +import Dhall.Import.Types + +import qualified Control.Exception +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Encoding + +#if MIN_VERSION_http_client(0,5,0) +import Network.HTTP.Client + (HttpException(..), HttpExceptionContent(..), Manager) +#else +import Network.HTTP.Client (HttpException(..), Manager) +#endif + +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Client.TLS as HTTP +import qualified Network.HTTP.Types + +mkPrettyHttpException :: String -> HttpException -> PrettyHttpException +mkPrettyHttpException url ex = + PrettyHttpException (renderPrettyHttpException url ex) (toDyn ex) + +renderPrettyHttpException :: String -> HttpException -> String +#if MIN_VERSION_http_client(0,5,0) +renderPrettyHttpException _ (InvalidUrlException _ r) = + "\n" + <> "\ESC[1;31mError\ESC[0m: Invalid URL\n" + <> "\n" + <> "URL: " <> show r <> "\n" +renderPrettyHttpException url (HttpExceptionRequest _ e) = + case e of + ConnectionFailure _ -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Remote host not found\n" + <> "\n" + <> "URL: " <> url <> "\n" + InvalidDestinationHost host -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Invalid remote host name:\n" + <> "\n" + <> "Host: " <> show host <> "\n" + ResponseTimeout -> + "\n" + <> "\ESC[1;31mError\ESC[0m: The remote host took too long to respond\n" + <> "\n" + <> "URL: " <> url <> "\n" + StatusCodeException response body -> prefix <> suffix + where + prefix + | statusCode == 401 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Access unauthorized\n" + | statusCode == 403 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Access forbidden\n" + | statusCode == 404 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Remote file not found\n" + | statusCode == 500 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Server-side failure\n" + | statusCode == 502 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Upstream failure\n" + | statusCode == 503 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Server temporarily unavailable\n" + | statusCode == 504 = + "\n" + <> "\ESC[1;31mError\ESC[0m: Upstream timeout\n" + | otherwise = + "\n" + <> "\ESC[1;31mError\ESC[0m: HTTP request failure\n" + + suffix = + "\n" + <> "HTTP status code: " <> show statusCode <> "\n" + <> "\n" + <> "URL: " <> url <> "\n" + <> message + + statusCode = + Network.HTTP.Types.statusCode + (HTTP.responseStatus response) + + message = + case Data.Text.Encoding.decodeUtf8' body of + Left _ -> + "\n" + <> "Message (non-UTF8 bytes):\n" + <> "\n" + <> truncatedBodyString <> "\n" + where + bodyString = show body + + dots = "…" + + truncatedLength = 80 - length dots + + truncatedBodyString + | truncatedLength < length bodyString = + take truncatedLength bodyString <> dots + | otherwise = + bodyString + Right "" -> + "" + Right bodyText -> + "\n" + <> "Message:\n" + <> "\n" + <> Text.unpack prefixedText + where + prefixedLines = + zipWith combine prefixes (Text.lines bodyText) + where + prefixes = + map (Text.pack . show) [(1 ::Int)..7] ++ [ "…" ] + + combine n line = n <> "│ " <> line + + prefixedText = Text.unlines prefixedLines + + e' -> "\n" <> show e' <> "\n" +#else +renderPrettyHttpException url e = case e of + FailedConnectionException2 _ _ _ e' -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Wrong host:\n" + <> "\n" + <> "Host: " <> show e' <> "\n" + InvalidDestinationHost host -> + "\n" + <> "\ESC[1;31mError\ESC[0m: Invalid host name:\n" + <> "\n" + <> "Host: " <> show host <> "\n" + ResponseTimeout -> + "\ESC[1;31mError\ESC[0m: The host took too long to respond\n" + <> "\n" + <> "URL: " <> url <> "\n" + e' -> "\n" + <> show e' <> "\n" +#endif + +newManager :: IO Manager +newManager = do + let settings = HTTP.tlsManagerSettings +#ifdef MIN_VERSION_http_client +#if MIN_VERSION_http_client(0,5,0) + { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (30 * 1000 * 1000) } -- 30 seconds +#else + { HTTP.managerResponseTimeout = Just (30 * 1000 * 1000) } -- 30 seconds +#endif +#endif + HTTP.newManager settings + +data NotCORSCompliant = NotCORSCompliant + { expectedOrigins :: [ByteString] + , actualOrigin :: ByteString + } + +instance Exception NotCORSCompliant + +instance Show NotCORSCompliant where + show (NotCORSCompliant {..}) = + Dhall.Util._ERROR <> ": Not CORS compliant\n" + <> "\n" + <> "Dhall supports transitive imports, meaning that an imported expression can\n" + <> "import other expressions. However, a remote import (the \"parent\" import)\n" + <> "cannot import another remote import (the \"child\" import) unless the child\n" + <> "import grants permission to do using CORS. The child import must respond with\n" + <> "an `Access-Control-Allow-Origin` response header that matches the parent\n" + <> "import, otherwise Dhall rejects the import.\n" + <> "\n" <> prologue + where + prologue = + case expectedOrigins of + [ expectedOrigin ] -> + "The following parent import:\n" + <> "\n" + <> "↳ " <> show actualOrigin <> "\n" + <> "\n" + <> "... did not match the expected origin:\n" + <> "\n" + <> "↳ " <> show expectedOrigin <> "\n" + <> "\n" + <> "... so import resolution failed.\n" + [] -> + "The child response did not include any `Access-Control-Allow-Origin` header,\n" + <> "so import resolution failed.\n" + _:_:_ -> + "The child response included more than one `Access-Control-Allow-Origin` header,\n" + <> "when only one such header should have been present, so import resolution\n" + <> "failed.\n" + <> "\n" + <> "This may indicate that the server for the child import is misconfigured.\n" + +corsCompliant + :: MonadIO io + => ImportType -> URL -> [(CI ByteString, ByteString)] -> io () +corsCompliant (Remote parentURL) childURL responseHeaders = liftIO $ do + let toOrigin (URL {..}) = + Data.Text.Encoding.encodeUtf8 (prefix <> "://" <> authority) + where + prefix = + case scheme of + HTTP -> "http" + HTTPS -> "https" + + let actualOrigin = toOrigin parentURL + + let childOrigin = toOrigin childURL + + let predicate (header, _) = header == "Access-Control-Allow-Origin" + + let originHeaders = filter predicate responseHeaders + + let expectedOrigins = map snd originHeaders + + case expectedOrigins of + [expectedOrigin] + | expectedOrigin == "*" -> + return () + | expectedOrigin == actualOrigin -> + return () + _ | actualOrigin == childOrigin -> + return () + | otherwise -> + Control.Exception.throwIO (NotCORSCompliant {..}) +corsCompliant _ _ _ = return () + +type HTTPHeader = Network.HTTP.Types.Header + +fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text +fetchFromHttpUrl childURL mheaders = do + manager <- liftIO $ newManager + + let childURLString = Text.unpack (renderURL childURL) + + request <- liftIO (HTTP.parseUrlThrow childURLString) + + let requestWithHeaders = + case mheaders of + Nothing -> request + Just headers -> request { HTTP.requestHeaders = headers } + + let io = HTTP.httpLbs requestWithHeaders manager + + let handler e = do + let _ = e :: HttpException + Control.Exception.throwIO (mkPrettyHttpException childURLString e) + + response <- liftIO (Control.Exception.handle handler io) + + Status {..} <- State.get + + let Chained parentImport = NonEmpty.head _stack + + let parentImportType = importType (importHashed parentImport) + + corsCompliant parentImportType childURL (HTTP.responseHeaders response) + + let bytes = HTTP.responseBody response + + case Data.Text.Lazy.Encoding.decodeUtf8' bytes of + Left err -> liftIO (Control.Exception.throwIO err) + Right text -> return (Data.Text.Lazy.toStrict text) diff --git a/ghcjs-src/Dhall/Crypto.hs b/ghcjs-src/Dhall/Crypto.hs new file mode 100644 --- /dev/null +++ b/ghcjs-src/Dhall/Crypto.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE JavaScriptFFI #-} + +module Dhall.Crypto ( + SHA256Digest(..) + , sha256DigestFromByteString + , sha256Hash + ) where + +import Control.DeepSeq (NFData) +import Data.ByteArray (ByteArrayAccess) +import Data.ByteArray.Encoding (Base(Base16), convertToBase) +import Data.ByteString (ByteString) +import GHC.Generics (Generic) +import JavaScript.TypedArray.ArrayBuffer (ArrayBuffer) +import System.IO.Unsafe (unsafePerformIO) + +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as ByteString.Char8 +import qualified GHCJS.Buffer as Buffer + +newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } + deriving (Eq, Generic, Ord, NFData, ByteArrayAccess) + +instance Show SHA256Digest where + show (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes + +sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest +sha256DigestFromByteString bytes + | ByteString.length bytes == 32 = Just $ SHA256Digest bytes + | otherwise = Nothing + +-- Use NodeJS' crypto module if there's a 'process' module, e.g. we're running +-- inside GHCJS' THRunner. If we're running in the browser, use the WebCrypto +-- interface. +foreign import javascript interruptible + "if (typeof process === 'undefined') { \ + \ crypto.subtle.digest('SHA-256', $1).then($c) \ + \} else { \ + \ $c(require('crypto').createHash('sha256').update(Buffer.from($1)).digest().buffer) \ + \}" + js_sha256Hash :: ArrayBuffer -> IO ArrayBuffer + +byteStringToArrayBuffer :: ByteString -> ArrayBuffer +byteStringToArrayBuffer b = + js_arrayBufferSlice offset len $ Buffer.getArrayBuffer buffer + where + (buffer, offset, len) = Buffer.fromByteString b + +foreign import javascript unsafe "$3.slice($1, $1 + $2)" + js_arrayBufferSlice :: Int -> Int -> ArrayBuffer -> ArrayBuffer + +arrayBufferToByteString :: ArrayBuffer -> ByteString +arrayBufferToByteString = + Buffer.toByteString 0 Nothing . Buffer.createFromArrayBuffer + +sha256Hash :: ByteString -> SHA256Digest +sha256Hash bytes + | ByteString.length out == 32 = SHA256Digest out + | otherwise = error "sha256Hash: didn't produce 32 bytes" + where + out = + arrayBufferToByteString $ + unsafePerformIO $ js_sha256Hash (byteStringToArrayBuffer bytes) diff --git a/ghcjs-src/Dhall/Import/HTTP.hs b/ghcjs-src/Dhall/Import/HTTP.hs new file mode 100644 --- /dev/null +++ b/ghcjs-src/Dhall/Import/HTTP.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.Import.HTTP where + +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Trans.State.Strict (StateT) +import Data.ByteString (ByteString) +import Data.CaseInsensitive (CI) +import Data.Semigroup ((<>)) + +import qualified Data.Text as Text +import qualified JavaScript.XHR + +import Dhall.Core (URL(..)) +import Dhall.URL (renderURL) +import Dhall.Import.Types + +fetchFromHttpUrl + :: URL + -> Maybe [(CI ByteString, ByteString)] + -> StateT Status IO Text.Text +fetchFromHttpUrl childURL Nothing = do + let childURLText = renderURL childURL + + let childURLString = Text.unpack childURLText + + -- No need to add a CORS compliance check when using GHCJS. The browser + -- will already check the CORS compliance of the following XHR + (statusCode, body) <- liftIO (JavaScript.XHR.get childURLText) + + case statusCode of + 200 -> return () + _ -> fail (childURLString <> " returned a non-200 status code: " <> show statusCode) + + return body +fetchFromHttpUrl _ _ = do + fail "Dhall does not yet support custom headers when built using GHCJS" diff --git a/src/Dhall.hs b/src/Dhall.hs --- a/src/Dhall.hs +++ b/src/Dhall.hs @@ -58,6 +58,7 @@ , auto , genericAuto , InterpretOptions(..) + , SingletonConstructors(..) , defaultInterpretOptions , bool , natural @@ -892,7 +893,7 @@ expectedOut = Pi "_" declared expectedIn - InputType {..} = inject + InputType {..} = injectWith opts Type extractIn expectedIn = autoWith opts @@ -1031,12 +1032,39 @@ , constructorModifier :: Text -> Text -- ^ Function used to transform Haskell constructor names into their -- corresponding Dhall alternative names + , singletonConstructors :: SingletonConstructors + -- ^ Specify how to handle constructors with only one field. The default is + -- `Wrapped` for backwards compatibility but will eventually be changed to + -- `Smart` , inputNormalizer :: Dhall.Core.ReifiedNormalizer X -- ^ This is only used by the `Interpret` instance for functions in order -- to normalize the function input before marshaling the input into a -- Dhall expression } +{-| This type specifies how to model a Haskell constructor with 1 field in + Dhall + + For example, consider the following Haskell datatype definition: + + > data Example = Foo { x :: Double } | Bar Double + + Depending on which option you pick, the corresponding Dhall type could be: + + > < Foo : Double | Bar : Double > -- Bare + + > < Foo : { x : Double } | Bar : { _1 : Double } > -- Wrapped + + > < Foo : { x : Double } | Bar : Double > -- Smart +-} +data SingletonConstructors + = Bare + -- ^ Never wrap the field in a record + | Wrapped + -- ^ Always wrap the field in a record + | Smart + -- ^ Only fields in a record if they are named + {-| Default interpret options, which you can tweak or override, like this: > autoWith @@ -1044,9 +1072,14 @@ -} defaultInterpretOptions :: InterpretOptions defaultInterpretOptions = InterpretOptions - { fieldModifier = id - , constructorModifier = id - , inputNormalizer = Dhall.Core.ReifiedNormalizer (const (pure Nothing)) + { fieldModifier = + id + , constructorModifier = + id + , singletonConstructors = + Wrapped + , inputNormalizer = + Dhall.Core.ReifiedNormalizer (const (pure Nothing)) } {-| This is the underlying class that powers the `Interpret` class's support @@ -1222,47 +1255,167 @@ expected = Record (Dhall.Map.fromList []) -instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g) where +getSelName :: Selector s => M1 i s f a -> State Int Text +getSelName n = case selName n of + "" -> do i <- get + put (i + 1) + pure (Data.Text.pack ("_" ++ show i)) + nn -> pure (Data.Text.pack nn) + +instance (GenericInterpret (f :*: g), GenericInterpret (h :*: i)) => GenericInterpret ((f :*: g) :*: (h :*: i)) where genericAutoWith options = do Type extractL expectedL <- genericAutoWith options Type extractR expectedR <- genericAutoWith options - let ktsL = unsafeExpectRecord "genericAutoWith (:*:)"expectedL - let ktsR = unsafeExpectRecord "genericAutoWith (:*:)"expectedR - pure - (Type - { extract = liftA2 (liftA2 (:*:)) extractL extractR - , expected = Record (Dhall.Map.union ktsL ktsR) - } - ) -getSelName :: Selector s => M1 i s f a -> State Int String -getSelName n = case selName n of - "" -> do i <- get - put (i + 1) - pure ("_" ++ show i) - nn -> pure nn + let ktsL = unsafeExpectRecord "genericAutoWith (:*:)" expectedL + let ktsR = unsafeExpectRecord "genericAutoWith (:*:)" expectedR + let expected = Record (Dhall.Map.union ktsL ktsR) + + let extract expression = + liftA2 (:*:) (extractL expression) (extractR expression) + + return (Type {..}) + +instance (GenericInterpret (f :*: g), Selector s, Interpret a) => GenericInterpret ((f :*: g) :*: M1 S s (K1 i a)) where + genericAutoWith options@InterpretOptions{..} = do + let nR :: M1 S s (K1 i a) r + nR = undefined + + nameR <- fmap fieldModifier (getSelName nR) + + Type extractL expectedL <- genericAutoWith options + + let Type extractR expectedR = autoWith options + + let ktsL = unsafeExpectRecord "genericAutoWith (:*:)" expectedL + + let expected = Record (Dhall.Map.insert nameR expectedR ktsL) + + let extract expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> + case Dhall.Map.lookup nameR kvs of + Just expressionR -> + liftA2 (:*:) + (extractL expression) + (fmap (M1 . K1) (extractR expressionR)) + _ -> die + _ -> die + + return (Type {..}) + +instance (Selector s, Interpret a, GenericInterpret (f :*: g)) => GenericInterpret (M1 S s (K1 i a) :*: (f :*: g)) where + genericAutoWith options@InterpretOptions{..} = do + let nL :: M1 S s (K1 i a) r + nL = undefined + + nameL <- fmap fieldModifier (getSelName nL) + + let Type extractL expectedL = autoWith options + + Type extractR expectedR <- genericAutoWith options + + let ktsR = unsafeExpectRecord "genericAutoWith (:*:)" expectedR + + let expected = Record (Dhall.Map.insert nameL expectedL ktsR) + + let extract expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> + case Dhall.Map.lookup nameL kvs of + Just expressionL -> + liftA2 (:*:) + (fmap (M1 . K1) (extractL expressionL)) + (extractR expression) + _ -> die + _ -> die + + return (Type {..}) + +instance (Selector s1, Selector s2, Interpret a1, Interpret a2) => GenericInterpret (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where + genericAutoWith options@InterpretOptions{..} = do + let nL :: M1 S s1 (K1 i1 a1) r + nL = undefined + + let nR :: M1 S s2 (K1 i2 a2) r + nR = undefined + + nameL <- fmap fieldModifier (getSelName nL) + nameR <- fmap fieldModifier (getSelName nR) + + let Type extractL expectedL = autoWith options + let Type extractR expectedR = autoWith options + + let expected = + Record + (Dhall.Map.fromList + [ (nameL, expectedL) + , (nameR, expectedR) + ] + ) + + let extract expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> do + case liftA2 (,) (Dhall.Map.lookup nameL kvs) (Dhall.Map.lookup nameR kvs) of + Just (expressionL, expressionR) -> + liftA2 (:*:) + (fmap (M1 . K1) (extractL expressionL)) + (fmap (M1 . K1) (extractR expressionR)) + Nothing -> die + _ -> die + + return (Type {..}) + instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where - genericAutoWith opts@(InterpretOptions {..}) = do - name <- getSelName n + genericAutoWith options@InterpretOptions{..} = do + let n :: M1 S s (K1 i a) r + n = undefined + + name <- fmap fieldModifier (getSelName n) + + let Type { extract = extract', expected = expected'} = autoWith options + let expected = - Record (Dhall.Map.fromList [(key, expected')]) - where - key = fieldModifier (Data.Text.pack name) - let extract expr@(RecordLit m) = - let name' = fieldModifier (Data.Text.pack name) - extract'' e = fmap (M1 . K1) (extract' e) - lookupRes = Dhall.Map.lookup name' m - typeError' = typeError expected expr - in Data.Maybe.maybe typeError' extract'' lookupRes - extract expr = typeError expected expr - pure (Type {..}) - where - n :: M1 i s f a - n = undefined + case singletonConstructors of + Bare -> + expected' + Smart | selName n == "" -> + expected' + _ -> + Record (Dhall.Map.singleton name expected') - Type extract' expected' = autoWith opts + let extract0 expression = fmap (M1 . K1) (extract' expression) + let extract1 expression = do + let die = typeError expected expression + + case expression of + RecordLit kvs -> do + case Dhall.Map.lookup name kvs of + Just subExpression -> + fmap (M1 . K1) (extract' subExpression) + Nothing -> + die + _ -> do + die + + + let extract = + case singletonConstructors of + Bare -> extract0 + Smart | selName n == "" -> extract0 + _ -> extract1 + + return (Type {..}) + {-| An @(InputType a)@ represents a way to marshal a value of type @\'a\'@ from Haskell into Dhall -} @@ -1460,6 +1613,38 @@ res <- genericInjectWith options pure (contramap unM1 res) +instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where + genericInjectWith options@InterpretOptions{..} = do + let InputType { embed = embed', declared = declared' } = + injectWith options + + let n :: M1 S s (K1 i a) r + n = undefined + + name <- fieldModifier <$> getSelName n + + let embed0 (M1 (K1 x)) = embed' x + + let embed1 (M1 (K1 x)) = + RecordLit (Dhall.Map.singleton name (embed' x)) + + let embed = + case singletonConstructors of + Bare -> embed0 + Smart | selName n == "" -> embed0 + _ -> embed1 + + let declared = + case singletonConstructors of + Bare -> + declared' + Smart | selName n == "" -> + declared' + _ -> + Record (Dhall.Map.singleton name declared') + + return (InputType {..}) + instance (Constructor c1, Constructor c2, GenericInject f1, GenericInject f2) => GenericInject (M1 C c1 f1 :+: M1 C c2 f2) where genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) where @@ -1577,47 +1762,107 @@ ktsL = unsafeExpectUnion "genericInjectWith (:+:)" declaredL ktsR = unsafeExpectUnion "genericInjectWith (:+:)" declaredR -instance (GenericInject f, GenericInject g) => GenericInject (f :*: g) where +instance (GenericInject (f :*: g), GenericInject (h :*: i)) => GenericInject ((f :*: g) :*: (h :*: i)) where genericInjectWith options = do - InputType embedInL declaredInL <- genericInjectWith options - InputType embedInR declaredInR <- genericInjectWith options + InputType embedL declaredL <- genericInjectWith options + InputType embedR declaredR <- genericInjectWith options let embed (l :*: r) = RecordLit (Dhall.Map.union mapL mapR) where mapL = - unsafeExpectRecordLit "genericInjectWith (:*:)" (embedInL l) + unsafeExpectRecordLit "genericInjectWith (:*:)" (embedL l) mapR = - unsafeExpectRecordLit "genericInjectWith (:*:)" (embedInR r) + unsafeExpectRecordLit "genericInjectWith (:*:)" (embedR r) let declared = Record (Dhall.Map.union mapL mapR) where - mapL = unsafeExpectRecord "genericInjectWith (:*:)" declaredInL - mapR = unsafeExpectRecord "genericInjectWith (:*:)" declaredInR + mapL = unsafeExpectRecord "genericInjectWith (:*:)" declaredL + mapR = unsafeExpectRecord "genericInjectWith (:*:)" declaredR pure (InputType {..}) +instance (GenericInject (f :*: g), Selector s, Inject a) => GenericInject ((f :*: g) :*: M1 S s (K1 i a)) where + genericInjectWith options@InterpretOptions{..} = do + let nR :: M1 S s (K1 i a) r + nR = undefined + + nameR <- fmap fieldModifier (getSelName nR) + + InputType embedL declaredL <- genericInjectWith options + + let InputType embedR declaredR = injectWith options + + let embed (l :*: M1 (K1 r)) = + RecordLit (Dhall.Map.insert nameR (embedR r) mapL) + where + mapL = + unsafeExpectRecordLit "genericInjectWith (:*:)" (embedL l) + + let declared = Record (Dhall.Map.insert nameR declaredR mapL) + where + mapL = unsafeExpectRecord "genericInjectWith (:*:)" declaredL + + return (InputType {..}) + +instance (Selector s, Inject a, GenericInject (f :*: g)) => GenericInject (M1 S s (K1 i a) :*: (f :*: g)) where + genericInjectWith options@InterpretOptions{..} = do + let nL :: M1 S s (K1 i a) r + nL = undefined + + nameL <- fmap fieldModifier (getSelName nL) + + let InputType embedL declaredL = injectWith options + + InputType embedR declaredR <- genericInjectWith options + + let embed (M1 (K1 l) :*: r) = + RecordLit (Dhall.Map.insert nameL (embedL l) mapR) + where + mapR = + unsafeExpectRecordLit "genericInjectWith (:*:)" (embedR r) + + let declared = Record (Dhall.Map.insert nameL declaredL mapR) + where + mapR = unsafeExpectRecord "genericInjectWith (:*:)" declaredR + + return (InputType {..}) + +instance (Selector s1, Selector s2, Inject a1, Inject a2) => GenericInject (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where + genericInjectWith options@InterpretOptions{..} = do + let nL :: M1 S s1 (K1 i1 a1) r + nL = undefined + + let nR :: M1 S s2 (K1 i2 a2) r + nR = undefined + + nameL <- fmap fieldModifier (getSelName nL) + nameR <- fmap fieldModifier (getSelName nR) + + let InputType embedL declaredL = injectWith options + let InputType embedR declaredR = injectWith options + + let embed (M1 (K1 l) :*: M1 (K1 r)) = + RecordLit + (Dhall.Map.fromList + [ (nameL, embedL l), (nameR, embedR r) ] + ) + + let declared = + Record + (Dhall.Map.fromList + [ (nameL, declaredL), (nameR, declaredR) ] + ) + + return (InputType {..}) + instance GenericInject U1 where genericInjectWith _ = pure (InputType {..}) where embed _ = RecordLit mempty declared = Record mempty - -instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where - genericInjectWith opts@(InterpretOptions {..}) = do - name <- fieldModifier . Data.Text.pack <$> getSelName n - let embed (M1 (K1 x)) = - RecordLit (Dhall.Map.singleton name (embedIn x)) - let declared = - Record (Dhall.Map.singleton name declaredIn) - pure (InputType {..}) - where - n :: M1 i s f a - n = undefined - - InputType embedIn declaredIn = injectWith opts {-| The 'RecordType' applicative functor allows you to build a 'Type' parser from a Dhall record. diff --git a/src/Dhall/Binary.hs b/src/Dhall/Binary.hs --- a/src/Dhall/Binary.hs +++ b/src/Dhall/Binary.hs @@ -50,12 +50,12 @@ import Data.Void (Void, absurd) import GHC.Float (double2Float, float2Double) -import qualified Crypto.Hash import qualified Control.Monad as Monad import qualified Data.ByteArray import qualified Data.ByteString import qualified Data.Sequence import qualified Dhall.Core +import qualified Dhall.Crypto import qualified Dhall.Map import qualified Dhall.Set @@ -767,7 +767,7 @@ "\x12\x20" -> return () _ -> empty - digest <- case Crypto.Hash.digestFromByteString suffix of + digest <- case Dhall.Crypto.sha256DigestFromByteString suffix of Nothing -> empty Just digest -> return digest diff --git a/src/Dhall/Core.hs b/src/Dhall/Core.hs --- a/src/Dhall/Core.hs +++ b/src/Dhall/Core.hs @@ -35,19 +35,20 @@ , Expr(..) -- * Normalization - , Dhall.Core.alphaNormalize - , normalize + , Eval.alphaNormalize + , Eval.normalize , normalizeWith , normalizeWithM , Normalizer , NormalizerM , ReifiedNormalizer (..) - , judgmentallyEqual + , Eval.judgmentallyEqual , subst , shift , isNormalized , isNormalizedWith , denote + , renote , shallowDenote , freeIn @@ -72,17 +73,15 @@ , escapeText , pathCharacter , throws + , textShow + , censorExpression + , censorText ) where -#if MIN_VERSION_base(4,8,0) -#else -import Control.Applicative (Applicative(..), (<$>)) -#endif import Control.Applicative (empty) import Control.DeepSeq (NFData) import Control.Exception (Exception) import Control.Monad.IO.Class (MonadIO(..)) -import Crypto.Hash (SHA256) import Data.Bifunctor (Bifunctor(..)) import Data.Data (Data) import Data.Foldable @@ -95,26 +94,30 @@ import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty) import Data.Traversable +import Data.Void (Void) import Dhall.Map (Map) import Dhall.Set (Set) -import Dhall.Src (Src) +import Dhall.Src (Src(..)) import {-# SOURCE #-} Dhall.Pretty.Internal import GHC.Generics (Generic) import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) +import Lens.Family (over) import Numeric.Natural (Natural) import Prelude hiding (succ) +import Unsafe.Coerce (unsafeCoerce) import qualified Control.Exception import qualified Control.Monad -import qualified Crypto.Hash import qualified Data.Char -import {-# SOURCE #-} qualified Dhall.Eval +import {-# SOURCE #-} qualified Dhall.Eval as Eval import qualified Data.HashSet import qualified Data.List.NonEmpty import qualified Data.Sequence +import qualified Data.Set import qualified Data.Text import qualified Data.Text.Prettyprint.Doc as Pretty +import qualified Dhall.Crypto import qualified Dhall.Map import qualified Dhall.Set import qualified Network.URI as URI @@ -288,7 +291,7 @@ -- | A `ImportType` extended with an optional hash for semantic integrity checks data ImportHashed = ImportHashed - { hash :: Maybe (Crypto.Hash.Digest SHA256) + { hash :: Maybe Dhall.Crypto.SHA256Digest , importType :: ImportType } deriving (Eq, Generic, Ord, Show, NFData) @@ -1219,35 +1222,6 @@ -- and `subst` does nothing to a closed expression subst _ _ (Embed p) = Embed p -{-| α-normalize an expression by renaming all bound variables to @\"_\"@ and - using De Bruijn indices to distinguish them - ->>> alphaNormalize (Lam "a" (Const Type) (Lam "b" (Const Type) (Lam "x" "a" (Lam "y" "b" "x")))) -Lam "_" (Const Type) (Lam "_" (Const Type) (Lam "_" (Var (V "_" 1)) (Lam "_" (Var (V "_" 1)) (Var (V "_" 1))))) - - α-normalization does not affect free variables: - ->>> alphaNormalize "x" -Var (V "x" 0) - --} -alphaNormalize :: Expr s a -> Expr s a -alphaNormalize = Dhall.Eval.alphaNormalize - -{-| Reduce an expression to its normal form, performing beta reduction - - `normalize` does not type-check the expression. You may want to type-check - expressions before normalizing them since normalization can convert an - ill-typed expression into a well-typed expression. - - `normalize` can also fail with `error` if you normalize an ill-typed - expression --} - -normalize :: Eq a => Expr s a -> Expr t a -normalize = Dhall.Eval.nfEmpty - - {-| This function is used to determine whether folds like @Natural/fold@ or @List/fold@ should be lazy or strict in their accumulator based on the type of the accumulator @@ -1345,6 +1319,11 @@ denote (ImportAlt a b ) = ImportAlt (denote a) (denote b) denote (Embed a ) = Embed a +-- | The \"opposite\" of `denote`, like @first absurd@ but faster +renote :: Expr Void a -> Expr s a +renote = unsafeCoerce +{-# INLINE renote #-} + shallowDenote :: Expr s a -> Expr s a shallowDenote (Note _ e) = shallowDenote e shallowDenote e = e @@ -1368,7 +1347,7 @@ -} normalizeWith :: Eq a => Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a normalizeWith (Just ctx) t = runIdentity (normalizeWithM (getReifiedNormalizer ctx) t) -normalizeWith _ t = Dhall.Eval.nfEmpty t +normalizeWith _ t = Eval.normalize t {-| This function generalizes `normalizeWith` by allowing the custom normalizer to use an arbitrary `Monad` @@ -1459,7 +1438,7 @@ | otherwise -> pure (NaturalLit 0) App (App NaturalSubtract (NaturalLit 0)) y -> pure y App (App NaturalSubtract _) (NaturalLit 0) -> pure (NaturalLit 0) - App (App NaturalSubtract x) y | judgmentallyEqual x y -> pure (NaturalLit 0) + App (App NaturalSubtract x) y | Eval.judgmentallyEqual x y -> pure (NaturalLit 0) App IntegerShow (IntegerLit n) | 0 <= n -> pure (TextLit (Chunks [] ("+" <> Data.Text.pack (show n)))) | otherwise -> pure (TextLit (Chunks [] (Data.Text.pack (show n)))) @@ -1588,8 +1567,8 @@ decide l (BoolLit True ) = l decide _ (BoolLit False) = BoolLit False decide l r - | judgmentallyEqual l r = l - | otherwise = BoolAnd 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 @@ -1597,30 +1576,30 @@ decide l (BoolLit False) = l decide _ (BoolLit True ) = BoolLit True decide l r - | judgmentallyEqual l r = l - | otherwise = BoolOr 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 - | judgmentallyEqual l r = BoolLit True - | otherwise = BoolEQ 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 - | judgmentallyEqual l r = BoolLit False - | otherwise = BoolNE 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 - | judgmentallyEqual l r = l - | otherwise = BoolIf b l r + | Eval.judgmentallyEqual l r = l + | otherwise = BoolIf b l r Natural -> pure Natural NaturalLit n -> pure (NaturalLit n) NaturalFold -> pure NaturalFold @@ -1733,7 +1712,7 @@ l decide (RecordLit m) (RecordLit n) = RecordLit (Dhall.Map.union n m) - decide l r | judgmentallyEqual l r = + decide l r | Eval.judgmentallyEqual l r = l decide l r = Prefer l r @@ -1810,13 +1789,21 @@ Just v -> pure (Field (Combine l (singletonRecordLit v)) x) Nothing -> loop (Field l x) _ -> pure (Field r' x) - Project r (Left xs)-> do - r' <- loop r - case r' of + Project x (Left fields)-> do + x' <- loop x + let fieldsSet = Dhall.Set.toSet fields + case x' of RecordLit kvs -> - pure (RecordLit (Dhall.Map.restrictKeys kvs (Dhall.Set.toSet xs))) - _ | null xs -> pure (RecordLit mempty) - | otherwise -> pure (Project r' (Left (Dhall.Set.sort xs))) + pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet)) + Project y _ -> + loop (Project y (Left fields)) + Prefer l (RecordLit rKvs) -> do + let rKs = Dhall.Map.keysSet rKvs + let l' = Project l (Left (Dhall.Set.fromSet (Data.Set.difference fieldsSet rKs))) + let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet) + loop (Prefer l' r') + _ | null fields -> pure (RecordLit mempty) + | otherwise -> pure (Project x' (Left (Dhall.Set.sort fields))) Project r (Right e1) -> do e2 <- loop e1 @@ -1853,15 +1840,6 @@ f c | c <= '\x1F' = Data.Text.pack (Text.Printf.printf "\\u%04x" (Data.Char.ord c)) | otherwise = Data.Text.singleton c -{-| Returns `True` if two expressions are α-equivalent and β-equivalent and - `False` otherwise - - `judgmentallyEqual` can fail with an `error` if you compare ill-typed - expressions --} -judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool -judgmentallyEqual = Dhall.Eval.convEmpty - -- | Use this to wrap you embedded functions (see `normalizeWith`) to make them -- polymorphic enough to be used. type NormalizerM m a = forall s. Expr s a -> m (Maybe (Expr s a)) @@ -1920,7 +1898,7 @@ App (App NaturalSubtract (NaturalLit _)) (NaturalLit _) -> False App (App NaturalSubtract (NaturalLit 0)) _ -> False App (App NaturalSubtract _) (NaturalLit 0) -> False - App (App NaturalSubtract x) y -> not (judgmentallyEqual x y) + App (App NaturalSubtract x) y -> not (Eval.judgmentallyEqual x y) App NaturalToInteger (NaturalLit _) -> False App IntegerShow (IntegerLit _) -> False App IntegerToDouble (IntegerLit _) -> False @@ -1946,28 +1924,28 @@ where decide (BoolLit _) _ = False decide _ (BoolLit _) = False - decide l r = not (judgmentallyEqual l r) + decide l r = not (Eval.judgmentallyEqual l r) BoolOr x y -> loop x && loop y && decide x y where decide (BoolLit _) _ = False decide _ (BoolLit _) = False - decide l r = not (judgmentallyEqual l r) + decide l r = not (Eval.judgmentallyEqual l r) BoolEQ x y -> loop x && loop y && decide x y where decide (BoolLit True) _ = False decide _ (BoolLit True) = False - decide l r = not (judgmentallyEqual l r) + decide l r = not (Eval.judgmentallyEqual l r) BoolNE x y -> loop x && loop y && decide x y where decide (BoolLit False) _ = False decide _ (BoolLit False ) = False - decide l r = not (judgmentallyEqual l r) + decide l r = not (Eval.judgmentallyEqual l r) BoolIf x y z -> loop x && loop y && loop z && decide x y z where decide (BoolLit _) _ _ = False decide _ (BoolLit True) (BoolLit False) = False - decide _ l r = not (judgmentallyEqual l r) + decide _ l r = not (Eval.judgmentallyEqual l r) Natural -> True NaturalLit _ -> True NaturalFold -> True @@ -2048,7 +2026,7 @@ decide (RecordLit m) _ | Data.Foldable.null m = False decide _ (RecordLit n) | Data.Foldable.null n = False decide (RecordLit _) (RecordLit _) = False - decide l r = not (judgmentallyEqual l r) + decide l r = not (Eval.judgmentallyEqual l r) Merge x y t -> loop x && loop y && all loop t ToMap x t -> case x of RecordLit _ -> False @@ -2065,6 +2043,8 @@ case p of Left s -> case r of RecordLit _ -> False + Project _ _ -> False + Prefer _ (RecordLit _) -> False _ -> not (Dhall.Set.null s) && Dhall.Set.isSorted s Right e' -> case e' of Record _ -> False @@ -2241,6 +2221,32 @@ subExpressions f (Note a b) = Note a <$> f b subExpressions f (ImportAlt l r) = ImportAlt <$> f l <*> f r subExpressions _ (Embed a) = pure (Embed a) + +{-| Utility used to implement the @--censor@ flag, by: + + * Replacing all `Src` text with spaces + * Replacing all `Text` literals inside type errors with spaces +-} +censorExpression :: Expr Src a -> Expr Src a +censorExpression (TextLit chunks) = TextLit (censorChunks chunks) +censorExpression (Note src e) = Note (censorSrc src) (censorExpression e) +censorExpression e = over subExpressions censorExpression e + +censorChunks :: Chunks Src a -> Chunks Src a +censorChunks (Chunks xys z) = Chunks xys' z' + where + z' = censorText z + + xys' = [ (censorText x, censorExpression y) | (x, y) <- xys ] + +-- | Utility used to censor `Text` by replacing all characters with a space +censorText :: Text -> Text +censorText = Data.Text.map (\_ -> ' ') + +censorSrc :: Src -> Src +censorSrc (Src { srcText = oldText, .. }) = Src { srcText = newText, .. } + where + newText = censorText oldText -- | A traversal over the immediate sub-expressions in 'Chunks'. chunkExprs diff --git a/src/Dhall/Eval.hs b/src/Dhall/Eval.hs --- a/src/Dhall/Eval.hs +++ b/src/Dhall/Eval.hs @@ -1,990 +1,1302 @@ -{-# LANGUAGE - BangPatterns, - CPP, - LambdaCase, - OverloadedStrings, - PatternSynonyms, - RankNTypes, - ScopedTypeVariables, - TupleSections, - ViewPatterns - #-} - -{-# OPTIONS_GHC - -O - -fno-warn-name-shadowing - -fno-warn-unused-matches - #-} - -{-| -Eval-apply environment machine with conversion checking and quoting to normal -forms. Fairly similar to GHCI's STG machine algorithmically, but much simpler, -with no known call optimization or environment trimming. - -Potential optimizations without changing Expr: - - In conversion checking, get non-shadowing variables not by linear - Env-walking, but by keeping track of Env size, and generating names which - are known to be illegal as source-level names (to rule out shadowing). - - Use HashMap Text chunks for large let-definitions blocks. "Large" vs "Small" - is fairly cheap to determine at evaluation time. - -Potential optimizations with changing Expr: - - Use Int in Var instead of Integer. Overflow is practically impossible. - - Use actual full de Bruijn indices in Var instead of Text counting indices. Then, we'd - switch to full de Bruijn levels in Val as well, and use proper constant time non-shadowing - name generation. - --} - -module Dhall.Eval ( - Env(..) - , Names(..) - , Closure(..) - , VChunks(..) - , Val(..) - , Void - , inst - , eval - , conv - , convEmpty - , quote - , nf - , nfEmpty - , Dhall.Eval.alphaNormalize - ) where - -#if MIN_VERSION_base(4,8,0) -#else -import Control.Applicative (Applicative(..), (<$>)) -#endif - -import Data.Foldable (foldr', toList) -import Data.Semigroup (Semigroup(..)) -import Data.Sequence (Seq) -import Data.Text (Text) -import Data.Void (Void) - -import Dhall.Core ( - Binding(..) - , Expr(..) - , Chunks(..) - , Const(..) - , Import - , Var(..) - , denote - ) - --- import Control.Exception (throw) --- import Dhall.Import.Types (InternalError) -import Dhall.Map (Map) -import Dhall.Set (Set) -import GHC.Natural (Natural) -import Unsafe.Coerce (unsafeCoerce) - -import qualified Codec.Serialise as Serialise -import qualified Data.Char -import qualified Data.Sequence -import qualified Data.Text -import qualified Dhall.Binary -import qualified Dhall.Map -import qualified Dhall.Set -import qualified Text.Printf - ----------------------------------------------------------------------------------------------------- - -data Env a = - Empty - | Skip !(Env a) {-# unpack #-} !Text - | Extend !(Env a) {-# unpack #-} !Text (Val a) - -coeExprVoid :: Expr Void a -> Expr s a -coeExprVoid = unsafeCoerce -{-# inline coeExprVoid #-} - -errorMsg :: String -errorMsg = unlines - [ _ERROR <> ": Compiler bug " - , " " - , "An ill-typed expression was encountered during normalization. " - , "Explanation: This error message means that there is a bug in the Dhall compiler." - , "You didn't do anything wrong, but if you would like to see this problem fixed " - , "then you should report the bug at: " - , " " - , "https://github.com/dhall-lang/dhall-haskell/issues " - ] - where - _ERROR :: String - _ERROR = "\ESC[1;31mError\ESC[0m" - - -data Closure a = Cl !Text !(Env a) !(Expr Void a) -data VChunks a = VChunks ![(Text, Val a)] !Text - -instance Semigroup (VChunks a) where - VChunks xys z <> VChunks [] z' = VChunks xys (z <> z') - VChunks xys z <> VChunks ((x', y'):xys') z' = VChunks (xys ++ (z <> x', y'):xys') z' - -instance Monoid (VChunks a) where - mempty = VChunks [] mempty - -#if !(MIN_VERSION_base(4,11,0)) - mappend = (<>) -#endif - -data HLamInfo a - = Prim - | Typed !Text (Val a) - | NaturalFoldCl (Val a) - | ListFoldCl (Val a) - | OptionalFoldCl (Val a) - | NaturalSubtractZero - -pattern VPrim :: (Val a -> Val a) -> Val a -pattern VPrim f = VHLam Prim f - -data Val a - = VConst !Const - | VVar !Text !Int - | VPrimVar - | VApp !(Val a) !(Val a) - - | VLam (Val a) {-# unpack #-} !(Closure a) - | VHLam !(HLamInfo a) !(Val a -> Val a) - - | VPi (Val a) {-# unpack #-} !(Closure a) - | VHPi !Text (Val a) !(Val a -> Val a) - - | VBool - | VBoolLit !Bool - | VBoolAnd !(Val a) !(Val a) - | VBoolOr !(Val a) !(Val a) - | VBoolEQ !(Val a) !(Val a) - | VBoolNE !(Val a) !(Val a) - | VBoolIf !(Val a) !(Val a) !(Val a) - - | VNatural - | VNaturalLit !Natural - | VNaturalFold !(Val a) !(Val a) !(Val a) !(Val a) - | VNaturalBuild !(Val a) - | VNaturalIsZero !(Val a) - | VNaturalEven !(Val a) - | VNaturalOdd !(Val a) - | VNaturalToInteger !(Val a) - | VNaturalShow !(Val a) - | VNaturalSubtract !(Val a) !(Val a) - | VNaturalPlus !(Val a) !(Val a) - | VNaturalTimes !(Val a) !(Val a) - - | VInteger - | VIntegerLit !Integer - | VIntegerShow !(Val a) - | VIntegerToDouble !(Val a) - - | VDouble - | VDoubleLit !Double - | VDoubleShow !(Val a) - - | VText - | VTextLit !(VChunks a) - | VTextAppend !(Val a) !(Val a) - | VTextShow !(Val a) - - | VList !(Val a) - | VListLit !(Maybe (Val a)) !(Seq (Val a)) - | VListAppend !(Val a) !(Val a) - | VListBuild (Val a) !(Val a) - | VListFold (Val a) !(Val a) !(Val a) !(Val a) !(Val a) - | VListLength (Val a) !(Val a) - | VListHead (Val a) !(Val a) - | VListLast (Val a) !(Val a) - | VListIndexed (Val a) !(Val a) - | VListReverse (Val a) !(Val a) - - | VOptional (Val a) - | VSome (Val a) - | VNone (Val a) - | VOptionalFold (Val a) !(Val a) (Val a) !(Val a) !(Val a) - | VOptionalBuild (Val a) !(Val a) - | VRecord !(Map Text (Val a)) - | VRecordLit !(Map Text (Val a)) - | VUnion !(Map Text (Maybe (Val a))) - | VCombine !(Val a) !(Val a) - | VCombineTypes !(Val a) !(Val a) - | VPrefer !(Val a) !(Val a) - | VMerge !(Val a) !(Val a) !(Maybe (Val a)) - | VToMap !(Val a) !(Maybe (Val a)) - | VField !(Val a) !Text - | VInject !(Map Text (Maybe (Val a))) !Text !(Maybe (Val a)) - | VProject !(Val a) !(Either (Set Text) (Val a)) - | VAssert !(Val a) - | VEquivalent !(Val a) !(Val a) - | VEmbed a - -vFun :: Val a -> Val a -> Val a -vFun a b = VHPi "_" a (\_ -> b) -{-# inline vFun #-} - --- Evaluation ----------------------------------------------------------------------------------------------------- - -textShow :: Text -> Text -textShow text = "\"" <> Data.Text.concatMap f text <> "\"" - where - f '"' = "\\\"" - f '$' = "\\u0024" - f '\\' = "\\\\" - f '\b' = "\\b" - f '\n' = "\\n" - f '\r' = "\\r" - f '\t' = "\\t" - f '\f' = "\\f" - f c | c <= '\x1F' = Data.Text.pack (Text.Printf.printf "\\u%04x" (Data.Char.ord c)) - | otherwise = Data.Text.singleton c - -countName :: Text -> Env a -> Int -countName x = go (0 :: Int) where - go !acc Empty = acc - go acc (Skip env x' ) = go (if x == x' then acc + 1 else acc) env - go acc (Extend env x' _) = go (if x == x' then acc + 1 else acc) env - -inst :: Eq a => Closure a -> Val a -> Val a -inst (Cl x env t) !u = eval (Extend env x u) t -{-# inline inst #-} - --- Out-of-env variables have negative de Bruijn levels. -vVar :: Env a -> Var -> Val a -vVar env (V x i) = go env i where - go (Extend env x' v) i - | x == x' = if i == 0 then v else go env (i - 1) - | otherwise = go env i - go (Skip env x') i - | x == x' = if i == 0 then VVar x (countName x env) else go env (i - 1) - | otherwise = go env i - go Empty i = VVar x (0 - i - 1) - -vApp :: Eq a => Val a -> Val a -> Val a -vApp !t !u = case t of - VLam _ t -> inst t u - VHLam _ t -> t u - t -> VApp t u -{-# inline vApp #-} - -vCombine :: Val a -> Val a -> Val a -vCombine t u = case (t, u) of - (VRecordLit m, u) | null m -> u - (t, VRecordLit m) | null m -> t - (VRecordLit m, VRecordLit m') -> VRecordLit (Dhall.Map.unionWith vCombine m m') - (t, u) -> VCombine t u - -vCombineTypes :: Val a -> Val a -> Val a -vCombineTypes t u = case (t, u) of - (VRecord m, u) | null m -> u - (t, VRecord m) | null m -> t - (VRecord m, VRecord m') -> VRecord (Dhall.Map.unionWith vCombineTypes m m') - (t, u) -> VCombineTypes t u - -vListAppend :: Val a -> Val a -> Val a -vListAppend t u = case (t, u) of - (VListLit _ xs, u) | null xs -> u - (t, VListLit _ ys) | null ys -> t - (VListLit t xs, VListLit _ ys) -> VListLit t (xs <> ys) - (t, u) -> VListAppend t u -{-# inline vListAppend #-} - -vNaturalPlus :: Val a -> Val a -> Val a -vNaturalPlus t u = case (t, u) of - (VNaturalLit 0, u ) -> u - (t, VNaturalLit 0) -> t - (VNaturalLit m, VNaturalLit n) -> VNaturalLit (m + n) - (t, u ) -> VNaturalPlus t u -{-# inline vNaturalPlus #-} - -vField :: Val a -> Text -> Val a -vField t0 k = go t0 where - go = \case - VUnion m -> case Dhall.Map.lookup k m of - Just (Just _) -> VPrim $ \ ~u -> VInject m k (Just u) - Just Nothing -> VInject m k Nothing - _ -> error errorMsg - VRecordLit m - | Just v <- Dhall.Map.lookup k m -> v - | otherwise -> error errorMsg - VProject t _ -> go t - VPrefer (VRecordLit m) r -> case Dhall.Map.lookup k m of - Just v -> VField (VPrefer (singletonVRecordLit v) r) k - Nothing -> go r - VPrefer l (VRecordLit m) -> case Dhall.Map.lookup k m of - Just v -> v - Nothing -> go l - VCombine (VRecordLit m) r -> case Dhall.Map.lookup k m of - Just v -> VField (VCombine (singletonVRecordLit v) r) k - Nothing -> go r - VCombine l (VRecordLit m) -> case Dhall.Map.lookup k m of - Just v -> VField (VCombine l (singletonVRecordLit v)) k - Nothing -> go l - t -> VField t k - - singletonVRecordLit v = VRecordLit (Dhall.Map.singleton k v) -{-# inline vField #-} - -eval :: forall a. Eq a => Env a -> Expr Void a -> Val a -eval !env t = - let - evalE :: Expr Void a -> Val a - evalE = eval env - {-# inline evalE #-} - - evalChunks :: Chunks Void a -> VChunks a - evalChunks (Chunks xys z) = - foldr' (\(x, t) vcs -> - case evalE t of - VTextLit vcs' -> VChunks [] x <> vcs' <> vcs - t -> VChunks [(x, t)] mempty <> vcs) - (VChunks [] z) - xys - {-# inline evalChunks #-} - - in case t of - Const k -> VConst k - Var v -> vVar env v - Lam x a t -> VLam (evalE a) (Cl x env t) - Pi x a b -> VPi (evalE a) (Cl x env b) - App t u -> vApp (evalE t) (evalE u) - Let (Binding _ x _ _mA _ a) b -> - let !env' = Extend env x (evalE a) - in eval env' b - Annot t _ -> evalE t - - Bool -> VBool - BoolLit b -> VBoolLit b - BoolAnd t u -> case (evalE t, evalE u) of - (VBoolLit True, u) -> u - (VBoolLit False, u) -> VBoolLit False - (t, VBoolLit True) -> t - (t, VBoolLit False) -> VBoolLit False - (t, u) | conv env t u -> t - (t, u) -> VBoolAnd t u - BoolOr t u -> case (evalE t, evalE u) of - (VBoolLit False, u) -> u - (VBoolLit True, u) -> VBoolLit True - (t, VBoolLit False) -> t - (t, VBoolLit True) -> VBoolLit True - (t, u) | conv env t u -> t - (t, u) -> VBoolOr t u - BoolEQ t u -> case (evalE t, evalE u) of - (VBoolLit True, u) -> u - (t, VBoolLit True) -> t - (t, u) | conv env t u -> VBoolLit True - (t, u) -> VBoolEQ t u - BoolNE t u -> case (evalE t, evalE u) of - (VBoolLit False, u) -> u - (t, VBoolLit False) -> t - (t, u) | conv env t u -> VBoolLit False - (t, u) -> VBoolNE t u - BoolIf b t f -> case (evalE b, evalE t, evalE f) of - (VBoolLit True, t, f) -> t - (VBoolLit False, t, f) -> f - (b, VBoolLit True, VBoolLit False) -> b - (b, t, f) | conv env t f -> t - (b, t, f) -> VBoolIf b t f - - Natural -> VNatural - NaturalLit n -> VNaturalLit n - NaturalFold -> VPrim $ \case - VNaturalLit n -> - VHLam (Typed "natural" (VConst Type)) $ \natural -> - VHLam (Typed "succ" (vFun natural natural)) $ \succ -> - VHLam (Typed "zero" natural) $ \zero -> - let go !acc 0 = acc - go acc n = go (vApp succ acc) (n - 1) - in go zero (fromIntegral n :: Integer) - n -> - VHLam (NaturalFoldCl n) $ \natural -> VPrim $ \succ -> VPrim $ \zero -> - VNaturalFold n natural succ zero - NaturalBuild -> VPrim $ \case - VHLam (NaturalFoldCl x) _ -> x - VPrimVar -> VNaturalBuild VPrimVar - t -> - t `vApp` VNatural - `vApp` VHLam (Typed "n" VNatural) (\n -> vNaturalPlus n (VNaturalLit 1)) - `vApp` VNaturalLit 0 - - NaturalIsZero -> VPrim $ \case VNaturalLit n -> VBoolLit (n == 0) - n -> VNaturalIsZero n - NaturalEven -> VPrim $ \case VNaturalLit n -> VBoolLit (even n) - n -> VNaturalEven n - NaturalOdd -> VPrim $ \case VNaturalLit n -> VBoolLit (odd n) - n -> VNaturalOdd n - NaturalToInteger -> VPrim $ \case VNaturalLit n -> VIntegerLit (fromIntegral n) - n -> VNaturalToInteger n - NaturalShow -> VPrim $ \case VNaturalLit n -> VTextLit (VChunks [] (Data.Text.pack (show n))) - n -> VNaturalShow n - NaturalSubtract -> VPrim $ \case - VNaturalLit 0 -> - VHLam NaturalSubtractZero id - x@(VNaturalLit m) -> - VPrim $ \case - VNaturalLit n - | n >= m -> VNaturalLit (subtract m n) - | otherwise -> VNaturalLit 0 - y -> VNaturalSubtract x y - x -> - VPrim $ \case - VNaturalLit 0 -> VNaturalLit 0 - y | conv env x y -> VNaturalLit 0 - y -> VNaturalSubtract x y - NaturalPlus t u -> vNaturalPlus (evalE t) (evalE u) - NaturalTimes t u -> case (evalE t, evalE u) of - (VNaturalLit 1, u ) -> u - (t, VNaturalLit 1) -> t - (VNaturalLit 0, u ) -> VNaturalLit 0 - (t, VNaturalLit 0) -> VNaturalLit 0 - (VNaturalLit m, VNaturalLit n) -> VNaturalLit (m * n) - (t, u ) -> VNaturalTimes t u - - Integer -> VInteger - IntegerLit n -> VIntegerLit n - IntegerShow -> VPrim $ \case - VIntegerLit n - | 0 <= n -> VTextLit (VChunks [] (Data.Text.pack ('+':show n))) - | otherwise -> VTextLit (VChunks [] (Data.Text.pack (show n))) - n -> VIntegerShow n - IntegerToDouble -> VPrim $ \case VIntegerLit n -> VDoubleLit (read (show n)) - -- `(read . show)` is used instead of `fromInteger` - -- because `read` uses the correct rounding rule - n -> VIntegerToDouble n - - Double -> VDouble - DoubleLit n -> VDoubleLit n - DoubleShow -> VPrim $ \case VDoubleLit n -> VTextLit (VChunks [] (Data.Text.pack (show n))) - n -> VDoubleShow n - - Text -> VText - TextLit cs -> case evalChunks cs of - VChunks [("", t)] "" -> t - vcs -> VTextLit vcs - TextAppend t u -> evalE (TextLit (Chunks [("", t), ("", u)] "")) - TextShow -> VPrim $ \case - VTextLit (VChunks [] x) -> VTextLit (VChunks [] (textShow x)) - t -> VTextShow t - - List -> VPrim VList - ListLit ma ts -> VListLit (evalE <$> ma) (evalE <$> ts) - ListAppend t u -> vListAppend (evalE t) (evalE u) - ListBuild -> VPrim $ \a -> VPrim $ \case - VHLam (ListFoldCl x) _ -> x - VPrimVar -> VListBuild a VPrimVar - t -> - t `vApp` VList a - `vApp` VHLam (Typed "a" a) (\x -> - VHLam (Typed "as" (VList a)) (\as -> - vListAppend (VListLit Nothing (pure x)) as)) - `vApp` VListLit (Just (VList a)) mempty - - ListFold -> VPrim $ \a -> VPrim $ \case - VListLit _ as -> - VHLam (Typed "list" (VConst Type)) $ \list -> - VHLam (Typed "cons" (vFun a $ vFun list list) ) $ \cons -> - VHLam (Typed "nil" list) $ \nil -> - foldr' (\x b -> cons `vApp` x `vApp` b) nil as - as -> - VHLam (ListFoldCl as) $ \t -> VPrim $ \c -> VPrim $ \n -> - VListFold a as t c n - - ListLength -> VPrim $ \ a -> VPrim $ \case - VListLit _ as -> VNaturalLit (fromIntegral (Data.Sequence.length as)) - as -> VListLength a as - ListHead -> VPrim $ \ a -> VPrim $ \case - VListLit _ as -> case Data.Sequence.viewl as of - y Data.Sequence.:< _ -> VSome y - _ -> VNone a - as -> VListHead a as - ListLast -> VPrim $ \ a -> VPrim $ \case - VListLit _ as -> case Data.Sequence.viewr as of - _ Data.Sequence.:> t -> VSome t - _ -> VNone a - as -> VListLast a as - ListIndexed -> VPrim $ \ a -> VPrim $ \case - VListLit _ as -> let - a' = if null as then - Just (VList (VRecord (Dhall.Map.fromList - [("index", VNatural), ("value", a)]))) - else - Nothing - as' = Data.Sequence.mapWithIndex - (\i t -> VRecordLit - (Dhall.Map.fromList [("index", VNaturalLit (fromIntegral i)), - ("value", t)])) - as - in VListLit a' as' - t -> VListIndexed a t - ListReverse -> VPrim $ \ ~a -> VPrim $ \case - VListLit t as | null as -> VListLit t (Data.Sequence.reverse as) - VListLit t as -> VListLit Nothing (Data.Sequence.reverse as) - t -> VListReverse a t - - Optional -> VPrim VOptional - Some t -> VSome (evalE t) - None -> VPrim $ \ ~a -> VNone a - - OptionalFold -> VPrim $ \ ~a -> VPrim $ \case - VNone _ -> - VHLam (Typed "optional" (VConst Type)) $ \optional -> - VHLam (Typed "some" (vFun a optional)) $ \some -> - VHLam (Typed "none" optional) $ \none -> - none - VSome t -> - VHLam (Typed "optional" (VConst Type)) $ \optional -> - VHLam (Typed "some" (vFun a optional)) $ \some -> - VHLam (Typed "none" optional) $ \none -> - some `vApp` t - opt -> - VHLam (OptionalFoldCl opt) $ \o -> - VPrim $ \s -> - VPrim $ \n -> - VOptionalFold a opt o s n - OptionalBuild -> VPrim $ \ ~a -> VPrim $ \case - VHLam (OptionalFoldCl x) _ -> x - VPrimVar -> VOptionalBuild a VPrimVar - t -> t `vApp` VOptional a - `vApp` VHLam (Typed "a" a) VSome - `vApp` VNone a - - Record kts -> VRecord (Dhall.Map.sort (evalE <$> kts)) - RecordLit kts -> VRecordLit (Dhall.Map.sort (evalE <$> kts)) - Union kts -> VUnion (Dhall.Map.sort ((evalE <$>) <$> kts)) - Combine t u -> vCombine (evalE t) (evalE u) - CombineTypes t u -> vCombineTypes (evalE t) (evalE u) - Prefer t u -> case (evalE t, evalE u) of - (VRecordLit m, u) | null m -> u - (t, VRecordLit m) | null m -> t - (VRecordLit m, VRecordLit m') -> - VRecordLit (Dhall.Map.union m' m) - (t, u) | conv env t u -> t - (t, u) -> VPrefer t u - Merge x y ma -> case (evalE x, evalE y, evalE <$> ma) of - (VRecordLit m, VInject _ k mt, _) - | Just f <- Dhall.Map.lookup k m -> maybe f (vApp f) mt - | otherwise -> error errorMsg - (x, y, ma) -> VMerge x y ma - ToMap x ma -> case (evalE x, evalE <$> ma) of - (VRecordLit m, ma'@(Just _)) | null m -> - VListLit ma' (Data.Sequence.empty) - (VRecordLit m, _) -> let - entry (k, v) = - VRecordLit (Dhall.Map.fromList [("mapKey", VTextLit $ VChunks [] k), - ("mapValue", v)]) - s = (Data.Sequence.fromList . map entry . Dhall.Map.toList) m - in VListLit Nothing s - (x, ma) -> VToMap x ma - Field t k -> vField (evalE t) k - Project t (Left ks) -> - if null ks then - VRecordLit mempty - else case evalE t of - VRecordLit kvs -> let - kvs' = Dhall.Map.restrictKeys kvs (Dhall.Set.toSet ks) - in VRecordLit kvs' - t -> VProject t (Left (Dhall.Set.sort ks)) - Project t (Right e) -> - case evalE e of - VRecord kts -> - evalE (Project t (Left (Dhall.Set.fromSet (Dhall.Map.keysSet kts)))) - e' -> VProject (evalE t) (Right e') - Assert t -> VAssert (evalE t) - Equivalent t u -> VEquivalent (evalE t) (evalE u) - Note _ e -> evalE e - ImportAlt t _ -> evalE t - Embed a -> VEmbed a - - --- Conversion checking --------------------------------------------------------------------------------- - -eqListBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool -eqListBy f = go where - go (x:xs) (y:ys) | f x y = go xs ys - go [] [] = True - go _ _ = False -{-# inline eqListBy #-} - -eqMapsBy :: Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool -eqMapsBy f mL mR = - Dhall.Map.size mL == Dhall.Map.size mR - && eqListBy eq (Dhall.Map.toList mL) (Dhall.Map.toList mR) - where - eq (kL, vL) (kR, vR) = kL == kR && f vL vR -{-# inline eqMapsBy #-} - -eqMaybeBy :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool -eqMaybeBy f = go where - go (Just x) (Just y) = f x y - go Nothing Nothing = True - go _ _ = False -{-# inline eqMaybeBy #-} - -conv :: forall a. Eq a => Env a -> Val a -> Val a -> Bool -conv !env t t' = - let - fresh :: Text -> (Text, Val a) - fresh x = (x, VVar x (countName x env)) - {-# inline fresh #-} - - freshCl :: Closure a -> (Text, Val a, Closure a) - freshCl cl@(Cl x _ _) = (x, snd (fresh x), cl) - {-# inline freshCl #-} - - convChunks :: VChunks a -> VChunks a -> Bool - convChunks (VChunks xys z) (VChunks xys' z') = - eqListBy (\(x, y) (x', y') -> x == x' && conv env y y') xys xys' && z == z' - {-# inline convChunks #-} - - convE :: Val a -> Val a -> Bool - convE = conv env - {-# inline convE #-} - - convSkip :: Text -> Val a -> Val a -> Bool - convSkip x = conv (Skip env x) - {-# inline convSkip #-} - - in case (t, t') of - (VConst k, VConst k') -> k == k' - (VVar x i, VVar x' i') -> x == x' && i == i' - - (VLam _ (freshCl -> (x, v, t)), VLam _ t' ) -> convSkip x (inst t v) (inst t' v) - (VLam _ (freshCl -> (x, v, t)), VHLam _ t') -> convSkip x (inst t v) (t' v) - (VLam _ (freshCl -> (x, v, t)), t' ) -> convSkip x (inst t v) (vApp t' v) - (VHLam _ t, VLam _ (freshCl -> (x, v, t'))) -> convSkip x (t v) (inst t' v) - (VHLam _ t, VHLam _ t' ) -> let (x, v) = fresh "x" in convSkip x (t v) (t' v) - (VHLam _ t, t' ) -> let (x, v) = fresh "x" in convSkip x (t v) (vApp t' v) - - (t, VLam _ (freshCl -> (x, v, t'))) -> convSkip x (vApp t v) (inst t' v) - (t, VHLam _ t' ) -> let (x, v) = fresh "x" in convSkip x (vApp t v) (t' v) - - (VApp t u, VApp t' u') -> convE t t' && convE u u' - - (VPi a b, VPi a' (freshCl -> (x, v, b'))) -> - convE a a' && convSkip x (inst b v) (inst b' v) - (VPi a b, VHPi (fresh -> (x, v)) a' b') -> - convE a a' && convSkip x (inst b v) (b' v) - (VHPi _ a b, VPi a' (freshCl -> (x, v, b'))) -> - convE a a' && convSkip x (b v) (inst b' v) - (VHPi _ a b, VHPi (fresh -> (x, v)) a' b') -> - convE a a' && convSkip x (b v) (b' v) - - (VBool , VBool ) -> True - (VBoolLit b , VBoolLit b' ) -> b == b' - (VBoolAnd t u, VBoolAnd t' u' ) -> convE t t' && convE u u' - (VBoolOr t u, VBoolOr t' u' ) -> convE t t' && convE u u' - (VBoolEQ t u, VBoolEQ t' u' ) -> convE t t' && convE u u' - (VBoolNE t u, VBoolNE t' u' ) -> convE t t' && convE u u' - (VBoolIf t u v, VBoolIf t' u' v') -> convE t t' && convE u u' && convE v v' - - (VNatural, VNatural) -> True - (VNaturalLit n, VNaturalLit n') -> n == n' - (VNaturalFold t _ u v, VNaturalFold t' _ u' v') -> - convE t t' && convE u u' && convE v v' - - (VNaturalBuild t , VNaturalBuild t') -> convE t t' - (VNaturalIsZero t , VNaturalIsZero t') -> convE t t' - (VNaturalEven t , VNaturalEven t') -> convE t t' - (VNaturalOdd t , VNaturalOdd t') -> convE t t' - (VNaturalToInteger t , VNaturalToInteger t') -> convE t t' - (VNaturalShow t , VNaturalShow t') -> convE t t' - (VNaturalSubtract x y , VNaturalSubtract x' y') -> convE x x' && convE y y' - (VNaturalPlus t u , VNaturalPlus t' u') -> convE t t' && convE u u' - (VNaturalTimes t u , VNaturalTimes t' u') -> convE t t' && convE u u' - - (VInteger , VInteger) -> True - (VIntegerLit t , VIntegerLit t') -> t == t' - (VIntegerShow t , VIntegerShow t') -> convE t t' - (VIntegerToDouble t , VIntegerToDouble t') -> convE t t' - - (VDouble , VDouble) -> True - (VDoubleLit n , VDoubleLit n') -> - Serialise.serialise (Dhall.Binary.encode (DoubleLit n :: Expr Void Import)) - == Serialise.serialise (Dhall.Binary.encode (DoubleLit n' :: Expr Void Import)) - (VDoubleShow t , VDoubleShow t') -> convE t t' - - (VText, VText) -> True - - (VTextLit cs , VTextLit cs') -> convChunks cs cs' - (VTextAppend t u , VTextAppend t' u') -> convE t t' && convE u u' - (VTextShow t , VTextShow t') -> convE t t' - - (VList a , VList a' ) -> convE a a' - (VListLit _ xs , VListLit _ xs') -> eqListBy convE (toList xs) (toList xs') - - (VListAppend t u , VListAppend t' u' ) -> convE t t' && convE u u' - (VListBuild a t , VListBuild a' t' ) -> convE t t' - (VListLength a t , VListLength a' t' ) -> convE a a' && convE t t' - (VListHead _ t , VListHead _ t' ) -> convE t t' - (VListLast _ t , VListLast _ t' ) -> convE t t' - (VListIndexed _ t , VListIndexed _ t' ) -> convE t t' - (VListReverse _ t , VListReverse _ t' ) -> convE t t' - (VListFold a l _ t u , VListFold a' l' _ t' u' ) -> - convE a a' && convE l l' && convE t t' && convE u u' - - (VOptional a , VOptional a' ) -> convE a a' - (VSome t , VSome t' ) -> convE t t' - (VNone _ , VNone _ ) -> True - (VOptionalBuild _ t , VOptionalBuild _ t' ) -> convE t t' - (VRecord m , VRecord m' ) -> eqMapsBy convE m m' - (VRecordLit m , VRecordLit m' ) -> eqMapsBy convE m m' - (VUnion m , VUnion m' ) -> eqMapsBy (eqMaybeBy convE) m m' - (VCombine t u , VCombine t' u' ) -> convE t t' && convE u u' - (VCombineTypes t u , VCombineTypes t' u' ) -> convE t t' && convE u u' - (VPrefer t u , VPrefer t' u' ) -> convE t t' && convE u u' - (VMerge t u _ , VMerge t' u' _ ) -> convE t t' && convE u u' - (VToMap t _ , VToMap t' _ ) -> convE t t' - (VField t k , VField t' k' ) -> convE t t' && k == k' - (VProject t (Left ks) , VProject t' (Left ks') ) -> convE t t' && ks == ks' - (VProject t (Right e) , VProject t' (Right e') ) -> convE t t' && convE e e' - (VAssert t , VAssert t' ) -> convE t t' - (VEquivalent t u , VEquivalent t' u' ) -> convE t t' && convE u u' - (VInject m k mt , VInject m' k' mt' ) -> eqMapsBy (eqMaybeBy convE) m m' - && k == k' && eqMaybeBy convE mt mt' - (VEmbed a , VEmbed a' ) -> a == a' - (VOptionalFold a t _ u v , VOptionalFold a' t' _ u' v' ) -> - convE a a' && convE t t' && convE u u' && convE v v' - - (_, _) -> False - -convEmpty :: Eq a => Expr s a -> Expr t a -> Bool -convEmpty (denote -> t) (denote -> u) = conv Empty (eval Empty t) (eval Empty u) - --- Quoting ----------------------------------------------------------------------------------------------------- - -data Names - = NEmpty - | NBind !Names {-# unpack #-} !Text - deriving Show - -envNames :: Env a -> Names -envNames Empty = NEmpty -envNames (Skip env x ) = NBind (envNames env) x -envNames (Extend env x _) = NBind (envNames env) x - -countName' :: Text -> Names -> Int -countName' x = go 0 where - go !acc NEmpty = acc - go acc (NBind env x') = go (if x == x' then acc + 1 else acc) env - --- | Quote a value into beta-normal form. -quote :: forall a. Eq a => Names -> Val a -> Expr Void a -quote !env !t = - let - fresh :: Text -> (Text, Val a) - fresh x = (x, VVar x (countName' x env)) - {-# inline fresh #-} - - freshCl :: Closure a -> (Text, Val a, Closure a) - freshCl cl@(Cl x _ _) = (x, snd (fresh x), cl) - {-# inline freshCl #-} - - qVar :: Text -> Int -> Expr Void a - qVar !x !i = Var (V x (fromIntegral (countName' x env - i - 1))) - {-# inline qVar #-} - - quoteE :: Val a -> Expr Void a - quoteE = quote env - {-# inline quoteE #-} - - quoteBind :: Text -> Val a -> Expr Void a - quoteBind x = quote (NBind env x) - {-# inline quoteBind #-} - - qApp :: Expr Void a -> Val a -> Expr Void a - qApp t VPrimVar = t - qApp t u = App t (quoteE u) - {-# inline qApp #-} - - in case t of - VConst k -> Const k - VVar x i -> qVar x i - VApp t u -> quoteE t `qApp` u - VLam a (freshCl -> (x, v, t)) -> Lam x (quoteE a) (quoteBind x (inst t v)) - VHLam i t -> case i of - Typed (fresh -> (x, v)) a -> Lam x (quoteE a) (quoteBind x (t v)) - Prim -> quote env (t VPrimVar) - NaturalFoldCl{} -> quote env (t VPrimVar) - ListFoldCl{} -> quote env (t VPrimVar) - OptionalFoldCl{} -> quote env (t VPrimVar) - NaturalSubtractZero -> App NaturalSubtract (NaturalLit 0) - - VPi a (freshCl -> (x, v, b)) -> Pi x (quoteE a) (quoteBind x (inst b v)) - VHPi (fresh -> (x, v)) a b -> Pi x (quoteE a) (quoteBind x (b v)) - - VBool -> Bool - VBoolLit b -> BoolLit b - VBoolAnd t u -> BoolAnd (quoteE t) (quoteE u) - VBoolOr t u -> BoolOr (quoteE t) (quoteE u) - VBoolEQ t u -> BoolEQ (quoteE t) (quoteE u) - VBoolNE t u -> BoolNE (quoteE t) (quoteE u) - VBoolIf t u v -> BoolIf (quoteE t) (quoteE u) (quoteE v) - - VNatural -> Natural - VNaturalLit n -> NaturalLit n - VNaturalFold a t u v -> NaturalFold `qApp` a `qApp` t `qApp` u `qApp` v - VNaturalBuild t -> NaturalBuild `qApp` t - VNaturalIsZero t -> NaturalIsZero `qApp` t - VNaturalEven t -> NaturalEven `qApp` t - VNaturalOdd t -> NaturalOdd `qApp` t - VNaturalToInteger t -> NaturalToInteger `qApp` t - VNaturalShow t -> NaturalShow `qApp` t - VNaturalPlus t u -> NaturalPlus (quoteE t) (quoteE u) - VNaturalTimes t u -> NaturalTimes (quoteE t) (quoteE u) - VNaturalSubtract x y -> NaturalSubtract `qApp` x `qApp` y - - VInteger -> Integer - VIntegerLit n -> IntegerLit n - VIntegerShow t -> IntegerShow `qApp` t - VIntegerToDouble t -> IntegerToDouble `qApp` t - - VDouble -> Double - VDoubleLit n -> DoubleLit n - VDoubleShow t -> DoubleShow `qApp` t - - VText -> Text - VTextLit (VChunks xys z) -> TextLit (Chunks ((quoteE <$>) <$> xys) z) - VTextAppend t u -> TextAppend (quoteE t) (quoteE u) - VTextShow t -> TextShow `qApp` t - - VList t -> List `qApp` t - VListLit ma ts -> ListLit (quoteE <$> ma) (quoteE <$> ts) - VListAppend t u -> ListAppend (quoteE t) (quoteE u) - VListBuild a t -> ListBuild `qApp` a `qApp` t - VListFold a l t u v -> ListFold `qApp` a `qApp` l `qApp` t `qApp` u `qApp` v - VListLength a t -> ListLength `qApp` a `qApp` t - VListHead a t -> ListHead `qApp` a `qApp` t - VListLast a t -> ListLast `qApp` a `qApp` t - VListIndexed a t -> ListIndexed `qApp` a `qApp` t - VListReverse a t -> ListReverse `qApp` a `qApp` t - - VOptional a -> Optional `qApp` a - VSome t -> Some (quoteE t) - VNone t -> None `qApp` t - VOptionalFold a o t u v -> OptionalFold `qApp` a `qApp` o `qApp` t `qApp` u `qApp` v - VOptionalBuild a t -> OptionalBuild `qApp` a `qApp` t - VRecord m -> Record (quoteE <$> m) - VRecordLit m -> RecordLit (quoteE <$> m) - VUnion m -> Union ((quoteE <$>) <$> m) - VCombine t u -> Combine (quoteE t) (quoteE u) - VCombineTypes t u -> CombineTypes (quoteE t) (quoteE u) - VPrefer t u -> Prefer (quoteE t) (quoteE u) - VMerge t u ma -> Merge (quoteE t) (quoteE u) (quoteE <$> ma) - VToMap t ma -> ToMap (quoteE t) (quoteE <$> ma) - VField t k -> Field (quoteE t) k - VProject t p -> Project (quoteE t) (fmap quoteE p) - VAssert t -> Assert (quoteE t) - VEquivalent t u -> Equivalent (quoteE t) (quoteE u) - VInject m k Nothing -> Field (Union ((quoteE <$>) <$> m)) k - VInject m k (Just t) -> Field (Union ((quoteE <$>) <$> m)) k `qApp` t - VEmbed a -> Embed a - VPrimVar -> error errorMsg - --- Normalization ----------------------------------------------------------------------------------------------------- - --- | Normalize an expression in an environment of values. Any variable pointing out of --- the environment is treated as opaque free variable. -nf :: Eq a => Env a -> Expr s a -> Expr t a -nf !env = coeExprVoid . quote (envNames env) . eval env . denote - --- | Normalize an expression in an empty environment. -nfEmpty :: Eq a => Expr s a -> Expr t a -nfEmpty = nf Empty - --- Alpha-renaming --------------------------------------------------------------------------------- - --- | Rename all binders to "_". -alphaNormalize :: Expr s a -> Expr s a -alphaNormalize = goEnv NEmpty where - - goVar :: Names -> Text -> Int -> Expr s a - goVar e topX topI = go 0 e topI where - go !acc (NBind env x) !i - | x == topX = if i == 0 then Var (V "_" acc) else go (acc + 1) env (i - 1) - | otherwise = go (acc + 1) env i - go acc NEmpty i = Var (V topX i) - - goEnv :: Names -> Expr s a -> Expr s a - goEnv !e t = let - - go = goEnv e - goBind x = goEnv (NBind e x) - goChunks (Chunks ts x) = Chunks ((go <$>) <$> ts) x - - in case t of - Const k -> Const k - Var (V x i) -> goVar e x i - Lam x t u -> Lam "_" (go t) (goBind x u) - Pi x a b -> Pi "_" (go a) (goBind x b) - App t u -> App (go t) (go u) - Let (Binding src0 x src1 mA src2 a) b -> - Let (Binding src0 "_" src1 (adapt <$> mA) src2 (go a)) (goBind x b) - where - adapt (src3, _A) = (src3, go _A) - Annot t u -> Annot (go t) (go u) - Bool -> Bool - BoolLit b -> BoolLit b - BoolAnd t u -> BoolAnd (go t) (go u) - BoolOr t u -> BoolOr (go t) (go u) - BoolEQ t u -> BoolEQ (go t) (go u) - BoolNE t u -> BoolNE (go t) (go u) - BoolIf b t f -> BoolIf (go b) (go t) (go f) - Natural -> Natural - NaturalLit n -> NaturalLit n - NaturalFold -> NaturalFold - NaturalBuild -> NaturalBuild - NaturalIsZero -> NaturalIsZero - NaturalEven -> NaturalEven - NaturalOdd -> NaturalOdd - NaturalToInteger -> NaturalToInteger - NaturalShow -> NaturalShow - NaturalSubtract -> NaturalSubtract - NaturalPlus t u -> NaturalPlus (go t) (go u) - NaturalTimes t u -> NaturalTimes (go t) (go u) - Integer -> Integer - IntegerLit n -> IntegerLit n - IntegerShow -> IntegerShow - IntegerToDouble -> IntegerToDouble - Double -> Double - DoubleLit n -> DoubleLit n - DoubleShow -> DoubleShow - Text -> Text - TextLit cs -> TextLit (goChunks cs) - TextAppend t u -> TextAppend (go t) (go u) - TextShow -> TextShow - List -> List - ListLit ma ts -> ListLit (go <$> ma) (go <$> ts) - ListAppend t u -> ListAppend (go t) (go u) - ListBuild -> ListBuild - ListFold -> ListFold - ListLength -> ListLength - ListHead -> ListHead - ListLast -> ListLast - ListIndexed -> ListIndexed - ListReverse -> ListReverse - Optional -> Optional - Some t -> Some (go t) - None -> None - OptionalFold -> OptionalFold - OptionalBuild -> OptionalBuild - Record kts -> Record (go <$> kts) - RecordLit kts -> RecordLit (go <$> kts) - Union kts -> Union ((go <$>) <$> kts) - Combine t u -> Combine (go t) (go u) - CombineTypes t u -> CombineTypes (go t) (go u) - Prefer t u -> Prefer (go t) (go u) - Merge x y ma -> Merge (go x) (go y) (go <$> ma) - ToMap x ma -> ToMap (go x) (go <$> ma) - Field t k -> Field (go t) k - Project t ks -> Project (go t) (go <$> ks) - Assert t -> Assert (go t) - Equivalent t u -> Equivalent (go t) (go u) - Note s e -> Note s (go e) - ImportAlt t u -> ImportAlt (go t) (go u) - Embed a -> Embed a +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -O #-} + +{-| Eval-apply environment machine with conversion checking and quoting to + normal forms. Fairly similar to GHCI's STG machine algorithmically, but much + simpler, with no known call optimization or environment trimming. + + Potential optimizations without changing Expr: + + * In conversion checking, get non-shadowing variables not by linear + Env-walking, but by keeping track of Env size, and generating names which + are known to be illegal as source-level names (to rule out shadowing). + + * Use HashMap Text chunks for large let-definitions blocks. "Large" vs + "Small" is fairly cheap to determine at evaluation time. + + Potential optimizations with changing Expr: + + * Use actual full de Bruijn indices in Var instead of Text counting indices. + Then, we'd switch to full de Bruijn levels in Val as well, and use proper + constant time non-shadowing name generation. +-} + +module Dhall.Eval ( + judgmentallyEqual + , normalize + , alphaNormalize + , eval + , quote + , envNames + , countNames + , conv + , toVHPi + , Closure(..) + , Names(..) + , Environment(..) + , Val(..) + , (~>) + ) where + +import Data.Foldable (foldr', toList) +import Data.Semigroup (Semigroup(..)) +import Data.Sequence (Seq, ViewL(..), ViewR(..)) +import Data.Text (Text) +import Data.Void (Void) + +import Dhall.Core + ( Binding(..) + , Expr(..) + , Chunks(..) + , Const(..) + , Import + , Var(..) + ) + +import Dhall.Map (Map) +import Dhall.Set (Set) +import GHC.Natural (Natural) +import Prelude hiding (succ) + +import qualified Codec.Serialise as Serialise +import qualified Data.Sequence as Sequence +import qualified Data.Set +import qualified Data.Text as Text +import qualified Dhall.Binary as Binary +import qualified Dhall.Core as Core +import qualified Dhall.Map as Map +import qualified Dhall.Set + +data Environment a + = Empty + | Skip !(Environment a) {-# UNPACK #-} !Text + | Extend !(Environment a) {-# UNPACK #-} !Text (Val a) + +errorMsg :: String +errorMsg = unlines + [ _ERROR <> ": Compiler bug " + , " " + , "An ill-typed expression was encountered during normalization. " + , "Explanation: This error message means that there is a bug in the Dhall compiler." + , "You didn't do anything wrong, but if you would like to see this problem fixed " + , "then you should report the bug at: " + , " " + , "https://github.com/dhall-lang/dhall-haskell/issues " + ] + where + _ERROR :: String + _ERROR = "\ESC[1;31mError\ESC[0m" + + +data Closure a = Closure !Text !(Environment a) !(Expr Void a) +data VChunks a = VChunks ![(Text, Val a)] !Text + +instance Semigroup (VChunks a) where + VChunks xys z <> VChunks [] z' = VChunks xys (z <> z') + VChunks xys z <> VChunks ((x', y'):xys') z' = VChunks (xys ++ (z <> x', y'):xys') z' + +instance Monoid (VChunks a) where + mempty = VChunks [] mempty + +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif + +{-| Some information is lost when `eval` converts a `Lam` or a built-in function + from the `Expr` type to a `VHLam` of the `Val` type and `quote` needs that + information in order to reconstruct an equivalent `Expr`. This `HLamInfo` + type holds that extra information necessary to perform that reconstruction +-} +data HLamInfo a + = Prim + -- ^ Don't store any information + | Typed !Text (Val a) + -- ^ Store the original name and type of the variable bound by the `Lam` + | NaturalFoldCl (Val a) + -- ^ The original function was a @Natural/fold@. We need to preserve this + -- information in order to implement @Natural/{build,fold}@ fusion + | ListFoldCl (Val a) + -- ^ The original function was a @List/fold@. We need to preserve this + -- information in order to implement @List/{build,fold}@ fusion + | OptionalFoldCl (Val a) + -- ^ The original function was an @Optional/fold@. We need to preserve this + -- information in order to implement @Optional/{build,fold}@ fusion + | NaturalSubtractZero + -- ^ The original function was a @Natural/subtract 0@. We need to preserve + -- this information in case the @Natural/subtract@ ends up not being fully + -- saturated, in which case we need to recover the unsaturated built-in + +pattern VPrim :: (Val a -> Val a) -> Val a +pattern VPrim f = VHLam Prim f + +toVHPi :: Eq a => Val a -> Maybe (Text, Val a, Val a -> Val a) +toVHPi (VPi a b@(Closure x _ _)) = Just (x, a, instantiate b) +toVHPi (VHPi x a b ) = Just (x, a, b) +toVHPi _ = Nothing + +data Val a + = VConst !Const + | VVar !Text !Int + | VPrimVar + | VApp !(Val a) !(Val a) + + | VLam (Val a) {-# UNPACK #-} !(Closure a) + | VHLam !(HLamInfo a) !(Val a -> Val a) + + | VPi (Val a) {-# UNPACK #-} !(Closure a) + | VHPi !Text (Val a) !(Val a -> Val a) + + | VBool + | VBoolLit !Bool + | VBoolAnd !(Val a) !(Val a) + | VBoolOr !(Val a) !(Val a) + | VBoolEQ !(Val a) !(Val a) + | VBoolNE !(Val a) !(Val a) + | VBoolIf !(Val a) !(Val a) !(Val a) + + | VNatural + | VNaturalLit !Natural + | VNaturalFold !(Val a) !(Val a) !(Val a) !(Val a) + | VNaturalBuild !(Val a) + | VNaturalIsZero !(Val a) + | VNaturalEven !(Val a) + | VNaturalOdd !(Val a) + | VNaturalToInteger !(Val a) + | VNaturalShow !(Val a) + | VNaturalSubtract !(Val a) !(Val a) + | VNaturalPlus !(Val a) !(Val a) + | VNaturalTimes !(Val a) !(Val a) + + | VInteger + | VIntegerLit !Integer + | VIntegerShow !(Val a) + | VIntegerToDouble !(Val a) + + | VDouble + | VDoubleLit !Double + | VDoubleShow !(Val a) + + | VText + | VTextLit !(VChunks a) + | VTextAppend !(Val a) !(Val a) + | VTextShow !(Val a) + + | VList !(Val a) + | VListLit !(Maybe (Val a)) !(Seq (Val a)) + | VListAppend !(Val a) !(Val a) + | VListBuild (Val a) !(Val a) + | VListFold (Val a) !(Val a) !(Val a) !(Val a) !(Val a) + | VListLength (Val a) !(Val a) + | VListHead (Val a) !(Val a) + | VListLast (Val a) !(Val a) + | VListIndexed (Val a) !(Val a) + | VListReverse (Val a) !(Val a) + + | VOptional (Val a) + | VSome (Val a) + | VNone (Val a) + | VOptionalFold (Val a) !(Val a) (Val a) !(Val a) !(Val a) + | VOptionalBuild (Val a) !(Val a) + | VRecord !(Map Text (Val a)) + | VRecordLit !(Map Text (Val a)) + | VUnion !(Map Text (Maybe (Val a))) + | VCombine !(Val a) !(Val a) + | VCombineTypes !(Val a) !(Val a) + | VPrefer !(Val a) !(Val a) + | VMerge !(Val a) !(Val a) !(Maybe (Val a)) + | VToMap !(Val a) !(Maybe (Val a)) + | VField !(Val a) !Text + | VInject !(Map Text (Maybe (Val a))) !Text !(Maybe (Val a)) + | VProject !(Val a) !(Either (Set Text) (Val a)) + | VAssert !(Val a) + | VEquivalent !(Val a) !(Val a) + | VEmbed a + +(~>) :: Val a -> Val a -> Val a +(~>) a b = VHPi "_" a (\_ -> b) +{-# INLINE (~>) #-} + +infixr 5 ~> + +countEnvironment :: Text -> Environment a -> Int +countEnvironment x = go (0 :: Int) + where + go !acc Empty = acc + go acc (Skip env x' ) = go (if x == x' then acc + 1 else acc) env + go acc (Extend env x' _) = go (if x == x' then acc + 1 else acc) env + +instantiate :: Eq a => Closure a -> Val a -> Val a +instantiate (Closure x env t) !u = eval (Extend env x u) t +{-# INLINE instantiate #-} + +-- Out-of-env variables have negative de Bruijn levels. +vVar :: Environment a -> Var -> Val a +vVar env0 (V x i0) = go env0 i0 + where + go (Extend env x' v) i + | x == x' = + if i == 0 then v else go env (i - 1) + | otherwise = + go env i + go (Skip env x') i + | x == x' = + if i == 0 then VVar x (countEnvironment x env) else go env (i - 1) + | otherwise = + go env i + go Empty i = + VVar x (0 - i - 1) + +vApp :: Eq a => Val a -> Val a -> Val a +vApp !t !u = + case t of + VLam _ t' -> instantiate t' u + VHLam _ t' -> t' u + t' -> VApp t' u +{-# INLINE vApp #-} + +vPrefer :: Eq a => Environment a -> Val a -> Val a -> Val a +vPrefer env t u = + case (t, u) of + (VRecordLit m, u') | null m -> + u' + (t', VRecordLit m) | null m -> + t' + (VRecordLit m, VRecordLit m') -> + VRecordLit (Map.union m' m) + (t', u') | conv env t' u' -> + t' + (t', u') -> + VPrefer t' u' +{-# INLINE vPrefer #-} + +vCombine :: Val a -> Val a -> Val a +vCombine t u = + case (t, u) of + (VRecordLit m, u') | null m -> + u' + (t', VRecordLit m) | null m -> + t' + (VRecordLit m, VRecordLit m') -> + VRecordLit (Map.unionWith vCombine m m') + (t', u') -> + VCombine t' u' + +vCombineTypes :: Val a -> Val a -> Val a +vCombineTypes t u = + case (t, u) of + (VRecord m, u') | null m -> + u' + (t', VRecord m) | null m -> + t' + (VRecord m, VRecord m') -> + VRecord (Map.unionWith vCombineTypes m m') + (t', u') -> + VCombineTypes t' u' + +vListAppend :: Val a -> Val a -> Val a +vListAppend t u = + case (t, u) of + (VListLit _ xs, u') | null xs -> + u' + (t', VListLit _ ys) | null ys -> + t' + (VListLit t' xs, VListLit _ ys) -> + VListLit t' (xs <> ys) + (t', u') -> + VListAppend t' u' +{-# INLINE vListAppend #-} + +vNaturalPlus :: Val a -> Val a -> Val a +vNaturalPlus t u = + case (t, u) of + (VNaturalLit 0, u') -> + u' + (t', VNaturalLit 0) -> + t' + (VNaturalLit m, VNaturalLit n) -> + VNaturalLit (m + n) + (t', u') -> + VNaturalPlus t' u' +{-# INLINE vNaturalPlus #-} + +vField :: Val a -> Text -> Val a +vField t0 k = go t0 + where + go = \case + VUnion m -> case Map.lookup k m of + Just (Just _) -> VPrim $ \ ~u -> VInject m k (Just u) + Just Nothing -> VInject m k Nothing + _ -> error errorMsg + VRecordLit m + | Just v <- Map.lookup k m -> v + | otherwise -> error errorMsg + VProject t _ -> go t + VPrefer (VRecordLit m) r -> case Map.lookup k m of + Just v -> VField (VPrefer (singletonVRecordLit v) r) k + Nothing -> go r + VPrefer l (VRecordLit m) -> case Map.lookup k m of + Just v -> v + Nothing -> go l + VCombine (VRecordLit m) r -> case Map.lookup k m of + Just v -> VField (VCombine (singletonVRecordLit v) r) k + Nothing -> go r + VCombine l (VRecordLit m) -> case Map.lookup k m of + Just v -> VField (VCombine l (singletonVRecordLit v)) k + Nothing -> go l + t -> VField t k + + singletonVRecordLit v = VRecordLit (Map.singleton k v) +{-# INLINE vField #-} + +vProjectByFields :: Eq a => Environment a -> Val a -> Set Text -> Val a +vProjectByFields env t ks = + if null ks + then VRecordLit mempty + else case t of + VRecordLit kvs -> + let kvs' = Map.restrictKeys kvs (Dhall.Set.toSet ks) + in VRecordLit kvs' + VProject t' _ -> + vProjectByFields env t' ks + VPrefer l (VRecordLit kvs) -> + let ksSet = Dhall.Set.toSet ks + + kvs' = Map.restrictKeys kvs ksSet + + ks' = + Dhall.Set.fromSet + (Data.Set.difference ksSet (Map.keysSet kvs')) + + in vPrefer env (vProjectByFields env l ks') (VRecordLit kvs') + t' -> + VProject t' (Left ks) + +eval :: forall a. Eq a => Environment a -> Expr Void a -> Val a +eval !env t0 = + case t0 of + Const k -> + VConst k + Var v -> + vVar env v + Lam x a t -> + VLam (eval env a) (Closure x env t) + Pi x a b -> + VPi (eval env a) (Closure x env b) + App t u -> + vApp (eval env t) (eval env u) + Let (Binding _ x _ _mA _ a) b -> + let !env' = Extend env x (eval env a) + in eval env' b + Annot t _ -> + eval env t + Bool -> + VBool + BoolLit b -> + VBoolLit b + BoolAnd t u -> + case (eval env t, eval env u) of + (VBoolLit True, u') -> u' + (VBoolLit False, _) -> VBoolLit False + (t', VBoolLit True) -> t' + (_ , VBoolLit False) -> VBoolLit False + (t', u') | conv env t' u' -> t' + (t', u') -> VBoolAnd t' u' + BoolOr t u -> + case (eval env t, eval env u) of + (VBoolLit False, u') -> u' + (VBoolLit True, _) -> VBoolLit True + (t', VBoolLit False) -> t' + (_ , VBoolLit True) -> VBoolLit True + (t', u') | conv env t' u' -> t' + (t', u') -> VBoolOr t' u' + BoolEQ t u -> + case (eval env t, eval env u) of + (VBoolLit True, u') -> u' + (t', VBoolLit True) -> t' + (t', u') | conv env t' u' -> VBoolLit True + (t', u') -> VBoolEQ t' u' + BoolNE t u -> + case (eval env t, eval env u) of + (VBoolLit False, u') -> u' + (t', VBoolLit False) -> t' + (t', u') | conv env t' u' -> VBoolLit False + (t', u') -> VBoolNE t' u' + BoolIf b t f -> + case (eval env b, eval env t, eval env f) of + (VBoolLit True, t', _ ) -> t' + (VBoolLit False, _ , f') -> f' + (b', VBoolLit True, VBoolLit False) -> b' + (_, t', f') | conv env t' f' -> t' + (b', t', f') -> VBoolIf b' t' f' + Natural -> + VNatural + NaturalLit n -> + VNaturalLit n + NaturalFold -> + VPrim $ \case + VNaturalLit n -> + VHLam (Typed "natural" (VConst Type)) $ \natural -> + VHLam (Typed "succ" (natural ~> natural)) $ \succ -> + VHLam (Typed "zero" natural) $ \zero -> + let go !acc 0 = acc + go acc m = go (vApp succ acc) (m - 1) + in go zero (fromIntegral n :: Integer) + n -> + VHLam (NaturalFoldCl n) $ \natural -> + VPrim $ \succ -> + VPrim $ \zero -> + VNaturalFold n natural succ zero + NaturalBuild -> + VPrim $ \case + VHLam (NaturalFoldCl x) _ -> + x + VPrimVar -> + VNaturalBuild VPrimVar + t -> t + `vApp` VNatural + `vApp` VHLam (Typed "n" VNatural) (\n -> vNaturalPlus n (VNaturalLit 1)) + `vApp` VNaturalLit 0 + + NaturalIsZero -> VPrim $ \case + VNaturalLit n -> VBoolLit (n == 0) + n -> VNaturalIsZero n + NaturalEven -> VPrim $ \case + VNaturalLit n -> VBoolLit (even n) + n -> VNaturalEven n + NaturalOdd -> VPrim $ \case + VNaturalLit n -> VBoolLit (odd n) + n -> VNaturalOdd n + NaturalToInteger -> VPrim $ \case + VNaturalLit n -> VIntegerLit (fromIntegral n) + n -> VNaturalToInteger n + NaturalShow -> VPrim $ \case + VNaturalLit n -> VTextLit (VChunks [] (Text.pack (show n))) + n -> VNaturalShow n + NaturalSubtract -> VPrim $ \case + VNaturalLit 0 -> + VHLam NaturalSubtractZero id + x@(VNaturalLit m) -> + VPrim $ \case + VNaturalLit n + | n >= m -> VNaturalLit (subtract m n) + | otherwise -> VNaturalLit 0 + y -> VNaturalSubtract x y + x -> + VPrim $ \case + VNaturalLit 0 -> VNaturalLit 0 + y | conv env x y -> VNaturalLit 0 + y -> VNaturalSubtract x y + NaturalPlus t u -> + vNaturalPlus (eval env t) (eval env u) + NaturalTimes t u -> + case (eval env t, eval env u) of + (VNaturalLit 1, u' ) -> u' + (t' , VNaturalLit 1) -> t' + (VNaturalLit 0, _ ) -> VNaturalLit 0 + (_ , VNaturalLit 0) -> VNaturalLit 0 + (VNaturalLit m, VNaturalLit n) -> VNaturalLit (m * n) + (t' , u' ) -> VNaturalTimes t' u' + Integer -> + VInteger + IntegerLit n -> + VIntegerLit n + IntegerShow -> + VPrim $ \case + VIntegerLit n + | 0 <= n -> VTextLit (VChunks [] (Text.pack ('+':show n))) + | otherwise -> VTextLit (VChunks [] (Text.pack (show n))) + n -> VIntegerShow n + IntegerToDouble -> + VPrim $ \case + VIntegerLit n -> VDoubleLit (read (show n)) + -- `(read . show)` is used instead of `fromInteger` + -- because `read` uses the correct rounding rule + n -> VIntegerToDouble n + Double -> + VDouble + DoubleLit n -> + VDoubleLit n + DoubleShow -> + VPrim $ \case + VDoubleLit n -> VTextLit (VChunks [] (Text.pack (show n))) + n -> VDoubleShow n + Text -> + VText + TextLit cs -> + case evalChunks cs of + VChunks [("", t)] "" -> t + vcs -> VTextLit vcs + TextAppend t u -> + eval env (TextLit (Chunks [("", t), ("", u)] "")) + TextShow -> + VPrim $ \case + VTextLit (VChunks [] x) -> VTextLit (VChunks [] (Core.textShow x)) + t -> VTextShow t + List -> + VPrim VList + ListLit ma ts -> + VListLit (fmap (eval env) ma) (fmap (eval env) ts) + ListAppend t u -> + vListAppend (eval env t) (eval env u) + ListBuild -> + VPrim $ \a -> + VPrim $ \case + VHLam (ListFoldCl x) _ -> + x + VPrimVar -> + VListBuild a VPrimVar + t -> t + `vApp` VList a + `vApp` VHLam (Typed "a" a) (\x -> + VHLam (Typed "as" (VList a)) (\as -> + vListAppend (VListLit Nothing (pure x)) as)) + `vApp` VListLit (Just (VList a)) mempty + + ListFold -> + VPrim $ \a -> + VPrim $ \case + VListLit _ as -> + VHLam (Typed "list" (VConst Type)) $ \list -> + VHLam (Typed "cons" (a ~> list ~> list) ) $ \cons -> + VHLam (Typed "nil" list) $ \nil -> + foldr' (\x b -> cons `vApp` x `vApp` b) nil as + as -> + VHLam (ListFoldCl as) $ \t -> + VPrim $ \c -> + VPrim $ \n -> + VListFold a as t c n + ListLength -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> VNaturalLit (fromIntegral (Sequence.length as)) + as -> VListLength a as + ListHead -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> + case Sequence.viewl as of + y :< _ -> VSome y + _ -> VNone a + as -> + VListHead a as + ListLast -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> + case Sequence.viewr as of + _ :> t -> VSome t + _ -> VNone a + as -> VListLast a as + ListIndexed -> + VPrim $ \ a -> + VPrim $ \case + VListLit _ as -> + let a' = + if null as + then Just (VList (VRecord (Map.fromList [("index", VNatural), ("value", a)]))) + else Nothing + + as' = + Sequence.mapWithIndex + (\i t -> + VRecordLit + (Map.fromList + [ ("index", VNaturalLit (fromIntegral i)) + , ("value", t) + ] + ) + ) + as + + in VListLit a' as' + t -> + VListIndexed a t + ListReverse -> + VPrim $ \ ~a -> + VPrim $ \case + VListLit t as | null as -> + VListLit t (Sequence.reverse as) + VListLit _ as -> + VListLit Nothing (Sequence.reverse as) + t -> + VListReverse a t + Optional -> + VPrim VOptional + Some t -> + VSome (eval env t) + None -> + VPrim $ \ ~a -> VNone a + OptionalFold -> + VPrim $ \ ~a -> + VPrim $ \case + VNone _ -> + VHLam (Typed "optional" (VConst Type)) $ \optional -> + VHLam (Typed "some" (a ~> optional)) $ \_some -> + VHLam (Typed "none" optional) $ \none -> + none + VSome t -> + VHLam (Typed "optional" (VConst Type)) $ \optional -> + VHLam (Typed "some" (a ~> optional)) $ \some -> + VHLam (Typed "none" optional) $ \_none -> + some `vApp` t + opt -> + VHLam (OptionalFoldCl opt) $ \o -> + VPrim $ \s -> + VPrim $ \n -> + VOptionalFold a opt o s n + OptionalBuild -> + VPrim $ \ ~a -> + VPrim $ \case + VHLam (OptionalFoldCl x) _ -> x + VPrimVar -> VOptionalBuild a VPrimVar + t -> t + `vApp` VOptional a + `vApp` VHLam (Typed "a" a) VSome + `vApp` VNone a + Record kts -> + VRecord (Map.sort (fmap (eval env) kts)) + RecordLit kts -> + VRecordLit (Map.sort (fmap (eval env) kts)) + Union kts -> + VUnion (Map.sort (fmap (fmap (eval env)) kts)) + Combine t u -> + vCombine (eval env t) (eval env u) + CombineTypes t u -> + vCombineTypes (eval env t) (eval env u) + Prefer t u -> + vPrefer env (eval env t) (eval env u) + Merge x y ma -> + case (eval env x, eval env y, fmap (eval env) ma) of + (VRecordLit m, VInject _ k mt, _) + | Just f <- Map.lookup k m -> maybe f (vApp f) mt + | otherwise -> error errorMsg + (x', y', ma') -> VMerge x' y' ma' + ToMap x ma -> + case (eval env x, fmap (eval env) ma) of + (VRecordLit m, ma'@(Just _)) | null m -> + VListLit ma' (Sequence.empty) + (VRecordLit m, _) -> + let entry (k, v) = + VRecordLit + (Map.fromList + [ ("mapKey", VTextLit $ VChunks [] k) + , ("mapValue", v) + ] + ) + + s = (Sequence.fromList . map entry . Map.toList) m + + in VListLit Nothing s + (x', ma') -> + VToMap x' ma' + Field t k -> + vField (eval env t) k + Project t (Left ks) -> + vProjectByFields env (eval env t) (Dhall.Set.sort ks) + Project t (Right e) -> + case eval env e of + VRecord kts -> + eval env (Project t (Left (Dhall.Set.fromSet (Map.keysSet kts)))) + e' -> + VProject (eval env t) (Right e') + Assert t -> + VAssert (eval env t) + Equivalent t u -> + VEquivalent (eval env t) (eval env u) + Note _ e -> + eval env e + ImportAlt t _ -> + eval env t + Embed a -> + VEmbed a + where + evalChunks :: Chunks Void a -> VChunks a + evalChunks (Chunks xys z) = foldr' cons nil xys + where + cons (x, t) vcs = + case eval env t of + VTextLit vcs' -> VChunks [] x <> vcs' <> vcs + t' -> VChunks [(x, t')] mempty <> vcs + + nil = VChunks [] z + {-# INLINE evalChunks #-} + +eqListBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool +eqListBy f = go + where + go (x:xs) (y:ys) | f x y = go xs ys + go [] [] = True + go _ _ = False +{-# INLINE eqListBy #-} + +eqMapsBy :: Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool +eqMapsBy f mL mR = + Map.size mL == Map.size mR + && eqListBy eq (Map.toList mL) (Map.toList mR) + where + eq (kL, vL) (kR, vR) = kL == kR && f vL vR +{-# INLINE eqMapsBy #-} + +eqMaybeBy :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool +eqMaybeBy f = go + where + go (Just x) (Just y) = f x y + go Nothing Nothing = True + go _ _ = False +{-# INLINE eqMaybeBy #-} + +conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool +conv !env t0 t0' = + case (t0, t0') of + (VConst k, VConst k') -> + k == k' + (VVar x i, VVar x' i') -> + x == x' && i == i' + (VLam _ (freshClosure -> (x, v, t)), VLam _ t' ) -> + convSkip x (instantiate t v) (instantiate t' v) + (VLam _ (freshClosure -> (x, v, t)), VHLam _ t') -> + convSkip x (instantiate t v) (t' v) + (VLam _ (freshClosure -> (x, v, t)), t' ) -> + convSkip x (instantiate t v) (vApp t' v) + (VHLam _ t, VLam _ (freshClosure -> (x, v, t'))) -> + convSkip x (t v) (instantiate t' v) + (VHLam _ t, VHLam _ t' ) -> + let (x, v) = fresh "x" in convSkip x (t v) (t' v) + (VHLam _ t, t' ) -> + let (x, v) = fresh "x" in convSkip x (t v) (vApp t' v) + (t, VLam _ (freshClosure -> (x, v, t'))) -> + convSkip x (vApp t v) (instantiate t' v) + (t, VHLam _ t' ) -> + let (x, v) = fresh "x" in convSkip x (vApp t v) (t' v) + (VApp t u, VApp t' u') -> + conv env t t' && conv env u u' + (VPi a b, VPi a' (freshClosure -> (x, v, b'))) -> + conv env a a' && convSkip x (instantiate b v) (instantiate b' v) + (VPi a b, VHPi (fresh -> (x, v)) a' b') -> + conv env a a' && convSkip x (instantiate b v) (b' v) + (VHPi _ a b, VPi a' (freshClosure -> (x, v, b'))) -> + conv env a a' && convSkip x (b v) (instantiate b' v) + (VHPi _ a b, VHPi (fresh -> (x, v)) a' b') -> + conv env a a' && convSkip x (b v) (b' v) + (VBool, VBool) -> + True + (VBoolLit b, VBoolLit b') -> + b == b' + (VBoolAnd t u, VBoolAnd t' u') -> + conv env t t' && conv env u u' + (VBoolOr t u, VBoolOr t' u') -> + conv env t t' && conv env u u' + (VBoolEQ t u, VBoolEQ t' u') -> + conv env t t' && conv env u u' + (VBoolNE t u, VBoolNE t' u') -> + conv env t t' && conv env u u' + (VBoolIf t u v, VBoolIf t' u' v') -> + conv env t t' && conv env u u' && conv env v v' + (VNatural, VNatural) -> + True + (VNaturalLit n, VNaturalLit n') -> + n == n' + (VNaturalFold t _ u v, VNaturalFold t' _ u' v') -> + conv env t t' && conv env u u' && conv env v v' + (VNaturalBuild t, VNaturalBuild t') -> + conv env t t' + (VNaturalIsZero t, VNaturalIsZero t') -> + conv env t t' + (VNaturalEven t, VNaturalEven t') -> + conv env t t' + (VNaturalOdd t, VNaturalOdd t') -> + conv env t t' + (VNaturalToInteger t, VNaturalToInteger t') -> + conv env t t' + (VNaturalShow t, VNaturalShow t') -> + conv env t t' + (VNaturalSubtract x y, VNaturalSubtract x' y') -> + conv env x x' && conv env y y' + (VNaturalPlus t u, VNaturalPlus t' u') -> + conv env t t' && conv env u u' + (VNaturalTimes t u, VNaturalTimes t' u') -> + conv env t t' && conv env u u' + (VInteger, VInteger) -> + True + (VIntegerLit t, VIntegerLit t') -> + t == t' + (VIntegerShow t, VIntegerShow t') -> + conv env t t' + (VIntegerToDouble t, VIntegerToDouble t') -> + conv env t t' + (VDouble, VDouble) -> + True + (VDoubleLit n, VDoubleLit n') -> + Serialise.serialise (Binary.encode (DoubleLit n :: Expr Void Import)) + == Serialise.serialise (Binary.encode (DoubleLit n' :: Expr Void Import)) + (VDoubleShow t, VDoubleShow t') -> + conv env t t' + (VText, VText) -> + True + (VTextLit cs, VTextLit cs') -> + convChunks cs cs' + (VTextAppend t u, VTextAppend t' u') -> + conv env t t' && conv env u u' + (VTextShow t, VTextShow t') -> + conv env t t' + (VList a, VList a') -> + conv env a a' + (VListLit _ xs, VListLit _ xs') -> + eqListBy (conv env) (toList xs) (toList xs') + (VListAppend t u, VListAppend t' u') -> + conv env t t' && conv env u u' + (VListBuild _ t, VListBuild _ t') -> + conv env t t' + (VListLength a t, VListLength a' t') -> + conv env a a' && conv env t t' + (VListHead _ t, VListHead _ t') -> + conv env t t' + (VListLast _ t, VListLast _ t') -> + conv env t t' + (VListIndexed _ t, VListIndexed _ t') -> + conv env t t' + (VListReverse _ t, VListReverse _ t') -> + conv env t t' + (VListFold a l _ t u, VListFold a' l' _ t' u') -> + conv env a a' && conv env l l' && conv env t t' && conv env u u' + (VOptional a, VOptional a') -> + conv env a a' + (VSome t, VSome t') -> + conv env t t' + (VNone _, VNone _) -> + True + (VOptionalBuild _ t, VOptionalBuild _ t') -> + conv env t t' + (VRecord m, VRecord m') -> + eqMapsBy (conv env) m m' + (VRecordLit m, VRecordLit m') -> + eqMapsBy (conv env) m m' + (VUnion m, VUnion m') -> + eqMapsBy (eqMaybeBy (conv env)) m m' + (VCombine t u, VCombine t' u') -> + conv env t t' && conv env u u' + (VCombineTypes t u, VCombineTypes t' u') -> + conv env t t' && conv env u u' + (VPrefer t u, VPrefer t' u') -> + conv env t t' && conv env u u' + (VMerge t u _, VMerge t' u' _) -> + conv env t t' && conv env u u' + (VToMap t _, VToMap t' _) -> + conv env t t' + (VField t k, VField t' k') -> + conv env t t' && k == k' + (VProject t (Left ks), VProject t' (Left ks')) -> + conv env t t' && ks == ks' + (VProject t (Right e), VProject t' (Right e')) -> + conv env t t' && conv env e e' + (VAssert t, VAssert t') -> + conv env t t' + (VEquivalent t u, VEquivalent t' u') -> + conv env t t' && conv env u u' + (VInject m k mt, VInject m' k' mt') -> + eqMapsBy (eqMaybeBy (conv env)) m m' && k == k' && eqMaybeBy (conv env) mt mt' + (VEmbed a, VEmbed a') -> + a == a' + (VOptionalFold a t _ u v, VOptionalFold a' t' _ u' v') -> + conv env a a' && conv env t t' && conv env u u' && conv env v v' + (_, _) -> + False + where + fresh :: Text -> (Text, Val a) + fresh x = (x, VVar x (countEnvironment x env)) + {-# INLINE fresh #-} + + freshClosure :: Closure a -> (Text, Val a, Closure a) + freshClosure closure@(Closure x _ _) = (x, snd (fresh x), closure) + {-# INLINE freshClosure #-} + + convChunks :: VChunks a -> VChunks a -> Bool + convChunks (VChunks xys z) (VChunks xys' z') = + eqListBy (\(x, y) (x', y') -> x == x' && conv env y y') xys xys' && z == z' + {-# INLINE convChunks #-} + + convSkip :: Text -> Val a -> Val a -> Bool + convSkip x = conv (Skip env x) + {-# INLINE convSkip #-} + +{-| Returns `True` if two expressions are α-equivalent and β-equivalent and + `False` otherwise + + `judgmentallyEqual` can fail with an `error` if you compare ill-typed + expressions +-} +judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool +judgmentallyEqual (Core.denote -> t) (Core.denote -> u) = + conv Empty (eval Empty t) (eval Empty u) + +data Names + = EmptyNames + | Bind !Names {-# UNPACK #-} !Text + deriving Show + +envNames :: Environment a -> Names +envNames Empty = EmptyNames +envNames (Skip env x ) = Bind (envNames env) x +envNames (Extend env x _) = Bind (envNames env) x + +countNames :: Text -> Names -> Int +countNames x = go 0 + where + go !acc EmptyNames = acc + go acc (Bind env x') = go (if x == x' then acc + 1 else acc) env + +-- | Quote a value into beta-normal form. +quote :: forall a. Eq a => Names -> Val a -> Expr Void a +quote !env !t0 = + case t0 of + VConst k -> + Const k + VVar !x !i -> + Var (V x (fromIntegral (countNames x env - i - 1))) + VApp t u -> + quote env t `qApp` u + VLam a (freshClosure -> (x, v, t)) -> + Lam x (quote env a) (quoteBind x (instantiate t v)) + VHLam i t -> + case i of + Typed (fresh -> (x, v)) a -> Lam x (quote env a) (quoteBind x (t v)) + Prim -> quote env (t VPrimVar) + NaturalFoldCl{} -> quote env (t VPrimVar) + ListFoldCl{} -> quote env (t VPrimVar) + OptionalFoldCl{} -> quote env (t VPrimVar) + NaturalSubtractZero -> App NaturalSubtract (NaturalLit 0) + + VPi a (freshClosure -> (x, v, b)) -> + Pi x (quote env a) (quoteBind x (instantiate b v)) + VHPi (fresh -> (x, v)) a b -> + Pi x (quote env a) (quoteBind x (b v)) + VBool -> + Bool + VBoolLit b -> + BoolLit b + VBoolAnd t u -> + BoolAnd (quote env t) (quote env u) + VBoolOr t u -> + BoolOr (quote env t) (quote env u) + VBoolEQ t u -> + BoolEQ (quote env t) (quote env u) + VBoolNE t u -> + BoolNE (quote env t) (quote env u) + VBoolIf t u v -> + BoolIf (quote env t) (quote env u) (quote env v) + VNatural -> + Natural + VNaturalLit n -> + NaturalLit n + VNaturalFold a t u v -> + NaturalFold `qApp` a `qApp` t `qApp` u `qApp` v + VNaturalBuild t -> + NaturalBuild `qApp` t + VNaturalIsZero t -> + NaturalIsZero `qApp` t + VNaturalEven t -> + NaturalEven `qApp` t + VNaturalOdd t -> + NaturalOdd `qApp` t + VNaturalToInteger t -> + NaturalToInteger `qApp` t + VNaturalShow t -> + NaturalShow `qApp` t + VNaturalPlus t u -> + NaturalPlus (quote env t) (quote env u) + VNaturalTimes t u -> + NaturalTimes (quote env t) (quote env u) + VNaturalSubtract x y -> + NaturalSubtract `qApp` x `qApp` y + VInteger -> + Integer + VIntegerLit n -> + IntegerLit n + VIntegerShow t -> + IntegerShow `qApp` t + VIntegerToDouble t -> + IntegerToDouble `qApp` t + VDouble -> + Double + VDoubleLit n -> + DoubleLit n + VDoubleShow t -> + DoubleShow `qApp` t + VText -> + Text + VTextLit (VChunks xys z) -> + TextLit (Chunks (fmap (fmap (quote env)) xys) z) + VTextAppend t u -> + TextAppend (quote env t) (quote env u) + VTextShow t -> + TextShow `qApp` t + VList t -> + List `qApp` t + VListLit ma ts -> + ListLit (fmap (quote env) ma) (fmap (quote env) ts) + VListAppend t u -> + ListAppend (quote env t) (quote env u) + VListBuild a t -> + ListBuild `qApp` a `qApp` t + VListFold a l t u v -> + ListFold `qApp` a `qApp` l `qApp` t `qApp` u `qApp` v + VListLength a t -> + ListLength `qApp` a `qApp` t + VListHead a t -> + ListHead `qApp` a `qApp` t + VListLast a t -> + ListLast `qApp` a `qApp` t + VListIndexed a t -> + ListIndexed `qApp` a `qApp` t + VListReverse a t -> + ListReverse `qApp` a `qApp` t + VOptional a -> + Optional `qApp` a + VSome t -> + Some (quote env t) + VNone t -> + None `qApp` t + VOptionalFold a o t u v -> + OptionalFold `qApp` a `qApp` o `qApp` t `qApp` u `qApp` v + VOptionalBuild a t -> + OptionalBuild `qApp` a `qApp` t + VRecord m -> + Record (fmap (quote env) m) + VRecordLit m -> + RecordLit (fmap (quote env) m) + VUnion m -> + Union (fmap (fmap (quote env)) m) + VCombine t u -> + Combine (quote env t) (quote env u) + VCombineTypes t u -> + CombineTypes (quote env t) (quote env u) + VPrefer t u -> + Prefer (quote env t) (quote env u) + VMerge t u ma -> + Merge (quote env t) (quote env u) (fmap (quote env) ma) + VToMap t ma -> + ToMap (quote env t) (fmap (quote env) ma) + VField t k -> + Field (quote env t) k + VProject t p -> + Project (quote env t) (fmap (quote env) p) + VAssert t -> + Assert (quote env t) + VEquivalent t u -> + Equivalent (quote env t) (quote env u) + VInject m k Nothing -> + Field (Union (fmap (fmap (quote env)) m)) k + VInject m k (Just t) -> + Field (Union (fmap (fmap (quote env)) m)) k `qApp` t + VEmbed a -> + Embed a + VPrimVar -> + error errorMsg + where + fresh :: Text -> (Text, Val a) + fresh x = (x, VVar x (countNames x env)) + {-# INLINE fresh #-} + + freshClosure :: Closure a -> (Text, Val a, Closure a) + freshClosure closure@(Closure x _ _) = (x, snd (fresh x), closure) + {-# INLINE freshClosure #-} + + quoteBind :: Text -> Val a -> Expr Void a + quoteBind x = quote (Bind env x) + {-# INLINE quoteBind #-} + + qApp :: Expr Void a -> Val a -> Expr Void a + qApp t VPrimVar = t + qApp t u = App t (quote env u) + {-# INLINE qApp #-} + +-- | Normalize an expression in an environment of values. Any variable pointing out of +-- the environment is treated as opaque free variable. +nf :: Eq a => Environment a -> Expr s a -> Expr t a +nf !env = Core.renote . quote (envNames env) . eval env . Core.denote + +{-| Reduce an expression to its normal form, performing beta reduction + + `normalize` does not type-check the expression. You may want to type-check + expressions before normalizing them since normalization can convert an + ill-typed expression into a well-typed expression. + + `normalize` can also fail with `error` if you normalize an ill-typed + expression +-} +normalize :: Eq a => Expr s a -> Expr t a +normalize = nf Empty + +{-| α-normalize an expression by renaming all bound variables to @\"_\"@ and + using De Bruijn indices to distinguish them + +>>> alphaNormalize (Lam "a" (Const Type) (Lam "b" (Const Type) (Lam "x" "a" (Lam "y" "b" "x")))) +Lam "_" (Const Type) (Lam "_" (Const Type) (Lam "_" (Var (V "_" 1)) (Lam "_" (Var (V "_" 1)) (Var (V "_" 1))))) + + α-normalization does not affect free variables: + +>>> alphaNormalize "x" +Var (V "x" 0) + +-} +alphaNormalize :: Expr s a -> Expr s a +alphaNormalize = goEnv EmptyNames + where + goVar :: Names -> Text -> Int -> Expr s a + goVar e topX topI = go 0 e topI + where + go !acc (Bind env x) !i + | x == topX = if i == 0 then Var (V "_" acc) else go (acc + 1) env (i - 1) + | otherwise = go (acc + 1) env i + go _ EmptyNames i = Var (V topX i) + + goEnv :: Names -> Expr s a -> Expr s a + goEnv !e0 t0 = + case t0 of + Const k -> + Const k + Var (V x i) -> + goVar e0 x i + Lam x t u -> + Lam "_" (go t) (goBind x u) + Pi x a b -> + Pi "_" (go a) (goBind x b) + App t u -> + App (go t) (go u) + Let (Binding src0 x src1 mA src2 a) b -> + Let (Binding src0 "_" src1 (fmap (fmap go) mA) src2 (go a)) (goBind x b) + Annot t u -> + Annot (go t) (go u) + Bool -> + Bool + BoolLit b -> + BoolLit b + BoolAnd t u -> + BoolAnd (go t) (go u) + BoolOr t u -> + BoolOr (go t) (go u) + BoolEQ t u -> + BoolEQ (go t) (go u) + BoolNE t u -> + BoolNE (go t) (go u) + BoolIf b t f -> + BoolIf (go b) (go t) (go f) + Natural -> + Natural + NaturalLit n -> + NaturalLit n + NaturalFold -> + NaturalFold + NaturalBuild -> + NaturalBuild + NaturalIsZero -> + NaturalIsZero + NaturalEven -> + NaturalEven + NaturalOdd -> + NaturalOdd + NaturalToInteger -> + NaturalToInteger + NaturalShow -> + NaturalShow + NaturalSubtract -> + NaturalSubtract + NaturalPlus t u -> + NaturalPlus (go t) (go u) + NaturalTimes t u -> + NaturalTimes (go t) (go u) + Integer -> + Integer + IntegerLit n -> + IntegerLit n + IntegerShow -> + IntegerShow + IntegerToDouble -> + IntegerToDouble + Double -> + Double + DoubleLit n -> + DoubleLit n + DoubleShow -> + DoubleShow + Text -> + Text + TextLit cs -> + TextLit (goChunks cs) + TextAppend t u -> + TextAppend (go t) (go u) + TextShow -> + TextShow + List -> + List + ListLit ma ts -> + ListLit (fmap go ma) (fmap go ts) + ListAppend t u -> + ListAppend (go t) (go u) + ListBuild -> + ListBuild + ListFold -> + ListFold + ListLength -> + ListLength + ListHead -> + ListHead + ListLast -> + ListLast + ListIndexed -> + ListIndexed + ListReverse -> + ListReverse + Optional -> + Optional + Some t -> + Some (go t) + None -> + None + OptionalFold -> + OptionalFold + OptionalBuild -> + OptionalBuild + Record kts -> + Record (fmap go kts) + RecordLit kts -> + RecordLit (fmap go kts) + Union kts -> + Union (fmap (fmap go) kts) + Combine t u -> + Combine (go t) (go u) + CombineTypes t u -> + CombineTypes (go t) (go u) + Prefer t u -> + Prefer (go t) (go u) + Merge x y ma -> + Merge (go x) (go y) (fmap go ma) + ToMap x ma -> + ToMap (go x) (fmap go ma) + Field t k -> + Field (go t) k + Project t ks -> + Project (go t) (fmap go ks) + Assert t -> + Assert (go t) + Equivalent t u -> + Equivalent (go t) (go u) + Note s e -> + Note s (go e) + ImportAlt t u -> + ImportAlt (go t) (go u) + Embed a -> + Embed a + where + go = goEnv e0 + goBind x = goEnv (Bind e0 x) + goChunks (Chunks ts x) = Chunks (fmap (fmap go) ts) x diff --git a/src/Dhall/Eval.hs-boot b/src/Dhall/Eval.hs-boot --- a/src/Dhall/Eval.hs-boot +++ b/src/Dhall/Eval.hs-boot @@ -3,6 +3,6 @@ import {-# SOURCE #-} Dhall.Core -convEmpty :: Eq a => Expr s a -> Expr t a -> Bool -nfEmpty :: Eq a => Expr s a -> Expr t a -alphaNormalize :: Expr s a -> Expr s a +judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool +normalize :: Eq a => Expr s a -> Expr t a +alphaNormalize :: Expr s a -> Expr s a diff --git a/src/Dhall/Format.hs b/src/Dhall/Format.hs --- a/src/Dhall/Format.hs +++ b/src/Dhall/Format.hs @@ -12,18 +12,17 @@ ) where import Control.Exception (Exception) -import Dhall.Parser (exprAndHeaderFromText) -import Dhall.Pretty (CharacterSet(..), annToAnsiStyle, layoutOpts) - import Data.Monoid ((<>)) +import Dhall.Pretty (CharacterSet(..), annToAnsiStyle, layoutOpts) +import Dhall.Util (Censor, Input(..)) import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text import qualified Control.Exception import qualified Data.Text.IO -import qualified Dhall.Core import qualified Dhall.Pretty +import qualified Dhall.Util import qualified System.Console.ANSI import qualified System.IO @@ -36,6 +35,7 @@ -- | Arguments to the `format` subcommand data Format = Format { characterSet :: CharacterSet + , censor :: Censor , formatMode :: FormatMode } @@ -43,15 +43,8 @@ that the input is already formatted -} data FormatMode - = Modify - { inplace :: Maybe FilePath - -- ^ Modify file in-place if present, otherwise read from @stdin@ and - -- write to @stdout@ - } - | Check - { path :: Maybe FilePath - -- ^ Read from the given file if present, otherwise read from @stdin@ - } + = Modify { inplace :: Input } + | Check { path :: Input } -- | Implementation of the @dhall format@ subcommand format @@ -61,20 +54,17 @@ case formatMode of Modify {..} -> case inplace of - Just file -> do - text <- Data.Text.IO.readFile file - - (header, expr) <- Dhall.Core.throws (exprAndHeaderFromText "(stdin)" text) + File file -> do + (header, expr) <- Dhall.Util.getExpressionAndHeader censor (File file) let doc = Pretty.pretty header <> Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet characterSet expr) <> "\n" + System.IO.withFile file System.IO.WriteMode (\handle -> do Pretty.Terminal.renderIO handle (Pretty.layoutSmart layoutOpts doc)) - Nothing -> do - inText <- Data.Text.IO.getContents - - (header, expr) <- Dhall.Core.throws (exprAndHeaderFromText "(stdin)" inText) + StandardInput -> do + (header, expr) <- Dhall.Util.getExpressionAndHeader censor StandardInput let doc = Pretty.pretty header <> Dhall.Pretty.prettyCharacterSet characterSet expr @@ -93,10 +83,10 @@ (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc)) Check {..} -> do originalText <- case path of - Just file -> Data.Text.IO.readFile file - Nothing -> Data.Text.IO.getContents + File file -> Data.Text.IO.readFile file + StandardInput -> Data.Text.IO.getContents - (header, expr) <- Dhall.Core.throws (exprAndHeaderFromText "(stdin)" originalText) + (header, expr) <- Dhall.Util.getExpressionAndHeader censor path let doc = Pretty.pretty header <> Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet characterSet expr) diff --git a/src/Dhall/Freeze.hs b/src/Dhall/Freeze.hs --- a/src/Dhall/Freeze.hs +++ b/src/Dhall/Freeze.hs @@ -16,12 +16,12 @@ import Control.Exception (SomeException) import Data.Monoid ((<>)) -import Data.Maybe (fromMaybe) import Data.Text import Dhall.Core (Expr(..), Import(..), ImportHashed(..), ImportType(..)) -import Dhall.Parser (exprAndHeaderFromText, Src) +import Dhall.Parser (Src) import Dhall.Pretty (CharacterSet, annToAnsiStyle, layoutOpts, prettyCharacterSet) import Dhall.TypeCheck (X) +import Dhall.Util (Censor, Input(..)) import System.Console.ANSI (hSupportsANSI) import qualified Control.Exception @@ -33,6 +33,7 @@ import qualified Dhall.Import import qualified Dhall.Optics import qualified Dhall.TypeCheck +import qualified Dhall.Util import qualified System.FilePath import qualified System.IO @@ -92,7 +93,7 @@ Remote {} -> freezeImport directory import_ _ -> return import_ -writeExpr :: Maybe FilePath -> (Text, Expr Src Import) -> CharacterSet -> IO () +writeExpr :: Input -> (Text, Expr Src Import) -> CharacterSet -> IO () writeExpr inplace (header, expr) characterSet = do let doc = Pretty.pretty header <> Dhall.Pretty.prettyCharacterSet characterSet expr @@ -100,12 +101,12 @@ let unAnnotated = Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc) case inplace of - Just f -> + File f -> System.IO.withFile f System.IO.WriteMode (\handle -> do Pretty.renderIO handle unAnnotated Data.Text.IO.hPutStrLn handle "" ) - Nothing -> do + StandardInput -> do supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout if supportsANSI then @@ -133,26 +134,18 @@ -- | Implementation of the @dhall freeze@ subcommand freeze - :: Maybe FilePath - -- ^ Modify file in-place if present, otherwise read from @stdin@ and write - -- to @stdout@ + :: Input -> Scope -> Intent -> CharacterSet + -> Censor -> IO () -freeze inplace scope intent characterSet = do - (text, directory) <- case inplace of - Nothing -> do - text <- Data.Text.IO.getContents - - return (text, ".") - - Just file -> do - text <- Data.Text.IO.readFile file - - return (text, System.FilePath.takeDirectory file) +freeze inplace scope intent characterSet censor = do + let directory = case inplace of + StandardInput -> "." + File file -> System.FilePath.takeDirectory file - (header, parsedExpression) <- Dhall.Core.throws (exprAndHeaderFromText srcInfo text) + (header, parsedExpression) <- Dhall.Util.getExpressionAndHeader censor inplace let freezeScope = case scope of @@ -208,5 +201,3 @@ frozenExpression <- rewrite parsedExpression writeExpr inplace (header, frozenExpression) characterSet - where - srcInfo = fromMaybe "(stdin)" inplace diff --git a/src/Dhall/Hash.hs b/src/Dhall/Hash.hs --- a/src/Dhall/Hash.hs +++ b/src/Dhall/Hash.hs @@ -7,24 +7,21 @@ hash ) where -import Dhall.Parser (exprFromText) import Dhall.Import (hashExpressionToCode) +import Dhall.Util (Censor, Input(..)) import qualified Control.Monad.Trans.State.Strict as State import qualified Control.Exception import qualified Dhall.Core import qualified Dhall.Import import qualified Dhall.TypeCheck +import qualified Dhall.Util import qualified Data.Text.IO -- | Implementation of the @dhall hash@ subcommand -hash :: IO () -hash = do - inText <- Data.Text.IO.getContents - - parsedExpression <- case exprFromText "(stdin)" inText of - Left exception -> Control.Exception.throwIO exception - Right parsedExpression -> return parsedExpression +hash :: Censor -> IO () +hash censor = do + parsedExpression <- Dhall.Util.getExpression censor StandardInput let status = Dhall.Import.emptyStatus "." diff --git a/src/Dhall/Import.hs b/src/Dhall/Import.hs --- a/src/Dhall/Import.hs +++ b/src/Dhall/Import.hs @@ -107,8 +107,9 @@ , hashExpression , hashExpressionToCode , writeExpressionToSemanticCache + , warnAboutMissingCaches , assertNoImports - , Status + , Status(..) , SemanticCacheMode(..) , Chained , chainedImport @@ -138,13 +139,12 @@ import Control.Applicative (Alternative(..)) import Codec.CBOR.Term (Term(..)) -import Control.Exception (Exception, SomeException, toException) -import Control.Monad (guard) +import Control.Exception (Exception, SomeException, IOException, toException) +import Control.Monad (when) import Control.Monad.Catch (throwM, MonadCatch(catch), handle) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict (StateT) -import Crypto.Hash (SHA256) import Data.ByteString (ByteString) import Data.CaseInsensitive (CI) import Data.List.NonEmpty (NonEmpty(..)) @@ -172,8 +172,7 @@ , bindingExprs , chunkExprs ) -#ifdef MIN_VERSION_http_client -import Network.HTTP.Client (Manager) +#ifdef WITH_HTTP import Dhall.Import.HTTP hiding (HTTPHeader) #endif import Dhall.Import.Types @@ -185,7 +184,6 @@ import qualified Codec.Serialise import qualified Control.Monad.Trans.Maybe as Maybe import qualified Control.Monad.Trans.State.Strict as State -import qualified Crypto.Hash import qualified Data.ByteString import qualified Data.ByteString.Lazy import qualified Data.CaseInsensitive @@ -197,11 +195,14 @@ import qualified Data.Text.IO import qualified Dhall.Binary import qualified Dhall.Core +import qualified Dhall.Crypto import qualified Dhall.Map import qualified Dhall.Parser import qualified Dhall.Pretty.Internal import qualified Dhall.TypeCheck import qualified System.Environment +import qualified System.Info +import qualified System.IO import qualified System.Directory as Directory import qualified System.FilePath as FilePath import qualified Text.Megaparsec @@ -404,8 +405,8 @@ -- | Exception thrown when an integrity check fails data HashMismatch = HashMismatch - { expectedHash :: Crypto.Hash.Digest SHA256 - , actualHash :: Crypto.Hash.Digest SHA256 + { expectedHash :: Dhall.Crypto.SHA256Digest + , actualHash :: Dhall.Crypto.SHA256Digest } deriving (Typeable) instance Exception HashMismatch @@ -503,7 +504,7 @@ case mCached of Just bytesStrict -> do - let actualHash = Crypto.Hash.hash bytesStrict + let actualHash = Dhall.Crypto.sha256Hash bytesStrict if semanticHash == actualHash then return () else do @@ -525,7 +526,7 @@ let variants = map (\version -> encodeExpression version (Dhall.Core.alphaNormalize importSemantics)) [ minBound .. maxBound ] - case Data.Foldable.find ((== semanticHash). Crypto.Hash.hash) variants of + case Data.Foldable.find ((== semanticHash). Dhall.Crypto.sha256Hash) variants of Just bytes -> liftIO $ writeToSemanticCache semanticHash bytes Nothing -> do let expectedHash = semanticHash @@ -536,7 +537,7 @@ return (ImportSemantics {..}) -- Fetch encoded normal form from "semantic cache" -fetchFromSemanticCache :: Crypto.Hash.Digest SHA256 -> IO (Maybe Data.ByteString.ByteString) +fetchFromSemanticCache :: Dhall.Crypto.SHA256Digest -> IO (Maybe Data.ByteString.ByteString) fetchFromSemanticCache expectedHash = Maybe.runMaybeT $ do cacheFile <- getCacheFile "dhall" expectedHash True <- liftIO (Directory.doesFileExist cacheFile) @@ -548,9 +549,9 @@ writeExpressionToSemanticCache expression = writeToSemanticCache hash bytes where bytes = encodeExpression NoVersion expression - hash = Crypto.Hash.hash bytes + hash = Dhall.Crypto.sha256Hash bytes -writeToSemanticCache :: Crypto.Hash.Digest SHA256 -> Data.ByteString.ByteString -> IO () +writeToSemanticCache :: Dhall.Crypto.SHA256Digest -> Data.ByteString.ByteString -> IO () writeToSemanticCache hash bytes = do _ <- Maybe.runMaybeT $ do cacheFile <- getCacheFile "dhall" hash @@ -659,17 +660,17 @@ -- AST (without normalising or type-checking it first). See -- https://github.com/dhall-lang/dhall-haskell/issues/1098 for further -- discussion. -computeSemisemanticHash :: Expr Src X -> Crypto.Hash.Digest Crypto.Hash.SHA256 +computeSemisemanticHash :: Expr Src X -> Dhall.Crypto.SHA256Digest computeSemisemanticHash resolvedExpr = hashExpression resolvedExpr -- Fetch encoded normal form from "semi-semantic cache" -fetchFromSemisemanticCache :: Crypto.Hash.Digest SHA256 -> IO (Maybe Data.ByteString.ByteString) +fetchFromSemisemanticCache :: Dhall.Crypto.SHA256Digest -> IO (Maybe Data.ByteString.ByteString) fetchFromSemisemanticCache semisemanticHash = Maybe.runMaybeT $ do cacheFile <- getCacheFile "dhall-haskell" semisemanticHash True <- liftIO (Directory.doesFileExist cacheFile) liftIO (Data.ByteString.readFile cacheFile) -writeToSemisemanticCache :: Crypto.Hash.Digest SHA256 -> Data.ByteString.ByteString -> IO () +writeToSemisemanticCache :: Dhall.Crypto.SHA256Digest -> Data.ByteString.ByteString -> IO () writeToSemisemanticCache semisemanticHash bytes = do _ <- Maybe.runMaybeT $ do cacheFile <- getCacheFile "dhall-haskell" semisemanticHash @@ -703,7 +704,7 @@ fetchRemote :: URL -> StateT Status IO Data.Text.Text -#ifndef MIN_VERSION_http_client +#ifndef WITH_HTTP fetchRemote (url@URL { headers = maybeHeadersExpression }) = do let maybeHeaders = fmap toHeaders maybeHeadersExpression let urlString = Text.unpack (Dhall.Core.pretty url) @@ -711,14 +712,13 @@ throwMissingImport (Imported _stack (CannotImportHTTPURL urlString maybeHeaders)) #else fetchRemote url = do - manager <- liftIO $ newManager - zoom remote (State.put (fetchFromHTTP manager)) - fetchFromHTTP manager url + zoom remote (State.put fetchFromHTTP) + fetchFromHTTP url where - fetchFromHTTP :: Manager -> URL -> StateT Status IO Data.Text.Text - fetchFromHTTP manager (url'@URL { headers = maybeHeadersExpression }) = do + fetchFromHTTP :: URL -> StateT Status IO Data.Text.Text + fetchFromHTTP (url'@URL { headers = maybeHeadersExpression }) = do let maybeHeaders = fmap toHeaders maybeHeadersExpression - fetchFromHttpUrl manager url' maybeHeaders + fetchFromHttpUrl url' maybeHeaders #endif -- | Given a well-typed (of type `List { header : Text, value Text }` or @@ -744,46 +744,139 @@ empty getCacheFile - :: (Alternative m, MonadIO m) => FilePath -> Crypto.Hash.Digest SHA256 -> m FilePath + :: (MonadCatch m, Alternative m, MonadIO m) => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath getCacheFile cacheName hash = do - let assertDirectory directory = do + cacheDirectory <- getOrCreateCacheDirectory False cacheName + + let cacheFile = cacheDirectory ("1220" <> show hash) + + return cacheFile + +warnAboutMissingCaches :: (MonadCatch m, Alternative m, MonadIO m) => m () +warnAboutMissingCaches = warn <|> return () + where warn = Data.Foldable.traverse_ (getOrCreateCacheDirectory True) ["dhall", "dhall-haskell"] + +getOrCreateCacheDirectory :: (MonadCatch m, Alternative m, MonadIO m) => Bool -> FilePath -> m FilePath +getOrCreateCacheDirectory showWarning cacheName = do + let warn message = do + let warning = + "\n" + <> "\ESC[1;33mWarning\ESC[0m: " + <> message + + when showWarning (liftIO (System.IO.hPutStrLn System.IO.stderr warning)) + + empty + + let handler action dir (ioex :: IOException) = do + let ioExMsg = + "When trying to " <> action <> ":\n" + <> "\n" + <> "↳ " <> dir <> "\n" + <> "\n" + <> "... the following exception was thrown:\n" + <> "\n" + <> "↳ " <> show ioex <> "\n" + + warn ioExMsg + + let setPermissions dir = do let private = transform Directory.emptyPermissions - where - transform = + where + transform = Directory.setOwnerReadable True - . Directory.setOwnerWritable True - . Directory.setOwnerSearchable True + . Directory.setOwnerWritable True + . Directory.setOwnerSearchable True + catch + (liftIO (Directory.setPermissions dir private)) + (handler "correct the permissions for" dir) + + let assertPermissions dir = do let accessible path = - Directory.readable path - && Directory.writable path - && Directory.searchable path + Directory.readable path + && Directory.writable path + && Directory.searchable path - directoryExists <- liftIO (Directory.doesDirectoryExist directory) + permissions <- + catch (liftIO (Directory.getPermissions dir)) + (handler "get permissions of" dir) - if directoryExists - then do - permissions <- liftIO (Directory.getPermissions directory) + if accessible permissions + then + return () + else do + let message = + "The directory:\n" + <> "\n" + <> "↳ " <> dir <> "\n" + <> "\n" + <> "... does not give you permission to read, write, or search files.\n\n" + <> "The directory's current permissions are:\n" + <> show permissions <> "\n" - guard (accessible permissions) + warn message + let existsDirectory dir = + catch (liftIO (Directory.doesDirectoryExist dir)) + (handler "check the existence of" dir) + + let existsFile path = + catch (liftIO (Directory.doesFileExist path)) + (handler "check the existence of" path) + + let createDirectory dir = + catch (liftIO (Directory.createDirectory dir)) + (handler "create" dir) + + let assertDirectory dir = do + existsDir <- existsDirectory dir + + if existsDir + then do + assertPermissions dir + else do - assertDirectory (FilePath.takeDirectory directory) + existsFile' <- existsFile dir - liftIO (Directory.createDirectory directory) + if existsFile' + then do + let message = + "The given path:\n" + <> "\n" + <> "↳ " <> dir <> "\n" + <> "\n" + <> "... already exists but is not a directory.\n" - liftIO (Directory.setPermissions directory private) + warn message - cacheDirectory <- getCacheDirectory + else do + assertDirectory (FilePath.takeDirectory dir) - assertDirectory (cacheDirectory cacheName) + createDirectory dir - let cacheFile = (cacheDirectory cacheName) ("1220" <> show hash) + setPermissions dir + + cacheBaseDirectory <- getCacheBaseDirectory showWarning - return cacheFile + let directory = cacheBaseDirectory cacheName -getCacheDirectory :: (Alternative m, MonadIO m) => m FilePath -getCacheDirectory = alternative₀ <|> alternative₁ + let message = + "Could not get or create the default cache directory:\n" + <> "\n" + <> "↳ " <> directory <> "\n" + <> "\n" + <> "You can enable caching by creating it if needed and setting read,\n" + <> "write and search permissions on it or providing another cache base\n" + <> "directory by setting the $XDG_CACHE_HOME environment variable.\n" + <> "\n" + + assertDirectory directory <|> warn message + + return directory + +getCacheBaseDirectory :: (Alternative m, MonadIO m) => Bool -> m FilePath +getCacheBaseDirectory showWarning = alternative₀ <|> alternative₁ <|> alternative₂ where alternative₀ = do maybeXDGCacheHome <- do @@ -793,13 +886,38 @@ Just xdgCacheHome -> return xdgCacheHome Nothing -> empty - alternative₁ = do - maybeHomeDirectory <- liftIO (System.Environment.lookupEnv "HOME") + alternative₁ + | isWindows = do + maybeLocalAppDirectory <- + liftIO (System.Environment.lookupEnv "LOCALAPPDATA") - case maybeHomeDirectory of - Just homeDirectory -> return (homeDirectory ".cache") - Nothing -> empty + case maybeLocalAppDirectory of + Just localAppDirectory -> return localAppDirectory + Nothing -> empty + | otherwise = do + maybeHomeDirectory <- + liftIO (System.Environment.lookupEnv "HOME") + + case maybeHomeDirectory of + Just homeDirectory -> return (homeDirectory ".cache") + Nothing -> empty + + where isWindows = System.Info.os == "mingw32" + + alternative₂ = do + let message = + "\n" + <> "\ESC[1;33mWarning\ESC[0m: " + <> "Could not locate a cache base directory from the environment.\n" + <> "\n" + <> "You can provide a cache base directory by pointing the $XDG_CACHE_HOME\n" + <> "environment variable to a directory with read and write permissions.\n" + + when showWarning (liftIO (System.IO.hPutStrLn System.IO.stderr message)) + + empty + -- If the URL contains headers typecheck them and replace them with their normal -- forms. normalizeHeaders :: URL -> StateT Status IO URL @@ -1014,9 +1132,9 @@ bytesStrict = Data.ByteString.Lazy.toStrict bytesLazy -- | Hash a fully resolved expression -hashExpression :: Expr s X -> (Crypto.Hash.Digest SHA256) +hashExpression :: Expr s X -> Dhall.Crypto.SHA256Digest hashExpression expression = - Crypto.Hash.hash (encodeExpression NoVersion expression) + Dhall.Crypto.sha256Hash (encodeExpression NoVersion expression) {-| Convenience utility to hash a fully resolved expression and return the base-16 encoded hash with the @sha256:@ prefix diff --git a/src/Dhall/Import/HTTP.hs b/src/Dhall/Import/HTTP.hs deleted file mode 100644 --- a/src/Dhall/Import/HTTP.hs +++ /dev/null @@ -1,351 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Dhall.Import.HTTP where - -import Control.Exception (Exception) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.State.Strict (StateT) -import Data.ByteString (ByteString) -import Data.CaseInsensitive (CI) -import Data.Dynamic (toDyn) -import Data.Semigroup ((<>)) -import Data.Text (Text) - -import Dhall.Core - ( Directory(..) - , File(..) - , Import(..) - , ImportHashed(..) - , ImportType(..) - , Scheme(..) - , URL(..) - ) - -import qualified Control.Monad.Trans.State.Strict as State -import qualified Data.Text as Text -import qualified Data.Text.Encoding -import qualified Dhall.Util -import qualified Network.URI.Encode as URI.Encode - -import Dhall.Import.Types - -import qualified Control.Exception -#ifdef __GHCJS__ -import qualified JavaScript.XHR -#else -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Text.Lazy -import qualified Data.Text.Lazy.Encoding -#endif - -#if MIN_VERSION_http_client(0,5,0) -import Network.HTTP.Client - (HttpException(..), HttpExceptionContent(..), Manager) -#else -import Network.HTTP.Client (HttpException(..), Manager) -#endif - -import qualified Network.HTTP.Client as HTTP -import qualified Network.HTTP.Client.TLS as HTTP -import qualified Network.HTTP.Types - -mkPrettyHttpException :: String -> HttpException -> PrettyHttpException -mkPrettyHttpException url ex = - PrettyHttpException (renderPrettyHttpException url ex) (toDyn ex) - -renderPrettyHttpException :: String -> HttpException -> String -#if MIN_VERSION_http_client(0,5,0) -renderPrettyHttpException _ (InvalidUrlException _ r) = - "\n" - <> "\ESC[1;31mError\ESC[0m: Invalid URL\n" - <> "\n" - <> "URL: " <> show r <> "\n" -renderPrettyHttpException url (HttpExceptionRequest _ e) = - case e of - ConnectionFailure _ -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Remote host not found\n" - <> "\n" - <> "URL: " <> url <> "\n" - InvalidDestinationHost host -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Invalid remote host name:\n" - <> "\n" - <> "Host: " <> show host <> "\n" - ResponseTimeout -> - "\n" - <> "\ESC[1;31mError\ESC[0m: The remote host took too long to respond\n" - <> "\n" - <> "URL: " <> url <> "\n" - StatusCodeException response body -> prefix <> suffix - where - prefix - | statusCode == 401 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Access unauthorized\n" - | statusCode == 403 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Access forbidden\n" - | statusCode == 404 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Remote file not found\n" - | statusCode == 500 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Server-side failure\n" - | statusCode == 502 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Upstream failure\n" - | statusCode == 503 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Server temporarily unavailable\n" - | statusCode == 504 = - "\n" - <> "\ESC[1;31mError\ESC[0m: Upstream timeout\n" - | otherwise = - "\n" - <> "\ESC[1;31mError\ESC[0m: HTTP request failure\n" - - suffix = - "\n" - <> "HTTP status code: " <> show statusCode <> "\n" - <> "\n" - <> "URL: " <> url <> "\n" - <> message - - statusCode = - Network.HTTP.Types.statusCode - (HTTP.responseStatus response) - - message = - case Data.Text.Encoding.decodeUtf8' body of - Left _ -> - "\n" - <> "Message (non-UTF8 bytes):\n" - <> "\n" - <> truncatedBodyString <> "\n" - where - bodyString = show body - - dots = "…" - - truncatedLength = 80 - length dots - - truncatedBodyString - | truncatedLength < length bodyString = - take truncatedLength bodyString <> dots - | otherwise = - bodyString - Right "" -> - "" - Right bodyText -> - "\n" - <> "Message:\n" - <> "\n" - <> Text.unpack prefixedText - where - prefixedLines = - zipWith combine prefixes (Text.lines bodyText) - where - prefixes = - map (Text.pack . show) [(1 ::Int)..7] ++ [ "…" ] - - combine n line = n <> "│ " <> line - - prefixedText = Text.unlines prefixedLines - - e' -> "\n" <> show e' <> "\n" -#else -renderPrettyHttpException url e = case e of - FailedConnectionException2 _ _ _ e' -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Wrong host:\n" - <> "\n" - <> "Host: " <> show e' <> "\n" - InvalidDestinationHost host -> - "\n" - <> "\ESC[1;31mError\ESC[0m: Invalid host name:\n" - <> "\n" - <> "Host: " <> show host <> "\n" - ResponseTimeout -> - "\ESC[1;31mError\ESC[0m: The host took too long to respond\n" - <> "\n" - <> "URL: " <> url <> "\n" - e' -> "\n" - <> show e' <> "\n" -#endif - -newManager :: IO Manager -newManager = do - let settings = HTTP.tlsManagerSettings -#ifdef MIN_VERSION_http_client -#if MIN_VERSION_http_client(0,5,0) - { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (30 * 1000 * 1000) } -- 30 seconds -#else - { HTTP.managerResponseTimeout = Just (30 * 1000 * 1000) } -- 30 seconds -#endif -#endif - HTTP.newManager settings - -data NotCORSCompliant = NotCORSCompliant - { expectedOrigins :: [ByteString] - , actualOrigin :: ByteString - } - -instance Exception NotCORSCompliant - -instance Show NotCORSCompliant where - show (NotCORSCompliant {..}) = - Dhall.Util._ERROR <> ": Not CORS compliant\n" - <> "\n" - <> "Dhall supports transitive imports, meaning that an imported expression can\n" - <> "import other expressions. However, a remote import (the \"parent\" import)\n" - <> "cannot import another remote import (the \"child\" import) unless the child\n" - <> "import grants permission to do using CORS. The child import must respond with\n" - <> "an `Access-Control-Allow-Origin` response header that matches the parent\n" - <> "import, otherwise Dhall rejects the import.\n" - <> "\n" <> prologue - where - prologue = - case expectedOrigins of - [ expectedOrigin ] -> - "The following parent import:\n" - <> "\n" - <> "↳ " <> show actualOrigin <> "\n" - <> "\n" - <> "... did not match the expected origin:\n" - <> "\n" - <> "↳ " <> show expectedOrigin <> "\n" - <> "\n" - <> "... so import resolution failed.\n" - [] -> - "The child response did not include any `Access-Control-Allow-Origin` header,\n" - <> "so import resolution failed.\n" - _:_:_ -> - "The child response included more than one `Access-Control-Allow-Origin` header,\n" - <> "when only one such header should have been present, so import resolution\n" - <> "failed.\n" - <> "\n" - <> "This may indicate that the server for the child import is misconfigured.\n" - -corsCompliant - :: MonadIO io - => ImportType -> URL -> [(CI ByteString, ByteString)] -> io () -corsCompliant (Remote parentURL) childURL responseHeaders = liftIO $ do - let toOrigin (URL {..}) = - Data.Text.Encoding.encodeUtf8 (prefix <> "://" <> authority) - where - prefix = - case scheme of - HTTP -> "http" - HTTPS -> "https" - - let actualOrigin = toOrigin parentURL - - let childOrigin = toOrigin childURL - - let predicate (header, _) = header == "Access-Control-Allow-Origin" - - let originHeaders = filter predicate responseHeaders - - let expectedOrigins = map snd originHeaders - - case expectedOrigins of - [expectedOrigin] - | expectedOrigin == "*" -> - return () - | expectedOrigin == actualOrigin -> - return () - _ | actualOrigin == childOrigin -> - return () - | otherwise -> - Control.Exception.throwIO (NotCORSCompliant {..}) -corsCompliant _ _ _ = return () - -renderComponent :: Text -> Text -renderComponent component = "/" <> URI.Encode.encodeText component - -renderQuery :: Text -> Text -renderQuery query = "?" <> query - -renderURL :: URL -> Text -renderURL url = - schemeText - <> authority - <> pathText - <> queryText - where - URL {..} = url - - File {..} = path - - Directory {..} = directory - - schemeText = case scheme of - HTTP -> "http://" - HTTPS -> "https://" - - pathText = - foldMap renderComponent (reverse components) - <> renderComponent file - - queryText = foldMap renderQuery query - -type HTTPHeader = Network.HTTP.Types.Header - -fetchFromHttpUrl - :: Manager - -> URL - -> Maybe [HTTPHeader] - -> StateT Status IO Text.Text -#ifdef __GHCJS__ -fetchFromHttpUrl _ childURL Nothing = do - let childURLText = renderURL childURL - - let childURLString = Text.unpack childURLText - - -- No need to add a CORS compliance check when using GHCJS. The browser - -- will already check the CORS compliance of the following XHR - (statusCode, body) <- liftIO (JavaScript.XHR.get childURLText) - - case statusCode of - 200 -> return () - _ -> fail (childURLString <> " returned a non-200 status code: " <> show statusCode) - - return body -fetchFromHttpUrl _ _ _ = do - fail "Dhall does not yet support custom headers when built using GHCJS" -#else -fetchFromHttpUrl manager childURL mheaders = do - let childURLString = Text.unpack (renderURL childURL) - - request <- liftIO (HTTP.parseUrlThrow childURLString) - - let requestWithHeaders = - case mheaders of - Nothing -> request - Just headers -> request { HTTP.requestHeaders = headers } - - let io = HTTP.httpLbs requestWithHeaders manager - - let handler e = do - let _ = e :: HttpException - Control.Exception.throwIO (mkPrettyHttpException childURLString e) - - response <- liftIO (Control.Exception.handle handler io) - - Status {..} <- State.get - - let Chained parentImport = NonEmpty.head _stack - - let parentImportType = importType (importHashed parentImport) - - corsCompliant parentImportType childURL (HTTP.responseHeaders response) - - let bytes = HTTP.responseBody response - - case Data.Text.Lazy.Encoding.decodeUtf8' bytes of - Left err -> liftIO (Control.Exception.throwIO err) - Right text -> return (Data.Text.Lazy.toStrict text) -#endif diff --git a/src/Dhall/Main.hs b/src/Dhall/Main.hs --- a/src/Dhall/Main.hs +++ b/src/Dhall/Main.hs @@ -26,13 +26,14 @@ import Data.Monoid ((<>)) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty) -import Data.Version (showVersion) import Dhall.Core (Expr(Annot), Import, pretty) import Dhall.Freeze (Intent(..), Scope(..)) import Dhall.Import (Imported(..), Depends(..), SemanticCacheMode(..)) import Dhall.Parser (Src) import Dhall.Pretty (Ann, CharacterSet(..), annToAnsiStyle, layoutOpts) -import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X) +import Dhall.TypeCheck (Censored(..), DetailedTypeError(..), TypeError, X) +import Dhall.Util (Censor(..), Input(..)) +import Dhall.Version (dhallVersionString) import Options.Applicative (Parser, ParserInfo) import System.Exit (ExitCode, exitFailure) import System.IO (Handle) @@ -62,13 +63,12 @@ import qualified Dhall.Import import qualified Dhall.Import.Types import qualified Dhall.Lint -import qualified Dhall.Parser import qualified Dhall.Pretty import qualified Dhall.Repl import qualified Dhall.TypeCheck +import qualified Dhall.Util import qualified GHC.IO.Encoding import qualified Options.Applicative -import qualified Paths_dhall as Meta import qualified System.Console.ANSI import qualified System.Exit as Exit import qualified System.IO @@ -78,33 +78,35 @@ -- | Top-level program options data Options = Options - { mode :: Mode - , explain :: Bool - , plain :: Bool - , ascii :: Bool + { mode :: Mode + , explain :: Bool + , plain :: Bool + , ascii :: Bool + , censor :: Censor } -- | The subcommands for the @dhall@ executable data Mode = Default - { file :: Maybe FilePath + { file :: Input , annotate :: Bool , alpha :: Bool , semanticCacheMode :: SemanticCacheMode + , version :: Bool } | Version - | Resolve { file :: Maybe FilePath, resolveMode :: Maybe ResolveMode } - | Type { file :: Maybe FilePath } - | Normalize { file :: Maybe FilePath, alpha :: Bool } + | Resolve { file :: Input, resolveMode :: Maybe ResolveMode } + | Type { file :: Input, quiet :: Bool } + | Normalize { file :: Input , alpha :: Bool } | Repl | Format { formatMode :: Dhall.Format.FormatMode } - | Freeze { inplace :: Maybe FilePath, all_ :: Bool, cache :: Bool } + | Freeze { inplace :: Input, all_ :: Bool, cache :: Bool } | Hash | Diff { expr1 :: Text, expr2 :: Text } - | Lint { inplace :: Maybe FilePath } - | Encode { file :: Maybe FilePath, json :: Bool } - | Decode { file :: Maybe FilePath, json :: Bool } - | Text { file :: Maybe FilePath } + | Lint { inplace :: Input } + | Encode { file :: Input, json :: Bool } + | Decode { file :: Input, json :: Bool } + | Text { file :: Input } data ResolveMode = Dot @@ -120,6 +122,7 @@ <*> switch "explain" "Explain error messages in more detail" <*> switch "plain" "Disable syntax highlighting" <*> switch "ascii" "Format code using only ASCII syntax" + <*> parseCensor where switch name description = Options.Applicative.switch @@ -127,6 +130,11 @@ <> Options.Applicative.help description ) + parseCensor = fmap f (switch "censor" "Hide source code in error messages") + where + f True = Censor + f False = NoCensor + subcommand :: String -> String -> Parser a -> Parser a subcommand name description parser = Options.Applicative.hsubparser @@ -149,15 +157,15 @@ <|> subcommand "resolve" "Resolve an expression's imports" - (Resolve <$> optional parseFile <*> parseResolveMode) + (Resolve <$> parseFile <*> parseResolveMode) <|> subcommand "type" "Infer an expression's type" - (Type <$> optional parseFile) + (Type <$> parseFile <*> parseQuiet) <|> subcommand "normalize" "Normalize an expression" - (Normalize <$> optional parseFile <*> parseAlpha) + (Normalize <$> parseFile <*> parseAlpha) <|> subcommand "repl" "Interpret expressions in a REPL" @@ -173,7 +181,7 @@ <|> subcommand "lint" "Improve Dhall code by using newer language features and removing dead code" - (Lint <$> optional parseInplace) + (Lint <$> parseInplace) <|> subcommand "format" "Standard code formatter for the Dhall language" @@ -181,33 +189,43 @@ <|> subcommand "freeze" "Add integrity checks to remote import statements of an expression" - (Freeze <$> optional parseInplace <*> parseAllFlag <*> parseCacheFlag) + (Freeze <$> parseInplace <*> parseAllFlag <*> parseCacheFlag) <|> subcommand "encode" "Encode a Dhall expression to binary" - (Encode <$> optional parseFile <*> parseJSONFlag) + (Encode <$> parseFile <*> parseJSONFlag) <|> subcommand "decode" "Decode a Dhall expression from binary" - (Decode <$> optional parseFile <*> parseJSONFlag) + (Decode <$> parseFile <*> parseJSONFlag) <|> subcommand "text" "Render a Dhall expression that evaluates to a Text literal" - (Text <$> optional parseFile) - <|> (Default <$> optional parseFile <*> parseAnnotate <*> parseAlpha <*> parseSemanticCacheMode) + (Text <$> parseFile) + <|> ( Default + <$> parseFile + <*> parseAnnotate + <*> parseAlpha + <*> parseSemanticCacheMode + <*> parseVersion + ) where argument = fmap Data.Text.pack . Options.Applicative.strArgument . Options.Applicative.metavar - parseFile = - Options.Applicative.strOption - ( Options.Applicative.long "file" - <> Options.Applicative.help "Read expression from a file instead of standard input" - <> Options.Applicative.metavar "FILE" - ) + parseFile = fmap f (optional p) + where + f Nothing = StandardInput + f (Just file) = File file + p = Options.Applicative.strOption + ( Options.Applicative.long "file" + <> Options.Applicative.help "Read expression from a file instead of standard input" + <> Options.Applicative.metavar "FILE" + ) + parseAlpha = Options.Applicative.switch ( Options.Applicative.long "alpha" @@ -229,6 +247,12 @@ "Handle protected imports as if the cache was empty" ) + parseVersion = + Options.Applicative.switch + ( Options.Applicative.long "version" + <> Options.Applicative.help "Display version" + ) + parseResolveMode = Options.Applicative.flag' (Just Dot) ( Options.Applicative.long "dot" @@ -249,13 +273,23 @@ ) <|> pure Nothing - parseInplace = - Options.Applicative.strOption - ( Options.Applicative.long "inplace" - <> Options.Applicative.help "Modify the specified file in-place" - <> Options.Applicative.metavar "FILE" - ) + parseQuiet = + Options.Applicative.switch + ( Options.Applicative.long "quiet" + <> Options.Applicative.help "Don't print the inferred type" + ) + parseInplace = fmap f (optional p) + where + f Nothing = StandardInput + f (Just file) = File file + + p = Options.Applicative.strOption + ( Options.Applicative.long "inplace" + <> Options.Applicative.help "Modify the specified file in-place" + <> Options.Applicative.metavar "FILE" + ) + parseJSONFlag = Options.Applicative.switch ( Options.Applicative.long "json" @@ -280,20 +314,11 @@ <> Options.Applicative.help "Only check if the input is formatted" ) - parseFormatMode = adapt <$> parseCheck <*> optional parseInplace + parseFormatMode = adapt <$> parseCheck <*> parseInplace where adapt True path = Dhall.Format.Check {..} adapt False inplace = Dhall.Format.Modify {..} -getExpression :: Maybe FilePath -> IO (Expr Src Import) -getExpression maybeFile = do - inText <- do - case maybeFile of - Just file -> Data.Text.IO.readFile file - Nothing -> Data.Text.IO.getContents - - Dhall.Core.throws (Dhall.Parser.exprFromText "(stdin)" inText) - -- | `ParserInfo` for the `Options` type parserInfoOptions :: ParserInfo Options parserInfoOptions = @@ -313,11 +338,14 @@ GHC.IO.Encoding.setLocaleEncoding System.IO.utf8 let rootDirectory = \case - Just f -> System.FilePath.takeDirectory f - Nothing -> "." + File f -> System.FilePath.takeDirectory f + StandardInput -> "." let toStatus = Dhall.Import.emptyStatus . rootDirectory + let getExpression = Dhall.Util.getExpression censor + let getExpressionAndHeader = Dhall.Util.getExpressionAndHeader censor + let handle io = Control.Exception.catches io [ Handler handleTypeError @@ -338,10 +366,16 @@ let _ = e :: TypeError Src X System.IO.hPutStrLn System.IO.stderr "" if explain - then Control.Exception.throwIO (DetailedTypeError e) + then + case censor of + Censor -> Control.Exception.throwIO (CensoredDetailed (DetailedTypeError e)) + NoCensor -> Control.Exception.throwIO (DetailedTypeError e) + else do Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m" - Control.Exception.throwIO e + case censor of + Censor -> Control.Exception.throwIO (Censored e) + NoCensor -> Control.Exception.throwIO e handleImported (Imported ps e) = Control.Exception.handle handleAll $ do let _ = e :: TypeError Src X @@ -373,12 +407,20 @@ let doc = Dhall.Pretty.prettyCharacterSet characterSet expression renderDoc h doc + + Dhall.Import.warnAboutMissingCaches handle $ case mode of Version -> do - putStrLn (showVersion Meta.version) + putStrLn dhallVersionString Default {..} -> do + if version + then do + putStrLn dhallVersionString + Exit.exitSuccess + else return () + expression <- getExpression file resolvedExpression <- @@ -482,7 +524,9 @@ inferredType <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression) - render System.IO.stdout (Dhall.Core.normalize inferredType) + if quiet + then return () + else render System.IO.stdout inferredType Repl -> do Dhall.Repl.repl characterSet explain @@ -508,18 +552,16 @@ let intent = if cache then Cache else Secure - Dhall.Freeze.freeze inplace scope intent characterSet + Dhall.Freeze.freeze inplace scope intent characterSet censor Hash -> do - Dhall.Hash.hash + Dhall.Hash.hash censor Lint {..} -> do - case inplace of - Just file -> do - text <- Data.Text.IO.readFile file - - (header, expression) <- Dhall.Core.throws (Dhall.Parser.exprAndHeaderFromText file text) + (header, expression) <- getExpressionAndHeader inplace + case inplace of + File file -> do let lintedExpression = Dhall.Lint.lint expression let doc = Pretty.pretty header @@ -528,11 +570,7 @@ System.IO.withFile file System.IO.WriteMode (\h -> do renderDoc h doc ) - Nothing -> do - text <- Data.Text.IO.getContents - - (header, expression) <- Dhall.Core.throws (Dhall.Parser.exprAndHeaderFromText "(stdin)" text) - + StandardInput -> do let lintedExpression = Dhall.Lint.lint expression let doc = Pretty.pretty header @@ -563,8 +601,8 @@ Decode {..} -> do bytes <- do case file of - Just f -> Data.ByteString.Lazy.readFile f - Nothing -> Data.ByteString.Lazy.getContents + File f -> Data.ByteString.Lazy.readFile f + StandardInput -> Data.ByteString.Lazy.getContents term <- do if json diff --git a/src/Dhall/Parser.hs b/src/Dhall/Parser.hs --- a/src/Dhall/Parser.hs +++ b/src/Dhall/Parser.hs @@ -7,6 +7,7 @@ -- * Utilities exprFromText , exprAndHeaderFromText + , censor -- * Parsers , expr, exprA @@ -25,9 +26,11 @@ import Dhall.Core import Dhall.Src (Src(..)) import Prelude hiding (const, pi) +import Text.Megaparsec (ParseErrorBundle(..), PosState(..)) import qualified Data.Char import qualified Data.Text +import qualified Dhall.Core as Core import qualified Text.Megaparsec import Dhall.Parser.Combinators @@ -52,6 +55,24 @@ #endif , input :: Text } + +{-| Replace the source code with spaces when rendering error messages + + This utility is used to implement the @--censor@ flag +-} +censor :: ParseError -> ParseError +censor parseError = + parseError + { unwrap = + (unwrap parseError) + { bundlePosState = + (bundlePosState (unwrap parseError)) + { pstateInput = + Core.censorText + (pstateInput (bundlePosState (unwrap parseError))) + } + } + } instance Show ParseError where show (ParseError {..}) = 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 @@ -20,7 +20,6 @@ import Text.Parser.Combinators (choice, try, ()) import qualified Control.Monad -import qualified Crypto.Hash import qualified Data.ByteArray.Encoding import qualified Data.ByteString import qualified Data.Char as Char @@ -30,6 +29,7 @@ import qualified Data.Sequence import qualified Data.Text import qualified Data.Text.Encoding +import qualified Dhall.Crypto import qualified Text.Megaparsec #if !MIN_VERSION_megaparsec(7, 0, 0) import qualified Text.Megaparsec.Char as Text.Megaparsec @@ -768,7 +768,7 @@ choice [ local, http, env, missing ] -importHash_ :: Parser (Crypto.Hash.Digest Crypto.Hash.SHA256) +importHash_ :: Parser Dhall.Crypto.SHA256Digest importHash_ = do _ <- Text.Parser.Char.text "sha256:" text <- count 64 (satisfy hexdig "hex digit") @@ -777,7 +777,7 @@ strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of Left string -> fail string Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString) - case Crypto.Hash.digestFromByteString strictBytes of + case Dhall.Crypto.sha256DigestFromByteString strictBytes of Nothing -> fail "Invalid sha256 hash" Just h -> pure h 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 @@ -988,18 +988,20 @@ prettyKeyValue :: Pretty a => Doc Ann -> (Text, Expr Src a) -> (Doc Ann, Doc Ann) prettyKeyValue separator (key, val) = - ( prettyAnyLabel key + duplicate (Pretty.group (Pretty.flatAlt long short)) + where + short = prettyAnyLabel key <> " " <> separator <> " " <> prettyExpression val - , prettyAnyLabel key + + long = prettyAnyLabel key <> " " <> separator - <> long - ) - where - long = Pretty.hardline <> " " <> prettyExpression val + <> Pretty.hardline + <> " " + <> prettyExpression val prettyRecord :: Pretty a => Map Text (Expr Src a) -> Doc Ann prettyRecord = diff --git a/src/Dhall/Repl.hs b/src/Dhall/Repl.hs --- a/src/Dhall/Repl.hs +++ b/src/Dhall/Repl.hs @@ -22,7 +22,6 @@ import Data.Maybe ( mapMaybe ) import Data.Semigroup ((<>)) import Data.Text ( Text ) -import Data.Version (showVersion) import Dhall.Context (Context) import Dhall.Import (hashExpressionToCode) import Dhall.Src (Src) @@ -49,7 +48,7 @@ import qualified Dhall.Map as Map import qualified Dhall.Parser as Dhall import qualified Dhall.TypeCheck as Dhall -import qualified Paths_dhall as Meta +import qualified Dhall.Version as Meta import qualified System.Console.ANSI import qualified System.Console.Haskeline.Completion as Haskeline import qualified System.Console.Haskeline.MonadException as Haskeline @@ -66,7 +65,7 @@ io = evalStateT ( Repline.evalRepl - ( pure "⊢ " ) + ( pure $ turnstile ++ " " ) ( dontCrash . eval ) options ( Just optionsPrefix ) @@ -75,6 +74,10 @@ ) (emptyEnv { characterSet, explain }) + turnstile = + case characterSet of + Unicode -> "⊢" + ASCII -> "|-" data Env = Env { envBindings :: Dhall.Context.Context Binding @@ -170,8 +173,8 @@ where definitions = reverse $ Dhall.Context.toList context - convertBinding (variable, Binding expr type_) = - Dhall.Core.Binding Nothing variable Nothing (Just (Nothing, type_)) Nothing expr + convertBinding (variable, Binding expr _) = + Dhall.Core.Binding Nothing variable Nothing Nothing Nothing expr bindings = fmap convertBinding definitions @@ -569,7 +572,7 @@ greeter :: MonadIO m => m () greeter = - let version = showVersion Meta.version + let version = Meta.dhallVersionString message = "Welcome to the Dhall v" <> version <> " REPL! Type :help for more information." in liftIO (putStrLn message) diff --git a/src/Dhall/TypeCheck.hs b/src/Dhall/TypeCheck.hs --- a/src/Dhall/TypeCheck.hs +++ b/src/Dhall/TypeCheck.hs @@ -1,3764 +1,4346 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wall #-} - --- | This module contains the logic for type checking Dhall code - -module Dhall.TypeCheck ( - -- * Type-checking - typeWith - , typeOf - , typeWithA - , checkContext - - -- * Types - , Typer - , X - , absurd - , TypeError(..) - , DetailedTypeError(..) - , TypeMessage(..) - ) where - -import Data.Void (Void, absurd) -import Control.Exception (Exception) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Writer.Strict (execWriterT, tell) -import Data.Functor (void) -import Data.Monoid (Endo(..), First(..)) -import Data.Sequence (Seq, ViewL(..)) -import Data.Semigroup (Max(..), Semigroup(..)) -import Data.Set (Set) -import Data.Text (Text) -import Data.Text.Prettyprint.Doc (Doc, Pretty(..)) -import Data.Typeable (Typeable) -import Dhall.Binary (ToTerm(..)) -import Dhall.Core (Binding(..), Const(..), Chunks(..), Expr(..), Var(..)) -import Dhall.Context (Context) -import Dhall.Pretty (Ann, layoutOpts) - -import qualified Data.Foldable -import qualified Data.Map -import qualified Data.Sequence -import qualified Data.Set -import qualified Data.Text as Text -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty -import qualified Dhall.Context -import qualified Dhall.Core -import qualified Dhall.Diff -import qualified Dhall.Map -import qualified Dhall.Set -import qualified Dhall.Pretty.Internal -import qualified Dhall.Util - -type X = Void - -traverseWithIndex_ :: Applicative f => (Int -> a -> f b) -> Seq a -> f () -traverseWithIndex_ k xs = - Data.Foldable.sequenceA_ (Data.Sequence.mapWithIndex k xs) - -axiom :: Const -> Either (TypeError s a) Const -axiom Type = return Kind -axiom Kind = return Sort -axiom Sort = Left (TypeError Dhall.Context.empty (Const Sort) Untyped) - -rule :: Const -> Const -> Const -rule Type Type = Type -rule Kind Type = Type -rule Sort Type = Type -rule Type Kind = Kind -rule Kind Kind = Kind -rule Sort Kind = Sort -rule Type Sort = Sort -rule Kind Sort = Sort -rule Sort Sort = Sort - -{-| Type-check an expression and return the expression's type if type-checking - succeeds or an error if type-checking fails - - `typeWith` does not necessarily normalize the type since full normalization - is not necessary for just type-checking. If you actually care about the - returned type then you may want to `Dhall.Core.normalize` it afterwards. - - The supplied `Context` records the types of the names in scope. If - these are ill-typed, the return value may be ill-typed. --} -typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X) -typeWith ctx expr = do - checkContext ctx - typeWithA absurd ctx expr - -{-| Function that converts the value inside an `Embed` constructor into a new - expression --} -type Typer a = forall s. a -> Expr s a - -{-| Generalization of `typeWith` that allows type-checking the `Embed` - constructor with custom logic --} -typeWithA - :: (Eq a, Pretty a) - => Typer a - -> Context (Expr s a) - -> Expr s a - -> Either (TypeError s a) (Expr s a) -typeWithA tpa = loop - where - loop _ (Const c ) = do - fmap Const (axiom c) - loop ctx e@(Var (V x n) ) = do - case Dhall.Context.lookup x n ctx of - Nothing -> Left (TypeError ctx e (UnboundVariable x)) - Just a -> do - -- Note: no need to typecheck the value we're - -- returning; that is done at insertion time. - return a - loop ctx (Lam x _A b ) = do - _ <- loop ctx _A - let ctx' = fmap (Dhall.Core.shift 1 (V x 0)) (Dhall.Context.insert x (Dhall.Core.normalize _A) ctx) - _B <- loop ctx' b - let p = Pi x _A _B - _t <- loop ctx p - return p - loop ctx e@(Pi x _A _B ) = do - tA <- fmap Dhall.Core.normalize (loop ctx _A) - kA <- case tA of - Const k -> return k - _ -> Left (TypeError ctx e (InvalidInputType _A)) - - let ctx' = fmap (Dhall.Core.shift 1 (V x 0)) (Dhall.Context.insert x (Dhall.Core.normalize _A) ctx) - tB <- fmap Dhall.Core.normalize (loop ctx' _B) - kB <- case tB of - Const k -> return k - _ -> Left (TypeError ctx' e (InvalidOutputType _B)) - - return (Const (rule kA kB)) - loop ctx e@(App f a ) = do - tf <- fmap Dhall.Core.normalize (loop ctx f) - (x, _A, _B) <- case tf of - Pi x _A _B -> return (x, _A, _B) - _ -> Left (TypeError ctx e (NotAFunction f tf)) - _A' <- loop ctx a - if Dhall.Core.judgmentallyEqual _A _A' - then do - let a' = Dhall.Core.shift 1 (V x 0) a - let _B' = Dhall.Core.subst (V x 0) a' _B - let _B'' = Dhall.Core.shift (-1) (V x 0) _B' - return _B'' - else do - let nf_A = Dhall.Core.normalize _A - let nf_A' = Dhall.Core.normalize _A' - Left (TypeError ctx e (TypeMismatch f nf_A a nf_A')) - loop ctx e@(Let (Binding _ x _ mA _ a0) b0) = do - _A1 <- loop ctx a0 - case mA of - Just (_, _A0) -> do - _ <- loop ctx _A0 - let nf_A0 = Dhall.Core.normalize _A0 - let nf_A1 = Dhall.Core.normalize _A1 - if Dhall.Core.judgmentallyEqual _A0 _A1 - then return () - else Left (TypeError ctx e (AnnotMismatch a0 nf_A0 nf_A1)) - Nothing -> return () - - let a1 = Dhall.Core.normalize a0 - let a2 = Dhall.Core.shift 1 (V x 0) a1 - - let b1 = Dhall.Core.subst (V x 0) a2 b0 - let b2 = Dhall.Core.shift (-1) (V x 0) b1 - loop ctx b2 - - loop ctx e@(Annot x t ) = do - case Dhall.Core.denote t of - Const _ -> return () - _ -> void (loop ctx t) - - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t t' - then do - return t - else do - let nf_t = Dhall.Core.normalize t - let nf_t' = Dhall.Core.normalize t' - Left (TypeError ctx e (AnnotMismatch x nf_t nf_t')) - loop _ Bool = do - return (Const Type) - loop _ (BoolLit _ ) = do - return Bool - loop ctx e@(BoolAnd l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantAnd l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantAnd r tr)) - - return Bool - loop ctx e@(BoolOr l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantOr l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantOr r tr)) - - return Bool - loop ctx e@(BoolEQ l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantEQ l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantEQ r tr)) - - return Bool - loop ctx e@(BoolNE l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Bool -> return () - _ -> Left (TypeError ctx e (CantNE l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Bool -> return () - _ -> Left (TypeError ctx e (CantNE r tr)) - - return Bool - loop ctx e@(BoolIf x y z ) = do - tx <- fmap Dhall.Core.normalize (loop ctx x) - case tx of - Bool -> return () - _ -> Left (TypeError ctx e (InvalidPredicate x tx)) - ty <- fmap Dhall.Core.normalize (loop ctx y ) - tty <- fmap Dhall.Core.normalize (loop ctx ty) - case tty of - Const Type -> return () - _ -> Left (TypeError ctx e (IfBranchMustBeTerm True y ty tty)) - - tz <- fmap Dhall.Core.normalize (loop ctx z) - ttz <- fmap Dhall.Core.normalize (loop ctx tz) - case ttz of - Const Type -> return () - _ -> Left (TypeError ctx e (IfBranchMustBeTerm False z tz ttz)) - - if Dhall.Core.judgmentallyEqual ty tz - then return () - else Left (TypeError ctx e (IfBranchMismatch y z ty tz)) - return ty - loop _ Natural = do - return (Const Type) - loop _ (NaturalLit _ ) = do - return Natural - loop _ NaturalFold = do - return - (Pi "_" Natural - (Pi "natural" (Const Type) - (Pi "succ" (Pi "_" "natural" "natural") - (Pi "zero" "natural" "natural") ) ) ) - loop _ NaturalBuild = do - return - (Pi "_" - (Pi "natural" (Const Type) - (Pi "succ" (Pi "_" "natural" "natural") - (Pi "zero" "natural" "natural") ) ) - Natural ) - loop _ NaturalIsZero = do - return (Pi "_" Natural Bool) - loop _ NaturalEven = do - return (Pi "_" Natural Bool) - loop _ NaturalOdd = do - return (Pi "_" Natural Bool) - loop _ NaturalToInteger = do - return (Pi "_" Natural Integer) - loop _ NaturalShow = do - return (Pi "_" Natural Text) - loop _ NaturalSubtract = do - return (Pi "_" Natural (Pi "_" Natural Natural)) - loop ctx e@(NaturalPlus l r) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Natural -> return () - _ -> Left (TypeError ctx e (CantAdd l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Natural -> return () - _ -> Left (TypeError ctx e (CantAdd r tr)) - return Natural - loop ctx e@(NaturalTimes l r) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Natural -> return () - _ -> Left (TypeError ctx e (CantMultiply l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Natural -> return () - _ -> Left (TypeError ctx e (CantMultiply r tr)) - return Natural - loop _ Integer = do - return (Const Type) - loop _ (IntegerLit _ ) = do - return Integer - loop _ IntegerShow = do - return (Pi "_" Integer Text) - loop _ IntegerToDouble = do - return (Pi "_" Integer Double) - loop _ Double = do - return (Const Type) - loop _ (DoubleLit _ ) = do - return Double - loop _ DoubleShow = do - return (Pi "_" Double Text) - loop _ Text = do - return (Const Type) - loop ctx e@(TextLit (Chunks xys _)) = do - let process (_, y) = do - ty <- fmap Dhall.Core.normalize (loop ctx y) - case ty of - Text -> return () - _ -> Left (TypeError ctx e (CantInterpolate y ty)) - mapM_ process xys - return Text - loop ctx e@(TextAppend l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - case tl of - Text -> return () - _ -> Left (TypeError ctx e (CantTextAppend l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - case tr of - Text -> return () - _ -> Left (TypeError ctx e (CantTextAppend r tr)) - return Text - loop _ TextShow = do - return (Pi "_" Text Text) - loop _ List = do - return (Pi "_" (Const Type) (Const Type)) - loop ctx e@(ListLit Nothing xs) = do - case Data.Sequence.viewl xs of - x0 :< xs' -> do - t <- loop ctx x0 - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const Type -> return () - _ -> Left (TypeError ctx e (InvalidListType (App List t))) - flip traverseWithIndex_ xs' (\i x -> do - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t t' - then return () - else do - let nf_t = Dhall.Core.normalize t - let nf_t' = Dhall.Core.normalize t' - let err = MismatchedListElements i nf_t x nf_t' - Left (TypeError ctx x err) ) - return (App List t) - _ -> Left (TypeError ctx e MissingListType) - loop ctx e@(ListLit (Just t0) xs) = do - _ <- loop ctx t0 - let nf_t0 = Dhall.Core.normalize t0 - t1 <- case nf_t0 of - App List t1 -> do - s <- fmap Dhall.Core.normalize (loop ctx t1) - case s of - Const Type -> return t1 - _ -> Left (TypeError ctx e (InvalidListType nf_t0)) - _ -> Left (TypeError ctx e (InvalidListType nf_t0)) - flip traverseWithIndex_ xs (\i x -> do - t' <- loop ctx x - if Dhall.Core.judgmentallyEqual t1 t' - then return () - else do - let nf_t = Dhall.Core.normalize t1 - let nf_t' = Dhall.Core.normalize t' - Left (TypeError ctx x (InvalidListElement i nf_t x nf_t')) ) - return (App List t1) - loop ctx e@(ListAppend l r ) = do - tl <- fmap Dhall.Core.normalize (loop ctx l) - el <- case tl of - App List el -> return el - _ -> Left (TypeError ctx e (CantListAppend l tl)) - - tr <- fmap Dhall.Core.normalize (loop ctx r) - er <- case tr of - App List er -> return er - _ -> Left (TypeError ctx e (CantListAppend r tr)) - - if Dhall.Core.judgmentallyEqual el er - then return (App List el) - else Left (TypeError ctx e (ListAppendMismatch el er)) - loop _ ListBuild = do - return - (Pi "a" (Const Type) - (Pi "_" - (Pi "list" (Const Type) - (Pi "cons" (Pi "_" "a" (Pi "_" "list" "list")) - (Pi "nil" "list" "list") ) ) - (App List "a") ) ) - loop _ ListFold = do - return - (Pi "a" (Const Type) - (Pi "_" (App List "a") - (Pi "list" (Const Type) - (Pi "cons" (Pi "_" "a" (Pi "_" "list" "list")) - (Pi "nil" "list" "list")) ) ) ) - loop _ ListLength = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") Natural)) - loop _ ListHead = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") (App Optional "a"))) - loop _ ListLast = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") (App Optional "a"))) - loop _ ListIndexed = do - let kts = [("index", Natural), ("value", "a")] - return - (Pi "a" (Const Type) - (Pi "_" (App List "a") - (App List (Record (Dhall.Map.fromList kts))) ) ) - loop _ ListReverse = do - return (Pi "a" (Const Type) (Pi "_" (App List "a") (App List "a"))) - loop _ Optional = do - return (Pi "_" (Const Type) (Const Type)) - loop _ None = do - return (Pi "A" (Const Type) (App Optional "A")) - loop ctx e@(Some a) = do - _A <- loop ctx a - s <- fmap Dhall.Core.normalize (loop ctx _A) - case s of - Const Type -> return () - _ -> Left (TypeError ctx e (InvalidSome a _A s)) - return (App Optional _A) - loop _ OptionalFold = do - return - (Pi "a" (Const Type) - (Pi "_" (App Optional "a") - (Pi "optional" (Const Type) - (Pi "just" (Pi "_" "a" "optional") - (Pi "nothing" "optional" "optional") ) ) ) ) - loop _ OptionalBuild = do - return - (Pi "a" (Const Type) - (Pi "_" f (App Optional "a") ) ) - where f = Pi "optional" (Const Type) - (Pi "just" (Pi "_" "a" "optional") - (Pi "nothing" "optional" "optional") ) - loop ctx e@(Record kts ) = do - let process k t = do - s <- lift (fmap Dhall.Core.normalize (loop ctx t)) - case s of - Const c -> tell (Max c) - _ -> lift (Left (TypeError ctx e (InvalidFieldType k t))) - Max c <- execWriterT (Dhall.Map.unorderedTraverseWithKey_ process kts) - return (Const c) - loop ctx e@(RecordLit kvs ) = do - let process k v = do - t <- loop ctx v - s <- fmap Dhall.Core.normalize (loop ctx t) - case s of - Const _ -> return t - _ -> Left (TypeError ctx e (InvalidFieldType k t)) - - Record <$> Dhall.Map.unorderedTraverseWithKey process kvs - loop ctx e@(Union kts ) = do - let nonEmpty k mt = First (fmap (\t -> (k, t)) mt) - - case getFirst (Dhall.Map.foldMapWithKey nonEmpty kts) of - Nothing -> do - return (Const Type) - - Just (k0, t0) -> do - s0 <- fmap Dhall.Core.normalize (loop ctx t0) - - c0 <- case s0 of - Const c0 -> do - return c0 - - _ -> do - Left (TypeError ctx e (InvalidAlternativeType k0 t0)) - - let process _ Nothing = do - return () - - process k (Just t) = do - s <- fmap Dhall.Core.normalize (loop ctx t) - - c <- case s of - Const c -> do - return c - - _ -> do - Left (TypeError ctx e (InvalidAlternativeType k t)) - - if c0 == c - then return () - else Left (TypeError ctx e (AlternativeAnnotationMismatch k t c k0 t0 c0)) - - Dhall.Map.unorderedTraverseWithKey_ process (Dhall.Map.delete k0 kts) - - return (Const c0) - loop ctx e@(Combine kvsX kvsY) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '∧' kvsX tKvsX)) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - ktsY <- case tKvsY of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '∧' kvsY tKvsY)) - - let combineTypes ktsL ktsR = do - let combine _ (Record ktsL') (Record ktsR') = combineTypes ktsL' ktsR' - combine k _ _ = Left (TypeError ctx e (FieldCollision k)) - - let eKts = Dhall.Map.outerJoin Right Right combine - ktsL ktsR - - fmap Record (Dhall.Map.unorderedTraverseWithKey (\_k v -> v) eKts) - - combineTypes ktsX ktsY - loop ctx e@(CombineTypes l r) = do - tL <- loop ctx l - let l' = Dhall.Core.normalize l - cL <- case tL of - Const cL -> return cL - _ -> Left (TypeError ctx e (CombineTypesRequiresRecordType l l')) - tR <- loop ctx r - let r' = Dhall.Core.normalize r - cR <- case tR of - Const cR -> return cR - _ -> Left (TypeError ctx e (CombineTypesRequiresRecordType r r')) - let c = max cL cR - - ktsL0 <- case l' of - Record kts -> return kts - _ -> Left (TypeError ctx e (CombineTypesRequiresRecordType l l')) - ktsR0 <- case r' of - Record kts -> return kts - _ -> Left (TypeError ctx e (CombineTypesRequiresRecordType r r')) - - let combineTypes ktsL ktsR = do - let mL = Dhall.Map.toMap ktsL - let mR = Dhall.Map.toMap ktsR - - let combine _ (Record ktsL') (Record ktsR') = combineTypes ktsL' ktsR' - combine k _ _ = Left (TypeError ctx e (FieldCollision k)) - - Data.Foldable.sequence_ (Data.Map.intersectionWithKey combine mL mR) - - combineTypes ktsL0 ktsR0 - - return (Const c) - loop ctx e@(Prefer kvsX kvsY) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '⫽' kvsX tKvsX)) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - ktsY <- case tKvsY of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustCombineARecord '⫽' kvsY tKvsY)) - - return (Record (Dhall.Map.union ktsY ktsX)) - loop ctx e@(Merge kvsX kvsY mT₁) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustMergeARecord kvsX tKvsX)) - - tKvsY <- fmap Dhall.Core.normalize (loop ctx kvsY) - - ktsY <- case tKvsY of - Union kts -> return kts - _ -> Left (TypeError ctx e (MustMergeUnion kvsY tKvsY)) - - let ksX = Dhall.Map.keysSet ktsX - let ksY = Dhall.Map.keysSet ktsY - - let diffX = Data.Set.difference ksX ksY - let diffY = Data.Set.difference ksY ksX - - if Data.Set.null diffX - then return () - else Left (TypeError ctx e (UnusedHandler diffX)) - - (mKX, _T₁) <- do - case mT₁ of - Just _T₁ -> do - return (Nothing, _T₁) - - Nothing -> do - case Dhall.Map.uncons ktsX of - Nothing -> do - Left (TypeError ctx e MissingMergeType) - - Just (kX, tX, _) -> do - _T₁ <- do - case Dhall.Map.lookup kX ktsY of - Nothing -> do - Left (TypeError ctx e (UnusedHandler diffX)) - - Just Nothing -> do - return tX - - Just (Just _) -> - case tX of - Pi x _A₀ _T₀ -> do - return (Dhall.Core.shift (-1) (V x 0) _T₀) - _ -> do - Left (TypeError ctx e (HandlerNotAFunction kX tX)) - - return (Just kX, _T₁) - - _ <- loop ctx _T₁ - - let process kY mTY = do - case Dhall.Map.lookup kY ktsX of - Nothing -> do - Left (TypeError ctx e (MissingHandler diffY)) - - Just tX -> do - _T₃ <- do - case mTY of - Nothing -> do - return tX - Just _A₁ -> do - case tX of - Pi x _A₀ _T₂ -> do - if Dhall.Core.judgmentallyEqual _A₀ _A₁ - then return () - else Left (TypeError ctx e (HandlerInputTypeMismatch kY _A₁ _A₀)) - - return (Dhall.Core.shift (-1) (V x 0) _T₂) - _ -> do - Left (TypeError ctx e (HandlerNotAFunction kY tX)) - - if Dhall.Core.judgmentallyEqual _T₁ _T₃ - then return () - else - case mKX of - Nothing -> do - Left (TypeError ctx e (InvalidHandlerOutputType kY _T₁ _T₃)) - Just kX -> do - Left (TypeError ctx e (HandlerOutputTypeMismatch kX _T₁ kY _T₃)) - - Dhall.Map.unorderedTraverseWithKey_ process ktsY - - return _T₁ - - loop ctx e@(ToMap kvsX mT₁) = do - tKvsX <- fmap Dhall.Core.normalize (loop ctx kvsX) - - ktsX <- case tKvsX of - Record kts -> return kts - _ -> Left (TypeError ctx e (MustMapARecord kvsX tKvsX)) - - _TKvsX <- loop ctx tKvsX - - case _TKvsX of - Const Type -> return () - kind -> Left (TypeError ctx e (InvalidToMapRecordKind tKvsX kind)) - - Data.Foldable.traverse_ (loop ctx) mT₁ - - let ktX = appEndo (foldMap (Endo . compareFieldTypes) ktsX) Nothing - mT₂ = fmap Dhall.Core.normalize mT₁ - mapType fieldType = App List (Record $ Dhall.Map.fromList [("mapKey", Text), - ("mapValue", fieldType)]) - compareFieldTypes t Nothing = Just (Right t) - compareFieldTypes t r@(Just (Right t')) - | Dhall.Core.judgmentallyEqual t t' = r - | otherwise = Just (Left $ TypeError ctx e (HeterogenousRecordToMap tKvsX t t')) - compareFieldTypes _ r@(Just Left{}) = r - - case (ktX, mT₂) of - (Nothing, Nothing) -> Left (TypeError ctx e MissingToMapType) - (Just err@Left{}, _) -> err - (Just (Right t), Nothing) -> pure (mapType t) - (Nothing, Just t@(App List (Record mapItemType))) - | Just fieldType <- Dhall.Map.lookup "mapValue" mapItemType, - Dhall.Core.judgmentallyEqual t (mapType fieldType) -> pure t - (Nothing, Just t) -> Left (TypeError ctx e $ InvalidToMapType t) - (Just (Right t₁), Just t₂) - | Dhall.Core.judgmentallyEqual (mapType t₁) t₂ -> pure t₂ - | otherwise -> Left (TypeError ctx e $ MapTypeMismatch (mapType t₁) t₂) - loop ctx e@(Field r x ) = do - t <- fmap Dhall.Core.normalize (loop ctx r) - - let text = Dhall.Pretty.Internal.docToStrictText (Dhall.Pretty.Internal.prettyLabel x) - - case t of - Record kts -> do - _ <- loop ctx t - - case Dhall.Map.lookup x kts of - Just t' -> return t' - Nothing -> Left (TypeError ctx e (MissingField x t)) - _ -> do - case Dhall.Core.normalize r of - Union kts -> - case Dhall.Map.lookup x kts of - Just (Just t') -> return (Pi x t' (Union kts)) - Just Nothing -> return (Union kts) - Nothing -> Left (TypeError ctx e (MissingConstructor x r)) - r' -> Left (TypeError ctx e (CantAccess text r' t)) - loop ctx e@(Project r (Left xs)) = do - t <- fmap Dhall.Core.normalize (loop ctx r) - - case t of - Record kts -> do - _ <- loop ctx t - - let process k = - case Dhall.Map.lookup k kts of - Just t' -> return (k, t') - Nothing -> Left (TypeError ctx e (MissingField k t)) - - let adapt = Record . Dhall.Map.fromList - - fmap adapt (traverse process (Dhall.Set.toList xs)) - _ -> do - let text = - Dhall.Pretty.Internal.docToStrictText (Dhall.Pretty.Internal.prettyLabels xs) - - Left (TypeError ctx e (CantProject text r t)) - loop ctx e@(Project r (Right t)) = do - _R <- fmap Dhall.Core.normalize (loop ctx r) - - case _R of - Record ktsR -> do - _ <- loop ctx t - - case Dhall.Core.normalize t of - Record ktsT -> do - let actualSubset = - Record (Dhall.Map.intersection ktsR ktsT) - - let expectedSubset = t - - let process k tT = do - case Dhall.Map.lookup k ktsR of - Nothing -> do - Left (TypeError ctx e (MissingField k _R)) - Just tR -> do - if Dhall.Core.judgmentallyEqual tT tR - then do - return () - else do - Left (TypeError ctx e (ProjectionTypeMismatch k tT tR expectedSubset actualSubset)) - - Dhall.Map.unorderedTraverseWithKey_ process ktsT - - return (Record ktsT) - _ -> do - Left (TypeError ctx e (CantProjectByExpression t)) - - _ -> do - let text = Dhall.Core.pretty t - - Left (TypeError ctx e (CantProject text r t)) - loop ctx e@(Assert t) = do - _ <- loop ctx t - - let t' = Dhall.Core.normalize t - - case t' of - Equivalent x y -> do - if Dhall.Core.judgmentallyEqual x y - then return t' - else Left (TypeError ctx e (AssertionFailed x y)) - - _ -> Left (TypeError ctx e (NotAnEquivalence t)) - loop ctx e@(Equivalent x y) = do - _A₀ <- loop ctx x - - c₀ <- loop ctx _A₀ - case c₀ of - Const Type -> return () - _ -> Left (TypeError ctx e (IncomparableExpression x)) - - _A₁ <- loop ctx y - - c₁ <- loop ctx _A₁ - case c₁ of - Const Type -> return () - _ -> Left (TypeError ctx e (IncomparableExpression y)) - - if Dhall.Core.judgmentallyEqual _A₀ _A₁ - then return () - else do - let nf_A₀ = Dhall.Core.normalize _A₀ - let nf_A₁ = Dhall.Core.normalize _A₁ - Left (TypeError ctx e (EquivalenceTypeMismatch x nf_A₀ y nf_A₁)) - - return (Const Type) - loop ctx (Note s e' ) = case loop ctx e' of - Left (TypeError ctx' (Note s' e'') m) -> Left (TypeError ctx' (Note s' e'') m) - Left (TypeError ctx' e'' m) -> Left (TypeError ctx' (Note s e'') m) - Right r -> Right r - loop ctx (ImportAlt l _r ) = - fmap Dhall.Core.normalize (loop ctx l) - loop _ (Embed p ) = Right $ tpa p - -{-| `typeOf` is the same as `typeWith` with an empty context, meaning that the - expression must be closed (i.e. no free variables), otherwise type-checking - will fail. --} -typeOf :: Expr s X -> Either (TypeError s X) (Expr s X) -typeOf = typeWith Dhall.Context.empty - --- | The specific type error -data TypeMessage s a - = UnboundVariable Text - | InvalidInputType (Expr s a) - | InvalidOutputType (Expr s a) - | NotAFunction (Expr s a) (Expr s a) - | TypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) - | AnnotMismatch (Expr s a) (Expr s a) (Expr s a) - | Untyped - | MissingListType - | MismatchedListElements Int (Expr s a) (Expr s a) (Expr s a) - | InvalidListElement Int (Expr s a) (Expr s a) (Expr s a) - | InvalidListType (Expr s a) - | InvalidSome (Expr s a) (Expr s a) (Expr s a) - | InvalidPredicate (Expr s a) (Expr s a) - | IfBranchMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) - | IfBranchMustBeTerm Bool (Expr s a) (Expr s a) (Expr s a) - | InvalidFieldType Text (Expr s a) - | InvalidAlternativeType Text (Expr s a) - | AlternativeAnnotationMismatch Text (Expr s a) Const Text (Expr s a) Const - | ListAppendMismatch (Expr s a) (Expr s a) - | MustCombineARecord Char (Expr s a) (Expr s a) - | CombineTypesRequiresRecordType (Expr s a) (Expr s a) - | RecordTypeMismatch Const Const (Expr s a) (Expr s a) - | FieldCollision Text - | MustMergeARecord (Expr s a) (Expr s a) - | MustMergeUnion (Expr s a) (Expr s a) - | MustMapARecord (Expr s a) (Expr s a) - | InvalidToMapRecordKind (Expr s a) (Expr s a) - | HeterogenousRecordToMap (Expr s a) (Expr s a) (Expr s a) - | InvalidToMapType (Expr s a) - | MapTypeMismatch (Expr s a) (Expr s a) - | MissingToMapType - | UnusedHandler (Set Text) - | MissingHandler (Set Text) - | HandlerInputTypeMismatch Text (Expr s a) (Expr s a) - | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a) - | InvalidHandlerOutputType Text (Expr s a) (Expr s a) - | MissingMergeType - | HandlerNotAFunction Text (Expr s a) - | CantAccess Text (Expr s a) (Expr s a) - | CantProject Text (Expr s a) (Expr s a) - | CantProjectByExpression (Expr s a) - | MissingField Text (Expr s a) - | MissingConstructor Text (Expr s a) - | ProjectionTypeMismatch Text (Expr s a) (Expr s a) (Expr s a) (Expr s a) - | AssertionFailed (Expr s a) (Expr s a) - | NotAnEquivalence (Expr s a) - | IncomparableExpression (Expr s a) - | EquivalenceTypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) - | CantAnd (Expr s a) (Expr s a) - | CantOr (Expr s a) (Expr s a) - | CantEQ (Expr s a) (Expr s a) - | CantNE (Expr s a) (Expr s a) - | CantInterpolate (Expr s a) (Expr s a) - | CantTextAppend (Expr s a) (Expr s a) - | CantListAppend (Expr s a) (Expr s a) - | CantAdd (Expr s a) (Expr s a) - | CantMultiply (Expr s a) (Expr s a) - deriving (Show) - -shortTypeMessage :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> Doc Ann -shortTypeMessage msg = - "\ESC[1;31mError\ESC[0m: " <> short <> "\n" - where - ErrorMessages {..} = prettyTypeMessage msg - -longTypeMessage :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> Doc Ann -longTypeMessage msg = - "\ESC[1;31mError\ESC[0m: " <> short <> "\n" - <> "\n" - <> long - where - ErrorMessages {..} = prettyTypeMessage msg - -data ErrorMessages = ErrorMessages - { short :: Doc Ann - -- ^ Default succinct 1-line explanation of what went wrong - , long :: Doc Ann - -- ^ Longer and more detailed explanation of the error - } - -_NOT :: Doc ann -_NOT = "\ESC[1mnot\ESC[0m" - -insert :: Pretty a => a -> Doc Ann -insert = Dhall.Util.insert - -prettyTypeMessage - :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> ErrorMessages -prettyTypeMessage (UnboundVariable x) = ErrorMessages {..} - -- We do not need to print variable name here. For the discussion see: - -- https://github.com/dhall-lang/dhall-haskell/pull/116 - where - short = "Unbound variable: " <> Pretty.pretty x - - long = - "Explanation: Expressions can only reference previously introduced (i.e. “bound”)\n\ - \variables that are still “in scope” \n\ - \ \n\ - \For example, the following valid expressions introduce a “bound” variable named \n\ - \❰x❱: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ λ(x : Bool) → x │ Anonymous functions introduce “bound” variables \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is the bound variable \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ let x = 1 in x │ ❰let❱ expressions introduce “bound” variables \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is the bound variable \n\ - \ \n\ - \ \n\ - \However, the following expressions are not valid because they all reference a \n\ - \variable that has not been introduced yet (i.e. an “unbound” variable): \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ λ(x : Bool) → y │ The variable ❰y❱ hasn't been introduced yet \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is the unbound variable \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ (let x = True in x) && x │ ❰x❱ is undefined outside the parentheses \n\ - \ └──────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is the unbound variable \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ let x = x in x │ The definition for ❰x❱ cannot reference itself \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ This is the unbound variable \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You misspell a variable name, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────────────┐ \n\ - \ │ λ(empty : Bool) → if emty then \"Empty\" else \"Full\" │ \n\ - \ └────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Typo \n\ - \ \n\ - \ \n\ - \● You misspell a reserved identifier, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ foral (a : Type) → a → a │ \n\ - \ └──────────────────────────┘ \n\ - \ ⇧ \n\ - \ Typo \n\ - \ \n\ - \ \n\ - \● You tried to define a recursive value, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ let x = x + 1 in x │ \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ Recursive definitions are not allowed \n\ - \ \n\ - \ \n\ - \● You accidentally forgot a ❰λ❱ or ❰∀❱/❰forall❱ \n\ - \ \n\ - \ \n\ - \ Unbound variable \n\ - \ ⇩ \n\ - \ ┌─────────────────┐ \n\ - \ │ (x : Bool) → x │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ A ❰λ❱ here would transform this into a valid anonymous function \n\ - \ \n\ - \ \n\ - \ Unbound variable \n\ - \ ⇩ \n\ - \ ┌────────────────────┐ \n\ - \ │ (x : Bool) → Bool │ \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ A ❰∀❱ or ❰forall❱ here would transform this into a valid function type \n\ - \ \n\ - \ \n\ - \● You forgot to prefix a file path with ❰./❱: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ path/to/file.dhall │ \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ This should be ❰./path/to/file.dhall❱ \n" - -prettyTypeMessage (InvalidInputType expr) = ErrorMessages {..} - where - short = "Invalid function input" - - long = - "Explanation: A function can accept an input “term” that has a given “type”, like\n\ - \this: \n\ - \ \n\ - \ \n\ - \ This is the input term that the function accepts \n\ - \ ⇩ \n\ - \ ┌───────────────────────┐ \n\ - \ │ ∀(x : Natural) → Bool │ This is the type of a function that accepts an \n\ - \ └───────────────────────┘ input term named ❰x❱ that has type ❰Natural❱ \n\ - \ ⇧ \n\ - \ This is the type of the input term \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ Bool → Natural │ This is the type of a function that accepts an anonymous\n\ - \ └────────────────┘ input term that has type ❰Bool❱ \n\ - \ ⇧ \n\ - \ This is the type of the input term \n\ - \ \n\ - \ \n\ - \... or a function can accept an input “type” that has a given “kind”, like this:\n\ - \ \n\ - \ \n\ - \ This is the input type that the function accepts \n\ - \ ⇩ \n\ - \ ┌────────────────────┐ \n\ - \ │ ∀(a : Type) → Type │ This is the type of a function that accepts an input\n\ - \ └────────────────────┘ type named ❰a❱ that has kind ❰Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the input type \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────┐ \n\ - \ │ (Type → Type) → Type │ This is the type of a function that accepts an \n\ - \ └──────────────────────┘ anonymous input type that has kind ❰Type → Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the input type \n\ - \ \n\ - \ \n\ - \Other function inputs are " <> _NOT <> " valid, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────┐ \n\ - \ │ ∀(x : 1) → x │ ❰1❱ is a “term” and not a “type” nor a “kind” so ❰x❱ \n\ - \ └──────────────┘ cannot have “type” ❰1❱ or “kind” ❰1❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ True → x │ ❰True❱ is a “term” and not a “type” nor a “kind” so the \n\ - \ └──────────┘ anonymous input cannot have “type” ❰True❱ or “kind” ❰True❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \You annotated a function input with the following expression: \n\ - \ \n\ - \" <> txt <> "\n\ - \ \n\ - \... which is neither a type nor a kind \n" - where - txt = insert expr - -prettyTypeMessage (InvalidOutputType expr) = ErrorMessages {..} - where - short = "Invalid function output" - - long = - "Explanation: A function can return an output “term” that has a given “type”, \n\ - \like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ ∀(x : Text) → Bool │ This is the type of a function that returns an \n\ - \ └────────────────────┘ output term that has type ❰Bool❱ \n\ - \ ⇧ \n\ - \ This is the type of the output term \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ Bool → Natural │ This is the type of a function that returns an output \n\ - \ └────────────────┘ term that has type ❰Natural❱ \n\ - \ ⇧ \n\ - \ This is the type of the output term \n\ - \ \n\ - \ \n\ - \... or a function can return an output “type” that has a given “kind”, like \n\ - \this: \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ ∀(a : Type) → Type │ This is the type of a function that returns an \n\ - \ └────────────────────┘ output type that has kind ❰Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the output type \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────┐ \n\ - \ │ (Type → Type) → Type │ This is the type of a function that returns an \n\ - \ └──────────────────────┘ output type that has kind ❰Type❱ \n\ - \ ⇧ \n\ - \ This is the kind of the output type \n\ - \ \n\ - \ \n\ - \Other outputs are " <> _NOT <> " valid, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ ∀(x : Bool) → x │ ❰x❱ is a “term” and not a “type” nor a “kind” so the \n\ - \ └─────────────────┘ output cannot have “type” ❰x❱ or “kind” ❰x❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ Text → True │ ❰True❱ is a “term” and not a “type” nor a “kind” so the \n\ - \ └─────────────┘ output cannot have “type” ❰True❱ or “kind” ❰True❱ \n\ - \ ⇧ \n\ - \ This is not a type or kind \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You use ❰∀❱ instead of ❰λ❱ by mistake, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ ∀(x: Bool) → x │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ Using ❰λ❱ here instead of ❰∀❱ would transform this into a valid function \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You specified that your function outputs a: \n\ - \ \n\ - \" <> txt <> "\n\ - \ \n\ - \... which is neither a type nor a kind: \n" - where - txt = insert expr - -prettyTypeMessage (NotAFunction expr0 expr1) = ErrorMessages {..} - where - short = "Not a function" - - long = - "Explanation: Expressions separated by whitespace denote function application, \n\ - \like this: \n\ - \ \n\ - \ \n\ - \ ┌─────┐ \n\ - \ │ f x │ This denotes the function ❰f❱ applied to an argument named ❰x❱ \n\ - \ └─────┘ \n\ - \ \n\ - \ \n\ - \A function is a term that has type ❰a → b❱ for some ❰a❱ or ❰b❱. For example, \n\ - \the following expressions are all functions because they have a function type: \n\ - \ \n\ - \ \n\ - \ The function's input type is ❰Bool❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(x : Bool) → x : Bool → Bool │ User-defined anonymous function \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output type is ❰Bool❱ \n\ - \ \n\ - \ \n\ - \ The function's input type is ❰Natural❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ Natural/even : Natural → Bool │ Built-in function \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output type is ❰Bool❱ \n\ - \ \n\ - \ \n\ - \ The function's input kind is ❰Type❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(a : Type) → a : Type → Type │ Type-level functions are still functions \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output kind is ❰Type❱ \n\ - \ \n\ - \ \n\ - \ The function's input kind is ❰Type❱ \n\ - \ ⇩ \n\ - \ ┌────────────────────┐ \n\ - \ │ List : Type → Type │ Built-in type-level function \n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ The function's output kind is ❰Type❱ \n\ - \ \n\ - \ \n\ - \ Function's input has kind ❰Type❱ \n\ - \ ⇩ \n\ - \ ┌─────────────────────────────────────────────────┐ \n\ - \ │ List/head : ∀(a : Type) → (List a → Optional a) │ A function can return \n\ - \ └─────────────────────────────────────────────────┘ another function \n\ - \ ⇧ \n\ - \ Function's output has type ❰List a → Optional a❱\n\ - \ \n\ - \ \n\ - \ The function's input type is ❰List Text❱ \n\ - \ ⇩ \n\ - \ ┌────────────────────────────────────────────┐ \n\ - \ │ List/head Text : List Text → Optional Text │ A function applied to an \n\ - \ └────────────────────────────────────────────┘ argument can be a function \n\ - \ ⇧ \n\ - \ The function's output type is ❰Optional Text❱\n\ - \ \n\ - \ \n\ - \An expression is not a function if the expression's type is not of the form \n\ - \❰a → b❱. For example, these are " <> _NOT <> " functions: \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ 1 : Natural │ ❰1❱ is not a function because ❰Natural❱ is not the type of \n\ - \ └─────────────┘ a function \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ Natural/even 2 : Bool │ ❰Natural/even 2❱ is not a function because \n\ - \ └───────────────────────┘ ❰Bool❱ is not the type of a function \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ List Text : Type │ ❰List Text❱ is not a function because ❰Type❱ is not \n\ - \ └──────────────────┘ the type of a function \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You tried to add two ❰Natural❱s without a space around the ❰+❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────┐ \n\ - \ │ 2+2 │ \n\ - \ └─────┘ \n\ - \ \n\ - \ \n\ - \ The above code is parsed as: \n\ - \ \n\ - \ \n\ - \ ┌────────┐ \n\ - \ │ 2 (+2) │ \n\ - \ └────────┘ \n\ - \ ⇧ \n\ - \ The compiler thinks that this ❰2❱ is a function whose argument is ❰+2❱ \n\ - \ \n\ - \ \n\ - \ This is because the ❰+❱ symbol has two meanings: you use ❰+❱ to add two \n\ - \ numbers, but you also can prefix ❰Natural❱ literals with a ❰+❱ to turn them \n\ - \ into ❰Integer❱ literals (like ❰+2❱) \n\ - \ \n\ - \ To fix the code, you need to put spaces around the ❰+❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ 2 + 2 │ \n\ - \ └───────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to use the following expression as a function: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... but this expression's type is: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which is not a function type \n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (TypeMismatch expr0 expr1 expr2 expr3) = ErrorMessages {..} - where - short = "Wrong type of function argument\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr3) - - long = - "Explanation: Every function declares what type or kind of argument to accept \n\ - \ \n\ - \For example: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(x : Bool) → x : Bool → Bool │ This anonymous function only accepts \n\ - \ └───────────────────────────────┘ arguments that have type ❰Bool❱ \n\ - \ ⇧ \n\ - \ The function's input type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ Natural/even : Natural → Bool │ This built-in function only accepts \n\ - \ └───────────────────────────────┘ arguments that have type ❰Natural❱ \n\ - \ ⇧ \n\ - \ The function's input type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ λ(a : Type) → a : Type → Type │ This anonymous function only accepts \n\ - \ └───────────────────────────────┘ arguments that have kind ❰Type❱ \n\ - \ ⇧ \n\ - \ The function's input kind \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ List : Type → Type │ This built-in function only accepts arguments that \n\ - \ └────────────────────┘ have kind ❰Type❱ \n\ - \ ⇧ \n\ - \ The function's input kind \n\ - \ \n\ - \ \n\ - \For example, the following expressions are valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ (λ(x : Bool) → x) True │ ❰True❱ has type ❰Bool❱, which matches the type \n\ - \ └────────────────────────┘ of argument that the anonymous function accepts \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ Natural/even 2 │ ❰2❱ has type ❰Natural❱, which matches the type of \n\ - \ └────────────────┘ argument that the ❰Natural/even❱ function accepts, \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ (λ(a : Type) → a) Bool │ ❰Bool❱ has kind ❰Type❱, which matches the kind \n\ - \ └────────────────────────┘ of argument that the anonymous function accepts \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ List Text │ ❰Text❱ has kind ❰Type❱, which matches the kind of argument \n\ - \ └───────────┘ that that the ❰List❱ function accepts \n\ - \ \n\ - \ \n\ - \However, you can " <> _NOT <> " apply a function to the wrong type or kind of argument\n\ - \ \n\ - \For example, the following expressions are not valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ (λ(x : Bool) → x) \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the anonymous function\n\ - \ └───────────────────────┘ expects an argument that has type ❰Bool❱ \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ Natural/even \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the ❰Natural/even❱ function\n\ - \ └──────────────────┘ expects an argument that has type ❰Natural❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ (λ(a : Type) → a) True │ ❰True❱ has type ❰Bool❱, but the anonymous \n\ - \ └────────────────────────┘ function expects an argument of kind ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌────────┐ \n\ - \ │ List 1 │ ❰1❱ has type ❰Natural❱, but the ❰List❱ function expects an \n\ - \ └────────┘ argument that has kind ❰Type❱ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You omit a function argument by mistake: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ List/head [1, 2, 3] │ \n\ - \ └───────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰List/head❱ is missing the first argument, \n\ - \ which should be: ❰Natural❱ \n\ - \ \n\ - \ \n\ - \● You supply an ❰Integer❱ literal to a function that expects a ❰Natural❱ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ Natural/even +2 │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This should be ❰2❱ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to invoke the following function: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which expects an argument of type or kind: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... on the following argument: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... which has a different type or kind: \n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - txt3 = insert expr3 - -prettyTypeMessage (AnnotMismatch expr0 expr1 expr2) = ErrorMessages {..} - where - short = "Expression doesn't match annotation\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) - long = - "Explanation: You can annotate an expression with its type or kind using the \n\ - \❰:❱ symbol, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ x : t │ ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱\n\ - \ └───────┘ \n\ - \ \n\ - \The type checker verifies that the expression's type or kind matches the \n\ - \provided annotation \n\ - \ \n\ - \For example, all of the following are valid annotations that the type checker \n\ - \accepts: \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ 1 : Natural │ ❰1❱ is an expression that has type ❰Natural❱, so the type \n\ - \ └─────────────┘ checker accepts the annotation \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ Natural/even 2 : Bool │ ❰Natural/even 2❱ has type ❰Bool❱, so the type \n\ - \ └───────────────────────┘ checker accepts the annotation \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ List : Type → Type │ ❰List❱ is an expression that has kind ❰Type → Type❱,\n\ - \ └────────────────────┘ so the type checker accepts the annotation \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ List Text : Type │ ❰List Text❱ is an expression that has kind ❰Type❱, so \n\ - \ └──────────────────┘ the type checker accepts the annotation \n\ - \ \n\ - \ \n\ - \However, the following annotations are " <> _NOT <> " valid and the type checker will\n\ - \reject them: \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ 1 : Text │ The type checker rejects this because ❰1❱ does not have type \n\ - \ └──────────┘ ❰Text❱ \n\ - \ \n\ - \ \n\ - \ ┌─────────────┐ \n\ - \ │ List : Type │ ❰List❱ does not have kind ❰Type❱ \n\ - \ └─────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● The Haskell Dhall interpreter implicitly inserts a top-level annotation \n\ - \ matching the expected type \n\ - \ \n\ - \ For example, if you run the following Haskell code: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ >>> input auto \"1\" :: IO Text │ \n\ - \ └───────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ... then the interpreter will actually type check the following annotated \n\ - \ expression: \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ 1 : Text │ \n\ - \ └──────────┘ \n\ - \ \n\ - \ \n\ - \ ... and then type-checking will fail \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You or the interpreter annotated this expression: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... with this type or kind: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but the inferred type or kind of the expression is actually: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - -prettyTypeMessage Untyped = ErrorMessages {..} - where - short = "❰Sort❱ has no type, kind, or sort" - - long = - "Explanation: There are five levels of expressions that form a hierarchy: \n\ - \ \n\ - \● terms \n\ - \● types \n\ - \● kinds \n\ - \● sorts \n\ - \● orders \n\ - \ \n\ - \The following example illustrates this hierarchy: \n\ - \ \n\ - \ ┌───────────────────────────────────┐ \n\ - \ │ \"ABC\" : Text : Type : Kind : Sort │ \n\ - \ └───────────────────────────────────┘ \n\ - \ ⇧ ⇧ ⇧ ⇧ ⇧ \n\ - \ term type kind sort order \n\ - \ \n\ - \There is nothing above ❰Sort❱ in this hierarchy, so if you try to type check any\n\ - \expression containing ❰Sort❱ anywhere in the expression then type checking fails\n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You supplied a sort where a kind was expected \n\ - \ \n\ - \ For example, the following expression will fail to type check: \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ f : Type -> Kind │ \n\ - \ └──────────────────┘ \n\ - \ ⇧ \n\ - \ ❰Kind❱ is a sort, not a kind \n" - -prettyTypeMessage (InvalidPredicate expr0 expr1) = ErrorMessages {..} - where - short = "Invalid predicate for ❰if❱" - - long = - "Explanation: Every ❰if❱ expression begins with a predicate which must have type \n\ - \❰Bool❱ \n\ - \ \n\ - \For example, these are valid ❰if❱ expressions: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ if True then \"Yes\" else \"No\" │ \n\ - \ └──────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Predicate \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ λ(x : Bool) → if x then False else True │ \n\ - \ └─────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Predicate \n\ - \ \n\ - \ \n\ - \... but these are " <> _NOT <> " valid ❰if❱ expressions: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ if 0 then \"Yes\" else \"No\" │ ❰0❱ does not have type ❰Bool❱ \n\ - \ └───────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ if \"\" then False else True │ ❰\"\"❱ does not have type ❰Bool❱ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might be used to other programming languages that accept predicates other \n\ - \ than ❰Bool❱ \n\ - \ \n\ - \ For example, some languages permit ❰0❱ or ❰\"\"❱ as valid predicates and treat\n\ - \ them as equivalent to ❰False❱. However, the Dhall language does not permit \n\ - \ this \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \Your ❰if❱ expression begins with the following predicate: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... that has type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but the predicate must instead have type ❰Bool❱ \n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (IfBranchMustBeTerm b expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "❰if❱ branch is not a term" - - long = - "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ - \is an expression: \n\ - \ \n\ - \ \n\ - \ Expression for ❰then❱ branch \n\ - \ ⇩ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ if True then \"Hello, world!\" │ \n\ - \ │ else \"Goodbye, world!\" │ \n\ - \ └────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Expression for ❰else❱ branch \n\ - \ \n\ - \ \n\ - \These expressions must be a “term”, where a “term” is defined as an expression \n\ - \that has a type thas has kind ❰Type❱ \n\ - \ \n\ - \For example, the following expressions are all valid “terms”: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ 1 : Natural : Type │ ❰1❱ is a term with a type (❰Natural❱) of kind ❰Type❱\n\ - \ └────────────────────┘ \n\ - \ ⇧ \n\ - \ term \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────┐ \n\ - \ │ Natural/odd : Natural → Bool : Type │ ❰Natural/odd❱ is a term with a type\n\ - \ └─────────────────────────────────────┘ (❰Natural → Bool❱) of kind ❰Type❱ \n\ - \ ⇧ \n\ - \ term \n\ - \ \n\ - \ \n\ - \However, the following expressions are " <> _NOT <> " valid terms: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ Text : Type : Kind │ ❰Text❱ has kind (❰Type❱) of sort ❰Kind❱ and is \n\ - \ └────────────────────┘ therefore not a term \n\ - \ ⇧ \n\ - \ type \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ List : Type → Type : Kind │ ❰List❱ has kind (❰Type → Type❱) of sort \n\ - \ └───────────────────────────┘ ❰Kind❱ and is therefore not a term \n\ - \ ⇧ \n\ - \ type-level function \n\ - \ \n\ - \ \n\ - \This means that you cannot define an ❰if❱ expression that returns a type. For \n\ - \example, the following ❰if❱ expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────┐ \n\ - \ │ if True then Text else Bool │ Invalid ❰if❱ expression \n\ - \ └─────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ type type \n\ - \ \n\ - \ \n\ - \Your ❰" <> txt0 <> "❱ branch of your ❰if❱ expression is: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which has kind: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... of sort: \n\ - \ \n\ - \" <> txt3 <> "\n\ - \ \n\ - \... and is not a term. Therefore your ❰if❱ expression is not valid \n" - where - txt0 = if b then "then" else "else" - txt1 = insert expr0 - txt2 = insert expr1 - txt3 = insert expr2 - -prettyTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) = - ErrorMessages {..} - where - short = "❰if❱ branches must have matching types\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr3) - - long = - "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ - \is an expression: \n\ - \ \n\ - \ \n\ - \ Expression for ❰then❱ branch \n\ - \ ⇩ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ if True then \"Hello, world!\" │ \n\ - \ │ else \"Goodbye, world!\" │ \n\ - \ └────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Expression for ❰else❱ branch \n\ - \ \n\ - \ \n\ - \These two expressions must have the same type. For example, the following ❰if❱ \n\ - \expressions are all valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ λ(b : Bool) → if b then 0 else 1 │ Both branches have type ❰Natural❱ \n\ - \ └──────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ λ(b : Bool) → │ \n\ - \ │ if b then Natural/even │ Both branches have type ❰Natural → Bool❱ \n\ - \ │ else Natural/odd │ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ This branch has type ❰Natural❱ \n\ - \ ⇩ \n\ - \ ┌────────────────────────┐ \n\ - \ │ if True then 0 │ \n\ - \ │ else \"ABC\" │ \n\ - \ └────────────────────────┘ \n\ - \ ⇧ \n\ - \ This branch has type ❰Text❱ \n\ - \ \n\ - \ \n\ - \The ❰then❱ and ❰else❱ branches must have matching types, even if the predicate \n\ - \is always ❰True❱ or ❰False❱ \n\ - \ \n\ - \Your ❰if❱ expression has the following ❰then❱ branch: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which has type: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... and the following ❰else❱ branch: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which has a different type: \n\ - \ \n\ - \" <> txt3 <> "\n\ - \ \n\ - \Fix your ❰then❱ and ❰else❱ branches to have matching types \n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - txt3 = insert expr3 - -prettyTypeMessage (InvalidListType expr0) = ErrorMessages {..} - where - short = "Invalid type for ❰List❱" - - long = - "Explanation: ❰List❱s can optionally document their type with a type annotation, \n\ - \like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ [1, 2, 3] : List Natural │ A ❰List❱ of three ❰Natural❱ numbers \n\ - \ └──────────────────────────┘ \n\ - \ ⇧ \n\ - \ The type of the ❰List❱'s elements, which are ❰Natural❱ \n\ - \ numbers \n\ - \ \n\ - \ \n\ - \ ┌───────────────────┐ \n\ - \ │ [] : List Natural │ An empty ❰List❱ \n\ - \ └───────────────────┘ \n\ - \ ⇧ \n\ - \ You must specify the type when the ❰List❱ is empty \n\ - \ \n\ - \ \n\ - \The type must be of the form ❰List ...❱ and not something else. For example, \n\ - \the following type annotation is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────┐ \n\ - \ │ ... : Bool │ \n\ - \ └────────────┘ \n\ - \ ⇧ \n\ - \ This type does not have the form ❰List ...❱ \n\ - \ \n\ - \ \n\ - \The element type must be a type and not something else. For example, the \n\ - \following element types are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────┐ \n\ - \ │ ... : List 1 │ \n\ - \ └──────────────┘ \n\ - \ ⇧ \n\ - \ This is a ❰Natural❱ number and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ ... : List Type │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This is a ❰Kind❱ and not a ❰Type❱ \n\ - \ \n\ - \ \n\ - \You declared that the ❰List❱ should have type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not a valid list type \n" - where - txt0 = insert expr0 - -prettyTypeMessage MissingListType = do - ErrorMessages {..} - where - short = "An empty list requires a type annotation" - - long = - "Explanation: Lists do not require a type annotation if they have at least one \n\ - \element: \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ [1, 2, 3] │ The compiler can infer that this list has type ❰List Natural❱\n\ - \ └───────────┘ \n\ - \ \n\ - \ \n\ - \However, empty lists still require a type annotation: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────┐ \n\ - \ │ [] : List Natural │ This type annotation is mandatory \n\ - \ └───────────────────┘ \n\ - \ \n\ - \ \n\ - \You cannot supply an empty list without a type annotation \n" - -prettyTypeMessage (MismatchedListElements i expr0 _expr1 expr2) = - ErrorMessages {..} - where - short = "List elements should all have the same type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2) - - long = - "Explanation: Every element in a list must have the same type \n\ - \ \n\ - \For example, this is a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ [1, 2, 3] │ Every element in this ❰List❱ is a ❰Natural❱ number \n\ - \ └───────────┘ \n\ - \ \n\ - \ \n\ - \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────┐ \n\ - \ │ [1, \"ABC\", 3] │ The first and second element have different types \n\ - \ └───────────────┘ \n\ - \ \n\ - \ \n\ - \Your first ❰List❱ element has this type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... but the element at index #" <> txt1 <> " has this type instead: \n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = insert expr0 - txt1 = pretty i - txt3 = insert expr2 - -prettyTypeMessage (InvalidListElement i expr0 _expr1 expr2) = - ErrorMessages {..} - where - short = "List element has the wrong type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2) - - long = - "Explanation: Every element in the list must have a type matching the type \n\ - \annotation at the end of the list \n\ - \ \n\ - \For example, this is a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────┐ \n\ - \ │ [1, 2, 3] : List Natural │ Every element in this ❰List❱ is an ❰Natural❱ \n\ - \ └──────────────────────────┘ \n\ - \ \n\ - \ \n\ - \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ [1, \"ABC\", 3] : List Natural │ The second element is not an ❰Natural❱ \n\ - \ └──────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Your ❰List❱ elements should have this type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... but the element at index #" <> txt1 <> " has this type instead: \n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = insert expr0 - txt1 = pretty i - txt3 = insert expr2 - -prettyTypeMessage (InvalidSome expr0 expr1 expr2) = ErrorMessages {..} - where - short = "❰Some❱ argument has the wrong type" - - long = - "Explanation: The ❰Some❱ constructor expects an argument that is a term, where \n\ - \the type of the type of a term must be ❰Type❱ \n\ - \ \n\ - \For example, this is a valid use of ❰Some❱: \n\ - \ \n\ - \ \n\ - \ ┌────────┐ \n\ - \ │ Some 1 │ ❰1❱ is a valid term because ❰1 : Natural : Type❱ \n\ - \ └────────┘ \n\ - \ \n\ - \ \n\ - \... but this is " <> _NOT <> " a valid ❰Optional❱ value: \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ Some Text │ ❰Text❱ is not a valid term because ❰Text : Type : Kind ❱ \n\ - \ └───────────┘ \n\ - \ \n\ - \ \n\ - \The ❰Some❱ argument you provided: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... has this type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but the type of that type is: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... which is not ❰Type❱ \n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - -prettyTypeMessage (InvalidFieldType k expr0) = ErrorMessages {..} - where - short = "Invalid field type" - - long = - "Explanation: Every record type annotates each field with a ❰Type❱, a ❰Kind❱, or \n\ - \a ❰Sort❱ like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────┐ \n\ - \ │ { foo : Natural, bar : Integer, baz : Text } │ Every field is annotated \n\ - \ └──────────────────────────────────────────────┘ with a ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ { foo : Type, bar : Type } │ Every field is annotated \n\ - \ └────────────────────────────┘ with a ❰Kind❱ \n\ - \ \n\ - \ \n\ - \However, the types of fields may " <> _NOT <> " be term-level values: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ { foo : Natural, bar : 1 } │ Invalid record type \n\ - \ └────────────────────────────┘ \n\ - \ ⇧ \n\ - \ ❰1❱ is a ❰Natural❱ number and not a ❰Type❱, \n\ - \ ❰Kind❱, or ❰Sort❱ \n\ - \ \n\ - \ \n\ - \You provided a record type with a field named: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... annotated with the following expression: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which is neither a ❰Type❱, a ❰Kind❱, nor a ❰Sort❱ \n" - where - txt0 = insert k - txt1 = insert expr0 - -prettyTypeMessage (InvalidAlternativeType k expr0) = ErrorMessages {..} - where - short = "Invalid alternative type" - - long = - "Explanation: Every union type specifies the type of each alternative, like this:\n\ - \ \n\ - \ \n\ - \ The type of the first alternative is ❰Bool❱ \n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ < Left : Bool, Right : Natural > │ A union type with two alternatives \n\ - \ └──────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The type of the second alternative is ❰Natural❱ \n\ - \ \n\ - \ \n\ - \However, these alternatives can only be annotated with ❰Type❱s, ❰Kind❱s, or \n\ - \❰Sort❱s. For example, the following union types are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ < Left : Bool, Right : 1 > │ Invalid union type \n\ - \ └────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a ❰Natural❱ and not a ❰Type❱, ❰Kind❱, or \n\ - \ ❰Sort❱ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally typed ❰:❱ instead of ❰=❱ for a union literal with one \n\ - \ alternative: \n\ - \ \n\ - \ ┌─────────────────┐ \n\ - \ │ < Example : 1 > │ \n\ - \ └─────────────────┘ \n\ - \ ⇧ \n\ - \ This could be ❰=❱ instead \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided a union type with an alternative named: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... annotated with the following expression which is not a ❰Type❱, ❰Kind❱, or \n\ - \❰Sort❱: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert k - txt1 = insert expr0 - -prettyTypeMessage (AlternativeAnnotationMismatch k0 expr0 c0 k1 expr1 c1) = ErrorMessages {..} - where - short = "Alternative annotation mismatch" - - long = - "Explanation: Every union type annotates each alternative with a ❰Type❱ or a \n\ - \❰Kind❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────┐ \n\ - \ │ < Left : Natural | Right : Bool > │ Every alternative is annotated with a\n\ - \ └───────────────────────────────────┘ ❰Type❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────┐ \n\ - \ │ < Foo : Type → Type | Bar : Type > │ Every alternative is annotated with \n\ - \ └────────────────────────────────────┘ a ❰Kind❱ \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ < Baz : Kind > │ Every alternative is annotated with a ❰Sort❱ \n\ - \ └────────────────┘ \n\ - \ \n\ - \ \n\ - \However, you cannot have a union type that mixes ❰Type❱s, ❰Kind❱s, or ❰Sort❱s \n\ - \for the annotations: \n\ - \ \n\ - \ \n\ - \ This is a ❰Type❱ annotation \n\ - \ ⇩ \n\ - \ ┌───────────────────────────────┐ \n\ - \ │ { foo : Natural, bar : Type } │ Invalid union type \n\ - \ └───────────────────────────────┘ \n\ - \ ⇧ \n\ - \ ... but this is a ❰Kind❱ annotation \n\ - \ \n\ - \ \n\ - \You provided a union type with an alternative named: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... annotated with the following expression: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which is a " <> level c0 <> " whereas another alternative named: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... annotated with the following expression: \n\ - \ \n\ - \" <> txt3 <> "\n\ - \ \n\ - \... is a " <> level c1 <> ", which does not match \n" - where - txt0 = insert k0 - txt1 = insert expr0 - txt2 = insert k1 - txt3 = insert expr1 - - level Type = "❰Type❱" - level Kind = "❰Kind❱" - level Sort = "❰Sort❱" - -prettyTypeMessage (ListAppendMismatch expr0 expr1) = ErrorMessages {..} - where - short = "You can only append ❰List❱s with matching element types\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) - - long = - "Explanation: You can append two ❰List❱s using the ❰#❱ operator, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ [1, 2, 3] # [4, 5] │ \n\ - \ └────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot append two ❰List❱s if they have different element types. \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ These elements have type ❰Natural❱ \n\ - \ ⇩ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ [1, 2, 3] # [True, False] │ Invalid: the element types don't match \n\ - \ └───────────────────────────┘ \n\ - \ ⇧ \n\ - \ These elements have type ❰Bool❱ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to append a ❰List❱ thas has elements of type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... with another ❰List❱ that has elements of type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... and those two types do not match \n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (MustCombineARecord c expr0 expr1) = ErrorMessages {..} - where - short = "You can only combine records" - - long = - "Explanation: You can combine records using the ❰" <> op <> "❱ operator, like this:\n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz = True } │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool }) → r " <> op <> " { bar = \"ABC\" } │ \n\ - \ └─────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot combine values that are not records. \n\ - \ \n\ - \For example, the following expressions are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " 1 │ \n\ - \ └──────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz : Bool } │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: This is a record type and not a record\n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } " <> op <> " < baz : Bool > │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: This is a union type and not a record \n\ - \ \n\ - \ \n\ - \You tried to combine the following value: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not a record, but is actually a: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - op = pretty c - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (CombineTypesRequiresRecordType expr0 expr1) = - ErrorMessages {..} - where - short = "❰⩓❱ requires arguments that are record types" - - long = - "Explanation: You can only use the ❰⩓❱ operator on arguments that are record type\n\ - \literals, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────┐ \n\ - \ │ { age : Natural } ⩓ { name : Text } │ \n\ - \ └─────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot use the ❰⩓❱ operator on any other type of arguments. For \n\ - \example, you cannot use variable arguments: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────┐ \n\ - \ │ λ(t : Type) → t ⩓ { name : Text } │ Invalid: ❰t❱ might not be a record \n\ - \ └───────────────────────────────────┘ type \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to supply the following argument: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which normalized to: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which is not a record type literal \n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (RecordTypeMismatch const0 const1 expr0 expr1) = - ErrorMessages {..} - where - short = "Record type mismatch" - - long = - "Explanation: You can only use the ❰⩓❱ operator on record types if they are both \n\ - \ ❰Type❱s or ❰Kind❱s: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────┐ \n\ - \ │ { age : Natural } ⩓ { name : Text } │ Valid: Both arguments are ❰Type❱s \n\ - \ └─────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────┐ \n\ - \ │ { Input : Type } ⩓ { Output : Type } │ Valid: Both arguments are ❰Kind❱s \n\ - \ └──────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot combine a ❰Type❱ and a ❰Kind❱: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────┐ \n\ - \ │ { Input : Type } ⩓ { name : Text } │ Invalid: The arguments do not match \n\ - \ └────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to combine the following record type: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... with this record types: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but the former record type is a: \n\ - \ \n\ - \" <> txt2 <> "\n\ - \ \n\ - \... but the latter record type is a: \n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert const0 - txt3 = insert const1 - -prettyTypeMessage (FieldCollision k) = ErrorMessages {..} - where - short = "Field collision" - - long = - "Explanation: You can combine records or record types if they don't share any \n\ - \fields in common, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } ∧ { baz = True } │ \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo : Text } ⩓ { bar : Bool } │ \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────┐ \n\ - \ │ λ(r : { baz : Bool}) → { foo = 1 } ∧ r │ \n\ - \ └────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot merge two records that share the same field unless the field \n\ - \is a record on both sides. \n\ - \ \n\ - \For example, the following expressions are " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = True } │ Invalid: Colliding ❰foo❱ \n\ - \ └───────────────────────────────────────────┘ fields \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo : Bool } ∧ { foo : Text } │ Invalid: Colliding ❰foo❱ fields \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the following expressions are valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────────┐ \n\ - \ │ { foo = { bar = True } } ∧ { foo = { baz = 1 } } │ Valid: Both ❰foo❱ \n\ - \ └──────────────────────────────────────────────────┘ fields are records \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────┐ \n\ - \ │ { foo : { bar : Bool } } ⩓ { foo : { baz : Text } } │ Valid: Both ❰foo❱ \n\ - \ └─────────────────────────────────────────────────────┘ fields are records \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You tried to use ❰∧❱ to update a field's value, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = 2 } │ \n\ - \ └────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid attempt to update ❰foo❱'s value to ❰2❱\n\ - \ \n\ - \ Field updates are intentionally not allowed as the Dhall language discourages \n\ - \ patch-oriented programming \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You combined two records that share the following field: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not allowed \n" - where - txt0 = insert k - -prettyTypeMessage (MustMergeARecord expr0 expr1) = ErrorMessages {..} - where - short = "❰merge❱ expects a record of handlers" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the first argument to ❰merge❱ must be a record and not some other type. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────────────┐ \n\ - \ │ let handler = λ(x : Bool) → x │ \n\ - \ │ in merge handler (< Foo : Bool >.Foo True) : Bool │ \n\ - \ └────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: ❰handler❱ isn't a record \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally provide an empty record type instead of an empty record when \n\ - \ you ❰merge❱ an empty union: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ λ(x : <>) → λ(a : Type) → merge {} x : a │ \n\ - \ └──────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This should be ❰{=}❱ instead \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided the following handler: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not a record, but is actually a value of type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (MustMergeUnion expr0 expr1) = ErrorMessages {..} - where - short = "❰merge❱ expects a union" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the second argument to ❰merge❱ must be a union and not some other type. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ let handlers = { Foo = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers True : True │ \n\ - \ └──────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: ❰True❱ isn't a union \n\ - \ \n\ - \ \n\ - \You tried to ❰merge❱ this expression: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not a union, but is actually a value of type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (UnusedHandler ks) = ErrorMessages {..} - where - short = "Unused handler" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you must provide exactly one handler per alternative in the union. You \n\ - \cannot supply extra handlers \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural >.Left 2 │ The ❰Right❱ alternative is \n\ - \ │ let handlers = │ missing \n\ - \ │ { Left = Natural/even │ \n\ - \ │ , Right = λ(x : Bool) → x │ Invalid: ❰Right❱ handler isn't\n\ - \ │ } │ used \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └──────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \You provided the following handlers: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which had no matching alternatives in the union you tried to ❰merge❱ \n" - where - txt0 = insert (Text.intercalate ", " (Data.Set.toList ks)) - -prettyTypeMessage (MissingHandler ks) = ErrorMessages {..} - where - short = "Missing handler" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you must provide exactly one handler per alternative in the union. You \n\ - \cannot omit any handlers \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ Invalid: Missing ❰Right❱ handler \n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────────────────────────────────┐ \n\ - \ │ let handlers = { Left = Natural/even } │ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └──────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Note that you need to provide handlers for other alternatives even if those \n\ - \alternatives are never used \n\ - \ \n\ - \You need to supply the following handlers: \n\ - \ \n\ - \" <> txt0 <> "\n" - where - txt0 = insert (Text.intercalate ", " (Data.Set.toList ks)) - -prettyTypeMessage MissingMergeType = - ErrorMessages {..} - where - short = "An empty ❰merge❱ requires a type annotation" - - long = - "Explanation: A ❰merge❱ does not require a type annotation if the union has at \n\ - \least one alternative, like this \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, you must provide a type annotation when merging an empty union: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────┐ \n\ - \ │ λ(a : <>) → merge {=} a : Bool │ \n\ - \ └────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This can be any type \n\ - \ \n\ - \ \n\ - \You can provide any type at all as the annotation, since merging an empty \n\ - \union can produce any type of output \n" - -prettyTypeMessage (HandlerInputTypeMismatch expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "Wrong handler input type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the input type of each handler function matches the type of the \n\ - \corresponding alternative: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ union : < Left : Natural | Right : Bool > │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These must match These must match \n\ - \ ⇩ ⇩ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ Invalid: Doesn't match the type of the ❰Right❱ alternative \n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────────────────────────────────────┐ \n\ - \ │ let handlers = { Left = Natural/even | Right = λ(x : Text) → x } │ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └──────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Your handler for the following alternative: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... needs to accept an input value of type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but actually accepts an input value of a different type: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - -prettyTypeMessage (InvalidHandlerOutputType expr0 expr1 expr2) = - ErrorMessages {..} - where - short = "Wrong handler output type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the output type of each handler function matches the declared \n\ - \type of the result: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These output types ... \n\ - \ \n\ - \ ... must match the declared type of the ❰merge❱ \n\ - \ ⇩ \n\ - \ ┌─────────────────────────────┐ \n\ - \ │ merge handlers union : Bool │ \n\ - \ └─────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Text │ \n\ - \ └──────────────────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Doesn't match output of either handler\n\ - \ \n\ - \ \n\ - \Your handler for the following alternative: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... needs to return an output value of type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but actually returns an output value of a different type: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - txt2 = insert expr2 - -prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) = - ErrorMessages {..} - where - short = "Handlers should have the same output type\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as the output type of each handler function is the same: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────────┐ \n\ - \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ - \ └───────────────────────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ These output types both match \n\ - \ \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────┐ \n\ - \ │ let Union = < Left : Natural | Right : Bool > │ \n\ - \ │ let handlers = │ \n\ - \ │ { Left = λ(x : Natural) → x │ This outputs ❰Natural❱ \n\ - \ │ , Right = λ(x : Bool ) → x │ This outputs ❰Bool❱ \n\ - \ │ } │ \n\ - \ │ in merge handlers (Union.Left 2) │ \n\ - \ └─────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: The handlers in this record don't have matching outputs\n\ - \ \n\ - \ \n\ - \The handler for the ❰" <> txt0 <> "❱ alternative has this output type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but the handler for the ❰" <> txt2 <> "❱ alternative has this output type instead:\n\ - \ \n\ - \" <> txt3 <> "\n" - where - txt0 = pretty key0 - txt1 = insert expr0 - txt2 = pretty key1 - txt3 = insert expr1 - -prettyTypeMessage (HandlerNotAFunction k expr0) = ErrorMessages {..} - where - short = "Handler is not a function" - - long = - "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ - \handler per alternative, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────┐ \n\ - \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ - \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ - \ │ in merge handlers union : Bool │ \n\ - \ └─────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... as long as each handler is a function -- FIXME \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────────────┐ \n\ - \ │ merge { Foo = True } (< Foo : Natural >.Foo 1) : Bool │ \n\ - \ └───────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a function \n\ - \ \n\ - \ \n\ - \Your handler for this alternative: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... has the following type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... which is not the type of a function \n" - where - txt0 = insert k - txt1 = insert expr0 - -prettyTypeMessage (MustMapARecord _expr0 _expr1) = ErrorMessages {..} - where - short = "❰toMap❱ expects a record value" - - long = - "Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let record = { one = 1, two = 2 } │ \n\ - \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the argument to ❰toMap❱ must be a record and not some other type. \n" - -prettyTypeMessage (InvalidToMapRecordKind type_ kind) = ErrorMessages {..} - where - short = "❰toMap❱ expects a record of kind ❰Type❱" - - long = - "Explanation: You can apply ❰toMap❱ to any homogenous record of kind ❰Type❱, like\n\ - \ this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let record = { one = 1, two = 2 } │ \n\ - \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but records of kind ❰Kind❱ or ❰Sort❱ cannot be turned into ❰List❱s. \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You applied ❰toMap❱ to a record of the following type: \n\ - \ \n\ - \" <> insert type_ <> "\n\ - \ \n\ - \... which has kind \n\ - \ \n\ - \" <> insert kind <> "\n" - -prettyTypeMessage (HeterogenousRecordToMap _expr0 _expr1 _expr2) = ErrorMessages {..} - where - short = "❰toMap❱ expects a homogenous record" - - long = - "Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let record = { one = 1, two = 2 } │ \n\ - \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but every field of the record must have the same type. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ toMap { Foo = True, Bar = 0 } │ \n\ - \ └─────────────────────────────────────────┘ \n\ - \ ⇧ ⇧ \n\ - \ Bool Natural \n" - -prettyTypeMessage (MapTypeMismatch expr0 expr1) = ErrorMessages {..} - where - short = "❰toMap❱ result type doesn't match annotation" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) - - long = - "Explanation: a ❰toMap❱ application has been annotated with a type that doesn't \n\ - \match its inferred type. \n" - -prettyTypeMessage (InvalidToMapType expr) = - ErrorMessages {..} - where - short = "An empty ❰toMap❱ was annotated with an invalid type" - <> "\n" - <> insert expr - - long = - "Explanation: A ❰toMap❱ applied to an empty record must have a type annotation: \n\ - \that matches a list of key-value pairs, like this \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ toMap {=} : List { mapKey : Text, mapValue : Natural} │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \The type you have provided doesn't match the expected form. \n\ - \ \n" - -prettyTypeMessage MissingToMapType = - ErrorMessages {..} - where - short = "An empty ❰toMap❱ requires a type annotation" - - long = - "Explanation: A ❰toMap❱ does not require a type annotation if the record has at \n\ - \least one field, like this \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ let record = { one = 1, two = 2 } │ \n\ - \ │ in toMap record │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, you must provide a type annotation with an empty record: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ - \ │ toMap {=} : List { mapKey : Text, mapValue : Natural} │ \n\ - \ └─────────────────────────────────────────────────────────────────────┘ \n\ - \ \n" - -prettyTypeMessage (CantAccess lazyText0 expr0 expr1) = ErrorMessages {..} - where - short = "Not a record or a union" - - long = - "Explanation: You can only access fields on records or unions, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ - \ └───────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ < foo : Bool | bar : Text >.foo │ ... and so is this \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────┐ \n\ - \ │ λ(r : < foo : Bool | bar : Text >) → r.foo │ ... and so is this \n\ - \ └────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot access fields on non-record expressions \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ 1.foo │ \n\ - \ └───────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to access the field: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... on the following expression which is not a record nor a union type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but is actually an expression of type: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert lazyText0 - txt1 = insert expr0 - txt2 = insert expr1 - -prettyTypeMessage (CantProject lazyText0 expr0 expr1) = ErrorMessages {..} - where - short = "Not a record" - - long = - "Explanation: You can only project fields on records, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\", baz = 1 }.{ foo, bar } │ This is valid ... \n\ - \ └─────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool, bar : Text , baz : Natural }) → r.{ foo, bar } │ ... and so is this \n\ - \ └────────────────────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot project fields on non-record expressions \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ 1.{ foo, bar } │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally try to project fields of a union instead of a record, like \n\ - \ this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────────────┐ \n\ - \ │ < foo : a | bar : b >.{ foo, bar } │ \n\ - \ └────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ This is a union, not a record \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to access the fields: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... on the following expression which is not a record: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but is actually an expression of type: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert lazyText0 - txt1 = insert expr0 - txt2 = insert expr1 - -prettyTypeMessage (CantProjectByExpression expr) = ErrorMessages {..} - where - short = "Selector is not a record type" - - long = - "Explanation: You can project by an expression if that expression is a record \n\ - \type: \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo = True }.({ foo : Bool }) │ This is valid ... \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool }) → r.{ foo : Bool } │ ... and so is this \n\ - \ └──────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot project by any other type of expression: \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ { foo = True }.(True) │ \n\ - \ └───────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: Not a record type \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You accidentally try to project by a record value instead of a record type, \n\ - \ like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ let T = { foo : Bool } │ \n\ - \ │ │ \n\ - \ │ let x = { foo = True , bar = 1} │ \n\ - \ │ │ \n\ - \ │ let y = { foo = False, bar = 2} │ \n\ - \ │ │ \n\ - \ │ in x.(y) │ \n\ - \ └─────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ The user might have meant ❰T❱ here \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to project out the following type: \n\ - \ \n\ - \" <> txt <> "\n\ - \ \n\ - \... which is not a record type \n" - where - txt = insert expr - -prettyTypeMessage (MissingField k expr0) = ErrorMessages {..} - where - short = "Missing record field" - - long = - "Explanation: You can only access fields on records, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ - \ └─────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────┐ \n\ - \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ - \ └───────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you can only access fields if they are present \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────┐ \n\ - \ │ { foo = True, bar = \"ABC\" }.qux │ \n\ - \ └─────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: the record has no ❰qux❱ field \n\ - \ \n\ - \ \n\ - \You tried to access a field named: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... but the field is missing because the record only defines the following \n\ - \fields: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert k - txt1 = insert expr0 - -prettyTypeMessage (MissingConstructor k expr0) = ErrorMessages {..} - where - short = "Missing constructor" - - long = - "Explanation: You can access constructors from unions, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────┐ \n\ - \ │ < Foo | Bar >.Foo │ This is valid ... \n\ - \ └───────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you can only access constructors if they match an union alternative of \n\ - \the same name. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────┐ \n\ - \ │ < Foo | Bar >.Baz │ \n\ - \ └───────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: the union has no ❰Baz❱ alternative \n\ - \ \n\ - \ \n\ - \You tried to access a constructor named: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... but the constructor is missing because the union only defines the following \n\ - \alternatives: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert k - txt1 = insert expr0 - -prettyTypeMessage (ProjectionTypeMismatch k expr0 expr1 expr2 expr3) = ErrorMessages {..} - where - short = "Projection type mismatch\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr2 expr3) - - long = - "Explanation: You can project a subset of fields from a record by specifying the \n\ - \desired type of the final record, like this: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = True }.({ foo : Natural }) │ This is valid \n\ - \ └─────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but the expected type for each desired field must match the actual type of \n\ - \the corresponding field in the original record. \n\ - \ \n\ - \For example, the following expression is " <> _NOT <> " valid: \n\ - \ \n\ - \ Invalid: The ❰foo❱ field contains ❰1❱, which has type ❰Natural❱...\n\ - \ ⇩ \n\ - \ ┌──────────────────────────────────────────┐ \n\ - \ │ { foo = 1, bar = True }.({ foo : Text }) │ \n\ - \ └──────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ ... but we requested that the ❰foo❱ field\n\ - \ must contain a value of type ❰Text❱ \n\ - \ \n\ - \ \n\ - \You tried to project out a field named: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... that should have type: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but that field instead had a value of type: \n\ - \ \n\ - \" <> txt2 <> "\n" - where - txt0 = insert k - txt1 = insert expr0 - txt2 = insert expr1 - -prettyTypeMessage (AssertionFailed expr0 expr1) = ErrorMessages {..} - where - short = "Assertion failed\n" - <> "\n" - <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) - - long = - "Explanation: You can assert at type-checking time that two terms are equal if \n\ - \they have the same normal form, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ assert : 2 + 2 ≡ 4 │ This is valid \n\ - \ └────────────────────┘ \n\ - \ \n\ - \ \n\ - \... and an assertion still succeeds if the normal forms only differ by renaming \n\ - \bound variables, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────────────┐ \n\ - \ │ assert : λ(n : Natural) → n + 0 ≡ λ(m : Natural) → m │ This is also valid\n\ - \ └──────────────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \However, an assertion fails if the normal forms differ in any other way. For \n\ - \example, the following assertion is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ assert : 0 ≡ 1 │ Invalid: ❰0❱ does not equal ❰1❱ \n\ - \ └────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have tried to ❰assert❱ a precondition on a function's input, like \n\ - \ this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────────────────────────────────────┐ \n\ - \ │ λ(n : Natural) → let _ = assert : Natural/isZero n ≡ False in n │ \n\ - \ └──────────────────────────────────────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: This assertion will always fail\n\ - \ \n\ - \ \n\ - \ This will not work. Such an assertion is checking all possible inputs to the \n\ - \ function, before you've even used the function at all. \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You tried to assert that this expression: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... is the same as this other expression: \n\ - \ \n\ - \" <> txt1 <> "\n\ - \ \n\ - \... but they differ\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (NotAnEquivalence expr) = ErrorMessages {..} - where - short = "Not an equivalence\n" - - long = - "Explanation: The type annotation for an ❰assert❱ must evaluate to an equivalence\n\ - \of the form ❰x ≡ y❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ assert : 2 + 2 ≡ 4 │ This is valid \n\ - \ └────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but any other type is not a valid annotation. For example, the following \n\ - \assertion is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌───────────────┐ \n\ - \ │ assert : True │ Invalid: ❰True❱ is not an equivalence \n\ - \ └───────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You tried to supply an expression of type ❰Bool❱ to the assertion, rather than\n\ - \ two separate expressions to compare, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────┐ \n\ - \ │ assert : Natural/isZero 0 │ Invalid: A boolean expression is not the \n\ - \ └───────────────────────────┘ same thing as a type-level equivalence \n\ - \ \n\ - \ \n\ - \ You have to explicitly compare two expressions, even if that just means \n\ - \ comparing the expression to ❰True❱, like this: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ assert : Natural/isZero 0 ≡ True │ Valid: You can assert that two boolean\n\ - \ └──────────────────────────────────┘ expressions are equivalent \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided the following type annotation for an ❰assert❱: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not an equivalence\n" - where - txt0 = insert expr - -prettyTypeMessage (IncomparableExpression expr) = ErrorMessages {..} - where - short = "Incomparable expression\n" - - long = - "Explanation: You can use an ❰assert❱ to compare two terms for equivalence, like \n\ - \this: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────┐ \n\ - \ │ assert : 2 + 2 ≡ 4 │ This is valid because ❰2 + 2❱ and ❰4❱ are both terms\n\ - \ └────────────────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot compare expressions, that are not terms, such as types. For \n\ - \example, the following equivalence is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ assert : Natural ≡ Natural │ Invalid: ❰Natural❱ is a type, not a term \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \You tried to compare the following expression: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not a term\n" - where - txt0 = insert expr - -prettyTypeMessage (EquivalenceTypeMismatch l _L r _R) = ErrorMessages {..} - where - short = "The two sides of the equivalence have different types" - - long = - "Explanation: You can use ❰≡❱ to compare two terms of the same type for \n\ - \equivalence, like this: \n\ - \ \n\ - \ \n\ - \ ┌───────────┐ \n\ - \ │ 2 + 2 ≡ 4 │ This is valid because ❰2 + 2❱ and ❰4❱ have the same type \n\ - \ └───────────┘ \n\ - \ \n\ - \ \n\ - \... but you cannot compare expressions, that have different types. For example,\n\ - \the following assertion is " <> _NOT <> " valid: \n\ - \ \n\ - \ \n\ - \ ┌──────────┐ \n\ - \ │ 1 ≡ True │ Invalid: ❰1❱ has type ❰Natural❱, ❰True❱ has type ❰Bool❱ \n\ - \ └──────────┘ \n\ - \ \n\ - \ \n\ - \You tried to compare the following expressions: \n\ - \ \n\ - \" <> insert l <> "\n\ - \ \n\ - \... which has type\n\ - \ \n\ - \" <> insert _L <> "\n\ - \ \n\ - \... and\n\ - \ \n\ - \" <> insert r <> "\n\ - \ \n\ - \... which has type\n\ - \ \n\ - \" <> insert _R <> "\n" - -prettyTypeMessage (CantAnd expr0 expr1) = - buildBooleanOperator "&&" expr0 expr1 - -prettyTypeMessage (CantOr expr0 expr1) = - buildBooleanOperator "||" expr0 expr1 - -prettyTypeMessage (CantEQ expr0 expr1) = - buildBooleanOperator "==" expr0 expr1 - -prettyTypeMessage (CantNE expr0 expr1) = - buildBooleanOperator "!=" expr0 expr1 - -prettyTypeMessage (CantInterpolate expr0 expr1) = ErrorMessages {..} - where - short = "You can only interpolate ❰Text❱" - - long = - "Explanation: Text interpolation only works on expressions of type ❰Text❱ \n\ - \ \n\ - \For example, these are all valid uses of string interpolation: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────┐ \n\ - \ │ \"ABC${\"DEF\"}GHI\" │ \n\ - \ └──────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────────┐ \n\ - \ │ λ(x : Text) → \"ABC${x}GHI\" │ \n\ - \ └────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────────────────────────────┐ \n\ - \ │ λ(age : Natural) → \"Age: ${Natural/show age}\" │ \n\ - \ └───────────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have thought that string interpolation automatically converts the \n\ - \ interpolated value to a ❰Text❱ representation of that value: \n\ - \ \n\ - \ \n\ - \ ┌──────────────────────────────────┐ \n\ - \ │ λ(age : Natural) → \"Age: ${age}\" │ \n\ - \ └──────────────────────────────────┘ \n\ - \ ⇧ \n\ - \ Invalid: ❰age❱ has type ❰Natural❱ \n\ - \ \n\ - \ \n\ - \● You might have forgotten to escape a string interpolation that you wanted \n\ - \ Dhall to ignore and pass through: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ \"echo ${HOME}\" │ \n\ - \ └────────────────┘ \n\ - \ ⇧ \n\ - \ ❰HOME❱ is not in scope and this might have meant to use ❰\\${HOME}❱\n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You interpolated this expression: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which does not have type ❰Text❱ but instead has type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (CantTextAppend expr0 expr1) = ErrorMessages {..} - where - short = "❰++❱ only works on ❰Text❱" - - long = - "Explanation: The ❰++❱ operator expects two arguments that have type ❰Text❱ \n\ - \ \n\ - \For example, this is a valid use of ❰++❱: \n\ - \ \n\ - \ \n\ - \ ┌────────────────┐ \n\ - \ │ \"ABC\" ++ \"DEF\" │ \n\ - \ └────────────────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have thought that ❰++❱ was the operator to combine two lists: \n\ - \ \n\ - \ \n\ - \ ┌────────────────────────┐ \n\ - \ │ [1, 2, 3] ++ [4, 5, 6] │ Not valid \n\ - \ └────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ ... but the list concatenation operator is actually ❰#❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ [1, 2, 3] # [4, 5, 6] │ Valid \n\ - \ └───────────────────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which does not have type ❰Text❱ but instead has type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (CantListAppend expr0 expr1) = ErrorMessages {..} - where - short = "❰#❱ only works on ❰List❱s" - - long = - "Explanation: The ❰#❱ operator expects two arguments that are both ❰List❱s \n\ - \ \n\ - \For example, this is a valid use of ❰#❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────────────┐ \n\ - \ │ [1, 2, 3] # [4, 5, 6] │ \n\ - \ └───────────────────────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which is not a ❰List❱ but instead has type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - -prettyTypeMessage (CantAdd expr0 expr1) = - buildNaturalOperator "+" expr0 expr1 - -prettyTypeMessage (CantMultiply expr0 expr1) = - buildNaturalOperator "*" expr0 expr1 - -buildBooleanOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages -buildBooleanOperator operator expr0 expr1 = ErrorMessages {..} - where - short = "❰" <> txt2 <> "❱ only works on ❰Bool❱s" - - long = - "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Bool❱\n\ - \ \n\ - \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ - \ \n\ - \ \n\ - \ ┌───────────────┐ \n\ - \ │ True " <> txt2 <> " False │ \n\ - \ └───────────────┘ \n\ - \ \n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which does not have type ❰Bool❱ but instead has type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - - txt2 = pretty operator - -buildNaturalOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages -buildNaturalOperator operator expr0 expr1 = ErrorMessages {..} - where - short = "❰" <> txt2 <> "❱ only works on ❰Natural❱s" - - long = - "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Natural❱\n\ - \ \n\ - \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ 3 " <> txt2 <> " 5 │ \n\ - \ └───────┘ \n\ - \ \n\ - \ \n\ - \Some common reasons why you might get this error: \n\ - \ \n\ - \● You might have tried to use an ❰Integer❱, which is " <> _NOT <> " allowed: \n\ - \ \n\ - \ \n\ - \ ┌─────────────────────────────────────────┐ \n\ - \ │ λ(x : Integer) → λ(y : Integer) → x " <> txt2 <> " y │ Not valid \n\ - \ └─────────────────────────────────────────┘ \n\ - \ \n\ - \ \n\ - \ You can only use ❰Natural❱ numbers \n\ - \ \n\ - \ \n\ - \● You might have mistakenly used an ❰Integer❱ literal, which is " <> _NOT <> " allowed:\n\ - \ \n\ - \ \n\ - \ ┌─────────┐ \n\ - \ │ +2 " <> txt2 <> " +2 │ Not valid \n\ - \ └─────────┘ \n\ - \ \n\ - \ \n\ - \ You need to remove the leading ❰+❱ to transform them into ❰Natural❱ literals, \n\ - \ like this: \n\ - \ \n\ - \ \n\ - \ ┌───────┐ \n\ - \ │ 2 " <> txt2 <> " 2 │ Valid \n\ - \ └───────┘ \n\ - \ \n\ - \ \n\ - \────────────────────────────────────────────────────────────────────────────────\n\ - \ \n\ - \You provided this argument: \n\ - \ \n\ - \" <> txt0 <> "\n\ - \ \n\ - \... which does not have type ❰Natural❱ but instead has type: \n\ - \ \n\ - \" <> txt1 <> "\n" - where - txt0 = insert expr0 - txt1 = insert expr1 - - txt2 = pretty operator - --- | A structured type error that includes context -data TypeError s a = TypeError - { context :: Context (Expr s a) - , current :: Expr s a - , typeMessage :: TypeMessage s a - } - -instance (Eq a, Pretty s, Pretty a, ToTerm a) => Show (TypeError s a) where - show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty - -instance (Eq a, Pretty s, Pretty a, ToTerm a, Typeable s, Typeable a) => Exception (TypeError s a) - -instance (Eq a, Pretty s, Pretty a, ToTerm a) => Pretty (TypeError s a) where - pretty (TypeError ctx expr msg) - = Pretty.unAnnotate - ( "\n" - <> ( if null (Dhall.Context.toList ctx) - then "" - else prettyContext ctx <> "\n\n" - ) - <> shortTypeMessage msg <> "\n" - <> source - ) - where - prettyKV (key, val) = - pretty key <> " : " <> Dhall.Util.snipDoc (pretty val) - - prettyContext = - Pretty.vsep - . map prettyKV - . reverse - . Dhall.Context.toList - - source = case expr of - Note s _ -> pretty s - _ -> mempty +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC -Wall #-} + +-- | This module contains the logic for type checking Dhall code + +module Dhall.TypeCheck ( + -- * Type-checking + typeWith + , typeOf + , typeWithA + , checkContext + , messageExpressions + + -- * Types + , Typer + , X + , absurd + , TypeError(..) + , DetailedTypeError(..) + , Censored(..) + , TypeMessage(..) + ) where + +import Control.Exception (Exception) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Writer.Strict (execWriterT, tell) +import Data.Monoid (Endo(..), First(..)) +import Data.Semigroup (Max(..), Semigroup(..)) +import Data.Sequence (Seq, ViewL(..)) +import Data.Set (Set) +import Data.Text (Text) +import Data.Text.Prettyprint.Doc (Doc, Pretty(..)) +import Data.Typeable (Typeable) +import Data.Void (Void, absurd) +import Dhall.Binary (ToTerm(..)) +import Dhall.Context (Context) +import Dhall.Core (Binding(..), Const(..), Chunks(..), Expr(..), Var(..)) +import Dhall.Eval + (Environment(..), Names(..), Val(..), (~>)) +import Dhall.Pretty (Ann, layoutOpts) +import Dhall.Src (Src) +import Lens.Family (over) + +import qualified Data.Foldable +import qualified Data.Map +import qualified Data.Sequence +import qualified Data.Set +import qualified Data.Text as Text +import qualified Data.Text.Prettyprint.Doc as Pretty +import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty +import qualified Dhall.Context +import qualified Dhall.Core +import qualified Dhall.Diff +import qualified Dhall.Eval as Eval +import qualified Dhall.Map +import qualified Dhall.Set +import qualified Dhall.Pretty.Internal +import qualified Dhall.Util + +type X = Void + +traverseWithIndex_ :: Applicative f => (Int -> a -> f b) -> Seq a -> f () +traverseWithIndex_ k xs = + Data.Foldable.sequenceA_ (Data.Sequence.mapWithIndex k xs) + +axiom :: Const -> Either (TypeError s a) Const +axiom Type = return Kind +axiom Kind = return Sort +axiom Sort = Left (TypeError Dhall.Context.empty (Const Sort) Untyped) + +rule :: Const -> Const -> Const +rule Type Type = Type +rule Kind Type = Type +rule Sort Type = Type +rule Type Kind = Kind +rule Kind Kind = Kind +rule Sort Kind = Sort +rule Type Sort = Sort +rule Kind Sort = Sort +rule Sort Sort = Sort + +{-| Type-check an expression and return the expression's type if type-checking + succeeds or an error if type-checking fails + + `typeWith` does not necessarily normalize the type since full normalization + is not necessary for just type-checking. If you actually care about the + returned type then you may want to `Dhall.Core.normalize` it afterwards. + + The supplied `Context` records the types of the names in scope. If + these are ill-typed, the return value may be ill-typed. +-} +typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X) +typeWith ctx expr = do + checkContext ctx + typeWithA absurd ctx expr + +{-| Function that converts the value inside an `Embed` constructor into a new + expression +-} +type Typer a = forall s. a -> Expr s a + +{-| Generalization of `typeWith` that allows type-checking the `Embed` + constructor with custom logic +-} +typeWithA + :: (Eq a, Pretty a) + => Typer a + -> Context (Expr s a) + -> Expr s a + -> Either (TypeError s a) (Expr s a) +typeWithA tpa context expression = + fmap (Dhall.Core.renote . Eval.quote EmptyNames) (infer tpa ctx expression) + where + ctx = contextToCtx context + +contextToCtx :: Eq a => Context (Expr s a) -> Ctx a +contextToCtx context = loop (Dhall.Context.toList context) + where + loop [] = + Ctx Empty TypesEmpty + + loop ((x, t):rest) = + Ctx (Skip vs x) (TypesBind ts x (Eval.eval vs (Dhall.Core.denote t))) + where + Ctx vs ts = loop rest + +ctxToContext :: Eq a => Ctx a -> Context (Expr s a) +ctxToContext (Ctx {..}) = loop types + where + loop (TypesBind ts x t) = Dhall.Context.insert x t' (loop ts) + where + ns = typesToNames ts + + t' = Dhall.Core.renote (Eval.quote ns t) + loop TypesEmpty = Dhall.Context.empty + +typesToNames :: Types a -> Names +typesToNames (TypesBind ts x _) = Bind ns x + where + ns = typesToNames ts +typesToNames TypesEmpty = EmptyNames + +data Types a = TypesEmpty | TypesBind !(Types a) {-# UNPACK #-} !Text (Val a) + +data Ctx a = Ctx { values :: !(Environment a), types :: !(Types a) } + +addType :: Text -> Val a -> Ctx a -> Ctx a +addType x t (Ctx vs ts) = Ctx (Skip vs x) (TypesBind ts x t) + +addTypeValue :: Text -> Val a -> Val a -> Ctx a -> Ctx a +addTypeValue x t v (Ctx vs ts) = Ctx (Extend vs x v) (TypesBind ts x t) + +fresh :: Ctx a -> Text -> Val a +fresh Ctx{..} x = VVar x (Eval.countNames x (Eval.envNames values)) + +{-| `typeWithA` is implemented internally in terms of `infer` in order to speed + up equivalence checking. + + Specifically, we extend the `Context` to become a `Ctx`, which can store + the entire contents of a `let` expression (i.e. the type *and* the value + of the bound variable). By storing this extra information in the `Ctx` we + no longer need to substitute `let` expressions at all (which is very + expensive!). + + However, this means that we need to use `Dhall.Eval.conv` to perform + equivalence checking instead of `Dhall.Core.judgmentallyEqual` since + only `judgmentallyEqual` is unable to use the information stored in the + extended context for accurate equivalence checking. +-} +infer + :: forall a s + . (Eq a, Pretty a) + => Typer a + -> Ctx a + -> Expr s a + -> Either (TypeError s a) (Val a) +infer typer = loop + where + {- The convention for primes (i.e. `'`s) is: + + * No primes (`x` ): An `Expr` that has not been `eval`ed yet + * One prime (`x'` ): A `Val` + * Two primes (`x''`): An `Expr` generated from `quote`ing a `Val` + -} + loop :: Ctx a -> Expr s a -> Either (TypeError s a) (Val a) + loop ctx@Ctx{..} expression = case expression of + Const c -> do + fmap VConst (axiom c) + + Var (V x0 n0) -> do + let go TypesEmpty _ = + die (UnboundVariable x0) + go (TypesBind ts x t) n + | x == x0 = if n == 0 then return t else go ts (n - 1) + | otherwise = go ts n + + go types n0 + + Lam x _A b -> do + tA' <- loop ctx _A + + case tA' of + VConst _ -> return () + _ -> die (InvalidInputType _A) + + let _A' = eval values _A + + let ctx' = addType x _A' ctx + + _B' <- loop ctx' b + + let _B'' = quote (Bind (Eval.envNames values) x) _B' + + tB' <- loop ctx' (Dhall.Core.renote _B'') + + case tB' of + VConst _ -> return () + _ -> die (InvalidOutputType _B'') + + return (VHPi x _A' (\u -> Eval.eval (Extend values x u) _B'')) + + Pi x _A _B -> do + tA' <- loop ctx _A + + kA <- case tA' of + VConst kA -> return kA + _ -> die (InvalidInputType _A) + + let _A' = eval values _A + + let ctx' = addType x _A' ctx + + tB' <- loop ctx' _B + + kB <- case tB' of + VConst kB -> return kB + _ -> die (InvalidOutputType _B) + + return (VConst (rule kA kB)) + + App f a -> do + tf' <- loop ctx f + + case Eval.toVHPi tf' of + Just (_x, _A₀', _B') -> do + _A₁' <- loop ctx a + + if Eval.conv values _A₀' _A₁' + then do + let a' = eval values a + + return (_B' a') + + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + die (TypeMismatch f _A₀'' a _A₁'') + Nothing -> do + die (NotAFunction f (quote names tf')) + + Let (Binding { value = a₀, variable = x, ..}) body -> do + let a₀' = eval values a₀ + + ctxNew <- case annotation of + Nothing -> do + _A' <- loop ctx a₀ + + return (addTypeValue x _A' a₀' ctx) + Just (_, _A₀) -> do + _ <- loop ctx _A₀ + + let _A₀' = eval values _A₀ + + _A₁' <- loop ctx a₀ + + if Eval.conv values _A₀' _A₁' + then do + return () + + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + die (AnnotMismatch a₀ _A₀'' _A₁'') + + return (addTypeValue x _A₀' a₀' ctx) + + loop ctxNew body + + Annot t _T₀ -> do + case Dhall.Core.denote _T₀ of + Const _ -> return () + _ -> do + _ <- loop ctx _T₀ + + return () + + let _T₀' = eval values _T₀ + + _T₁' <- loop ctx t + + if Eval.conv values _T₀' _T₁' + then do + return _T₀' + + else do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + die (AnnotMismatch t _T₀'' _T₁'') + + Bool -> do + return (VConst Type) + + BoolLit _ -> do + return VBool + + BoolAnd l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantAnd l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantAnd r (quote names tr')) + + return VBool + + BoolOr l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantOr l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantOr r (quote names tr')) + + return VBool + + BoolEQ l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantEQ l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantEQ r (quote names tr')) + + return VBool + + BoolNE l r -> do + tl' <- loop ctx l + + case tl' of + VBool -> return () + _ -> die (CantNE l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VBool -> return () + _ -> die (CantNE r (quote names tr')) + + return VBool + + BoolIf t l r -> do + tt' <- loop ctx t + + case tt' of + VBool -> return () + _ -> die (InvalidPredicate t (quote names tt')) + + _L' <- loop ctx l + + _R' <- loop ctx r + + tL' <- loop ctx (quote names _L') + + let _L'' = quote names _L' + + case tL' of + VConst Type -> do + return () + _ -> do + let tL'' = quote names tL' + die (IfBranchMustBeTerm True l _L'' tL'') + + tR' <- loop ctx (quote names _R') + + let _R'' = quote names _R' + + case tR' of + VConst Type -> do + return () + _ -> do + let tR'' = quote names tR' + die (IfBranchMustBeTerm True r _R'' tR'') + + if Eval.conv values _L' _R' + then return () + else die (IfBranchMismatch l r _L'' _R'') + + return _L' + + Natural -> do + return (VConst Type) + + NaturalLit _ -> do + return VNatural + + NaturalFold -> do + return + ( VNatural + ~> VHPi "natural" (VConst Type) (\natural -> + VHPi "succ" (natural ~> natural) (\_succ -> + VHPi "zero" natural (\_zero -> + natural + ) + ) + ) + ) + + NaturalBuild -> do + return + ( VHPi "natural" (VConst Type) (\natural -> + VHPi "succ" (natural ~> natural) (\_succ -> + VHPi "zero" natural (\_zero -> + natural + ) + ) + ) + ~> VNatural + ) + + NaturalIsZero -> do + return (VNatural ~> VBool) + + NaturalEven -> do + return (VNatural ~> VBool) + + NaturalOdd -> do + return (VNatural ~> VBool) + + NaturalToInteger -> do + return (VNatural ~> VInteger) + + NaturalShow -> do + return (VNatural ~> VText) + + NaturalSubtract -> do + return (VNatural ~> VNatural ~> VNatural) + + NaturalPlus l r -> do + tl' <- loop ctx l + + case tl' of + VNatural -> return () + _ -> die (CantAdd l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VNatural -> return () + _ -> die (CantAdd r (quote names tr')) + + return VNatural + + NaturalTimes l r -> do + tl' <- loop ctx l + + case tl' of + VNatural -> return () + _ -> die (CantMultiply l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VNatural -> return () + _ -> die (CantMultiply r (quote names tr')) + + return VNatural + + Integer -> do + return (VConst Type) + + IntegerLit _ -> do + return VInteger + + IntegerShow -> do + return (VInteger ~> VText) + + IntegerToDouble -> do + return (VInteger ~> VDouble) + + Double -> do + return (VConst Type) + + DoubleLit _ -> do + return VDouble + + DoubleShow -> do + return (VDouble ~> VText) + + Text -> do + return (VConst Type) + + TextLit (Chunks xys _) -> do + let process (_, y) = do + _Y' <- loop ctx y + + case _Y' of + VText -> return () + _ -> die (CantInterpolate y (quote names _Y')) + + mapM_ process xys + + return VText + + TextAppend l r -> do + tl' <- loop ctx l + + case tl' of + VText -> return () + _ -> die (CantTextAppend l (quote names tl')) + + tr' <- loop ctx r + + case tr' of + VText -> return () + _ -> die (CantTextAppend r (quote names tr')) + + return VText + + TextShow -> do + return (VText ~> VText) + + List -> do + return (VConst Type ~> VConst Type) + + ListLit Nothing ts₀ -> do + case Data.Sequence.viewl ts₀ of + t₀ :< ts₁ -> do + _T₀' <- loop ctx t₀ + + let _T₀'' = quote names _T₀' + + tT₀' <- loop ctx _T₀'' + + case tT₀' of + VConst Type -> return () + _ -> die (InvalidListType (App List _T₀'')) + + let process i t₁ = do + _T₁' <- loop ctx t₁ + + if Eval.conv values _T₀' _T₁' + then do + return () + + else do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + + -- Carefully note that we don't use `die` + -- here so that the source span is narrowed + -- to just the offending element + let err = MismatchedListElements i _T₀'' t₁ _T₁'' + + let context = ctxToContext ctx + + Left (TypeError context t₁ err) + + traverseWithIndex_ process ts₁ + + return (VList _T₀') + + _ -> do + die MissingListType + + ListLit (Just _T₀) ts -> do + _ <- loop ctx _T₀ + + let _T₀' = eval values _T₀ + + let _T₀'' = quote names _T₀' + + case _T₀' of + VList _T₁' -> do + tT₁' <- loop ctx (quote names _T₁') + + case tT₁' of + VConst Type -> return () + _ -> die (InvalidListType _T₀'') + + _ -> do + die (InvalidListType _T₀'') + + let process i t = do + _T₁' <- loop ctx t + + if Eval.conv values _T₀' _T₁' + then return () + else do + let _T₁'' = quote names _T₁' + die (InvalidListElement i _T₀'' t _T₁'') + + traverseWithIndex_ process ts + + return _T₀' + + ListAppend x y -> do + tx' <- loop ctx x + + _A₀' <- case tx' of + VList _A₀' -> return _A₀' + _ -> die (CantListAppend x (quote names tx')) + + ty' <- loop ctx y + + _A₁' <- case ty' of + VList _A₁' -> return _A₁' + _ -> die (CantListAppend y (quote names ty')) + + if Eval.conv values _A₀' _A₁' + then return () + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + die (ListAppendMismatch _A₀'' _A₁'') + + return (VList _A₀') + + ListBuild -> do + return + ( VHPi "a" (VConst Type) (\a -> + VHPi "list" (VConst Type) (\list -> + VHPi "cons" (a ~> list ~> list) (\_cons -> + (VHPi "nil" list (\_nil -> list)) + ) + ) + ~> VList a + ) + ) + + ListFold -> do + return + ( VHPi "a" (VConst Type) (\a -> + VList a + ~> VHPi "list" (VConst Type) (\list -> + VHPi "cons" (a ~> list ~> list) (\_cons -> + (VHPi "nil" list (\_nil -> list)) + ) + ) + ) + ) + + ListLength -> do + return (VHPi "a" (VConst Type) (\a -> VList a ~> VNatural)) + + ListHead -> do + return (VHPi "a" (VConst Type) (\a -> VList a ~> VOptional a)) + + ListLast -> do + return (VHPi "a" (VConst Type) (\a -> VList a ~> VOptional a)) + + ListIndexed -> do + return + ( VHPi "a" (VConst Type) (\a -> + VList a + ~> VList + (VRecord + (Dhall.Map.fromList + [ ("index", VNatural) + , ("value", a ) + ] + ) + ) + ) + ) + ListReverse -> do + return (VHPi "a" (VConst Type) (\a -> VList a ~> VList a)) + + Optional -> do + return (VConst Type ~> VConst Type) + + None -> do + return (VHPi "A" (VConst Type) (\_A -> VOptional _A)) + + Some a -> do + _A' <- loop ctx a + + tA' <- loop ctx (quote names _A') + + case tA' of + VConst Type -> return () + _ -> do + let _A'' = quote names _A' + let tA'' = quote names tA' + + die (InvalidSome a _A'' tA'') + + return (VOptional _A') + + OptionalFold -> do + return + ( VHPi "a" (VConst Type) (\a -> + VOptional a + ~> VHPi "optional" (VConst Type) (\optional -> + VHPi "just" (a ~> optional) (\_just -> + VHPi "nothing" optional (\_nothing -> + optional + ) + ) + ) + ) + ) + + OptionalBuild -> do + return + ( VHPi "a" (VConst Type) (\a -> + VHPi "optional" (VConst Type) (\optional -> + VHPi "just" (a ~> optional) (\_just -> + VHPi "nothing" optional (\_nothing -> + optional + ) + ) + ) + ~> VOptional a + ) + ) + + Record xTs -> do + let process x _T = do + tT' <- lift (loop ctx _T) + + case tT' of + VConst c -> tell (Max c) + _ -> lift (die (InvalidFieldType x _T)) + + Max c <- execWriterT (Dhall.Map.unorderedTraverseWithKey_ process xTs) + + return (VConst c) + + RecordLit xts -> do + let process x t = do + _T' <- loop ctx t + + let _T'' = quote names _T' + + tT' <- loop ctx _T'' + + case tT' of + VConst _ -> return _T' + _ -> die (InvalidFieldType x _T'') + + xTs <- Dhall.Map.unorderedTraverseWithKey process (Dhall.Map.sort xts) + + return (VRecord xTs) + + Union xTs -> do + let nonEmpty x mT = First (fmap (\_T -> (x, _T)) mT) + + case getFirst (Dhall.Map.foldMapWithKey nonEmpty xTs) of + Nothing -> do + return (VConst Type) + + Just (x₀, _T₀) -> do + tT₀' <- loop ctx _T₀ + + c₀ <- case tT₀' of + VConst c₀ -> return c₀ + _ -> die (InvalidAlternativeType x₀ _T₀) + + let process _ Nothing = do + return () + + process x₁ (Just _T₁) = do + tT₁' <- loop ctx _T₁ + + c₁ <- case tT₁' of + VConst c₁ -> return c₁ + _ -> die (InvalidAlternativeType x₁ _T₁) + + if c₀ == c₁ + then return () + else die (AlternativeAnnotationMismatch x₁ _T₁ c₁ x₀ _T₀ c₀) + + Dhall.Map.unorderedTraverseWithKey_ process (Dhall.Map.delete x₀ xTs) + + return (VConst c₀) + Combine l r -> do + _L' <- loop ctx l + + xLs' <- case _L' of + VRecord xLs' -> do + return xLs' + + _ -> do + let _L'' = quote names _L' + + die (MustCombineARecord '∧' l _L'') + + _R' <- loop ctx r + + xRs' <- case _R' of + VRecord xRs' -> do + return xRs' + + _ -> do + let _R'' = quote names _R' + + die (MustCombineARecord '∧' r _R'') + + let combineTypes xLs₀' xRs₀' = do + let combine _ (VRecord xLs₁') (VRecord xRs₁') = + combineTypes xLs₁' xRs₁' + + combine x _ _ = do + die (FieldCollision x) + + let xEs = + Dhall.Map.outerJoin Right Right combine xLs₀' xRs₀' + + xTs <- Dhall.Map.unorderedTraverseWithKey (\_x _E -> _E) xEs + + return (VRecord xTs) + + combineTypes xLs' xRs' + + CombineTypes l r -> do + _L' <- loop ctx l + + let l' = eval values l + + let l'' = quote names l' + + cL <- case _L' of + VConst cL -> return cL + _ -> die (CombineTypesRequiresRecordType l l'') + + _R' <- loop ctx r + + let r' = eval values r + + let r'' = quote names r' + + cR <- case _R' of + VConst cR -> return cR + _ -> die (CombineTypesRequiresRecordType r r'') + + let c = max cL cR + + xLs' <- case l' of + VRecord xLs' -> return xLs' + _ -> die (CombineTypesRequiresRecordType l l'') + + xRs' <- case r' of + VRecord xRs' -> return xRs' + _ -> die (CombineTypesRequiresRecordType r r'') + + let combineTypes xLs₀' xRs₀' = do + let combine _ (VRecord xLs₁') (VRecord xRs₁') = + combineTypes xLs₁' xRs₁' + + combine x _ _ = + die (FieldCollision x) + + let mL = Dhall.Map.toMap xLs₀' + let mR = Dhall.Map.toMap xRs₀' + + Data.Foldable.sequence_ (Data.Map.intersectionWithKey combine mL mR) + + combineTypes xLs' xRs' + + return (VConst c) + + Prefer l r -> do + _L' <- loop ctx l + + xLs' <- case _L' of + VRecord xLs' -> return xLs' + _ -> die (MustCombineARecord '⫽' l r) + + _R' <- loop ctx r + + xRs' <- case _R' of + VRecord xRs' -> return xRs' + _ -> die (MustCombineARecord '⫽' l r) + + return (VRecord (Dhall.Map.union xRs' xLs')) + + Merge t u mT₁ -> do + _T' <- loop ctx t + + yTs' <- case _T' of + VRecord yTs' -> do + return yTs' + + _ -> do + let _T'' = quote names _T' + + die (MustMergeARecord t _T'') + + _U' <- loop ctx u + + yUs' <- case _U' of + VUnion yUs' -> do + return yUs' + + _ -> do + let _U'' = quote names _U' + + die (MustMergeUnion u _U'') + + let ysT = Dhall.Map.keysSet yTs' + let ysU = Dhall.Map.keysSet yUs' + + let diffT = Data.Set.difference ysT ysU + let diffU = Data.Set.difference ysU ysT + + if Data.Set.null diffT + then return () + else die (UnusedHandler diffT) + + (my₀, _T₁') <- do + case mT₁ of + Just _T₁ -> do + return (Nothing, eval values _T₁) + + Nothing -> do + case Dhall.Map.uncons yTs' of + Nothing -> do + die MissingMergeType + + Just (y₀, _T', _) -> do + _T₁' <- do + case Dhall.Map.lookup y₀ yUs' of + Nothing -> do + die (UnusedHandler diffU) + + Just Nothing -> do + return _T' + + Just (Just _) -> do + case Eval.toVHPi _T' of + Just (x, _A₀', _T₀') -> do + return (_T₀' (fresh ctx x)) + + Nothing -> do + let _T'' = quote names _T' + + die (HandlerNotAFunction y₀ _T'') + + return (Just y₀, _T₁') + + let _T₁'' = quote names _T₁' + + _ <- loop ctx _T₁'' + + let process y mU = do + case Dhall.Map.lookup y yTs' of + Nothing -> do + die (MissingHandler diffU) + + Just _T' -> do + _T₃' <- do + case mU of + Nothing -> do + return _T' + + Just _A₁' -> do + case Eval.toVHPi _T' of + Just (x, _A₀', _T₂') -> do + if Eval.conv values _A₀' _A₁' + then do + return () + + else do + let _A₀'' = quote names _A₀' + let _A₁'' = quote names _A₁' + + die (HandlerInputTypeMismatch y _A₁'' _A₀'') + + return (_T₂' (fresh ctx x)) + + Nothing -> do + let _T'' = quote names _T' + + die (HandlerNotAFunction y _T'') + + if Eval.conv values _T₁' _T₃' + then do + return () + + else do + let _T₃'' = quote names _T₃' + + case my₀ of + Nothing -> die (InvalidHandlerOutputType y _T₁'' _T₃'') + Just y₀ -> die (HandlerOutputTypeMismatch y₀ _T₁'' y _T₃'') + + Dhall.Map.unorderedTraverseWithKey_ process yUs' + + return _T₁' + + ToMap e mT₁ -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + xTs' <- case _E' of + VRecord xTs' -> return xTs' + _ -> die (MustMapARecord e _E'') + + tE' <- loop ctx _E'' + + let tE'' = quote names tE' + + case tE' of + VConst Type -> return () + _ -> die (InvalidToMapRecordKind _E'' tE'') + + Data.Foldable.traverse_ (loop ctx) mT₁ + + let compareFieldTypes _T₀' Nothing = + Just (Right _T₀') + + compareFieldTypes _T₀' r@(Just (Right _T₁')) + | Eval.conv values _T₀' _T₁' = r + | otherwise = do + let _T₀'' = quote names _T₀' + let _T₁'' = quote names _T₁' + + Just (die (HeterogenousRecordToMap _E'' _T₀'' _T₁'')) + + compareFieldTypes _T₀' r@(Just (Left _)) = + r + + let r = appEndo (foldMap (Endo . compareFieldTypes) xTs') Nothing + + let mT₁' = fmap (eval values) mT₁ + + let mapType _T' = + VList + (VRecord + (Dhall.Map.fromList + [("mapKey", VText), ("mapValue", _T')] + ) + ) + + case (r, mT₁') of + (Nothing, Nothing) -> do + die MissingToMapType + (Just err@(Left _), _) -> do + err + (Just (Right _T'), Nothing) -> do + pure (mapType _T') + (Nothing, Just _T₁'@(VList (VRecord itemTypes))) + | Just _T' <- Dhall.Map.lookup "mapValue" itemTypes + , Eval.conv values (mapType _T') _T₁' -> do + pure _T₁' + (Nothing, Just _T₁') -> do + let _T₁'' = quote names _T₁' + + die (InvalidToMapType _T₁'') + (Just (Right _T'), Just _T₁') + | Eval.conv values (mapType _T') _T₁' -> do + pure _T₁' + | otherwise -> do + let _T₁'' = quote names _T₁' + + die (MapTypeMismatch (quote names (mapType _T')) _T₁'') + + Field e x -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + case _E' of + VRecord xTs' -> do + _ <- loop ctx _E'' + + case Dhall.Map.lookup x xTs' of + Just _T' -> return _T' + Nothing -> die (MissingField x _E'') + _ -> do + let e' = eval values e + + let e'' = quote names e' + + case e' of + VUnion xTs' -> do + case Dhall.Map.lookup x xTs' of + Just (Just _T') -> return (VHPi x _T' (\_ -> e')) + Just Nothing -> return e' + Nothing -> die (MissingConstructor x e) + + _ -> do + let text = Dhall.Pretty.Internal.docToStrictText (Dhall.Pretty.Internal.prettyLabel x) + + die (CantAccess text e'' _E'') + Project e (Left xs) -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + case _E' of + VRecord xTs' -> do + _ <- loop ctx _E'' + + let process x = + case Dhall.Map.lookup x xTs' of + Just _T' -> return (x, _T') + Nothing -> die (MissingField x _E'') + + let adapt = VRecord . Dhall.Map.fromList + + fmap adapt (traverse process (Dhall.Set.toList (Dhall.Set.sort xs))) + + _ -> do + let text = + Dhall.Pretty.Internal.docToStrictText (Dhall.Pretty.Internal.prettyLabels xs) + + die (CantProject text e _E'') + + Project e (Right s) -> do + _E' <- loop ctx e + + let _E'' = quote names _E' + + case _E' of + VRecord xEs' -> do + _ <- loop ctx s + + let s' = eval values s + + case s' of + VRecord xSs' -> do + let actualSubset = + quote names (VRecord (Dhall.Map.intersection xEs' xSs')) + + let expectedSubset = s + + let process x _S' = do + let _S'' = quote names _S' + + case Dhall.Map.lookup x xEs' of + Nothing -> do + die (MissingField x _E'') + + Just _E' -> do + if Eval.conv values _E' _S' + then return () + else die (ProjectionTypeMismatch x _E'' _S'' expectedSubset actualSubset) + + Dhall.Map.unorderedTraverseWithKey_ process xSs' + + return s' + + _ -> do + die (CantProjectByExpression s) + + _ -> do + let text = Dhall.Core.pretty s + + die (CantProject text e s) + + Assert _T -> do + _ <- loop ctx _T + + let _T' = eval values _T + + case _T' of + VEquivalent x' y' -> do + let x'' = quote names x' + let y'' = quote names y' + + if Eval.conv values x' y' + then return _T' + else die (AssertionFailed x'' y'') + + _ -> do + die (NotAnEquivalence _T) + + Equivalent x y -> do + _A₀' <- loop ctx x + + let _A₀'' = quote names _A₀' + + tA₀' <- loop ctx _A₀'' + + case tA₀' of + VConst Type -> return () + _ -> die (IncomparableExpression x) + + _A₁' <- loop ctx y + + let _A₁'' = quote names _A₁' + + tA₁' <- loop ctx _A₁'' + + case tA₁' of + VConst Type -> return () + _ -> die (IncomparableExpression y) + + if Eval.conv values _A₀' _A₁' + then return () + else die (EquivalenceTypeMismatch x _A₀'' y _A₁'') + + return (VConst Type) + + Note s e -> + case loop ctx e of + Left (TypeError ctx' (Note s' e') m) -> + Left (TypeError ctx' (Note s' e') m) + Left (TypeError ctx' e' m) -> + Left (TypeError ctx' (Note s e') m) + Right r -> + Right r + + ImportAlt l _r -> do + loop ctx l + + Embed p -> do + return (eval values (typer p)) + where + die err = Left (TypeError context expression err) + where + context = ctxToContext ctx + + names = typesToNames types + + eval vs e = Eval.eval vs (Dhall.Core.denote e) + + quote ns value = Dhall.Core.renote (Eval.quote ns value) + +{-| `typeOf` is the same as `typeWith` with an empty context, meaning that the + expression must be closed (i.e. no free variables), otherwise type-checking + will fail. +-} +typeOf :: Expr s X -> Either (TypeError s X) (Expr s X) +typeOf = typeWith Dhall.Context.empty + +-- | The specific type error +data TypeMessage s a + = UnboundVariable Text + | InvalidInputType (Expr s a) + | InvalidOutputType (Expr s a) + | NotAFunction (Expr s a) (Expr s a) + | TypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | AnnotMismatch (Expr s a) (Expr s a) (Expr s a) + | Untyped + | MissingListType + | MismatchedListElements Int (Expr s a) (Expr s a) (Expr s a) + | InvalidListElement Int (Expr s a) (Expr s a) (Expr s a) + | InvalidListType (Expr s a) + | InvalidSome (Expr s a) (Expr s a) (Expr s a) + | InvalidPredicate (Expr s a) (Expr s a) + | IfBranchMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | IfBranchMustBeTerm Bool (Expr s a) (Expr s a) (Expr s a) + | InvalidFieldType Text (Expr s a) + | InvalidAlternativeType Text (Expr s a) + | AlternativeAnnotationMismatch Text (Expr s a) Const Text (Expr s a) Const + | ListAppendMismatch (Expr s a) (Expr s a) + | MustCombineARecord Char (Expr s a) (Expr s a) + | CombineTypesRequiresRecordType (Expr s a) (Expr s a) + | RecordTypeMismatch Const Const (Expr s a) (Expr s a) + | FieldCollision Text + | MustMergeARecord (Expr s a) (Expr s a) + | MustMergeUnion (Expr s a) (Expr s a) + | MustMapARecord (Expr s a) (Expr s a) + | InvalidToMapRecordKind (Expr s a) (Expr s a) + | HeterogenousRecordToMap (Expr s a) (Expr s a) (Expr s a) + | InvalidToMapType (Expr s a) + | MapTypeMismatch (Expr s a) (Expr s a) + | MissingToMapType + | UnusedHandler (Set Text) + | MissingHandler (Set Text) + | HandlerInputTypeMismatch Text (Expr s a) (Expr s a) + | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a) + | InvalidHandlerOutputType Text (Expr s a) (Expr s a) + | MissingMergeType + | HandlerNotAFunction Text (Expr s a) + | CantAccess Text (Expr s a) (Expr s a) + | CantProject Text (Expr s a) (Expr s a) + | CantProjectByExpression (Expr s a) + | MissingField Text (Expr s a) + | MissingConstructor Text (Expr s a) + | ProjectionTypeMismatch Text (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | AssertionFailed (Expr s a) (Expr s a) + | NotAnEquivalence (Expr s a) + | IncomparableExpression (Expr s a) + | EquivalenceTypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a) + | CantAnd (Expr s a) (Expr s a) + | CantOr (Expr s a) (Expr s a) + | CantEQ (Expr s a) (Expr s a) + | CantNE (Expr s a) (Expr s a) + | CantInterpolate (Expr s a) (Expr s a) + | CantTextAppend (Expr s a) (Expr s a) + | CantListAppend (Expr s a) (Expr s a) + | CantAdd (Expr s a) (Expr s a) + | CantMultiply (Expr s a) (Expr s a) + deriving (Show) + +shortTypeMessage :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> Doc Ann +shortTypeMessage msg = + "\ESC[1;31mError\ESC[0m: " <> short <> "\n" + where + ErrorMessages {..} = prettyTypeMessage msg + +longTypeMessage :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> Doc Ann +longTypeMessage msg = + "\ESC[1;31mError\ESC[0m: " <> short <> "\n" + <> "\n" + <> long + where + ErrorMessages {..} = prettyTypeMessage msg + +data ErrorMessages = ErrorMessages + { short :: Doc Ann + -- ^ Default succinct 1-line explanation of what went wrong + , long :: Doc Ann + -- ^ Longer and more detailed explanation of the error + } + +_NOT :: Doc ann +_NOT = "\ESC[1mnot\ESC[0m" + +insert :: Pretty a => a -> Doc Ann +insert = Dhall.Util.insert + +prettyTypeMessage + :: (Eq a, Pretty a, ToTerm a) => TypeMessage s a -> ErrorMessages +prettyTypeMessage (UnboundVariable x) = ErrorMessages {..} + -- We do not need to print variable name here. For the discussion see: + -- https://github.com/dhall-lang/dhall-haskell/pull/116 + where + short = "Unbound variable: " <> Pretty.pretty x + + long = + "Explanation: Expressions can only reference previously introduced (i.e. “bound”)\n\ + \variables that are still “in scope” \n\ + \ \n\ + \For example, the following valid expressions introduce a “bound” variable named \n\ + \❰x❱: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ λ(x : Bool) → x │ Anonymous functions introduce “bound” variables \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is the bound variable \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ let x = 1 in x │ ❰let❱ expressions introduce “bound” variables \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is the bound variable \n\ + \ \n\ + \ \n\ + \However, the following expressions are not valid because they all reference a \n\ + \variable that has not been introduced yet (i.e. an “unbound” variable): \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ λ(x : Bool) → y │ The variable ❰y❱ hasn't been introduced yet \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is the unbound variable \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ (let x = True in x) && x │ ❰x❱ is undefined outside the parentheses \n\ + \ └──────────────────────────┘ \n\ + \ ⇧ \n\ + \ This is the unbound variable \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ let x = x in x │ The definition for ❰x❱ cannot reference itself \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ This is the unbound variable \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You misspell a variable name, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────────┐ \n\ + \ │ λ(empty : Bool) → if emty then \"Empty\" else \"Full\" │ \n\ + \ └────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Typo \n\ + \ \n\ + \ \n\ + \● You misspell a reserved identifier, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ foral (a : Type) → a → a │ \n\ + \ └──────────────────────────┘ \n\ + \ ⇧ \n\ + \ Typo \n\ + \ \n\ + \ \n\ + \● You tried to define a recursive value, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ let x = x + 1 in x │ \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ Recursive definitions are not allowed \n\ + \ \n\ + \ \n\ + \● You accidentally forgot a ❰λ❱ or ❰∀❱/❰forall❱ \n\ + \ \n\ + \ \n\ + \ Unbound variable \n\ + \ ⇩ \n\ + \ ┌─────────────────┐ \n\ + \ │ (x : Bool) → x │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ A ❰λ❱ here would transform this into a valid anonymous function \n\ + \ \n\ + \ \n\ + \ Unbound variable \n\ + \ ⇩ \n\ + \ ┌────────────────────┐ \n\ + \ │ (x : Bool) → Bool │ \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ A ❰∀❱ or ❰forall❱ here would transform this into a valid function type \n\ + \ \n\ + \ \n\ + \● You forgot to prefix a file path with ❰./❱: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ path/to/file.dhall │ \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰./path/to/file.dhall❱ \n" + +prettyTypeMessage (InvalidInputType expr) = ErrorMessages {..} + where + short = "Invalid function input" + + long = + "Explanation: A function can accept an input “term” that has a given “type”, like\n\ + \this: \n\ + \ \n\ + \ \n\ + \ This is the input term that the function accepts \n\ + \ ⇩ \n\ + \ ┌───────────────────────┐ \n\ + \ │ ∀(x : Natural) → Bool │ This is the type of a function that accepts an \n\ + \ └───────────────────────┘ input term named ❰x❱ that has type ❰Natural❱ \n\ + \ ⇧ \n\ + \ This is the type of the input term \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ Bool → Natural │ This is the type of a function that accepts an anonymous\n\ + \ └────────────────┘ input term that has type ❰Bool❱ \n\ + \ ⇧ \n\ + \ This is the type of the input term \n\ + \ \n\ + \ \n\ + \... or a function can accept an input “type” that has a given “kind”, like this:\n\ + \ \n\ + \ \n\ + \ This is the input type that the function accepts \n\ + \ ⇩ \n\ + \ ┌────────────────────┐ \n\ + \ │ ∀(a : Type) → Type │ This is the type of a function that accepts an input\n\ + \ └────────────────────┘ type named ❰a❱ that has kind ❰Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the input type \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ (Type → Type) → Type │ This is the type of a function that accepts an \n\ + \ └──────────────────────┘ anonymous input type that has kind ❰Type → Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the input type \n\ + \ \n\ + \ \n\ + \Other function inputs are " <> _NOT <> " valid, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────┐ \n\ + \ │ ∀(x : 1) → x │ ❰1❱ is a “term” and not a “type” nor a “kind” so ❰x❱ \n\ + \ └──────────────┘ cannot have “type” ❰1❱ or “kind” ❰1❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ True → x │ ❰True❱ is a “term” and not a “type” nor a “kind” so the \n\ + \ └──────────┘ anonymous input cannot have “type” ❰True❱ or “kind” ❰True❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \You annotated a function input with the following expression: \n\ + \ \n\ + \" <> txt <> "\n\ + \ \n\ + \... which is neither a type nor a kind \n" + where + txt = insert expr + +prettyTypeMessage (InvalidOutputType expr) = ErrorMessages {..} + where + short = "Invalid function output" + + long = + "Explanation: A function can return an output “term” that has a given “type”, \n\ + \like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ ∀(x : Text) → Bool │ This is the type of a function that returns an \n\ + \ └────────────────────┘ output term that has type ❰Bool❱ \n\ + \ ⇧ \n\ + \ This is the type of the output term \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ Bool → Natural │ This is the type of a function that returns an output \n\ + \ └────────────────┘ term that has type ❰Natural❱ \n\ + \ ⇧ \n\ + \ This is the type of the output term \n\ + \ \n\ + \ \n\ + \... or a function can return an output “type” that has a given “kind”, like \n\ + \this: \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ ∀(a : Type) → Type │ This is the type of a function that returns an \n\ + \ └────────────────────┘ output type that has kind ❰Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the output type \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────┐ \n\ + \ │ (Type → Type) → Type │ This is the type of a function that returns an \n\ + \ └──────────────────────┘ output type that has kind ❰Type❱ \n\ + \ ⇧ \n\ + \ This is the kind of the output type \n\ + \ \n\ + \ \n\ + \Other outputs are " <> _NOT <> " valid, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ ∀(x : Bool) → x │ ❰x❱ is a “term” and not a “type” nor a “kind” so the \n\ + \ └─────────────────┘ output cannot have “type” ❰x❱ or “kind” ❰x❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ Text → True │ ❰True❱ is a “term” and not a “type” nor a “kind” so the \n\ + \ └─────────────┘ output cannot have “type” ❰True❱ or “kind” ❰True❱ \n\ + \ ⇧ \n\ + \ This is not a type or kind \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You use ❰∀❱ instead of ❰λ❱ by mistake, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ ∀(x: Bool) → x │ \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ Using ❰λ❱ here instead of ❰∀❱ would transform this into a valid function \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You specified that your function outputs a: \n\ + \ \n\ + \" <> txt <> "\n\ + \ \n\ + \... which is neither a type nor a kind: \n" + where + txt = insert expr + +prettyTypeMessage (NotAFunction expr0 expr1) = ErrorMessages {..} + where + short = "Not a function" + + long = + "Explanation: Expressions separated by whitespace denote function application, \n\ + \like this: \n\ + \ \n\ + \ \n\ + \ ┌─────┐ \n\ + \ │ f x │ This denotes the function ❰f❱ applied to an argument named ❰x❱ \n\ + \ └─────┘ \n\ + \ \n\ + \ \n\ + \A function is a term that has type ❰a → b❱ for some ❰a❱ or ❰b❱. For example, \n\ + \the following expressions are all functions because they have a function type: \n\ + \ \n\ + \ \n\ + \ The function's input type is ❰Bool❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(x : Bool) → x : Bool → Bool │ User-defined anonymous function \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output type is ❰Bool❱ \n\ + \ \n\ + \ \n\ + \ The function's input type is ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ Natural/even : Natural → Bool │ Built-in function \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output type is ❰Bool❱ \n\ + \ \n\ + \ \n\ + \ The function's input kind is ❰Type❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(a : Type) → a : Type → Type │ Type-level functions are still functions \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output kind is ❰Type❱ \n\ + \ \n\ + \ \n\ + \ The function's input kind is ❰Type❱ \n\ + \ ⇩ \n\ + \ ┌────────────────────┐ \n\ + \ │ List : Type → Type │ Built-in type-level function \n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ The function's output kind is ❰Type❱ \n\ + \ \n\ + \ \n\ + \ Function's input has kind ❰Type❱ \n\ + \ ⇩ \n\ + \ ┌─────────────────────────────────────────────────┐ \n\ + \ │ List/head : ∀(a : Type) → (List a → Optional a) │ A function can return \n\ + \ └─────────────────────────────────────────────────┘ another function \n\ + \ ⇧ \n\ + \ Function's output has type ❰List a → Optional a❱\n\ + \ \n\ + \ \n\ + \ The function's input type is ❰List Text❱ \n\ + \ ⇩ \n\ + \ ┌────────────────────────────────────────────┐ \n\ + \ │ List/head Text : List Text → Optional Text │ A function applied to an \n\ + \ └────────────────────────────────────────────┘ argument can be a function \n\ + \ ⇧ \n\ + \ The function's output type is ❰Optional Text❱\n\ + \ \n\ + \ \n\ + \An expression is not a function if the expression's type is not of the form \n\ + \❰a → b❱. For example, these are " <> _NOT <> " functions: \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ 1 : Natural │ ❰1❱ is not a function because ❰Natural❱ is not the type of \n\ + \ └─────────────┘ a function \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ Natural/even 2 : Bool │ ❰Natural/even 2❱ is not a function because \n\ + \ └───────────────────────┘ ❰Bool❱ is not the type of a function \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ List Text : Type │ ❰List Text❱ is not a function because ❰Type❱ is not \n\ + \ └──────────────────┘ the type of a function \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You tried to add two ❰Natural❱s without a space around the ❰+❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────┐ \n\ + \ │ 2+2 │ \n\ + \ └─────┘ \n\ + \ \n\ + \ \n\ + \ The above code is parsed as: \n\ + \ \n\ + \ \n\ + \ ┌────────┐ \n\ + \ │ 2 (+2) │ \n\ + \ └────────┘ \n\ + \ ⇧ \n\ + \ The compiler thinks that this ❰2❱ is a function whose argument is ❰+2❱ \n\ + \ \n\ + \ \n\ + \ This is because the ❰+❱ symbol has two meanings: you use ❰+❱ to add two \n\ + \ numbers, but you also can prefix ❰Natural❱ literals with a ❰+❱ to turn them \n\ + \ into ❰Integer❱ literals (like ❰+2❱) \n\ + \ \n\ + \ To fix the code, you need to put spaces around the ❰+❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 2 + 2 │ \n\ + \ └───────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to use the following expression as a function: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but this expression's type is: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not a function type \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (TypeMismatch expr0 expr1 expr2 expr3) = ErrorMessages {..} + where + short = "Wrong type of function argument\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr3) + + long = + "Explanation: Every function declares what type or kind of argument to accept \n\ + \ \n\ + \For example: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(x : Bool) → x : Bool → Bool │ This anonymous function only accepts \n\ + \ └───────────────────────────────┘ arguments that have type ❰Bool❱ \n\ + \ ⇧ \n\ + \ The function's input type \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ Natural/even : Natural → Bool │ This built-in function only accepts \n\ + \ └───────────────────────────────┘ arguments that have type ❰Natural❱ \n\ + \ ⇧ \n\ + \ The function's input type \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ λ(a : Type) → a : Type → Type │ This anonymous function only accepts \n\ + \ └───────────────────────────────┘ arguments that have kind ❰Type❱ \n\ + \ ⇧ \n\ + \ The function's input kind \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ List : Type → Type │ This built-in function only accepts arguments that \n\ + \ └────────────────────┘ have kind ❰Type❱ \n\ + \ ⇧ \n\ + \ The function's input kind \n\ + \ \n\ + \ \n\ + \For example, the following expressions are valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ (λ(x : Bool) → x) True │ ❰True❱ has type ❰Bool❱, which matches the type \n\ + \ └────────────────────────┘ of argument that the anonymous function accepts \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ Natural/even 2 │ ❰2❱ has type ❰Natural❱, which matches the type of \n\ + \ └────────────────┘ argument that the ❰Natural/even❱ function accepts, \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ (λ(a : Type) → a) Bool │ ❰Bool❱ has kind ❰Type❱, which matches the kind \n\ + \ └────────────────────────┘ of argument that the anonymous function accepts \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ List Text │ ❰Text❱ has kind ❰Type❱, which matches the kind of argument \n\ + \ └───────────┘ that that the ❰List❱ function accepts \n\ + \ \n\ + \ \n\ + \However, you can " <> _NOT <> " apply a function to the wrong type or kind of argument\n\ + \ \n\ + \For example, the following expressions are not valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ (λ(x : Bool) → x) \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the anonymous function\n\ + \ └───────────────────────┘ expects an argument that has type ❰Bool❱ \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ Natural/even \"A\" │ ❰\"A\"❱ has type ❰Text❱, but the ❰Natural/even❱ function\n\ + \ └──────────────────┘ expects an argument that has type ❰Natural❱ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ (λ(a : Type) → a) True │ ❰True❱ has type ❰Bool❱, but the anonymous \n\ + \ └────────────────────────┘ function expects an argument of kind ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌────────┐ \n\ + \ │ List 1 │ ❰1❱ has type ❰Natural❱, but the ❰List❱ function expects an \n\ + \ └────────┘ argument that has kind ❰Type❱ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You omit a function argument by mistake: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ List/head [1, 2, 3] │ \n\ + \ └───────────────────────┘ \n\ + \ ⇧ \n\ + \ ❰List/head❱ is missing the first argument, \n\ + \ which should be: ❰Natural❱ \n\ + \ \n\ + \ \n\ + \● You supply an ❰Integer❱ literal to a function that expects a ❰Natural❱ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ Natural/even +2 │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰2❱ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to invoke the following function: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which expects an argument of type or kind: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... on the following argument: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... which has a different type or kind: \n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + txt3 = insert expr3 + +prettyTypeMessage (AnnotMismatch expr0 expr1 expr2) = ErrorMessages {..} + where + short = "Expression doesn't match annotation\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) + long = + "Explanation: You can annotate an expression with its type or kind using the \n\ + \❰:❱ symbol, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ x : t │ ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱\n\ + \ └───────┘ \n\ + \ \n\ + \The type checker verifies that the expression's type or kind matches the \n\ + \provided annotation \n\ + \ \n\ + \For example, all of the following are valid annotations that the type checker \n\ + \accepts: \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ 1 : Natural │ ❰1❱ is an expression that has type ❰Natural❱, so the type \n\ + \ └─────────────┘ checker accepts the annotation \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ Natural/even 2 : Bool │ ❰Natural/even 2❱ has type ❰Bool❱, so the type \n\ + \ └───────────────────────┘ checker accepts the annotation \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ List : Type → Type │ ❰List❱ is an expression that has kind ❰Type → Type❱,\n\ + \ └────────────────────┘ so the type checker accepts the annotation \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ List Text : Type │ ❰List Text❱ is an expression that has kind ❰Type❱, so \n\ + \ └──────────────────┘ the type checker accepts the annotation \n\ + \ \n\ + \ \n\ + \However, the following annotations are " <> _NOT <> " valid and the type checker will\n\ + \reject them: \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ 1 : Text │ The type checker rejects this because ❰1❱ does not have type \n\ + \ └──────────┘ ❰Text❱ \n\ + \ \n\ + \ \n\ + \ ┌─────────────┐ \n\ + \ │ List : Type │ ❰List❱ does not have kind ❰Type❱ \n\ + \ └─────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● The Haskell Dhall interpreter implicitly inserts a top-level annotation \n\ + \ matching the expected type \n\ + \ \n\ + \ For example, if you run the following Haskell code: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ >>> input auto \"1\" :: IO Text │ \n\ + \ └───────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ... then the interpreter will actually type check the following annotated \n\ + \ expression: \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ 1 : Text │ \n\ + \ └──────────┘ \n\ + \ \n\ + \ \n\ + \ ... and then type-checking will fail \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You or the interpreter annotated this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... with this type or kind: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the inferred type or kind of the expression is actually: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage Untyped = ErrorMessages {..} + where + short = "❰Sort❱ has no type, kind, or sort" + + long = + "Explanation: There are five levels of expressions that form a hierarchy: \n\ + \ \n\ + \● terms \n\ + \● types \n\ + \● kinds \n\ + \● sorts \n\ + \● orders \n\ + \ \n\ + \The following example illustrates this hierarchy: \n\ + \ \n\ + \ ┌───────────────────────────────────┐ \n\ + \ │ \"ABC\" : Text : Type : Kind : Sort │ \n\ + \ └───────────────────────────────────┘ \n\ + \ ⇧ ⇧ ⇧ ⇧ ⇧ \n\ + \ term type kind sort order \n\ + \ \n\ + \There is nothing above ❰Sort❱ in this hierarchy, so if you try to type check any\n\ + \expression containing ❰Sort❱ anywhere in the expression then type checking fails\n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You supplied a sort where a kind was expected \n\ + \ \n\ + \ For example, the following expression will fail to type check: \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ f : Type -> Kind │ \n\ + \ └──────────────────┘ \n\ + \ ⇧ \n\ + \ ❰Kind❱ is a sort, not a kind \n" + +prettyTypeMessage (InvalidPredicate expr0 expr1) = ErrorMessages {..} + where + short = "Invalid predicate for ❰if❱" + + long = + "Explanation: Every ❰if❱ expression begins with a predicate which must have type \n\ + \❰Bool❱ \n\ + \ \n\ + \For example, these are valid ❰if❱ expressions: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────┐ \n\ + \ │ if True then \"Yes\" else \"No\" │ \n\ + \ └──────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Predicate \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ λ(x : Bool) → if x then False else True │ \n\ + \ └─────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Predicate \n\ + \ \n\ + \ \n\ + \... but these are " <> _NOT <> " valid ❰if❱ expressions: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ if 0 then \"Yes\" else \"No\" │ ❰0❱ does not have type ❰Bool❱ \n\ + \ └───────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ if \"\" then False else True │ ❰\"\"❱ does not have type ❰Bool❱ \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might be used to other programming languages that accept predicates other \n\ + \ than ❰Bool❱ \n\ + \ \n\ + \ For example, some languages permit ❰0❱ or ❰\"\"❱ as valid predicates and treat\n\ + \ them as equivalent to ❰False❱. However, the Dhall language does not permit \n\ + \ this \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \Your ❰if❱ expression begins with the following predicate: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... that has type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the predicate must instead have type ❰Bool❱ \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (IfBranchMustBeTerm b expr0 expr1 expr2) = + ErrorMessages {..} + where + short = "❰if❱ branch is not a term" + + long = + "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ + \is an expression: \n\ + \ \n\ + \ \n\ + \ Expression for ❰then❱ branch \n\ + \ ⇩ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ if True then \"Hello, world!\" │ \n\ + \ │ else \"Goodbye, world!\" │ \n\ + \ └────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Expression for ❰else❱ branch \n\ + \ \n\ + \ \n\ + \These expressions must be a “term”, where a “term” is defined as an expression \n\ + \that has a type thas has kind ❰Type❱ \n\ + \ \n\ + \For example, the following expressions are all valid “terms”: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ 1 : Natural : Type │ ❰1❱ is a term with a type (❰Natural❱) of kind ❰Type❱\n\ + \ └────────────────────┘ \n\ + \ ⇧ \n\ + \ term \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────┐ \n\ + \ │ Natural/odd : Natural → Bool : Type │ ❰Natural/odd❱ is a term with a type\n\ + \ └─────────────────────────────────────┘ (❰Natural → Bool❱) of kind ❰Type❱ \n\ + \ ⇧ \n\ + \ term \n\ + \ \n\ + \ \n\ + \However, the following expressions are " <> _NOT <> " valid terms: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ Text : Type : Kind │ ❰Text❱ has kind (❰Type❱) of sort ❰Kind❱ and is \n\ + \ └────────────────────┘ therefore not a term \n\ + \ ⇧ \n\ + \ type \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ List : Type → Type : Kind │ ❰List❱ has kind (❰Type → Type❱) of sort \n\ + \ └───────────────────────────┘ ❰Kind❱ and is therefore not a term \n\ + \ ⇧ \n\ + \ type-level function \n\ + \ \n\ + \ \n\ + \This means that you cannot define an ❰if❱ expression that returns a type. For \n\ + \example, the following ❰if❱ expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────┐ \n\ + \ │ if True then Text else Bool │ Invalid ❰if❱ expression \n\ + \ └─────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ type type \n\ + \ \n\ + \ \n\ + \Your ❰" <> txt0 <> "❱ branch of your ❰if❱ expression is: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which has kind: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... of sort: \n\ + \ \n\ + \" <> txt3 <> "\n\ + \ \n\ + \... and is not a term. Therefore your ❰if❱ expression is not valid \n" + where + txt0 = if b then "then" else "else" + txt1 = insert expr0 + txt2 = insert expr1 + txt3 = insert expr2 + +prettyTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) = + ErrorMessages {..} + where + short = "❰if❱ branches must have matching types\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr3) + + long = + "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\ + \is an expression: \n\ + \ \n\ + \ \n\ + \ Expression for ❰then❱ branch \n\ + \ ⇩ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ if True then \"Hello, world!\" │ \n\ + \ │ else \"Goodbye, world!\" │ \n\ + \ └────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Expression for ❰else❱ branch \n\ + \ \n\ + \ \n\ + \These two expressions must have the same type. For example, the following ❰if❱ \n\ + \expressions are all valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ λ(b : Bool) → if b then 0 else 1 │ Both branches have type ❰Natural❱ \n\ + \ └──────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ λ(b : Bool) → │ \n\ + \ │ if b then Natural/even │ Both branches have type ❰Natural → Bool❱ \n\ + \ │ else Natural/odd │ \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ This branch has type ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌────────────────────────┐ \n\ + \ │ if True then 0 │ \n\ + \ │ else \"ABC\" │ \n\ + \ └────────────────────────┘ \n\ + \ ⇧ \n\ + \ This branch has type ❰Text❱ \n\ + \ \n\ + \ \n\ + \The ❰then❱ and ❰else❱ branches must have matching types, even if the predicate \n\ + \is always ❰True❱ or ❰False❱ \n\ + \ \n\ + \Your ❰if❱ expression has the following ❰then❱ branch: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which has type: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... and the following ❰else❱ branch: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which has a different type: \n\ + \ \n\ + \" <> txt3 <> "\n\ + \ \n\ + \Fix your ❰then❱ and ❰else❱ branches to have matching types \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + txt3 = insert expr3 + +prettyTypeMessage (InvalidListType expr0) = ErrorMessages {..} + where + short = "Invalid type for ❰List❱" + + long = + "Explanation: ❰List❱s can optionally document their type with a type annotation, \n\ + \like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ [1, 2, 3] : List Natural │ A ❰List❱ of three ❰Natural❱ numbers \n\ + \ └──────────────────────────┘ \n\ + \ ⇧ \n\ + \ The type of the ❰List❱'s elements, which are ❰Natural❱ \n\ + \ numbers \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ [] : List Natural │ An empty ❰List❱ \n\ + \ └───────────────────┘ \n\ + \ ⇧ \n\ + \ You must specify the type when the ❰List❱ is empty \n\ + \ \n\ + \ \n\ + \The type must be of the form ❰List ...❱ and not something else. For example, \n\ + \the following type annotation is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────┐ \n\ + \ │ ... : Bool │ \n\ + \ └────────────┘ \n\ + \ ⇧ \n\ + \ This type does not have the form ❰List ...❱ \n\ + \ \n\ + \ \n\ + \The element type must be a type and not something else. For example, the \n\ + \following element types are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────┐ \n\ + \ │ ... : List 1 │ \n\ + \ └──────────────┘ \n\ + \ ⇧ \n\ + \ This is a ❰Natural❱ number and not a ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ ... : List Type │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This is a ❰Kind❱ and not a ❰Type❱ \n\ + \ \n\ + \ \n\ + \You declared that the ❰List❱ should have type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a valid list type \n" + where + txt0 = insert expr0 + +prettyTypeMessage MissingListType = do + ErrorMessages {..} + where + short = "An empty list requires a type annotation" + + long = + "Explanation: Lists do not require a type annotation if they have at least one \n\ + \element: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ [1, 2, 3] │ The compiler can infer that this list has type ❰List Natural❱\n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \However, empty lists still require a type annotation: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ [] : List Natural │ This type annotation is mandatory \n\ + \ └───────────────────┘ \n\ + \ \n\ + \ \n\ + \You cannot supply an empty list without a type annotation \n" + +prettyTypeMessage (MismatchedListElements i expr0 _expr1 expr2) = + ErrorMessages {..} + where + short = "List elements should all have the same type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2) + + long = + "Explanation: Every element in a list must have the same type \n\ + \ \n\ + \For example, this is a valid ❰List❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ [1, 2, 3] │ Every element in this ❰List❱ is a ❰Natural❱ number \n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ [1, \"ABC\", 3] │ The first and second element have different types \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \Your first ❰List❱ element has this type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the element at index #" <> txt1 <> " has this type instead: \n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = insert expr0 + txt1 = pretty i + txt3 = insert expr2 + +prettyTypeMessage (InvalidListElement i expr0 _expr1 expr2) = + ErrorMessages {..} + where + short = "List element has the wrong type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr2) + + long = + "Explanation: Every element in the list must have a type matching the type \n\ + \annotation at the end of the list \n\ + \ \n\ + \For example, this is a valid ❰List❱: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────┐ \n\ + \ │ [1, 2, 3] : List Natural │ Every element in this ❰List❱ is an ❰Natural❱ \n\ + \ └──────────────────────────┘ \n\ + \ \n\ + \ \n\ + \.. but this is " <> _NOT <> " a valid ❰List❱: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────┐ \n\ + \ │ [1, \"ABC\", 3] : List Natural │ The second element is not an ❰Natural❱ \n\ + \ └──────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Your ❰List❱ elements should have this type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the element at index #" <> txt1 <> " has this type instead: \n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = insert expr0 + txt1 = pretty i + txt3 = insert expr2 + +prettyTypeMessage (InvalidSome expr0 expr1 expr2) = ErrorMessages {..} + where + short = "❰Some❱ argument has the wrong type" + + long = + "Explanation: The ❰Some❱ constructor expects an argument that is a term, where \n\ + \the type of the type of a term must be ❰Type❱ \n\ + \ \n\ + \For example, this is a valid use of ❰Some❱: \n\ + \ \n\ + \ \n\ + \ ┌────────┐ \n\ + \ │ Some 1 │ ❰1❱ is a valid term because ❰1 : Natural : Type❱ \n\ + \ └────────┘ \n\ + \ \n\ + \ \n\ + \... but this is " <> _NOT <> " a valid ❰Optional❱ value: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ Some Text │ ❰Text❱ is not a valid term because ❰Text : Type : Kind ❱ \n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \The ❰Some❱ argument you provided: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... has this type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the type of that type is: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... which is not ❰Type❱ \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage (InvalidFieldType k expr0) = ErrorMessages {..} + where + short = "Invalid field type" + + long = + "Explanation: Every record type annotates each field with a ❰Type❱, a ❰Kind❱, or \n\ + \a ❰Sort❱ like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────┐ \n\ + \ │ { foo : Natural, bar : Integer, baz : Text } │ Every field is annotated \n\ + \ └──────────────────────────────────────────────┘ with a ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ { foo : Type, bar : Type } │ Every field is annotated \n\ + \ └────────────────────────────┘ with a ❰Kind❱ \n\ + \ \n\ + \ \n\ + \However, the types of fields may " <> _NOT <> " be term-level values: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ { foo : Natural, bar : 1 } │ Invalid record type \n\ + \ └────────────────────────────┘ \n\ + \ ⇧ \n\ + \ ❰1❱ is a ❰Natural❱ number and not a ❰Type❱, \n\ + \ ❰Kind❱, or ❰Sort❱ \n\ + \ \n\ + \ \n\ + \You provided a record type with a field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... annotated with the following expression: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is neither a ❰Type❱, a ❰Kind❱, nor a ❰Sort❱ \n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (InvalidAlternativeType k expr0) = ErrorMessages {..} + where + short = "Invalid alternative type" + + long = + "Explanation: Every union type specifies the type of each alternative, like this:\n\ + \ \n\ + \ \n\ + \ The type of the first alternative is ❰Bool❱ \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ < Left : Bool, Right : Natural > │ A union type with two alternatives \n\ + \ └──────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The type of the second alternative is ❰Natural❱ \n\ + \ \n\ + \ \n\ + \However, these alternatives can only be annotated with ❰Type❱s, ❰Kind❱s, or \n\ + \❰Sort❱s. For example, the following union types are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ < Left : Bool, Right : 1 > │ Invalid union type \n\ + \ └────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This is a ❰Natural❱ and not a ❰Type❱, ❰Kind❱, or \n\ + \ ❰Sort❱ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally typed ❰:❱ instead of ❰=❱ for a union literal with one \n\ + \ alternative: \n\ + \ \n\ + \ ┌─────────────────┐ \n\ + \ │ < Example : 1 > │ \n\ + \ └─────────────────┘ \n\ + \ ⇧ \n\ + \ This could be ❰=❱ instead \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided a union type with an alternative named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... annotated with the following expression which is not a ❰Type❱, ❰Kind❱, or \n\ + \❰Sort❱: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (AlternativeAnnotationMismatch k0 expr0 c0 k1 expr1 c1) = ErrorMessages {..} + where + short = "Alternative annotation mismatch" + + long = + "Explanation: Every union type annotates each alternative with a ❰Type❱ or a \n\ + \❰Kind❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────┐ \n\ + \ │ < Left : Natural | Right : Bool > │ Every alternative is annotated with a\n\ + \ └───────────────────────────────────┘ ❰Type❱ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────┐ \n\ + \ │ < Foo : Type → Type | Bar : Type > │ Every alternative is annotated with \n\ + \ └────────────────────────────────────┘ a ❰Kind❱ \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ < Baz : Kind > │ Every alternative is annotated with a ❰Sort❱ \n\ + \ └────────────────┘ \n\ + \ \n\ + \ \n\ + \However, you cannot have a union type that mixes ❰Type❱s, ❰Kind❱s, or ❰Sort❱s \n\ + \for the annotations: \n\ + \ \n\ + \ \n\ + \ This is a ❰Type❱ annotation \n\ + \ ⇩ \n\ + \ ┌───────────────────────────────┐ \n\ + \ │ { foo : Natural, bar : Type } │ Invalid union type \n\ + \ └───────────────────────────────┘ \n\ + \ ⇧ \n\ + \ ... but this is a ❰Kind❱ annotation \n\ + \ \n\ + \ \n\ + \You provided a union type with an alternative named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... annotated with the following expression: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is a " <> level c0 <> " whereas another alternative named: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... annotated with the following expression: \n\ + \ \n\ + \" <> txt3 <> "\n\ + \ \n\ + \... is a " <> level c1 <> ", which does not match \n" + where + txt0 = insert k0 + txt1 = insert expr0 + txt2 = insert k1 + txt3 = insert expr1 + + level Type = "❰Type❱" + level Kind = "❰Kind❱" + level Sort = "❰Sort❱" + +prettyTypeMessage (ListAppendMismatch expr0 expr1) = ErrorMessages {..} + where + short = "You can only append ❰List❱s with matching element types\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + long = + "Explanation: You can append two ❰List❱s using the ❰#❱ operator, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ [1, 2, 3] # [4, 5] │ \n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot append two ❰List❱s if they have different element types. \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ These elements have type ❰Natural❱ \n\ + \ ⇩ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ [1, 2, 3] # [True, False] │ Invalid: the element types don't match \n\ + \ └───────────────────────────┘ \n\ + \ ⇧ \n\ + \ These elements have type ❰Bool❱ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to append a ❰List❱ thas has elements of type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... with another ❰List❱ that has elements of type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... and those two types do not match \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (MustCombineARecord c expr0 expr1) = ErrorMessages {..} + where + short = "You can only combine records" + + long = + "Explanation: You can combine records using the ❰" <> op <> "❱ operator, like this:\n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz = True } │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool }) → r " <> op <> " { bar = \"ABC\" } │ \n\ + \ └─────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot combine values that are not records. \n\ + \ \n\ + \For example, the following expressions are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " 1 │ \n\ + \ └──────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz : Bool } │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: This is a record type and not a record\n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } " <> op <> " < baz : Bool > │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: This is a union type and not a record \n\ + \ \n\ + \ \n\ + \You tried to combine the following value: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a record, but is actually a: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + op = pretty c + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CombineTypesRequiresRecordType expr0 expr1) = + ErrorMessages {..} + where + short = "❰⩓❱ requires arguments that are record types" + + long = + "Explanation: You can only use the ❰⩓❱ operator on arguments that are record type\n\ + \literals, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────┐ \n\ + \ │ { age : Natural } ⩓ { name : Text } │ \n\ + \ └─────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot use the ❰⩓❱ operator on any other type of arguments. For \n\ + \example, you cannot use variable arguments: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────┐ \n\ + \ │ λ(t : Type) → t ⩓ { name : Text } │ Invalid: ❰t❱ might not be a record \n\ + \ └───────────────────────────────────┘ type \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to supply the following argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which normalized to: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not a record type literal \n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (RecordTypeMismatch const0 const1 expr0 expr1) = + ErrorMessages {..} + where + short = "Record type mismatch" + + long = + "Explanation: You can only use the ❰⩓❱ operator on record types if they are both \n\ + \ ❰Type❱s or ❰Kind❱s: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────┐ \n\ + \ │ { age : Natural } ⩓ { name : Text } │ Valid: Both arguments are ❰Type❱s \n\ + \ └─────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────┐ \n\ + \ │ { Input : Type } ⩓ { Output : Type } │ Valid: Both arguments are ❰Kind❱s \n\ + \ └──────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot combine a ❰Type❱ and a ❰Kind❱: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────┐ \n\ + \ │ { Input : Type } ⩓ { name : Text } │ Invalid: The arguments do not match \n\ + \ └────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to combine the following record type: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... with this record types: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the former record type is a: \n\ + \ \n\ + \" <> txt2 <> "\n\ + \ \n\ + \... but the latter record type is a: \n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert const0 + txt3 = insert const1 + +prettyTypeMessage (FieldCollision k) = ErrorMessages {..} + where + short = "Field collision" + + long = + "Explanation: You can combine records or record types if they don't share any \n\ + \fields in common, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } ∧ { baz = True } │ \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo : Text } ⩓ { bar : Bool } │ \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────┐ \n\ + \ │ λ(r : { baz : Bool}) → { foo = 1 } ∧ r │ \n\ + \ └────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot merge two records that share the same field unless the field \n\ + \is a record on both sides. \n\ + \ \n\ + \For example, the following expressions are " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = True } │ Invalid: Colliding ❰foo❱ \n\ + \ └───────────────────────────────────────────┘ fields \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo : Bool } ∧ { foo : Text } │ Invalid: Colliding ❰foo❱ fields \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the following expressions are valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────┐ \n\ + \ │ { foo = { bar = True } } ∧ { foo = { baz = 1 } } │ Valid: Both ❰foo❱ \n\ + \ └──────────────────────────────────────────────────┘ fields are records \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────┐ \n\ + \ │ { foo : { bar : Bool } } ⩓ { foo : { baz : Text } } │ Valid: Both ❰foo❱ \n\ + \ └─────────────────────────────────────────────────────┘ fields are records \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You tried to use ❰∧❱ to update a field's value, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = \"ABC\" } ∧ { foo = 2 } │ \n\ + \ └────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid attempt to update ❰foo❱'s value to ❰2❱\n\ + \ \n\ + \ Field updates are intentionally not allowed as the Dhall language discourages \n\ + \ patch-oriented programming \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You combined two records that share the following field: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not allowed \n" + where + txt0 = insert k + +prettyTypeMessage (MustMergeARecord expr0 expr1) = ErrorMessages {..} + where + short = "❰merge❱ expects a record of handlers" + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the first argument to ❰merge❱ must be a record and not some other type. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────────┐ \n\ + \ │ let handler = λ(x : Bool) → x │ \n\ + \ │ in merge handler (< Foo : Bool >.Foo True) : Bool │ \n\ + \ └────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: ❰handler❱ isn't a record \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally provide an empty record type instead of an empty record when \n\ + \ you ❰merge❱ an empty union: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ λ(x : <>) → λ(a : Type) → merge {} x : a │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This should be ❰{=}❱ instead \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided the following handler: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a record, but is actually a value of type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (MustMergeUnion expr0 expr1) = ErrorMessages {..} + where + short = "❰merge❱ expects a union" + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the second argument to ❰merge❱ must be a union and not some other type. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ let handlers = { Foo = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers True : True │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: ❰True❱ isn't a union \n\ + \ \n\ + \ \n\ + \You tried to ❰merge❱ this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a union, but is actually a value of type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (UnusedHandler ks) = ErrorMessages {..} + where + short = "Unused handler" + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you must provide exactly one handler per alternative in the union. You \n\ + \cannot supply extra handlers \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural >.Left 2 │ The ❰Right❱ alternative is \n\ + \ │ let handlers = │ missing \n\ + \ │ { Left = Natural/even │ \n\ + \ │ , Right = λ(x : Bool) → x │ Invalid: ❰Right❱ handler isn't\n\ + \ │ } │ used \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \You provided the following handlers: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which had no matching alternatives in the union you tried to ❰merge❱ \n" + where + txt0 = insert (Text.intercalate ", " (Data.Set.toList ks)) + +prettyTypeMessage (MissingHandler ks) = ErrorMessages {..} + where + short = "Missing handler" + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you must provide exactly one handler per alternative in the union. You \n\ + \cannot omit any handlers \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ Invalid: Missing ❰Right❱ handler \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────────────────────────┐ \n\ + \ │ let handlers = { Left = Natural/even } │ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └──────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Note that you need to provide handlers for other alternatives even if those \n\ + \alternatives are never used \n\ + \ \n\ + \You need to supply the following handlers: \n\ + \ \n\ + \" <> txt0 <> "\n" + where + txt0 = insert (Text.intercalate ", " (Data.Set.toList ks)) + +prettyTypeMessage MissingMergeType = + ErrorMessages {..} + where + short = "An empty ❰merge❱ requires a type annotation" + + long = + "Explanation: A ❰merge❱ does not require a type annotation if the union has at \n\ + \least one alternative, like this \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, you must provide a type annotation when merging an empty union: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────┐ \n\ + \ │ λ(a : <>) → merge {=} a : Bool │ \n\ + \ └────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This can be any type \n\ + \ \n\ + \ \n\ + \You can provide any type at all as the annotation, since merging an empty \n\ + \union can produce any type of output \n" + +prettyTypeMessage (HandlerInputTypeMismatch expr0 expr1 expr2) = + ErrorMessages {..} + where + short = "Wrong handler input type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as the input type of each handler function matches the type of the \n\ + \corresponding alternative: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ union : < Left : Natural | Right : Bool > │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ These must match These must match \n\ + \ ⇩ ⇩ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ Invalid: Doesn't match the type of the ❰Right❱ alternative \n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────────────────────────────┐ \n\ + \ │ let handlers = { Left = Natural/even | Right = λ(x : Text) → x } │ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └──────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Your handler for the following alternative: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... needs to accept an input value of type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but actually accepts an input value of a different type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage (InvalidHandlerOutputType expr0 expr1 expr2) = + ErrorMessages {..} + where + short = "Wrong handler output type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr1 expr2) + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as the output type of each handler function matches the declared \n\ + \type of the result: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ These output types ... \n\ + \ \n\ + \ ... must match the declared type of the ❰merge❱ \n\ + \ ⇩ \n\ + \ ┌─────────────────────────────┐ \n\ + \ │ merge handlers union : Bool │ \n\ + \ └─────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Text │ \n\ + \ └──────────────────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Doesn't match output of either handler\n\ + \ \n\ + \ \n\ + \Your handler for the following alternative: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... needs to return an output value of type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but actually returns an output value of a different type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + txt2 = insert expr2 + +prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) = + ErrorMessages {..} + where + short = "Handlers should have the same output type\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as the output type of each handler function is the same: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────────┐ \n\ + \ │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │ \n\ + \ └───────────────────────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ These output types both match \n\ + \ \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────┐ \n\ + \ │ let Union = < Left : Natural | Right : Bool > │ \n\ + \ │ let handlers = │ \n\ + \ │ { Left = λ(x : Natural) → x │ This outputs ❰Natural❱ \n\ + \ │ , Right = λ(x : Bool ) → x │ This outputs ❰Bool❱ \n\ + \ │ } │ \n\ + \ │ in merge handlers (Union.Left 2) │ \n\ + \ └─────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: The handlers in this record don't have matching outputs\n\ + \ \n\ + \ \n\ + \The handler for the ❰" <> txt0 <> "❱ alternative has this output type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but the handler for the ❰" <> txt2 <> "❱ alternative has this output type instead:\n\ + \ \n\ + \" <> txt3 <> "\n" + where + txt0 = pretty key0 + txt1 = insert expr0 + txt2 = pretty key1 + txt3 = insert expr1 + +prettyTypeMessage (HandlerNotAFunction k expr0) = ErrorMessages {..} + where + short = "Handler is not a function" + + long = + "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\ + \handler per alternative, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────┐ \n\ + \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ + \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\ + \ │ in merge handlers union : Bool │ \n\ + \ └─────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... as long as each handler is a function -- FIXME \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────────────┐ \n\ + \ │ merge { Foo = True } (< Foo : Natural >.Foo 1) : Bool │ \n\ + \ └───────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a function \n\ + \ \n\ + \ \n\ + \Your handler for this alternative: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... has the following type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... which is not the type of a function \n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (MustMapARecord _expr0 _expr1) = ErrorMessages {..} + where + short = "❰toMap❱ expects a record value" + + long = + "Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the argument to ❰toMap❱ must be a record and not some other type. \n" + +prettyTypeMessage (InvalidToMapRecordKind type_ kind) = ErrorMessages {..} + where + short = "❰toMap❱ expects a record of kind ❰Type❱" + + long = + "Explanation: You can apply ❰toMap❱ to any homogenous record of kind ❰Type❱, like\n\ + \ this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but records of kind ❰Kind❱ or ❰Sort❱ cannot be turned into ❰List❱s. \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You applied ❰toMap❱ to a record of the following type: \n\ + \ \n\ + \" <> insert type_ <> "\n\ + \ \n\ + \... which has kind \n\ + \ \n\ + \" <> insert kind <> "\n" + +prettyTypeMessage (HeterogenousRecordToMap _expr0 _expr1 _expr2) = ErrorMessages {..} + where + short = "❰toMap❱ expects a homogenous record" + + long = + "Explanation: You can apply ❰toMap❱ to any homogenous record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but every field of the record must have the same type. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ toMap { Foo = True, Bar = 0 } │ \n\ + \ └─────────────────────────────────────────┘ \n\ + \ ⇧ ⇧ \n\ + \ Bool Natural \n" + +prettyTypeMessage (MapTypeMismatch expr0 expr1) = ErrorMessages {..} + where + short = "❰toMap❱ result type doesn't match annotation" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + long = + "Explanation: a ❰toMap❱ application has been annotated with a type that doesn't \n\ + \match its inferred type. \n" + +prettyTypeMessage (InvalidToMapType expr) = + ErrorMessages {..} + where + short = "An empty ❰toMap❱ was annotated with an invalid type" + <> "\n" + <> insert expr + + long = + "Explanation: A ❰toMap❱ applied to an empty record must have a type annotation: \n\ + \that matches a list of key-value pairs, like this \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ toMap {=} : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \The type you have provided doesn't match the expected form. \n\ + \ \n" + +prettyTypeMessage MissingToMapType = + ErrorMessages {..} + where + short = "An empty ❰toMap❱ requires a type annotation" + + long = + "Explanation: A ❰toMap❱ does not require a type annotation if the record has at \n\ + \least one field, like this \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ let record = { one = 1, two = 2 } │ \n\ + \ │ in toMap record │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, you must provide a type annotation with an empty record: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ + \ │ toMap {=} : List { mapKey : Text, mapValue : Natural} │ \n\ + \ └─────────────────────────────────────────────────────────────────────┘ \n\ + \ \n" + +prettyTypeMessage (CantAccess lazyText0 expr0 expr1) = ErrorMessages {..} + where + short = "Not a record or a union" + + long = + "Explanation: You can only access fields on records or unions, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ + \ └───────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ < foo : Bool | bar : Text >.foo │ ... and so is this \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────┐ \n\ + \ │ λ(r : < foo : Bool | bar : Text >) → r.foo │ ... and so is this \n\ + \ └────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot access fields on non-record expressions \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 1.foo │ \n\ + \ └───────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to access the field: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... on the following expression which is not a record nor a union type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but is actually an expression of type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert lazyText0 + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (CantProject lazyText0 expr0 expr1) = ErrorMessages {..} + where + short = "Not a record" + + long = + "Explanation: You can only project fields on records, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\", baz = 1 }.{ foo, bar } │ This is valid ... \n\ + \ └─────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool, bar : Text , baz : Natural }) → r.{ foo, bar } │ ... and so is this \n\ + \ └────────────────────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot project fields on non-record expressions \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ 1.{ foo, bar } │ \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally try to project fields of a union instead of a record, like \n\ + \ this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────────────┐ \n\ + \ │ < foo : a | bar : b >.{ foo, bar } │ \n\ + \ └────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ This is a union, not a record \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to access the fields: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... on the following expression which is not a record: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but is actually an expression of type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert lazyText0 + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (CantProjectByExpression expr) = ErrorMessages {..} + where + short = "Selector is not a record type" + + long = + "Explanation: You can project by an expression if that expression is a record \n\ + \type: \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True }.({ foo : Bool }) │ This is valid ... \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool }) → r.{ foo : Bool } │ ... and so is this \n\ + \ └──────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot project by any other type of expression: \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ { foo = True }.(True) │ \n\ + \ └───────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: Not a record type \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You accidentally try to project by a record value instead of a record type, \n\ + \ like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ let T = { foo : Bool } │ \n\ + \ │ │ \n\ + \ │ let x = { foo = True , bar = 1} │ \n\ + \ │ │ \n\ + \ │ let y = { foo = False, bar = 2} │ \n\ + \ │ │ \n\ + \ │ in x.(y) │ \n\ + \ └─────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ The user might have meant ❰T❱ here \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to project out the following type: \n\ + \ \n\ + \" <> txt <> "\n\ + \ \n\ + \... which is not a record type \n" + where + txt = insert expr + +prettyTypeMessage (MissingField k expr0) = ErrorMessages {..} + where + short = "Missing record field" + + long = + "Explanation: You can only access fields on records, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\" }.foo │ This is valid ... \n\ + \ └─────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────┐ \n\ + \ │ λ(r : { foo : Bool, bar : Text }) → r.foo │ ... and so is this \n\ + \ └───────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you can only access fields if they are present \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────┐ \n\ + \ │ { foo = True, bar = \"ABC\" }.qux │ \n\ + \ └─────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: the record has no ❰qux❱ field \n\ + \ \n\ + \ \n\ + \You tried to access a field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the field is missing because the record only defines the following \n\ + \fields: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (MissingConstructor k expr0) = ErrorMessages {..} + where + short = "Missing constructor" + + long = + "Explanation: You can access constructors from unions, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ < Foo | Bar >.Foo │ This is valid ... \n\ + \ └───────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you can only access constructors if they match an union alternative of \n\ + \the same name. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────┐ \n\ + \ │ < Foo | Bar >.Baz │ \n\ + \ └───────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: the union has no ❰Baz❱ alternative \n\ + \ \n\ + \ \n\ + \You tried to access a constructor named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... but the constructor is missing because the union only defines the following \n\ + \alternatives: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + +prettyTypeMessage (ProjectionTypeMismatch k expr0 expr1 expr2 expr3) = ErrorMessages {..} + where + short = "Projection type mismatch\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr2 expr3) + + long = + "Explanation: You can project a subset of fields from a record by specifying the \n\ + \desired type of the final record, like this: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = True }.({ foo : Natural }) │ This is valid \n\ + \ └─────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but the expected type for each desired field must match the actual type of \n\ + \the corresponding field in the original record. \n\ + \ \n\ + \For example, the following expression is " <> _NOT <> " valid: \n\ + \ \n\ + \ Invalid: The ❰foo❱ field contains ❰1❱, which has type ❰Natural❱...\n\ + \ ⇩ \n\ + \ ┌──────────────────────────────────────────┐ \n\ + \ │ { foo = 1, bar = True }.({ foo : Text }) │ \n\ + \ └──────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ ... but we requested that the ❰foo❱ field\n\ + \ must contain a value of type ❰Text❱ \n\ + \ \n\ + \ \n\ + \You tried to project out a field named: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... that should have type: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but that field instead had a value of type: \n\ + \ \n\ + \" <> txt2 <> "\n" + where + txt0 = insert k + txt1 = insert expr0 + txt2 = insert expr1 + +prettyTypeMessage (AssertionFailed expr0 expr1) = ErrorMessages {..} + where + short = "Assertion failed\n" + <> "\n" + <> Dhall.Diff.doc (Dhall.Diff.diffNormalized expr0 expr1) + + long = + "Explanation: You can assert at type-checking time that two terms are equal if \n\ + \they have the same normal form, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ assert : 2 + 2 ≡ 4 │ This is valid \n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... and an assertion still succeeds if the normal forms only differ by renaming \n\ + \bound variables, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────────┐ \n\ + \ │ assert : λ(n : Natural) → n + 0 ≡ λ(m : Natural) → m │ This is also valid\n\ + \ └──────────────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \However, an assertion fails if the normal forms differ in any other way. For \n\ + \example, the following assertion is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ assert : 0 ≡ 1 │ Invalid: ❰0❱ does not equal ❰1❱ \n\ + \ └────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have tried to ❰assert❱ a precondition on a function's input, like \n\ + \ this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────────────────────────────────────┐ \n\ + \ │ λ(n : Natural) → let _ = assert : Natural/isZero n ≡ False in n │ \n\ + \ └──────────────────────────────────────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: This assertion will always fail\n\ + \ \n\ + \ \n\ + \ This will not work. Such an assertion is checking all possible inputs to the \n\ + \ function, before you've even used the function at all. \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You tried to assert that this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... is the same as this other expression: \n\ + \ \n\ + \" <> txt1 <> "\n\ + \ \n\ + \... but they differ\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (NotAnEquivalence expr) = ErrorMessages {..} + where + short = "Not an equivalence\n" + + long = + "Explanation: The type annotation for an ❰assert❱ must evaluate to an equivalence\n\ + \of the form ❰x ≡ y❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ assert : 2 + 2 ≡ 4 │ This is valid \n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but any other type is not a valid annotation. For example, the following \n\ + \assertion is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ assert : True │ Invalid: ❰True❱ is not an equivalence \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You tried to supply an expression of type ❰Bool❱ to the assertion, rather than\n\ + \ two separate expressions to compare, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────┐ \n\ + \ │ assert : Natural/isZero 0 │ Invalid: A boolean expression is not the \n\ + \ └───────────────────────────┘ same thing as a type-level equivalence \n\ + \ \n\ + \ \n\ + \ You have to explicitly compare two expressions, even if that just means \n\ + \ comparing the expression to ❰True❱, like this: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ assert : Natural/isZero 0 ≡ True │ Valid: You can assert that two boolean\n\ + \ └──────────────────────────────────┘ expressions are equivalent \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided the following type annotation for an ❰assert❱: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not an equivalence\n" + where + txt0 = insert expr + +prettyTypeMessage (IncomparableExpression expr) = ErrorMessages {..} + where + short = "Incomparable expression\n" + + long = + "Explanation: You can use an ❰assert❱ to compare two terms for equivalence, like \n\ + \this: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────┐ \n\ + \ │ assert : 2 + 2 ≡ 4 │ This is valid because ❰2 + 2❱ and ❰4❱ are both terms\n\ + \ └────────────────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot compare expressions, that are not terms, such as types. For \n\ + \example, the following equivalence is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ assert : Natural ≡ Natural │ Invalid: ❰Natural❱ is a type, not a term \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \You tried to compare the following expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a term\n" + where + txt0 = insert expr + +prettyTypeMessage (EquivalenceTypeMismatch l _L r _R) = ErrorMessages {..} + where + short = "The two sides of the equivalence have different types" + + long = + "Explanation: You can use ❰≡❱ to compare two terms of the same type for \n\ + \equivalence, like this: \n\ + \ \n\ + \ \n\ + \ ┌───────────┐ \n\ + \ │ 2 + 2 ≡ 4 │ This is valid because ❰2 + 2❱ and ❰4❱ have the same type \n\ + \ └───────────┘ \n\ + \ \n\ + \ \n\ + \... but you cannot compare expressions, that have different types. For example,\n\ + \the following assertion is " <> _NOT <> " valid: \n\ + \ \n\ + \ \n\ + \ ┌──────────┐ \n\ + \ │ 1 ≡ True │ Invalid: ❰1❱ has type ❰Natural❱, ❰True❱ has type ❰Bool❱ \n\ + \ └──────────┘ \n\ + \ \n\ + \ \n\ + \You tried to compare the following expressions: \n\ + \ \n\ + \" <> insert l <> "\n\ + \ \n\ + \... which has type\n\ + \ \n\ + \" <> insert _L <> "\n\ + \ \n\ + \... and\n\ + \ \n\ + \" <> insert r <> "\n\ + \ \n\ + \... which has type\n\ + \ \n\ + \" <> insert _R <> "\n" + +prettyTypeMessage (CantAnd expr0 expr1) = + buildBooleanOperator "&&" expr0 expr1 + +prettyTypeMessage (CantOr expr0 expr1) = + buildBooleanOperator "||" expr0 expr1 + +prettyTypeMessage (CantEQ expr0 expr1) = + buildBooleanOperator "==" expr0 expr1 + +prettyTypeMessage (CantNE expr0 expr1) = + buildBooleanOperator "!=" expr0 expr1 + +prettyTypeMessage (CantInterpolate expr0 expr1) = ErrorMessages {..} + where + short = "You can only interpolate ❰Text❱" + + long = + "Explanation: Text interpolation only works on expressions of type ❰Text❱ \n\ + \ \n\ + \For example, these are all valid uses of string interpolation: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────┐ \n\ + \ │ \"ABC${\"DEF\"}GHI\" │ \n\ + \ └──────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────────┐ \n\ + \ │ λ(x : Text) → \"ABC${x}GHI\" │ \n\ + \ └────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────────────────────────────┐ \n\ + \ │ λ(age : Natural) → \"Age: ${Natural/show age}\" │ \n\ + \ └───────────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have thought that string interpolation automatically converts the \n\ + \ interpolated value to a ❰Text❱ representation of that value: \n\ + \ \n\ + \ \n\ + \ ┌──────────────────────────────────┐ \n\ + \ │ λ(age : Natural) → \"Age: ${age}\" │ \n\ + \ └──────────────────────────────────┘ \n\ + \ ⇧ \n\ + \ Invalid: ❰age❱ has type ❰Natural❱ \n\ + \ \n\ + \ \n\ + \● You might have forgotten to escape a string interpolation that you wanted \n\ + \ Dhall to ignore and pass through: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ \"echo ${HOME}\" │ \n\ + \ └────────────────┘ \n\ + \ ⇧ \n\ + \ ❰HOME❱ is not in scope and this might have meant to use ❰\\${HOME}❱\n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You interpolated this expression: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Text❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantTextAppend expr0 expr1) = ErrorMessages {..} + where + short = "❰++❱ only works on ❰Text❱" + + long = + "Explanation: The ❰++❱ operator expects two arguments that have type ❰Text❱ \n\ + \ \n\ + \For example, this is a valid use of ❰++❱: \n\ + \ \n\ + \ \n\ + \ ┌────────────────┐ \n\ + \ │ \"ABC\" ++ \"DEF\" │ \n\ + \ └────────────────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have thought that ❰++❱ was the operator to combine two lists: \n\ + \ \n\ + \ \n\ + \ ┌────────────────────────┐ \n\ + \ │ [1, 2, 3] ++ [4, 5, 6] │ Not valid \n\ + \ └────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ ... but the list concatenation operator is actually ❰#❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ [1, 2, 3] # [4, 5, 6] │ Valid \n\ + \ └───────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Text❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantListAppend expr0 expr1) = ErrorMessages {..} + where + short = "❰#❱ only works on ❰List❱s" + + long = + "Explanation: The ❰#❱ operator expects two arguments that are both ❰List❱s \n\ + \ \n\ + \For example, this is a valid use of ❰#❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────────────┐ \n\ + \ │ [1, 2, 3] # [4, 5, 6] │ \n\ + \ └───────────────────────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which is not a ❰List❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + +prettyTypeMessage (CantAdd expr0 expr1) = + buildNaturalOperator "+" expr0 expr1 + +prettyTypeMessage (CantMultiply expr0 expr1) = + buildNaturalOperator "*" expr0 expr1 + +buildBooleanOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages +buildBooleanOperator operator expr0 expr1 = ErrorMessages {..} + where + short = "❰" <> txt2 <> "❱ only works on ❰Bool❱s" + + long = + "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Bool❱\n\ + \ \n\ + \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ + \ \n\ + \ \n\ + \ ┌───────────────┐ \n\ + \ │ True " <> txt2 <> " False │ \n\ + \ └───────────────┘ \n\ + \ \n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Bool❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + + txt2 = pretty operator + +buildNaturalOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages +buildNaturalOperator operator expr0 expr1 = ErrorMessages {..} + where + short = "❰" <> txt2 <> "❱ only works on ❰Natural❱s" + + long = + "Explanation: The ❰" <> txt2 <> "❱ operator expects two arguments that have type ❰Natural❱\n\ + \ \n\ + \For example, this is a valid use of ❰" <> txt2 <> "❱: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 3 " <> txt2 <> " 5 │ \n\ + \ └───────┘ \n\ + \ \n\ + \ \n\ + \Some common reasons why you might get this error: \n\ + \ \n\ + \● You might have tried to use an ❰Integer❱, which is " <> _NOT <> " allowed: \n\ + \ \n\ + \ \n\ + \ ┌─────────────────────────────────────────┐ \n\ + \ │ λ(x : Integer) → λ(y : Integer) → x " <> txt2 <> " y │ Not valid \n\ + \ └─────────────────────────────────────────┘ \n\ + \ \n\ + \ \n\ + \ You can only use ❰Natural❱ numbers \n\ + \ \n\ + \ \n\ + \● You might have mistakenly used an ❰Integer❱ literal, which is " <> _NOT <> " allowed:\n\ + \ \n\ + \ \n\ + \ ┌─────────┐ \n\ + \ │ +2 " <> txt2 <> " +2 │ Not valid \n\ + \ └─────────┘ \n\ + \ \n\ + \ \n\ + \ You need to remove the leading ❰+❱ to transform them into ❰Natural❱ literals, \n\ + \ like this: \n\ + \ \n\ + \ \n\ + \ ┌───────┐ \n\ + \ │ 2 " <> txt2 <> " 2 │ Valid \n\ + \ └───────┘ \n\ + \ \n\ + \ \n\ + \────────────────────────────────────────────────────────────────────────────────\n\ + \ \n\ + \You provided this argument: \n\ + \ \n\ + \" <> txt0 <> "\n\ + \ \n\ + \... which does not have type ❰Natural❱ but instead has type: \n\ + \ \n\ + \" <> txt1 <> "\n" + where + txt0 = insert expr0 + txt1 = insert expr1 + + txt2 = pretty operator + +-- | A structured type error that includes context +data TypeError s a = TypeError + { context :: Context (Expr s a) + , current :: Expr s a + , typeMessage :: TypeMessage s a + } + +instance (Eq a, Pretty s, Pretty a, ToTerm a) => Show (TypeError s a) where + show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty + +instance (Eq a, Pretty s, Pretty a, ToTerm a, Typeable s, Typeable a) => Exception (TypeError s a) + +instance (Eq a, Pretty s, Pretty a, ToTerm a) => Pretty (TypeError s a) where + pretty (TypeError ctx expr msg) + = Pretty.unAnnotate + ( "\n" + <> ( if null (Dhall.Context.toList ctx) + then "" + else prettyContext ctx <> "\n\n" + ) + <> shortTypeMessage msg <> "\n" + <> source + ) + where + prettyKV (key, val) = + pretty key <> " : " <> Dhall.Util.snipDoc (pretty val) + + prettyContext = + Pretty.vsep + . map prettyKV + . reverse + . Dhall.Context.toList + + source = case expr of + Note s _ -> pretty s + _ -> mempty + +{-| Wrap a type error in this exception type to censor source code and + `Text` literals from the error message +-} +data Censored + = CensoredDetailed (DetailedTypeError Src X) + | Censored (TypeError Src X) + +instance Show Censored where + show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty + +instance Exception Censored + +instance Pretty Censored where + pretty (CensoredDetailed (DetailedTypeError e)) = + pretty (DetailedTypeError (censorTypeError e)) + pretty (Censored e) = pretty (censorTypeError e) + +censorTypeError :: TypeError Src a -> TypeError Src a +censorTypeError (TypeError c e m) = TypeError c' e' m' + where + c' = fmap Dhall.Core.censorExpression c + + e' = Dhall.Core.censorExpression e + + m' = over messageExpressions Dhall.Core.censorExpression m + +-- | @Traversal@ that traverses every `Expr` in a `TypeMessage` +messageExpressions + :: Applicative f + => (Expr s a -> f (Expr t b)) -> TypeMessage s a -> f (TypeMessage t b) +messageExpressions f m = case m of + UnboundVariable a -> + UnboundVariable <$> pure a + InvalidInputType a -> + InvalidInputType <$> f a + InvalidOutputType a -> + InvalidOutputType <$> f a + NotAFunction a b -> + NotAFunction <$> f a <*> f b + TypeMismatch a b c d -> + TypeMismatch <$> f a <*> f b <*> f c <*> f d + AnnotMismatch a b c -> + AnnotMismatch <$> f a <*> f b <*> f c + Untyped -> + pure Untyped + MissingListType -> + pure MissingListType + MismatchedListElements a b c d -> + MismatchedListElements <$> pure a <*> f b <*> f c <*> f d + InvalidListElement a b c d -> + InvalidListElement <$> pure a <*> f b <*> f c <*> f d + InvalidListType a -> + InvalidListType <$> f a + InvalidSome a b c -> + InvalidSome <$> f a <*> f b <*> f c + InvalidPredicate a b -> + InvalidPredicate <$> f a <*> f b + IfBranchMismatch a b c d -> + IfBranchMismatch <$> f a <*> f b <*> f c <*> f d + IfBranchMustBeTerm a b c d -> + IfBranchMustBeTerm <$> pure a <*> f b <*> f c <*> f d + InvalidFieldType a b -> + InvalidFieldType <$> pure a <*> f b + InvalidAlternativeType a b -> + InvalidAlternativeType <$> pure a <*> f b + AlternativeAnnotationMismatch a b c d e g -> + AlternativeAnnotationMismatch <$> pure a <*> f b <*> pure c <*> pure d <*> f e <*> pure g + ListAppendMismatch a b -> + ListAppendMismatch <$> f a <*> f b + MustCombineARecord a b c -> + MustCombineARecord <$> pure a <*> f b <*> f c + CombineTypesRequiresRecordType a b -> + CombineTypesRequiresRecordType <$> f a <*> f b + RecordTypeMismatch a b c d -> + RecordTypeMismatch <$> pure a <*> pure b <*> f c <*> f d + FieldCollision a -> + FieldCollision <$> pure a + MustMergeARecord a b -> + MustMergeARecord <$> f a <*> f b + MustMergeUnion a b -> + MustMergeUnion <$> f a <*> f b + MustMapARecord a b -> + MustMapARecord <$> f a <*> f b + InvalidToMapRecordKind a b -> + InvalidToMapRecordKind <$> f a <*> f b + HeterogenousRecordToMap a b c -> + HeterogenousRecordToMap <$> f a <*> f b <*> f c + InvalidToMapType a -> + InvalidToMapType <$> f a + MapTypeMismatch a b -> + MapTypeMismatch <$> f a <*> f b + MissingToMapType -> + pure MissingToMapType + UnusedHandler a -> + UnusedHandler <$> pure a + MissingHandler a -> + MissingHandler <$> pure a + HandlerInputTypeMismatch a b c -> + HandlerInputTypeMismatch <$> pure a <*> f b <*> f c + HandlerOutputTypeMismatch a b c d -> + HandlerOutputTypeMismatch <$> pure a <*> f b <*> pure c <*> f d + InvalidHandlerOutputType a b c -> + InvalidHandlerOutputType <$> pure a <*> f b <*> f c + MissingMergeType -> + pure MissingMergeType + HandlerNotAFunction a b -> + HandlerNotAFunction <$> pure a <*> f b + CantAccess a b c -> + CantAccess <$> pure a <*> f b <*> f c + CantProject a b c -> + CantProject <$> pure a <*> f b <*> f c + CantProjectByExpression a -> + CantProjectByExpression <$> f a + MissingField a b -> + MissingField <$> pure a <*> f b + MissingConstructor a b -> + MissingConstructor <$> pure a <*> f b + ProjectionTypeMismatch a b c d e -> + ProjectionTypeMismatch <$> pure a <*> f b <*> f c <*> f d <*> f e + AssertionFailed a b -> + AssertionFailed <$> f a <*> f b + NotAnEquivalence a -> + NotAnEquivalence <$> f a + IncomparableExpression a -> + IncomparableExpression <$> f a + EquivalenceTypeMismatch a b c d -> + EquivalenceTypeMismatch <$> f a <*> f b <*> f c <*> f d + CantAnd a b -> + CantAnd <$> f a <*> f b + CantOr a b -> + CantOr <$> f a <*> f b + CantEQ a b -> + CantEQ <$> f a <*> f b + CantNE a b -> + CantNE <$> f a <*> f b + CantInterpolate a b -> + CantInterpolate <$> f a <*> f b + CantTextAppend a b -> + CantTextAppend <$> f a <*> f b + CantListAppend a b -> + CantListAppend <$> f a <*> f b + CantAdd a b -> + CantAdd <$> f a <*> f b + CantMultiply a b -> + CantMultiply <$> f a <*> f b {-| Newtype used to wrap error messages so that they render with a more detailed explanation of what went wrong diff --git a/src/Dhall/URL.hs b/src/Dhall/URL.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/URL.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Dhall.URL where + +import Data.Monoid ((<>)) +import Data.Text (Text) + +import Dhall.Core + ( Scheme(..) + , URL(..) + , File(..) + , Directory(..) + ) + +import qualified Network.URI.Encode as URI.Encode + +renderComponent :: Text -> Text +renderComponent component = "/" <> URI.Encode.encodeText component + +renderQuery :: Text -> Text +renderQuery query = "?" <> query + +renderURL :: URL -> Text +renderURL url = + schemeText + <> authority + <> pathText + <> queryText + where + URL {..} = url + + File {..} = path + + Directory {..} = directory + + schemeText = case scheme of + HTTP -> "http://" + HTTPS -> "https://" + + pathText = + foldMap renderComponent (reverse components) + <> renderComponent file + + queryText = foldMap renderQuery query diff --git a/src/Dhall/Util.hs b/src/Dhall/Util.hs --- a/src/Dhall/Util.hs +++ b/src/Dhall/Util.hs @@ -7,17 +7,28 @@ , snipDoc , insert , _ERROR + , Censor(..) + , Input(..) + , getExpression + , getExpressionAndHeader ) where +import Data.Bifunctor (first) import Data.Monoid ((<>)) import Data.String (IsString) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty) +import Dhall.Core (Expr, Import) +import Dhall.Parser (ParseError) import Dhall.Pretty (Ann) +import Dhall.Src (Src) import qualified Data.Text +import qualified Data.Text.IO import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty +import qualified Dhall.Core +import qualified Dhall.Parser import qualified Dhall.Pretty -- | Utility function to cut out the interior of a large text block @@ -81,3 +92,38 @@ -- | Prefix used for error messages _ERROR :: IsString string => string _ERROR = "\ESC[1;31mError\ESC[0m" + +get :: (String -> Text -> Either ParseError a) -> Censor -> Input -> IO a +get parser censor input = do + inText <- do + case input of + File file -> Data.Text.IO.readFile file + StandardInput -> Data.Text.IO.getContents + + let name = + case input of + File file -> file + StandardInput -> "(stdin)" + + let result = parser name inText + + let censoredResult = + case censor of + NoCensor -> result + Censor -> first Dhall.Parser.censor result + + Dhall.Core.throws censoredResult + +-- | Set to `Censor` if you want to censor error text that might include secrets +data Censor = NoCensor | Censor + +-- | Path to input +data Input = StandardInput | File FilePath + +-- | Convenient utility for retrieving an expression +getExpression :: Censor -> Input -> IO (Expr Src Import) +getExpression = get Dhall.Parser.exprFromText + +-- | Convenient utility for retrieving an expression along with its header +getExpressionAndHeader :: Censor -> Input -> IO (Text, Expr Src Import) +getExpressionAndHeader = get Dhall.Parser.exprAndHeaderFromText diff --git a/src/Dhall/Version.hs b/src/Dhall/Version.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Version.hs @@ -0,0 +1,12 @@ +module Dhall.Version ( dhallVersion + , dhallVersionString + ) where + +import qualified Data.Version as V +import qualified Paths_dhall as P + +dhallVersion :: V.Version +dhallVersion = P.version + +dhallVersionString :: String +dhallVersionString = V.showVersion dhallVersion diff --git a/tests/Dhall/Test/Dhall.hs b/tests/Dhall/Test/Dhall.hs --- a/tests/Dhall/Test/Dhall.hs +++ b/tests/Dhall/Test/Dhall.hs @@ -161,9 +161,17 @@ data Enum = E0 | E1 | E2 deriving (Eq, Generic, Inject, Interpret, Show) -data Mixed = M0 Bool | M1 | M2 () +data Records + = R0 {} + | R1 { a :: () } + | R2 { x :: Double } + | R3 { a :: (), b :: () } + | R4 { x :: Double, y :: Double } deriving (Eq, Generic, Inject, Interpret, Show) +data Products = P0 | P1 () | P2 Double | P3 () () | P4 Double Double + deriving (Eq, Generic, Inject, Interpret, Show) + deriving instance Interpret () shouldHandleUnionsCorrectly :: TestTree @@ -173,27 +181,81 @@ `shouldPassThrough` [ N0 True, N1 5, N2 "ABC" ] , "λ(x : < E0 | E1 | E2 >) → x" `shouldPassThrough` [ E0, E1, E2 ] - , "λ(x : < M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >) → x" - `shouldPassThrough` [ M0 True, M1, M2 () ] + , "λ(x : < R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >) → x" + `shouldPassThrough` [ R0 {}, R1 { a = () }, R2 { x = 1.0 }, R3 { a = (), b = () }, R4 { x = 1.0, y = 2.0 } ] + , "λ(x : < P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >) → x" + `shouldPassThrough` [ P0 , P1 (), P2 1.0, P3 () (), P4 1.0 2.0 ] + , "λ(x : < N0 : Bool | N1 : Natural | N2 : Text >) → x" + `shouldPassThroughSmart` [ N0 True, N1 5, N2 "ABC" ] + , "λ(x : < R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >) → x" + `shouldPassThroughSmart` [ R0 {}, R1 { a = () }, R2 { x = 1.0 }, R3 { a = (), b = () }, R4 { x = 1.0, y = 2.0 } ] + , "λ(x : < P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >) → x" + `shouldPassThroughSmart` [ P0 , P1 (), P2 1.0, P3 () (), P4 1.0 2.0 ] + , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }" `shouldMarshalInto` N0 True , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }" `shouldMarshalInto` N1 5 , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }" + `shouldMarshalInto` N2 "ABC" + , "(< N0 : Bool | N1 : Natural | N2 : Text >).N0 True" + `shouldMarshalIntoSmart` N0 True + , "(< N0 : Bool | N1 : Natural | N2 : Text >).N1 5" + `shouldMarshalIntoSmart` N1 5 + , "(< N0 : Bool | N1 : Natural | N2 : Text >).N2 \"ABC\"" + `shouldMarshalIntoSmart` N2 "ABC" + , "(< E0 | E1 | E2>).E0" `shouldMarshalInto` E0 , "(< E0 | E1 | E2>).E1" `shouldMarshalInto` E1 , "(< E0 | E1 | E2>).E2" `shouldMarshalInto` E2 - , "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M0 { _1 = True }" - `shouldMarshalInto` M0 True - , "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M1" - `shouldMarshalInto` M1 - , "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M2 { _1 = {=} }" - `shouldMarshalInto` M2 () + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + `shouldMarshalInto` R0 + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + `shouldMarshalInto` R1 { a = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0 }" + `shouldMarshalInto` R2 { x = 1.0 } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + `shouldMarshalInto` R3 { a = (), b = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + `shouldMarshalInto` R4 { x = 1.0, y = 2.0 } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + `shouldMarshalIntoSmart` R0 + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + `shouldMarshalIntoSmart` R1 { a = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0 }" + `shouldMarshalIntoSmart` R2 { x = 1.0 } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + `shouldMarshalIntoSmart` R3 { a = (), b = () } + , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + `shouldMarshalIntoSmart` R4 { x = 1.0, y = 2.0 } + + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + `shouldMarshalInto` P0 + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }" + `shouldMarshalInto` P1 () + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }" + `shouldMarshalInto` P2 1.0 + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + `shouldMarshalInto` P3 () () + , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + `shouldMarshalInto` P4 1.0 2.0 + + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + `shouldMarshalIntoSmart` P0 + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1" + `shouldMarshalIntoSmart` P1 () + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 1.0" + `shouldMarshalIntoSmart` P2 1.0 + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + `shouldMarshalIntoSmart` P3 () () + , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + `shouldMarshalIntoSmart` P4 1.0 2.0 + , N0 True `shouldInjectInto` "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }" @@ -204,30 +266,82 @@ `shouldInjectInto` "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }" + , N0 True + `shouldInjectIntoSmart` + "(< N0 : Bool | N1 : Natural | N2 : Text >).N0 True" + , N1 5 + `shouldInjectIntoSmart` + "(< N0 : Bool | N1 : Natural | N2 : Text >).N1 5" + , N2 "ABC" + `shouldInjectIntoSmart` + "(< N0 : Bool | N1 : Natural | N2 : Text >).N2 \"ABC\"" + , E0 `shouldInjectInto` "< E0 | E1 | E2 >.E0" , E1 `shouldInjectInto` "< E0 | E1 | E2 >.E1" , E2 `shouldInjectInto` "< E0 | E1 | E2 >.E2" - , M0 True `shouldInjectInto` "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M0 { _1 = True }" - , M1 `shouldInjectInto` "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M1" - , M2 () `shouldInjectInto` "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M2 { _1 = {=} }" + , R0 `shouldInjectInto` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + , R1 { a = () } `shouldInjectInto` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + , R2 { x = 1.0 } `shouldInjectInto` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0}" + , R3 { a = (), b = () } `shouldInjectInto` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + , R4 { x = 1.0, y = 2.0 } `shouldInjectInto` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + + , R0 `shouldInjectIntoSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" + , R1 { a = () } `shouldInjectIntoSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }" + , R2 { x = 1.0 } `shouldInjectIntoSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0}" + , R3 { a = (), b = () } `shouldInjectIntoSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" + , R4 { x = 1.0, y = 2.0 } `shouldInjectIntoSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" + + , P0 `shouldInjectInto` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + , P1 () `shouldInjectInto` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }" + , P2 1.0 `shouldInjectInto` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }" + , P3 () () `shouldInjectInto` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + , P4 1.0 2.0 `shouldInjectInto` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" + + , P0 `shouldInjectIntoSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" + , P1 () `shouldInjectIntoSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1" + , P2 1.0 `shouldInjectIntoSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 1.0" + , P3 () () `shouldInjectIntoSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }" + , P4 1.0 2.0 `shouldInjectIntoSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" ] where + smartOptions = + Dhall.defaultInterpretOptions + { Dhall.singletonConstructors = Dhall.Smart } + code `shouldPassThrough` values = testCase "Pass through" $ do f <- Dhall.input Dhall.auto code values @=? map f values + code `shouldPassThroughSmart` values = testCase "Pass through" $ do + f <- Dhall.input (Dhall.autoWith smartOptions) code + + values @=? map f values + code `shouldMarshalInto` expectedValue = testCase "Marshal" $ do actualValue <- Dhall.input Dhall.auto code + expectedValue @=? actualValue + code `shouldMarshalIntoSmart` expectedValue = testCase "Marshal" $ do + actualValue <- Dhall.input (Dhall.autoWith smartOptions) code + + expectedValue @=? actualValue + value `shouldInjectInto` expectedCode = testCase "Inject" $ do parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode) resolvedExpression <- Dhall.Import.assertNoImports parsedExpression Dhall.Core.denote resolvedExpression @=? Dhall.embed Dhall.inject value + + value `shouldInjectIntoSmart` expectedCode = testCase "Inject" $ do + parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode) + + resolvedExpression <- Dhall.Import.assertNoImports parsedExpression + + Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.injectWith smartOptions) value shouldConvertDhallToHaskellCorrectly :: TestTree shouldConvertDhallToHaskellCorrectly = 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 @@ -14,7 +14,6 @@ import qualified Dhall.Test.QuickCheck import qualified Dhall.Test.Regression import qualified Dhall.Test.Tutorial -import qualified Dhall.Test.TypeCheck import qualified Dhall.Test.TypeInference import qualified GHC.IO.Encoding import qualified System.Directory @@ -30,8 +29,6 @@ formattingTests <- Dhall.Test.Format.getTests - typecheckingTests <- Dhall.Test.TypeCheck.getTests - typeinferenceTests <- Dhall.Test.TypeInference.getTests importingTests <- Dhall.Test.Import.getTests @@ -47,7 +44,6 @@ [ normalizationTests , parsingTests , importingTests - , typecheckingTests , typeinferenceTests , formattingTests , lintTests diff --git a/tests/Dhall/Test/TypeCheck.hs b/tests/Dhall/Test/TypeCheck.hs deleted file mode 100644 --- a/tests/Dhall/Test/TypeCheck.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Dhall.Test.TypeCheck where - -import Control.Exception (SomeException) -import Data.Monoid (mempty, (<>)) -import Data.Text (Text) -import Prelude hiding (FilePath) -import Test.Tasty (TestTree) -import Turtle (FilePath, ()) - -import qualified Control.Exception as Exception -import qualified Data.Text as Text -import qualified Dhall.Core as Core -import qualified Dhall.Parser as Parser -import qualified Dhall.Test.Util as Test.Util -import qualified Dhall.TypeCheck as TypeCheck -import qualified Test.Tasty as Tasty -import qualified Test.Tasty.HUnit as Tasty.HUnit -import qualified Turtle - -typecheckDirectory :: FilePath -typecheckDirectory = "./dhall-lang/tests/typecheck" - -getTests :: IO TestTree -getTests = do - let successTestFiles = Turtle.lstree (typecheckDirectory "success") - - successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest successTestFiles - - let failureTestFiles = Turtle.lstree (typecheckDirectory "failure") - - failureTests <- Test.Util.discover (Turtle.chars <> ".dhall") failureTest failureTestFiles - - let testTree = Tasty.testGroup "typecheck tests" - [ successTests - , failureTests - ] - - return testTree - -successTest :: Text -> TestTree -successTest prefix = do - let skip = [] - - Test.Util.testCase prefix skip $ do - let actualCode = Test.Util.toDhallPath (prefix <> "A.dhall") - let expectedCode = Test.Util.toDhallPath (prefix <> "B.dhall") - - actualExpr <- Core.throws (Parser.exprFromText mempty actualCode ) - expectedExpr <- Core.throws (Parser.exprFromText mempty expectedCode) - - let annotatedExpr = Core.Annot actualExpr expectedExpr - - tryResolvedExpr <- Exception.try (Test.Util.load annotatedExpr) - - resolvedExpr <- case tryResolvedExpr of - Left exception -> Tasty.HUnit.assertFailure (show (exception :: SomeException)) - Right resolvedExpr -> return resolvedExpr - - case TypeCheck.typeOf resolvedExpr of - Left exception -> Tasty.HUnit.assertFailure (show exception) - Right _ -> return () -{- - _ <- Core.throws (TypeCheck.typeOf resolvedExpr) --} - - return () - -failureTest :: Text -> TestTree -failureTest path = do - let skip = [ typecheckDirectory "failure/unit/MergeEmptyNeedsDirectAnnotation1.dhall" - ] - - Test.Util.testCase path skip $ do - let dhallPath = Test.Util.toDhallPath path - - expression <- Core.throws (Parser.exprFromText mempty dhallPath) - - let io :: IO Bool - io = do - _ <- Test.Util.load expression - return True - - let handler :: SomeException -> IO Bool - handler _ = return False - - typeChecked <- Exception.handle handler io - - if typeChecked - then Tasty.HUnit.assertFailure (Text.unpack path <> " should not have type-checked") - else return () diff --git a/tests/Dhall/Test/TypeInference.hs b/tests/Dhall/Test/TypeInference.hs --- a/tests/Dhall/Test/TypeInference.hs +++ b/tests/Dhall/Test/TypeInference.hs @@ -2,12 +2,14 @@ module Dhall.Test.TypeInference where +import Control.Exception (SomeException(..)) import Data.Monoid (mempty, (<>)) import Data.Text (Text) import Prelude hiding (FilePath) import Test.Tasty (TestTree) import Turtle (FilePath, ()) +import qualified Control.Exception as Exception import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import qualified Dhall.Core as Core @@ -15,6 +17,7 @@ import qualified Dhall.Parser as Parser import qualified Dhall.Test.Util as Test.Util import qualified Dhall.TypeCheck as TypeCheck +import qualified System.FilePath as FilePath import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as Tasty.HUnit import qualified Turtle @@ -28,8 +31,13 @@ successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest successTestFiles + let failureTestFiles = Turtle.lstree (typeInferenceDirectory "failure") + + failureTests <- Test.Util.discover (Turtle.chars <* ".dhall") failureTest failureTestFiles + let testTree = Tasty.testGroup "type-inference tests" [ successTests + , failureTests ] return testTree @@ -44,21 +52,68 @@ ] Test.Util.testCase prefix skip $ do - value <- expr "A.dhall" + let prefixFP = Text.unpack prefix - expectedType <- expr "B.dhall" + actualCode <- Text.IO.readFile (prefixFP <> "A.dhall") - inferredType <- case TypeCheck.typeOf value of + actualExpr <- Core.throws (Parser.exprFromText mempty actualCode) + + tryResolvedExpr <- + Exception.try + (Test.Util.loadRelativeTo + (FilePath.takeDirectory prefixFP) + Import.IgnoreSemanticCache + (Core.denote actualExpr)) + + resolvedExpr <- case tryResolvedExpr of + Left exception -> Tasty.HUnit.assertFailure (show (exception :: SomeException)) + Right resolvedExpr -> return resolvedExpr + + expectedTypeCode <- Text.IO.readFile (prefixFP <> "B.dhall") + + expectedType <- Core.throws (Parser.exprFromText mempty expectedTypeCode) + + resolvedExpectedType <- Import.assertNoImports (Core.denote expectedType) + + inferredType <- case TypeCheck.typeOf resolvedExpr of Left exception -> Tasty.HUnit.assertFailure (show exception) Right inferredType -> return inferredType let message = "The inferred type did not match the expected type" - Tasty.HUnit.assertEqual message expectedType inferredType - where - expr suffix = do - code <- Text.IO.readFile (Text.unpack prefix <> suffix) + Tasty.HUnit.assertEqual message resolvedExpectedType inferredType - e <- Core.throws (Parser.exprFromText mempty code) +failureTest :: Text -> TestTree +failureTest prefix = do + let skip = [ typeInferenceDirectory "failure/unit/MergeEmptyNeedsDirectAnnotation1" - Import.assertNoImports (Core.denote e) + -- Duplicate fields are incorrectly caught during parsing: + -- https://github.com/dhall-lang/dhall-haskell/issues/772 + , typeInferenceDirectory "failure/unit/RecordLitDuplicateFields" + , typeInferenceDirectory "failure/unit/RecordTypeDuplicateFields" + , typeInferenceDirectory "failure/unit/UnionTypeDuplicateVariants1" + , typeInferenceDirectory "failure/unit/UnionTypeDuplicateVariants2" + ] + + Test.Util.testCase prefix skip $ do + let prefixFP = Text.unpack prefix + + code <- Text.IO.readFile (prefixFP <> ".dhall") + + expression <- case Parser.exprFromText mempty code of + Left _ -> Tasty.HUnit.assertFailure (prefixFP <> " should have parsed") + Right e -> return e + + tryResolvedExpr <- + Exception.try + (Test.Util.loadRelativeTo + (FilePath.takeDirectory prefixFP) + Import.IgnoreSemanticCache + expression) + + case tryResolvedExpr of + Left (SomeException _) -> return () + + Right resolved -> case TypeCheck.typeOf resolved of + Left _ -> return () + Right _ -> Tasty.HUnit.assertFailure (prefixFP <> " should not have type-checked") diff --git a/tests/Dhall/Test/Util.hs b/tests/Dhall/Test/Util.hs --- a/tests/Dhall/Test/Util.hs +++ b/tests/Dhall/Test/Util.hs @@ -7,6 +7,7 @@ , codeWith , equivalent , load + , loadRelativeTo , loadWith , normalize' , normalizeWith' @@ -25,7 +26,7 @@ import Data.Text (Text) import Dhall.Context (Context) import Dhall.Core (Expr, Normalizer, ReifiedNormalizer(..), Import) -import Dhall.Import (Status) +import Dhall.Import (Status(..), SemanticCacheMode(..)) import Data.Monoid((<>)) import Dhall.Parser (Src) import Dhall.TypeCheck (X) @@ -44,6 +45,7 @@ import qualified Dhall.Parser import qualified Dhall.TypeCheck import qualified Control.Monad.Trans.State.Strict as State +import qualified System.FilePath as FilePath import qualified Test.Tasty as Tasty import qualified Test.Tasty.ExpectedFailure as Tasty.ExpectedFailure import qualified Turtle @@ -80,8 +82,13 @@ return expr1 load :: Expr Src Import -> IO (Expr Src X) -load expression = - State.evalStateT (loadWith expression) (Dhall.Import.emptyStatus ".") +load = loadRelativeTo "." UseSemanticCache + +loadRelativeTo :: FilePath.FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X) +loadRelativeTo rootDirectory semanticCacheMode expression = + State.evalStateT + (loadWith expression) + (Dhall.Import.emptyStatus rootDirectory) { _semanticCacheMode = semanticCacheMode } #ifdef WITH_HTTP loadWith :: Expr Src Import -> StateT Status IO (Expr Src X) diff --git a/tests/format/largeRecordA.dhall b/tests/format/largeRecordA.dhall new file mode 100644 --- /dev/null +++ b/tests/format/largeRecordA.dhall @@ -0,0 +1,143 @@ +-- This file was tested using console NetHack version 3.6.1 +-- +-- To exercise all options documented in https://nethackwiki.com/wiki/Options +-- see `./unvalidated.dhall` + +let types = ./../types.dhall + +let defaults = ./../defaults.dhall + +in defaults.Config + ⫽ { AUTOCOMPLETE = + [ { enable = True, value = "zap" } + , { enable = False, value = "annotate" } + ] + , acoustics = Some True + , align = Some { enable = True, value = types.Alignment.chaotic } + , autodescribe = Some False + , autodig = Some False + , AUTOPICKUP_EXCEPTION = + [ { pickup = False, name = "chest" } + , { pickup = True, name = "dagger" } + ] + , BIND = + [ { keybinding = "!", command = "loot" } + , { keybinding = "^v", command = "untrap" } + , { keybinding = "M-x", command = "terrain" } + ] + , catname = Some "Mirri" + , checkpoint = Some True + , checkspace = Some True + , clicklook = Some False + , cmdassist = Some True + , confirm = Some True + , dark_room = Some False + , disclose = + Some + ( defaults.Disclose + ⫽ { inventory = Some { prompt = True, default = True } + , attributes = Some { prompt = True, default = False } + , monsters_killed = Some { prompt = False, default = True } + , monsters_genocided = Some { prompt = False, default = False } + , conduct = Some { prompt = False, default = False } + , dungeon_overview = Some { prompt = False, default = False } + } + ) + , dogname = Some "Cujo" + , extmenu = Some False + , fixinv = Some True + , force_invmenu = Some False + , fruit = Some "slime mold" + , gender = Some types.Gender.female + , goldX = Some False + , help = Some True + , hilite_pet = Some False + , hilite_pile = Some False + , hilite_status = + defaults.HiliteStatus + ⫽ { gold = + [ { color = types.Color.yellow + , trigger = Some types.Numeric.always + , attributes = None types.Attributes + } + ] + } + , hitpointbar = Some True + , horsename = Some "Erhir" + , ignintr = Some False + , implicit_uncursed = Some True + , legacy = Some True + , lit_corridor = Some False + , lootabc = Some False + , mail = Some True + , mention_walls = Some False + , menucolors = + [ { regex = "blessed" + , color = Some types.Color.cyan + , attributes = defaults.Attributes ⫽ { bold = Some True } + } + ] + , menustyle = Some types.MenuStyle.traditional + , menu_deselect_all = Some "-" + , menu_deselect_page = Some "\\" + , menu_first_page = Some "^" + , menu_headings = Some types.MenuHeadings.bold + , menu_invert_all = Some "@" + , menu_invert_page = Some "~" + , menu_last_page = Some "|" + , menu_next_page = Some ">" + , menu_objsyms = Some False + , menu_previous_page = Some "<" + , menu_search = Some ":" + , menu_select_all = Some "." + , menu_tab_sep = Some False + , msg_window = Some types.MsgWindow.single + , MSGTYPE = [ types.MsgType.hide "You swap places with .*" ] + , name = Some "Kaeru" + , news = Some True + , nudist = Some False + , null = Some False + , number_pad = Some types.NumberPad.Letters + , packorder = Some "\")[%?+!=/(*`0_" + , paranoid_confirmation = + defaults.ParanoidConfirmation ⫽ { pray = Some True } + , pettype = Some types.PetType.cat + , pickup_burden = Some types.PickupBurden.stressed + , pickup_thrown = Some True + , pickup_types = Some "?!/" + , pile_limit = Some (types.PileLimit.limit 5) + , playmode = Some types.PlayMode.normal + , pushweapon = Some False + , race = Some { enable = True, value = types.Race.elf } + , rest_on_space = Some False + , role = Some { enable = True, value = types.Role.wizard } + , roguesymset = Some types.SymSet.RogueEpyx + , runmode = Some types.RunMode.walk + , safe_pet = Some True + , sanity_check = Some False + , scores = { own = Some True, around = Some 2, top = Some 10 } + , showexp = Some False + , showrace = Some False + , showscore = Some False + , silent = Some True + , sortloot = Some types.SortLoot.none + , sortpack = Some True + , sparkle = Some True + , standout = Some False + , status_updates = Some True + , statushilites = Some 10 + , suppress_alert = Some "3.3.1" + , symset = Some types.SymSet.DECgraphics + , time = Some False + , timed_delay = Some True + , tombstone = Some True + , toptenwin = Some False + , travel = Some True + , verbose = Some True + , whatis_coord = Some types.WhatisCoord.none + , whatis_filter = Some types.WhatisFilter.no_filtering + , whatis_menu = Some False + , whatis_moveskip = Some False + , windowtype = Some "tty" + , wizkit = Some "wizkit.txt" + } diff --git a/tests/format/largeRecordB.dhall b/tests/format/largeRecordB.dhall new file mode 100644 --- /dev/null +++ b/tests/format/largeRecordB.dhall @@ -0,0 +1,143 @@ +-- This file was tested using console NetHack version 3.6.1 +-- +-- To exercise all options documented in https://nethackwiki.com/wiki/Options +-- see `./unvalidated.dhall` + +let types = ./../types.dhall + +let defaults = ./../defaults.dhall + +in defaults.Config + ⫽ { AUTOCOMPLETE = + [ { enable = True, value = "zap" } + , { enable = False, value = "annotate" } + ] + , acoustics = Some True + , align = Some { enable = True, value = types.Alignment.chaotic } + , autodescribe = Some False + , autodig = Some False + , AUTOPICKUP_EXCEPTION = + [ { pickup = False, name = "chest" } + , { pickup = True, name = "dagger" } + ] + , BIND = + [ { keybinding = "!", command = "loot" } + , { keybinding = "^v", command = "untrap" } + , { keybinding = "M-x", command = "terrain" } + ] + , catname = Some "Mirri" + , checkpoint = Some True + , checkspace = Some True + , clicklook = Some False + , cmdassist = Some True + , confirm = Some True + , dark_room = Some False + , disclose = + Some + ( defaults.Disclose + ⫽ { inventory = Some { prompt = True, default = True } + , attributes = Some { prompt = True, default = False } + , monsters_killed = Some { prompt = False, default = True } + , monsters_genocided = Some { prompt = False, default = False } + , conduct = Some { prompt = False, default = False } + , dungeon_overview = Some { prompt = False, default = False } + } + ) + , dogname = Some "Cujo" + , extmenu = Some False + , fixinv = Some True + , force_invmenu = Some False + , fruit = Some "slime mold" + , gender = Some types.Gender.female + , goldX = Some False + , help = Some True + , hilite_pet = Some False + , hilite_pile = Some False + , hilite_status = + defaults.HiliteStatus + ⫽ { gold = + [ { color = types.Color.yellow + , trigger = Some types.Numeric.always + , attributes = None types.Attributes + } + ] + } + , hitpointbar = Some True + , horsename = Some "Erhir" + , ignintr = Some False + , implicit_uncursed = Some True + , legacy = Some True + , lit_corridor = Some False + , lootabc = Some False + , mail = Some True + , mention_walls = Some False + , menucolors = + [ { regex = "blessed" + , color = Some types.Color.cyan + , attributes = defaults.Attributes ⫽ { bold = Some True } + } + ] + , menustyle = Some types.MenuStyle.traditional + , menu_deselect_all = Some "-" + , menu_deselect_page = Some "\\" + , menu_first_page = Some "^" + , menu_headings = Some types.MenuHeadings.bold + , menu_invert_all = Some "@" + , menu_invert_page = Some "~" + , menu_last_page = Some "|" + , menu_next_page = Some ">" + , menu_objsyms = Some False + , menu_previous_page = Some "<" + , menu_search = Some ":" + , menu_select_all = Some "." + , menu_tab_sep = Some False + , msg_window = Some types.MsgWindow.single + , MSGTYPE = [ types.MsgType.hide "You swap places with .*" ] + , name = Some "Kaeru" + , news = Some True + , nudist = Some False + , null = Some False + , number_pad = Some types.NumberPad.Letters + , packorder = Some "\")[%?+!=/(*`0_" + , paranoid_confirmation = + defaults.ParanoidConfirmation ⫽ { pray = Some True } + , pettype = Some types.PetType.cat + , pickup_burden = Some types.PickupBurden.stressed + , pickup_thrown = Some True + , pickup_types = Some "?!/" + , pile_limit = Some (types.PileLimit.limit 5) + , playmode = Some types.PlayMode.normal + , pushweapon = Some False + , race = Some { enable = True, value = types.Race.elf } + , rest_on_space = Some False + , role = Some { enable = True, value = types.Role.wizard } + , roguesymset = Some types.SymSet.RogueEpyx + , runmode = Some types.RunMode.walk + , safe_pet = Some True + , sanity_check = Some False + , scores = { own = Some True, around = Some 2, top = Some 10 } + , showexp = Some False + , showrace = Some False + , showscore = Some False + , silent = Some True + , sortloot = Some types.SortLoot.none + , sortpack = Some True + , sparkle = Some True + , standout = Some False + , status_updates = Some True + , statushilites = Some 10 + , suppress_alert = Some "3.3.1" + , symset = Some types.SymSet.DECgraphics + , time = Some False + , timed_delay = Some True + , tombstone = Some True + , toptenwin = Some False + , travel = Some True + , verbose = Some True + , whatis_coord = Some types.WhatisCoord.none + , whatis_filter = Some types.WhatisFilter.no_filtering + , whatis_menu = Some False + , whatis_moveskip = Some False + , windowtype = Some "tty" + , wizkit = Some "wizkit.txt" + } diff --git a/tests/format/unicodeB.dhall b/tests/format/unicodeB.dhall --- a/tests/format/unicodeB.dhall +++ b/tests/format/unicodeB.dhall @@ -1,15 +1,10 @@ λ(isActive : Bool) -→ { barLeftEnd = - Some "┨" - , barRightEnd = - Some "┠" - , separator = - Some "┃" +→ { barLeftEnd = Some "┨" + , barRightEnd = Some "┠" + , separator = Some "┃" , alignment = < ToTheLeft | ToTheRight | Centered >.ToTheLeft : ./Alignment.dhall - , barWidth = - None Natural - , barSegments = - [ "index", "command", "path", "title" ] + , barWidth = None Natural + , barSegments = [ "index", "command", "path", "title" ] } : ./Bar.dhall