dhall 1.28.0 → 1.29.0
raw patch · 94 files changed
+1901/−608 lines, 94 filesdep ~cborg-jsondep ~haskelinedep ~prettyprinterbinary-addedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: cborg-json, haskeline, prettyprinter
API changes (from Hackage documentation)
- Dhall.Parser.Expression: dropLiteral :: Int -> Chunks s a -> Chunks s a
- Dhall.Parser.Expression: emptyLine :: Chunks s a -> Bool
- Dhall.Parser.Expression: leadingSpaces :: Chunks s a -> Text
- Dhall.Parser.Expression: linesLiteral :: Chunks s a -> NonEmpty (Chunks s a)
- Dhall.Parser.Expression: splitOn :: Text -> Text -> NonEmpty Text
- Dhall.Parser.Expression: toDoubleQuoted :: Chunks Src a -> Chunks Src a
- Dhall.Parser.Expression: unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a
- Dhall.TypeCheck: MustMergeUnion :: Expr s a -> Expr s a -> TypeMessage s a
+ Dhall.DirectoryTree: FilesystemError :: Expr Void Void -> FilesystemError
+ Dhall.DirectoryTree: [unexpectedExpression] :: FilesystemError -> Expr Void Void
+ Dhall.DirectoryTree: instance GHC.Exception.Type.Exception Dhall.DirectoryTree.FilesystemError
+ Dhall.DirectoryTree: instance GHC.Show.Show Dhall.DirectoryTree.FilesystemError
+ Dhall.DirectoryTree: newtype FilesystemError
+ Dhall.DirectoryTree: toDirectoryTree :: FilePath -> Expr Void Void -> IO ()
+ Dhall.Main: DirectoryTree :: Input -> FilePath -> Mode
+ Dhall.Main: [path] :: Mode -> FilePath
+ Dhall.Pretty: escapeEnvironmentVariable :: Text -> Text
+ Dhall.Pretty: escapeLabel :: Bool -> Text -> Text
+ Dhall.TH: makeHaskellTypeFromUnion :: Text -> Text -> Q [Dec]
+ Dhall.TypeCheck: ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
+ Dhall.TypeCheck: MustMergeUnionOrOptional :: Expr s a -> Expr s a -> TypeMessage s a
+ Dhall.TypeCheck: [long] :: ErrorMessages -> Doc Ann
+ Dhall.TypeCheck: [short] :: ErrorMessages -> Doc Ann
+ Dhall.TypeCheck: data ErrorMessages
+ Dhall.TypeCheck: prettyTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
- Dhall.Lint: lint :: Expr s Import -> Expr t Import
+ Dhall.Lint: lint :: Expr s Import -> Expr s Import
Files
- CHANGELOG.md +41/−0
- dhall-lang/Prelude/Function/identity +12/−0
- dhall-lang/Prelude/Function/package.dhall +3/−0
- dhall-lang/Prelude/Integer/add +1/−1
- dhall-lang/Prelude/Integer/equal +7/−8
- dhall-lang/Prelude/Integer/greaterThan +5/−7
- dhall-lang/Prelude/Integer/greaterThanEqual +4/−8
- dhall-lang/Prelude/Integer/lessThan +1/−1
- dhall-lang/Prelude/Integer/lessThanEqual +24/−7
- dhall-lang/Prelude/Integer/multiply +15/−10
- dhall-lang/Prelude/Integer/negative +20/−0
- dhall-lang/Prelude/Integer/nonNegative +20/−0
- dhall-lang/Prelude/Integer/nonPositive +16/−0
- dhall-lang/Prelude/Integer/package.dhall +21/−9
- dhall-lang/Prelude/Integer/positive +24/−0
- dhall-lang/Prelude/Integer/subtract +28/−21
- dhall-lang/Prelude/Integer/toNatural +4/−4
- dhall-lang/Prelude/JSON/Type +10/−7
- dhall-lang/Prelude/JSON/array +7/−6
- dhall-lang/Prelude/JSON/bool +6/−5
- dhall-lang/Prelude/JSON/core.dhall +19/−7
- dhall-lang/Prelude/JSON/double +33/−0
- dhall-lang/Prelude/JSON/integer +33/−0
- dhall-lang/Prelude/JSON/natural +29/−0
- dhall-lang/Prelude/JSON/null +6/−5
- dhall-lang/Prelude/JSON/number +6/−13
- dhall-lang/Prelude/JSON/object +7/−6
- dhall-lang/Prelude/JSON/omitNullFields +12/−9
- dhall-lang/Prelude/JSON/package.dhall +4/−4
- dhall-lang/Prelude/JSON/render +4/−3
- dhall-lang/Prelude/JSON/renderInteger.dhall +24/−0
- dhall-lang/Prelude/JSON/renderYAML +4/−3
- dhall-lang/Prelude/JSON/string +6/−5
- dhall-lang/Prelude/package.dhall +3/−3
- dhall-lang/tests/normalization/success/unit/MergeNoneA.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/MergeNoneB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/MergeSomeA.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/MergeSomeB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionB.dhall +1/−1
- dhall-lang/tests/parser/success/hexadecimalA.dhall +6/−0
- dhall-lang/tests/parser/success/hexadecimalB.dhallb +1/−0
- dhall-lang/tests/parser/success/preferMissingNoSpacesB.dhallb binary
- dhall-lang/tests/parser/success/unit/RecordLitSomeA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/RecordLitSomeB.dhallb binary
- dhall-lang/tests/parser/success/unit/SelectionSomeA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/SelectionSomeB.dhallb binary
- dhall-lang/tests/parser/success/unit/UnionTypeSomeA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/UnionTypeSomeB.dhallb +1/−0
- dhall-lang/tests/type-inference/success/preludeB.dhall +72/−12
- dhall-lang/tests/type-inference/success/unit/MergeNoneA.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/MergeNoneB.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/MergeSomeA.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/MergeSomeB.dhall +1/−0
- dhall.cabal +21/−9
- src/Dhall.hs +3/−4
- src/Dhall/DirectoryTree.hs +151/−0
- src/Dhall/Eval.hs +6/−0
- src/Dhall/Freeze.hs +8/−8
- src/Dhall/Lint.hs +21/−16
- src/Dhall/Main.hs +48/−9
- src/Dhall/Normalize.hs +16/−1
- src/Dhall/Parser/Expression.hs +1/−89
- src/Dhall/Parser/Token.hs +14/−8
- src/Dhall/Pretty.hs +3/−0
- src/Dhall/Pretty/Internal.hs +91/−62
- src/Dhall/Syntax.hs +96/−0
- src/Dhall/TH.hs +258/−25
- src/Dhall/Tutorial.hs +1/−1
- src/Dhall/TypeCheck.hs +68/−47
- tests/Dhall/Test/Dhall.hs +47/−43
- tests/Dhall/Test/Import.hs +16/−1
- tests/Dhall/Test/Lint.hs +19/−11
- tests/Dhall/Test/Main.hs +2/−0
- tests/Dhall/Test/Parser.hs +0/−4
- tests/Dhall/Test/Regression.hs +1/−1
- tests/Dhall/Test/TH.hs +40/−0
- tests/format/applicationMultilineB.dhall +2/−3
- tests/format/ipfsA.dhall +163/−0
- tests/format/ipfsB.dhall +143/−0
- tests/format/issue1400-1A.dhall +1/−1
- tests/format/issue1400-1B.dhall +11/−11
- tests/format/largeRecordB.dhall +30/−31
- tests/format/recordCompletionB.dhall +22/−23
- tests/format/significantLeadingSpacesA.dhall +1/−0
- tests/format/significantLeadingSpacesB.dhall +5/−0
- tests/format/stringWithNullB.dhall +1/−1
- tests/lint/success/fixAssertA.dhall +5/−1
- tests/lint/success/fixAssertB.dhall +1/−1
- tests/lint/success/issue1586A.dhall +1/−0
- tests/lint/success/issue1586B.dhall +5/−0
- tests/lint/success/multiletB.dhall +11/−10
- tests/recursive/expr0.dhall +8/−11
- tests/recursive/expr1.dhall +8/−11
- tests/th/example.dhall +1/−0
CHANGELOG.md view
@@ -1,3 +1,44 @@+1.29.0++* [Supports version 13.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v13.0.0)+* BREAKING CHANGE: [Generate Haskell datatype declarations from Dhall types](https://github.com/dhall-lang/dhall-haskell/commit/b0280826790930d18a5498fb802120478fa11767#diff-a9729dccf50be61ce3d8c68c16f0fd50)+ * You can now use the `makeHaskellTypeFromUnion` Template Haskell utility+ to generate a Haskell datatype declaration from a Dhall union type+ * This helps ensure that your Haskell types and Dhall types stay in sync,+ when you want the Dhall type to be the source of truth+ * This is a breaking change because the default `InterpretOptions` changed+ the default handling of singleton constructors from `Wrapped` to `Smart`+ * You can preserve the old behavior using:+ `autoWith defaultInterpretOptions{ singletonConstructors = Wrapped }`+* BUG FIX: [Fix `dhall freeze --cache` and `dhall lint` to preserve `let`-related comments](https://github.com/dhall-lang/dhall-haskell/pull/1597)+ * Now they match the behavior of `dhall format` with regard to preserving+ these comments+* BUG FIX: [Fix escaping of significant leading whitespace when formatting code](https://github.com/dhall-lang/dhall-haskell/pull/1598)+ * The formatter would sometimes unnecessarily escape significant leading+ whitespace for the final line of multiline string literals, which this+ change fixes+* BUG FIX: [Fix `dhall encode --json` for `Double` values](https://github.com/dhall-lang/dhall-haskell/issues/1350)+* NEW FEATURE: [`dhall to-directory-tree` command](https://github.com/dhall-lang/dhall-haskell/pull/1606)+ * You can now generate a directory tree from a Dhall expression+ * Specifically:+ * records are converted to directories+ * `Text` fields are converted to files named after the field+ * `Optional` values are omitted if `None`+ * Everything else is rejected+* NEW FEATURE: [Hexadecimal literals](https://github.com/dhall-lang/dhall-haskell/pull/1607)+ * See the [changelog for standard version 13.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v13.0.0) for more details+* NEW FEATURE: [`merge` works on `Optional` values](https://github.com/dhall-lang/dhall-haskell/pull/1608)+ * See the [changelog for standard version 13.0.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v13.0.0) for more details+* [Improve formatter](https://github.com/dhall-lang/dhall-haskell/pull/1609)+ * `dhall format` will now render expressions nested inside record fields or+ alternatives more compactly, including:+ * Records+ * Record completion expressions+ * Expressions wrapped in `Some`+ * Lists+* [Exclude the `using ...` suffix from imports listed by `dhall resolve`](https://github.com/dhall-lang/dhall-haskell/pull/1603)+ * Specifically when using the `--{immediate,transitive}-dependencies` flags+ 1.28.0 * [Supports version 12.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v12.0.0)
+ dhall-lang/Prelude/Function/identity view
@@ -0,0 +1,12 @@+{-+The identity function simply returns its input+-}+let identity+ : ∀(a : Type) → ∀(x : a) → a+ = λ(a : Type) → λ(x : a) → x++let example0 = assert : identity Natural 1 ≡ 1++let example1 = assert : identity Bool ≡ (λ(x : Bool) → x)++in identity
dhall-lang/Prelude/Function/package.dhall view
@@ -1,4 +1,7 @@ { compose = ./compose sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 ? ./compose+, identity =+ ./identity sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4+ ? ./identity }
dhall-lang/Prelude/Integer/add view
@@ -2,7 +2,7 @@ `add m n` computes `m + n`. -} let Integer/subtract =- ./subtract sha256:8de76d2e235eec1629750ae62e191f13631b36708bfda0425572d87e5a9a37e7+ ./subtract sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda ? ./subtract let add
dhall-lang/Prelude/Integer/equal view
@@ -1,19 +1,18 @@ {- `equal` checks if two Integers are equal. -}-let greaterThan =- ./greaterThan sha256:accaa6b7cbca7ec2ace4a529e5f3bb57679df2b5ad962bde5b7867d9253d4b8c- ? ./greaterThan--let Bool/not =- ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4- ? ../Bool/not+let Natural/equal =+ ../Natural/equal sha256:7f108edfa35ddc7cebafb24dc073478e93a802e13b5bc3fd22f4768c9b066e60+ ? ../Natural/equal let equal : Integer → Integer → Bool = λ(a : Integer) → λ(b : Integer)- → Bool/not (greaterThan a b) && Bool/not (greaterThan b a)+ → Natural/equal (Integer/clamp a) (Integer/clamp b)+ && Natural/equal+ (Integer/clamp (Integer/negate a))+ (Integer/clamp (Integer/negate b)) let example0 = assert : equal +5 +5 ≡ True
dhall-lang/Prelude/Integer/greaterThan view
@@ -1,19 +1,17 @@ {- `greaterThan` checks if one Integer is greater than another. -}-let Integer/subtract =- ./subtract sha256:8de76d2e235eec1629750ae62e191f13631b36708bfda0425572d87e5a9a37e7- ? ./subtract- let Bool/not = ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 ? ../Bool/not +let lessThanEqual =+ ./lessThanEqual sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc+ ? ./lessThanEqual+ let greaterThan : Integer → Integer → Bool- = λ(x : Integer)- → λ(y : Integer)- → Bool/not (Natural/isZero (Integer/clamp (Integer/subtract y x)))+ = λ(x : Integer) → λ(y : Integer) → Bool/not (lessThanEqual x y) let example0 = assert : greaterThan +5 +6 ≡ False
dhall-lang/Prelude/Integer/greaterThanEqual view
@@ -1,17 +1,13 @@ {- `greaterThanEqual` checks if one Integer is greater than or equal to another. -}-let greaterThan =- ./greaterThan sha256:accaa6b7cbca7ec2ace4a529e5f3bb57679df2b5ad962bde5b7867d9253d4b8c- ? ./greaterThan--let Bool/not =- ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4- ? ../Bool/not+let lessThanEqual =+ ./lessThanEqual sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc+ ? ./lessThanEqual let greaterThanEqual : Integer → Integer → Bool- = λ(x : Integer) → λ(y : Integer) → Bool/not (greaterThan y x)+ = λ(x : Integer) → λ(y : Integer) → lessThanEqual y x let example0 = assert : greaterThanEqual +5 +6 ≡ False
dhall-lang/Prelude/Integer/lessThan view
@@ -2,7 +2,7 @@ `lessThan` checks if one Integer is less than another. -} let greaterThan =- ./greaterThan sha256:accaa6b7cbca7ec2ace4a529e5f3bb57679df2b5ad962bde5b7867d9253d4b8c+ ./greaterThan sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b ? ./greaterThan let lessThan
dhall-lang/Prelude/Integer/lessThanEqual view
@@ -1,17 +1,34 @@ {- `lessThanEqual` checks if one Integer is less than or equal to another. -}-let lessThan =- ./lessThan sha256:14cc3bc6ca8757f7c3af338f079fcc18e0c7ee3ed0d20914a9693aec81ae628d- ? ./lessThan+let Natural/greaterThanEqual =+ ../Natural/greaterThanEqual sha256:30ebfab0febd7aa0ccccfdf3dc36ee6d50f0117f35dd4a9b034750b7e885a1a4+ ? ../Natural/greaterThanEqual -let Bool/not =- ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4- ? ../Bool/not+let Natural/lessThanEqual =+ ../Natural/lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99+ ? ../Natural/lessThanEqual +let nonPositive =+ ./nonPositive sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b+ ? ./nonPositive++let nonNegative =+ ./nonNegative sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663+ ? ./nonNegative+ let lessThanEqual : Integer → Integer → Bool- = λ(x : Integer) → λ(y : Integer) → Bool/not (lessThan y x)+ = λ(x : Integer)+ → λ(y : Integer)+ → if nonPositive x++ then nonNegative y+ || Natural/greaterThanEqual+ (Integer/clamp (Integer/negate x))+ (Integer/clamp (Integer/negate y))++ else Natural/lessThanEqual (Integer/clamp x) (Integer/clamp y) let example0 = assert : lessThanEqual +5 +6 ≡ True
dhall-lang/Prelude/Integer/multiply view
@@ -2,27 +2,32 @@ `multiply m n` computes `m * n`. -} -let Integer/abs =- ./abs sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1- ? ./abs+let nonPositive =+ ./nonPositive sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b+ ? ./nonPositive +let multiplyNonNegative =+ λ(x : Integer)+ → λ(y : Integer)+ → Natural/toInteger (Integer/clamp x * Integer/clamp y)+ let multiply : Integer → Integer → Integer = λ(m : Integer) → λ(n : Integer)- → let mAbs = Integer/abs m+ → if nonPositive m - let nAbs = Integer/abs n+ then if nonPositive n - let mNonPos = Natural/isZero (Integer/clamp m)+ then multiplyNonNegative (Integer/negate m) (Integer/negate n) - let nNonPos = Natural/isZero (Integer/clamp n)+ else Integer/negate (multiplyNonNegative (Integer/negate m) n) - in if mNonPos == nNonPos+ else if nonPositive n - then Natural/toInteger (mAbs * nAbs)+ then Integer/negate (multiplyNonNegative m (Integer/negate n)) - else Integer/negate (Natural/toInteger (mAbs * nAbs))+ else multiplyNonNegative m n let example0 = assert : multiply +3 +5 ≡ +15
+ dhall-lang/Prelude/Integer/negative view
@@ -0,0 +1,20 @@+{-+Returns `True` for any `Integer` less than `+0`.++`negative` is more efficient than `./lessThan +0` or `./lessThanEqual -1`.+-}+let positive =+ ./positive sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3+ ? ./positive++let negative+ : Integer → Bool+ = λ(n : Integer) → positive (Integer/negate n)++let example0 = assert : negative +1 ≡ False++let example1 = assert : negative +0 ≡ False++let example2 = assert : negative -1 ≡ True++in negative
+ dhall-lang/Prelude/Integer/nonNegative view
@@ -0,0 +1,20 @@+{-+Returns `True` for `+0` and any positive `Integer`.++`nonNegative` is more efficient than `./greaterThanEqual +0` or `./greaterThan -1`.+-}+let nonPositive =+ ./nonPositive sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b+ ? ./nonPositive++let nonNegative+ : Integer → Bool+ = λ(n : Integer) → nonPositive (Integer/negate n)++let example0 = assert : nonNegative +1 ≡ True++let example1 = assert : nonNegative +0 ≡ True++let example2 = assert : nonNegative -1 ≡ False++in nonNegative
+ dhall-lang/Prelude/Integer/nonPositive view
@@ -0,0 +1,16 @@+{-+Returns `True` for `+0` and any negative `Integer`.++`nonPositive` is more efficient than `./lessThanEqual +0` or `./lessThan +1`.+-}+let nonPositive+ : Integer → Bool+ = λ(n : Integer) → Natural/isZero (Integer/clamp n)++let example0 = assert : nonPositive +1 ≡ False++let example1 = assert : nonPositive +0 ≡ True++let example2 = assert : nonPositive -1 ≡ True++in nonPositive
dhall-lang/Prelude/Integer/package.dhall view
@@ -2,42 +2,54 @@ ./abs sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1 ? ./abs , add =- ./add sha256:96f1ae60f958febc911935ac4aa2685394642b116b7bddcec7e1ed201a69ed2c+ ./add sha256:7da1306a0bf87c5668beead2a1db1b18861e53d7ce1f38057b2964b649f59c3b ? ./add , clamp = ./clamp sha256:ea42096cf3e024fadfaf910e0b839005b0ea7514fff11e5a3950a77694d9c5d2 ? ./clamp , equal =- ./equal sha256:e4414b9eef4142eed6bb0b52eb6fd0074210b68d210e96dd5161697b0f14426a+ ./equal sha256:2d99a205086aa77eea17ae1dab22c275f3eb007bccdc8d9895b93497ebfc39f8 ? ./equal , greaterThan =- ./greaterThan sha256:accaa6b7cbca7ec2ace4a529e5f3bb57679df2b5ad962bde5b7867d9253d4b8c+ ./greaterThan sha256:d23affd73029fc9aaf867c2c7b86510ca2802d3f0d1f3e1d1a93ffd87b7cb64b ? ./greaterThan , greaterThanEqual =- ./greaterThanEqual sha256:cede1f63b58cb26623148ef741f18e6476ad71d9d541dd54be2b1ec4972a4ad0+ ./greaterThanEqual sha256:a9fa2dc5cd6067a23b39d7fe8d14a63109583b320429fb0e446658a5aae0a958 ? ./greaterThanEqual , lessThan =- ./lessThan sha256:14cc3bc6ca8757f7c3af338f079fcc18e0c7ee3ed0d20914a9693aec81ae628d+ ./lessThan sha256:eeaa0081d10c6c97464ef193c40f1aa5cbb12f0202972ab42f3d310c2fd6a3f0 ? ./lessThan , lessThanEqual =- ./lessThanEqual sha256:a849203a9cd270210588f9db23e02b819117a997df1c8131b6f9a634cb2e5c8d+ ./lessThanEqual sha256:e3cca9f3942f81fa78a2bea23c0c24519c67cfe438116c38e797e12dcd26f6bc ? ./lessThanEqual , multiply =- ./multiply sha256:71b2a720976c70f0cd06baba9c213867b9744e655927dc3857fa92c864c3cf86+ ./multiply sha256:dcb1ed7c8475ece8d67db92cd249fc728541778ff82509e28c3760e341880e4d ? ./multiply , negate = ./negate sha256:2373c992e1de93634bc6a8781eb073b2a92a70170133e49762a785f3a136df5d ? ./negate+, negative =+ ./negative sha256:23e4b3c61eea9e878a7f83bf25fd0ea2c6a6d60174890d65be885828b690a570+ ? ./negative+, nonNegative =+ ./nonNegative sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663+ ? ./nonNegative+, nonPositive =+ ./nonPositive sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b+ ? ./nonPositive+, positive =+ ./positive sha256:7bdbf50fcdb83d01f74c7e2a92bf5c9104eff5d8c5b4587e9337f0caefcfdbe3+ ? ./positive , show = ./show sha256:ecf8b0594cd5181bc45d3b7ea0d44d3ba9ad5dac6ec17bb8968beb65f4b1baa9 ? ./show , subtract =- ./subtract sha256:8de76d2e235eec1629750ae62e191f13631b36708bfda0425572d87e5a9a37e7+ ./subtract sha256:a34d36272fa8ae4f1ec8b56222fe8dc8a2ec55ec6538b840de0cbe207b006fda ? ./subtract , toDouble = ./toDouble sha256:77bc5d635dc4d952f37cc96f2a681d5ac503b4e8b21fc00055b1946adb5beda7 ? ./toDouble , toNatural =- ./toNatural sha256:68dabff205ffdb1ca0df3dabc561ce717b7ae6521c9da9eed893b923ae5a0e1c+ ./toNatural sha256:4d128730d74e7f832e53873cb5204aa91b79758be5ce4e1aa991fe1951304a0e ? ./toNatural }
+ dhall-lang/Prelude/Integer/positive view
@@ -0,0 +1,24 @@+{-+Returns `True` for any `Integer` greater than `+0`.++`positive` is more efficient than `./greaterThan +0` or `./greaterThanEqual +1`.+-}+let not =+ ../Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4+ ? ../Bool/not++let nonPositive =+ ./nonPositive sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b+ ? ./nonPositive++let positive+ : Integer → Bool+ = λ(n : Integer) → not (nonPositive n)++let example0 = assert : positive +1 ≡ True++let example1 = assert : positive +0 ≡ False++let example2 = assert : positive -1 ≡ False++in positive
dhall-lang/Prelude/Integer/subtract view
@@ -1,39 +1,46 @@ {- `subtract m n` computes `n - m`. -}-let Natural/lessThanEqual =- ../Natural/lessThanEqual sha256:1a5caa2b80a42b9f58fff58e47ac0d9a9946d0b2d36c54034b8ddfe3cb0f3c99- ? ../Natural/lessThanEqual+let nonPositive =+ ./nonPositive sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b+ ? ./nonPositive -let Integer/abs =- ./abs sha256:35212fcbe1e60cb95b033a4a9c6e45befca4a298aa9919915999d09e69ddced1- ? ./abs+let subtractNonNegative =+ λ(xi : Integer)+ → λ(yi : Integer)+ → let xn = Integer/clamp xi + let yn = Integer/clamp yi++ let dn = Natural/subtract xn yn++ in if Natural/isZero dn++ then Integer/negate (Natural/toInteger (Natural/subtract yn xn))++ else Natural/toInteger dn+ let subtract : Integer → Integer → Integer = λ(m : Integer) → λ(n : Integer)- → let mAbs = Integer/abs m-- let nAbs = Integer/abs n-- let mNonPos = Natural/isZero (Integer/clamp m)-- let nNonPos = Natural/isZero (Integer/clamp n)+ → if nonPositive m - let diff =- if mNonPos == nNonPos+ then if nonPositive n - then if Natural/lessThanEqual mAbs nAbs+ then subtractNonNegative (Integer/negate n) (Integer/negate m) - then Integer/negate- (Natural/toInteger (Natural/subtract mAbs nAbs))+ else Natural/toInteger+ (Integer/clamp (Integer/negate m) + Integer/clamp n) - else Natural/toInteger (Natural/subtract nAbs mAbs)+ else if nonPositive n - else Natural/toInteger (mAbs + nAbs)+ then Integer/negate+ ( Natural/toInteger+ (Integer/clamp m + Integer/clamp (Integer/negate n))+ ) - in if mNonPos then diff else Integer/negate diff+ else subtractNonNegative m n let example0 = assert : subtract +3 +5 ≡ +2
dhall-lang/Prelude/Integer/toNatural view
@@ -1,14 +1,14 @@ {- Convert an `Integer` to an `Optional Natural`, with negative numbers becoming `None Natural`. -}-let Integer/lessThan =- ./lessThan sha256:14cc3bc6ca8757f7c3af338f079fcc18e0c7ee3ed0d20914a9693aec81ae628d- ? ./lessThan+let nonNegative =+ ./nonNegative sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663+ ? ./nonNegative let toNatural : Integer → Optional Natural = λ(n : Integer)- → if Integer/lessThan n +0 then None Natural else Some (Integer/clamp n)+ → if nonNegative n then Some (Integer/clamp n) else None Natural let example0 = assert : toNatural +7 ≡ Some 7
dhall-lang/Prelude/JSON/Type view
@@ -17,8 +17,10 @@ Bool → JSON , null : JSON- , number :+ , double : Double → JSON+ , integer :+ Integer → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string :@@ -30,7 +32,7 @@ , { mapKey = "bar" , mapValue =- json.array [ json.number 1.0, json.bool True ]+ json.array [ json.double 1.0, json.bool True ] } ] ```@@ -47,7 +49,7 @@ , { mapKey = "bar" , mapValue =- JSON.array [ JSON.number 1.0, JSON.bool True ]+ JSON.array [ JSON.double 1.0, JSON.bool True ] } ] ```@@ -57,12 +59,13 @@ : Type = ∀(JSON : Type) → ∀ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → JSON
dhall-lang/Prelude/JSON/array view
@@ -2,7 +2,7 @@ ``` let JSON = ./package.dhall-in JSON.render (JSON.array [ JSON.number 1.0, JSON.bool True ])+in JSON.render (JSON.array [ JSON.double 1.0, JSON.bool True ]) = "[ 1.0, true ]" let JSON/Type = ./Type@@ -12,7 +12,7 @@ ``` -} let JSON =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type let List/map =@@ -24,12 +24,13 @@ = λ(x : List JSON) → λ(JSON : Type) → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → json.array (List/map JSON@1 JSON (λ(j : JSON@1) → j JSON json) x)
dhall-lang/Prelude/JSON/bool view
@@ -11,7 +11,7 @@ ``` -} let JSON =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type let bool@@ -19,12 +19,13 @@ = λ(x : Bool) → λ(JSON : Type) → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → json.bool x
dhall-lang/Prelude/JSON/core.dhall view
@@ -9,7 +9,7 @@ cycles. -} { Type =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type , Tagged = ./Tagged sha256:21feca7d2b23f210d0696131d792e18a7d24fdcc85d41a49ba85b98670eba194@@ -24,21 +24,33 @@ ./keyValue sha256:a0a97199d280c4cce72ffcbbf93b7ceda0a569cf4d173ac98e0aaaa78034b98c ? ./keyValue , string =- ./string sha256:7a8ac435d30a96092d72889f3d48eabf7cba47ecf553fd6bc07a79fdf473e8d2+ ./string sha256:7ddb3a3b9f3ed09ed011d621a10ad9825185cd03503be98a81d42f6afb77940e ? ./string , number =- ./number sha256:534745568065ae19d2b0fe1d09eeb071e9717d0f392187eb0bc95f386b018bec+ ./number sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32 ? ./number+, double =+ ./double sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32+ ? ./double+, integer =+ ./integer sha256:c81a417397fc6f62155ec71fdd8d2047f981f0881295b307de3dd88747bf7e40+ ? ./integer+, natural =+ ./natural sha256:a839dc6789f19f820e9cbf70c60f41f3b057c59ece1d226d04db5aca447eb0e5+ ? ./natural , object =- ./object sha256:a4e047cf157c3971b026b3942a87d474c85950d9b9654f8ebc8631740abf75a9+ ./object sha256:869aede785c34798be9f9fd457ece73e7f683f352ae4555f791516a365faf4ac ? ./object , array =- ./array sha256:3a4c06cf135f4c80619e48c0808f6600d19782705bc59ee7c27cfc2e0f097eb7+ ./array sha256:fb6346a9c63638fe3c59f8108e19eebdbddc51389ec5570bab4c25f890ccccc8 ? ./array , bool =- ./bool sha256:018d29f030b45d642aba6bb81bf2c19a7bf183684612ce7a2c8afd2099783c48+ ./bool sha256:e043d9ed01e5b45899059e128243f3dae7ce65f293f0015ce816fc36d30f7f39 ? ./bool , null =- ./null sha256:52c1d45ab2ca54875b444bfb1afdea497c8c9b0652e5044fafd8b16d97f4b78d+ ./null sha256:1eeb9aee38eb8dde0e64efbaf60f24612c8194cc00b510bfb627c2ee2e1877b8 ? ./null+, renderInteger =+ ./renderInteger.dhall sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c+ ? ./renderInteger.dhall }
+ dhall-lang/Prelude/JSON/double view
@@ -0,0 +1,33 @@+{- Create a JSON number from a Dhall `Double`++```+let JSON = ./package.dhall+in JSON.render (JSON.double 42.0)+= "42.0"++let JSON = ./package.dhall+in JSON.render (JSON.double -1.5e-10)+= "-1.5e-10"+```+-}+let JSON =+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759+ ? ./Type++let double+ : Double → JSON+ = λ(x : Double)+ → λ(JSON : Type)+ → λ ( json+ : { array : List JSON → JSON+ , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON+ , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON+ }+ )+ → json.double x++in double
+ dhall-lang/Prelude/JSON/integer view
@@ -0,0 +1,33 @@+{- Create a JSON number from a Dhall `Integer`++```+let JSON = ./package.dhall+in JSON.render (JSON.integer -1)+= "-1"++let JSON = ./package.dhall+in JSON.render (JSON.integer +2)+= "+2"+```+-}+let JSON =+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759+ ? ./Type++let integer+ : Integer → JSON+ = λ(x : Integer)+ → λ(JSON : Type)+ → λ ( json+ : { array : List JSON → JSON+ , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON+ , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON+ }+ )+ → json.integer x++in integer
+ dhall-lang/Prelude/JSON/natural view
@@ -0,0 +1,29 @@+{- Create a JSON number from a Dhall `Natural`++```+let JSON = ./package.dhall+in JSON.render (JSON.natural 42)+= "42"+```+-}+let JSON =+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759+ ? ./Type++let natural+ : Natural → JSON+ = λ(x : Natural)+ → λ(JSON : Type)+ → λ ( json+ : { array : List JSON → JSON+ , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON+ , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON+ }+ )+ → json.integer (Natural/toInteger x)++in natural
dhall-lang/Prelude/JSON/null view
@@ -7,19 +7,20 @@ ``` -} let JSON =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type let null : JSON = λ(JSON : Type) → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → json.null
dhall-lang/Prelude/JSON/number view
@@ -11,22 +11,15 @@ ``` -} let JSON =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type +let double =+ ./double sha256:e70162c73c4978ad0d0d99505f61c7d990f3abadfcc08b34388b29c0934a7a32+ ? ./double+ let number : Double → JSON- = λ(x : Double)- → λ(JSON : Type)- → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON- , bool : Bool → JSON- , null : JSON- }- )- → json.number x+ = double in number
dhall-lang/Prelude/JSON/object view
@@ -4,7 +4,7 @@ let JSON = ./package.dhall in JSON.render ( JSON.object- [ { mapKey = "foo", mapValue = JSON.number 1.0 }+ [ { mapKey = "foo", mapValue = JSON.double 1.0 } , { mapKey = "bar", mapValue = JSON.bool True } ] )@@ -18,7 +18,7 @@ ``` -} let JSON =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type let List/map =@@ -30,12 +30,13 @@ = λ(x : List { mapKey : Text, mapValue : JSON }) → λ(JSON : Type) → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → json.object
dhall-lang/Prelude/JSON/omitNullFields view
@@ -3,7 +3,7 @@ for a configuration to encode absent fields -} let JSON =- ./core.dhall sha256:22ba363a8622642e788ffdd8fb98e5a51b1be8ebfcbefe2853e74932078a60af+ ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let List/concatMap =@@ -19,12 +19,13 @@ = λ(old : JSON.Type) → λ(JSON : Type) → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → let result =@@ -32,8 +33,10 @@ { value : JSON, isNull : Bool } { string = λ(x : Text) → { value = json.string x, isNull = False }- , number =- λ(x : Double) → { value = json.number x, isNull = False }+ , double =+ λ(x : Double) → { value = json.double x, isNull = False }+ , integer =+ λ(x : Integer) → { value = json.integer x, isNull = False } , object = λ ( keyValues : List@@ -100,7 +103,7 @@ ( JSON.object ( toMap { string = JSON.string a- , number = JSON.number b+ , double = JSON.double b , bool = JSON.bool c , null = JSON.null }@@ -109,7 +112,7 @@ ≡ JSON.object ( toMap { string = JSON.string a- , number = JSON.number b+ , double = JSON.double b , bool = JSON.bool c } )
dhall-lang/Prelude/JSON/package.dhall view
@@ -1,11 +1,11 @@ { render =- ./render sha256:81f5a84efbb35211b1556838e86d17ed497912cf765bfa4ab76708b21e5371f1+ ./render sha256:f7c372fcc954bfbbc7f83deec2006608a48efa2b08e8753bfdf73dc0aa7b4faf ? ./render , renderYAML =- ./renderYAML sha256:862b535f6b905f1ce4b83207c58dd53ce5af0026da4c0960a3aec90fdbbb3eb0+ ./renderYAML sha256:0949b834275fb231023ea80831d830352e0b89a15f4081f043cb83e745fdb6e8 ? ./renderYAML , omitNullFields =- ./omitNullFields sha256:c28270c553f48c406bd161c61776963315e278af5dae9331c4a320c3f4ecb4ec+ ./omitNullFields sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0 ? ./omitNullFields , tagInline = ./tagInline sha256:49559ac11906ba6cc9eac25753e31e7addb13bc760df108024174c55523984c4@@ -14,6 +14,6 @@ ./tagNested sha256:93a7415853b7677c832246efadc8e880c1b641a23589286a836a384ca311d26f ? ./tagNested }-∧ ( ./core.dhall sha256:22ba363a8622642e788ffdd8fb98e5a51b1be8ebfcbefe2853e74932078a60af+∧ ( ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall )
dhall-lang/Prelude/JSON/render view
@@ -4,7 +4,7 @@ more sophisticated you should use `dhall-to-json` or `dhall-to-yaml` -} let JSON =- ./core.dhall sha256:22ba363a8622642e788ffdd8fb98e5a51b1be8ebfcbefe2853e74932078a60af+ ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let Text/concatMapSep =@@ -17,7 +17,8 @@ → j Text { string = λ(x : Text) → Text/show x- , number = λ(x : Double) → Double/show x+ , double = λ(x : Double) → Double/show x+ , integer = λ(x : Integer) → JSON.renderInteger x , object = λ(x : List { mapKey : Text, mapValue : Text }) → let body =@@ -47,7 +48,7 @@ , JSON.string "Hello" , JSON.object [ { mapKey = "foo", mapValue = JSON.null }- , { mapKey = "bar", mapValue = JSON.number 1.0 }+ , { mapKey = "bar", mapValue = JSON.double 1.0 } ] ] )
+ dhall-lang/Prelude/JSON/renderInteger.dhall view
@@ -0,0 +1,24 @@+{- Render an `Integer` value as a `JSON number`, according to the JSON+ standard, in which a number may not start with a plus sign (`+`).+-}++let Integer/nonNegative =+ ../Integer/nonNegative sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663+ ? ../Integer/nonNegative++let renderInteger+ : Integer → Text+ = λ(integer : Integer)+ → if Integer/nonNegative integer++ then Natural/show (Integer/clamp integer)++ else Integer/show integer++let positive = assert : renderInteger +1 ≡ "1"++let zero = assert : renderInteger +0 ≡ "0"++let negative = assert : renderInteger -1 ≡ "-1"++in renderInteger
dhall-lang/Prelude/JSON/renderYAML view
@@ -9,7 +9,7 @@ -} let JSON =- ./core.dhall sha256:22ba363a8622642e788ffdd8fb98e5a51b1be8ebfcbefe2853e74932078a60af+ ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let Text/concatSep =@@ -120,7 +120,8 @@ ( json Block { string = λ(x : Text) → singleLine (Text/show x)- , number = λ(x : Double) → singleLine (Double/show x)+ , double = λ(x : Double) → singleLine (Double/show x)+ , integer = λ(x : Integer) → singleLine (JSON.renderInteger x) , object = λ(fields : List ObjectField) → manyBlocks@@ -161,7 +162,7 @@ , JSON.string "Hello" , JSON.object [ { mapKey = "foo", mapValue = JSON.null }- , { mapKey = "bar", mapValue = JSON.number 1.0 }+ , { mapKey = "bar", mapValue = JSON.double 1.0 } ] ] )
dhall-lang/Prelude/JSON/string view
@@ -11,7 +11,7 @@ ``` -} let JSON =- ./Type sha256:5adb234f5868a5b0eddeb034d690aaba8cb94ea20d0d557003e90334fff6be3e+ ./Type sha256:40edbc9371979426df63e064333b02689b969c4cfbbccfa481216d2d1a6e9759 ? ./Type let string@@ -19,12 +19,13 @@ = λ(x : Text) → λ(JSON : Type) → λ ( json- : { string : Text → JSON- , number : Double → JSON- , object : List { mapKey : Text, mapValue : JSON } → JSON- , array : List JSON → JSON+ : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON } ) → json.string x
dhall-lang/Prelude/package.dhall view
@@ -5,10 +5,10 @@ ./Double/package.dhall sha256:b8d20ab3216083622ae371fb42a6732bc67bb2d66e84989c8ddba7556a336cf7 ? ./Double/package.dhall , Function =- ./Function/package.dhall sha256:74c3822b98b9d37f9f820af8e1a7ee790bcfac03050eabd45af4a255fb93e026+ ./Function/package.dhall sha256:6d17cf0fd4fabe1737fb117f87c04b8ff82b299915a5b673c0a543b134b8fffe ? ./Function/package.dhall , Integer =- ./Integer/package.dhall sha256:dbc82e5542a642b9372ce6126967028c0cade2b8ad6923312b086b686ad67e06+ ./Integer/package.dhall sha256:d1a572ca3a764781496847e4921d7d9a881c18ffcfac6ae28d0e5299066938a0 ? ./Integer/package.dhall , List = ./List/package.dhall sha256:f0fdab7ab30415c128d89424589c42a15c835338be116fa14484086e4ba118d7@@ -29,7 +29,7 @@ ./Optional/package.dhall sha256:7608f2d38dabee8bfe6865b4adc11289059984220f422d2b023b15b3908f7a4c ? ./Optional/package.dhall , JSON =- ./JSON/package.dhall sha256:843783d29e60b558c2de431ce1206ce34bdfde375fcf06de8ec5bf77092fdef7+ ./JSON/package.dhall sha256:7533c6c457353bde410a57a5c1d82c6097c8d4dbf9f55a0d926ab56f4ffce77c ? ./JSON/package.dhall , Text = ./Text/package.dhall sha256:0a0ad9f649aed94c2680491efb384925b5b2bb5b353f1b8a7eb134955c1ffe45
+ dhall-lang/tests/normalization/success/unit/MergeNoneA.dhall view
@@ -0,0 +1,1 @@+merge { None = False, Some = \(b : Bool) -> b } (None Bool)
+ dhall-lang/tests/normalization/success/unit/MergeNoneB.dhall view
@@ -0,0 +1,1 @@+False
+ dhall-lang/tests/normalization/success/unit/MergeSomeA.dhall view
@@ -0,0 +1,1 @@+merge { None = False, Some = \(b : Bool) -> b } (Some True)
+ dhall-lang/tests/normalization/success/unit/MergeSomeB.dhall view
@@ -0,0 +1,1 @@+True
dhall-lang/tests/normalization/success/unit/NaturalBuildFoldFusionB.dhall view
@@ -1,1 +1,1 @@-λ(x : Natural) → Natural/fold x Natural (λ(n : Natural) → n + 1) 0+λ(x : Natural) → Natural/fold x Natural (λ(x : Natural) → x + 1) 0
+ dhall-lang/tests/parser/success/hexadecimalA.dhall view
@@ -0,0 +1,6 @@+ λ(x : Bool)+→ λ(x : Bool)+→ { example0 = 0xFF+ , example1 = -0x1A10+ , example2 = x@0x01+ }
+ dhall-lang/tests/parser/success/hexadecimalB.dhallb view
@@ -0,0 +1,1 @@+axdBoolaxdBool£hexample0ÿhexample19hexample2ax
dhall-lang/tests/parser/success/preferMissingNoSpacesB.dhallb view
binary file changed (15 → 15 bytes)
+ dhall-lang/tests/parser/success/unit/RecordLitSomeA.dhall view
@@ -0,0 +1,1 @@+{ Some = 0 }
+ dhall-lang/tests/parser/success/unit/RecordLitSomeB.dhallb view
binary file changed (absent → 11 bytes)
+ dhall-lang/tests/parser/success/unit/SelectionSomeA.dhall view
@@ -0,0 +1,1 @@+record.{ Some }
+ dhall-lang/tests/parser/success/unit/SelectionSomeB.dhallb view
binary file changed (absent → 16 bytes)
+ dhall-lang/tests/parser/success/unit/UnionTypeSomeA.dhall view
@@ -0,0 +1,1 @@+< Some: Natural >
+ dhall-lang/tests/parser/success/unit/UnionTypeSomeB.dhallb view
@@ -0,0 +1,1 @@+¡dSomegNatural
dhall-lang/tests/type-inference/success/preludeB.dhall view
@@ -20,6 +20,7 @@ → ∀(g : B → C) → ∀(x : A) → C+ , identity : ∀(a : Type) → ∀(x : a) → a } , Integer : { abs : ∀(n : Integer) → Natural@@ -32,6 +33,10 @@ , lessThanEqual : ∀(x : Integer) → ∀(y : Integer) → Bool , multiply : ∀(m : Integer) → ∀(n : Integer) → Integer , negate : Integer → Integer+ , negative : ∀(n : Integer) → Bool+ , nonNegative : ∀(n : Integer) → Bool+ , nonPositive : ∀(n : Integer) → Bool+ , positive : ∀(n : Integer) → Bool , show : Integer → Text , subtract : ∀(m : Integer) → ∀(n : Integer) → Integer , toDouble : Integer → Double@@ -48,8 +53,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON@@ -62,8 +68,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -75,13 +82,42 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON } ) → JSON+ , double :+ ∀(x : Double)+ → ∀(JSON : Type)+ → ∀ ( json+ : { array : List JSON → JSON+ , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON+ , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON+ }+ )+ → JSON+ , integer :+ ∀(x : Integer)+ → ∀(JSON : Type)+ → ∀ ( json+ : { array : List JSON → JSON+ , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON+ , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON+ }+ )+ → JSON , keyText : ∀(key : Text) → ∀(value : Text) → { mapKey : Text, mapValue : Text } , keyValue :@@ -89,13 +125,28 @@ → ∀(key : Text) → ∀(value : v) → { mapKey : Text, mapValue : v }+ , natural :+ ∀(x : Natural)+ → ∀(JSON : Type)+ → ∀ ( json+ : { array : List JSON → JSON+ , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON+ , null : JSON+ , object : List { mapKey : Text, mapValue : JSON } → JSON+ , string : Text → JSON+ }+ )+ → JSON , null : ∀(JSON : Type) → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -107,8 +158,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -123,8 +175,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON@@ -137,8 +190,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -150,8 +204,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -162,8 +217,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -175,8 +231,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -184,14 +241,16 @@ → JSON ) → Text+ , renderInteger : ∀(integer : Integer) → Text , renderYAML : ∀ ( json : ∀(JSON : Type) → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }@@ -205,8 +264,9 @@ → ∀ ( json : { array : List JSON → JSON , bool : Bool → JSON+ , double : Double → JSON+ , integer : Integer → JSON , null : JSON- , number : Double → JSON , object : List { mapKey : Text, mapValue : JSON } → JSON , string : Text → JSON }
+ dhall-lang/tests/type-inference/success/unit/MergeNoneA.dhall view
@@ -0,0 +1,1 @@+merge { None = False, Some = \(b : Bool) -> b } (None Bool)
+ dhall-lang/tests/type-inference/success/unit/MergeNoneB.dhall view
@@ -0,0 +1,1 @@+Bool
+ dhall-lang/tests/type-inference/success/unit/MergeSomeA.dhall view
@@ -0,0 +1,1 @@+merge { None = False, Some = \(b : Bool) -> b } (Some True)
+ dhall-lang/tests/type-inference/success/unit/MergeSomeB.dhall view
@@ -0,0 +1,1 @@+Bool
dhall.cabal view
@@ -1,5 +1,5 @@ Name: dhall-Version: 1.28.0+Version: 1.29.0 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 7.10.3, GHC == 8.4.3, GHC == 8.6.1@@ -39,6 +39,7 @@ dhall-lang/Prelude/Double/package.dhall dhall-lang/Prelude/Double/show dhall-lang/Prelude/Function/compose+ dhall-lang/Prelude/Function/identity dhall-lang/Prelude/Function/package.dhall dhall-lang/Prelude/Integer/abs dhall-lang/Prelude/Integer/add@@ -50,7 +51,11 @@ dhall-lang/Prelude/Integer/lessThanEqual dhall-lang/Prelude/Integer/multiply dhall-lang/Prelude/Integer/negate+ dhall-lang/Prelude/Integer/negative+ dhall-lang/Prelude/Integer/nonNegative+ dhall-lang/Prelude/Integer/nonPositive dhall-lang/Prelude/Integer/package.dhall+ dhall-lang/Prelude/Integer/positive dhall-lang/Prelude/Integer/show dhall-lang/Prelude/Integer/subtract dhall-lang/Prelude/Integer/toDouble@@ -61,14 +66,18 @@ dhall-lang/Prelude/JSON/array dhall-lang/Prelude/JSON/bool dhall-lang/Prelude/JSON/core.dhall+ dhall-lang/Prelude/JSON/double+ dhall-lang/Prelude/JSON/integer dhall-lang/Prelude/JSON/keyText dhall-lang/Prelude/JSON/keyValue+ dhall-lang/Prelude/JSON/natural dhall-lang/Prelude/JSON/null dhall-lang/Prelude/JSON/number dhall-lang/Prelude/JSON/object dhall-lang/Prelude/JSON/omitNullFields dhall-lang/Prelude/JSON/package.dhall dhall-lang/Prelude/JSON/render+ dhall-lang/Prelude/JSON/renderInteger.dhall dhall-lang/Prelude/JSON/renderYAML dhall-lang/Prelude/JSON/string dhall-lang/Prelude/JSON/tagInline@@ -165,12 +174,13 @@ dhall-lang/Prelude/XML/render dhall-lang/Prelude/XML/text dhall-lang/Prelude/package.dhall+ dhall-lang/tests/alpha-normalization/success/unit/*.dhall dhall-lang/tests/binary-decode/failure/unit/*.dhallb dhall-lang/tests/binary-decode/success/unit/*.dhall dhall-lang/tests/binary-decode/success/unit/*.dhallb dhall-lang/tests/import/cache/dhall/1220efc43103e49b56c5bf089db8e0365bbfc455b8a2f0dc6ee5727a3586f85969fd- dhall-lang/tests/import/data/*.txt dhall-lang/tests/import/data/*.dhall+ dhall-lang/tests/import/data/*.txt dhall-lang/tests/import/data/fieldOrder/*.dhall dhall-lang/tests/import/failure/*.dhall dhall-lang/tests/import/success/*.dhall@@ -182,18 +192,17 @@ dhall-lang/tests/normalization/success/simple/*.dhall dhall-lang/tests/normalization/success/simplifications/*.dhall dhall-lang/tests/normalization/success/unit/*.dhall- dhall-lang/tests/alpha-normalization/success/unit/*.dhall dhall-lang/tests/parser/failure/*.dhall dhall-lang/tests/parser/success/*.dhall dhall-lang/tests/parser/success/*.dhallb+ dhall-lang/tests/parser/success/text/*.dhall+ dhall-lang/tests/parser/success/text/*.dhallb dhall-lang/tests/parser/success/unit/*.dhall dhall-lang/tests/parser/success/unit/*.dhallb dhall-lang/tests/parser/success/unit/import/*.dhall dhall-lang/tests/parser/success/unit/import/*.dhallb dhall-lang/tests/parser/success/unit/import/urls/*.dhall dhall-lang/tests/parser/success/unit/import/urls/*.dhallb- dhall-lang/tests/parser/success/text/*.dhall- dhall-lang/tests/parser/success/text/*.dhallb dhall-lang/tests/semantic-hash/success/*.dhall dhall-lang/tests/semantic-hash/success/*.hash dhall-lang/tests/semantic-hash/success/haskell-tutorial/access/*.dhall@@ -387,17 +396,18 @@ 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/simple/access/*.dhall dhall-lang/tests/type-inference/success/unit/*.dhall- tests/format/*.dhall- tests/lint/success/*.dhall tests/diff/*.dhall tests/diff/*.txt+ tests/format/*.dhall+ tests/lint/success/*.dhall tests/recursive/*.dhall tests/regression/*.dhall tests/tags/*.dhall tests/tags/*.tags+ tests/th/*.dhall tests/tutorial/*.dhall Source-Repository head@@ -425,7 +435,7 @@ bytestring < 0.11, case-insensitive < 1.3 , cborg >= 0.2.0.0 && < 0.3 ,- cborg-json < 0.3 ,+ cborg-json >= 0.2.2.0 && < 0.3 , containers >= 0.5.0.0 && < 0.7 , contravariant < 1.6 , data-fix < 0.3 ,@@ -517,6 +527,7 @@ Dhall.Core Dhall.Crypto Dhall.Diff+ Dhall.DirectoryTree Dhall.Format Dhall.Freeze Dhall.Import@@ -582,6 +593,7 @@ Dhall.Test.QuickCheck Dhall.Test.Regression Dhall.Test.SemanticHash+ Dhall.Test.TH Dhall.Test.Tutorial Dhall.Test.TypeInference Dhall.Test.Util
src/Dhall.hs view
@@ -1225,7 +1225,7 @@ -- > \(Expr : Type) -- > -> let ExprF = -- > < LitF :--- > { _1 : Natural }+-- > Natural -- > | AddF : -- > { _1 : Expr, _2 : Expr } -- > | MulF :@@ -1233,7 +1233,7 @@ -- > > -- > -- > in \(Fix : ExprF -> Expr)--- > -> let Lit = \(x : Natural) -> Fix (ExprF.LitF { _1 = x })+-- > -> let Lit = \(x : Natural) -> Fix (ExprF.LitF x) -- > -- > let Add = -- > \(x : Expr)@@ -1291,7 +1291,6 @@ -- 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 Void -- ^ This is only used by the `FromDhall` instance for functions in order@@ -1334,7 +1333,7 @@ , constructorModifier = id , singletonConstructors =- Wrapped+ Smart , inputNormalizer = Dhall.Core.ReifiedNormalizer (const (pure Nothing)) }
+ src/Dhall/DirectoryTree.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Implementation of the @dhall to-directory-tree@ subcommand+module Dhall.DirectoryTree+ ( -- * Filesystem+ toDirectoryTree+ , FilesystemError(..)+ ) where++import Control.Exception (Exception)+import Data.Monoid ((<>))+import Data.Void (Void)+import Dhall.Syntax (Chunks(..), Expr(..))+import System.FilePath ((</>))++import qualified Control.Exception as Exception+import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty+import qualified Dhall.Util as Util+import qualified Dhall.Map as Map+import qualified Dhall.Pretty+import qualified System.Directory as Directory+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO++{-| Attempt to transform a Dhall record into a directory tree where:++ * Records are translated into directories++ * @Text@ values or fields are translated into files++ * @Optional@ values are omitted if @None@++ For example, the following Dhall record:++ > { dir = { `hello.txt` = "Hello\n" }+ > , `goodbye.txt`= Some "Goodbye\n"+ > , `missing.txt` = None Text+ > }++ ... should translate to this directory tree:++ > $ tree result+ > result+ > ├── dir+ > │ └── hello.txt+ > └── goodbye.txt+ >+ > $ cat result/dir/hello.txt+ > Hello+ >+ > $ cat result/goodbye.txt+ > Goodbye++ Use this in conjunction with the Prelude's support for rendering JSON/YAML+ in "pure Dhall" so that you can generate files containing JSON. For+ example:++ > let JSON =+ > https://prelude.dhall-lang.org/v12.0.0/JSON/package.dhall sha256:843783d29e60b558c2de431ce1206ce34bdfde375fcf06de8ec5bf77092fdef7+ >+ > in { `example.json` =+ > JSON.render (JSON.array [ JSON.number 1.0, JSON.bool True ])+ > , `example.yaml` =+ > JSON.renderYAML+ > (JSON.object (toMap { foo = JSON.string "Hello", bar = JSON.null }))+ > }++ ... which would generate:++ > $ cat result/example.json+ > [ 1.0, true ]+ >+ > $ cat result/example.yaml+ > ! "bar": null+ > ! "foo": "Hello"++ This utility does not take care of type-checking and normalizing the+ provided expression. This will raise a `FilesystemError` exception upon+ encountering an expression that is not a `TextLit` or `RecordLit`.+-}+toDirectoryTree :: FilePath -> Expr Void Void -> IO ()+toDirectoryTree path expression = case expression of+ RecordLit keyValues -> do+ let process key value = do+ Directory.createDirectoryIfMissing False path++ toDirectoryTree (path </> Text.unpack key) value++ Map.unorderedTraverseWithKey_ process keyValues++ TextLit (Chunks [] text) -> do+ Text.IO.writeFile path text++ Some value -> do+ toDirectoryTree path value++ App None _ -> do+ return ()++ _ -> do+ let unexpectedExpression = expression++ Exception.throwIO FilesystemError{..}++{- | This error indicates that you supplied an invalid Dhall expression to the+ `directoryTree` function. The Dhall expression could not be translated to+ a directory tree.+-}+newtype FilesystemError =+ FilesystemError { unexpectedExpression :: Expr Void Void }++instance Show FilesystemError where+ show FilesystemError{..} =+ Pretty.renderString (Dhall.Pretty.layout message)+ where+ message =+ Util._ERROR <> ": Not a valid directory tree expression\n\+ \ \n\+ \Explanation: Only a subset of Dhall expressions can be converted to a directory \n\+ \tree. Specifically, record literals can be converted to directories, ❰Text❱ \n\+ \literals can be converted to files, and ❰Optional❱ values are included if ❰Some❱\n\+ \and omitted if ❰None❱. No other type of value can be translated to a directory \n\+ \tree. \n\+ \ \n\+ \For example, this is a valid expression that can be translated to a directory \n\+ \tree: \n\+ \ \n\+ \ \n\+ \ ┌──────────────────────────────────┐ \n\+ \ │ { `example.json` = \"[1, true]\" } │ \n\+ \ └──────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \In contrast, the following expression is not allowed due to containing a \n\+ \❰Natural❱ field, which cannot be translated in this way: \n\+ \ \n\+ \ \n\+ \ ┌───────────────────────┐ \n\+ \ │ { `example.txt` = 1 } │ \n\+ \ └───────────────────────┘ \n\+ \ \n\+ \ \n\+ \You tried to translate the following expression to a directory tree: \n\+ \ \n\+ \" <> Util.insert unexpectedExpression <> "\n\+ \ \n\+ \... which is neither a ❰Text❱ literal, a record literal, nor an ❰Optional❱ \n\+ \value. \n"++instance Exception FilesystemError
src/Dhall/Eval.hs view
@@ -697,6 +697,12 @@ (VRecordLit m, VInject _ k mt, _) | Just f <- Map.lookup k m -> maybe f (vApp f) mt | otherwise -> error errorMsg+ (VRecordLit m, VSome t, _)+ | Just f <- Map.lookup "Some" m -> vApp f t+ | otherwise -> error errorMsg+ (VRecordLit m, VNone _, _)+ | Just t <- Map.lookup "None" m -> t+ | otherwise -> error errorMsg (x', y', ma') -> VMerge x' y' ma' ToMap x ma -> case (eval env x, fmap (eval env) ma) of
src/Dhall/Freeze.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-} -- | This module contains the implementation of the @dhall freeze@ subcommand @@ -27,7 +28,7 @@ import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text-import qualified Dhall.Core+import qualified Dhall.Core as Core import qualified Dhall.Import import qualified Dhall.Optics import qualified Dhall.Pretty@@ -60,11 +61,10 @@ Left exception -> Control.Exception.throwIO exception Right _ -> return () - let normalizedExpression =- Dhall.Core.alphaNormalize (Dhall.Core.normalize expression)+ let normalizedExpression = Core.alphaNormalize (Core.normalize expression) -- make sure the frozen import is present in the semantic cache- Dhall.Import.writeExpressionToSemanticCache (Dhall.Core.denote expression)+ Dhall.Import.writeExpressionToSemanticCache (Core.denote expression) let expressionHash = Dhall.Import.hashExpression normalizedExpression @@ -152,10 +152,10 @@ let cache (ImportAlt- (Embed+ (Core.shallowDenote -> Embed (Import { importHashed = ImportHashed { hash = Just _expectedHash } }) )- import_@(ImportAlt+ import_@(Core.shallowDenote -> ImportAlt (Embed (Import { importHashed = ImportHashed { hash = Just _actualHash } }) )@@ -190,9 +190,9 @@ traverse freezeFunction expression Cache -> Dhall.Optics.transformMOf- Dhall.Core.subExpressions+ Core.subExpressions cache- (Dhall.Core.denote expression)+ expression frozenExpression <- rewrite parsedExpression
src/Dhall/Lint.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-} -- | This module contains the implementation of the @dhall lint@ command @@ -29,7 +30,7 @@ ) import qualified Data.List.NonEmpty as NonEmpty-import qualified Dhall.Core+import qualified Dhall.Core as Core import qualified Dhall.Optics import qualified Lens.Family @@ -42,12 +43,14 @@ * consolidates nested @let@ bindings to use a multiple-@let@ binding with 'removeLetInLet' * fixes paths of the form @.\/..\/foo@ to @..\/foo@ -}-lint :: Expr s Import -> Expr t Import-lint =- Dhall.Optics.rewriteOf- subExpressions- (\e -> fixAssert e <|> removeUnusedBindings e <|> fixParentPath e)- . removeLetInLet+lint :: Expr s Import -> Expr s Import+lint = Dhall.Optics.rewriteOf subExpressions rewrite+ where+ rewrite e =+ fixAssert e+ <|> removeUnusedBindings e+ <|> fixParentPath e+ <|> removeLetInLet e -- | Remove unused `Let` bindings. removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)@@ -55,16 +58,16 @@ removeUnusedBindings (Let (Binding _ _ _ _ _ e) _) | isOrContainsAssert e = Nothing removeUnusedBindings (Let (Binding _ a _ _ _ _) d)- | not (V a 0 `Dhall.Core.freeIn` d) =- Just (Dhall.Core.shift (-1) (V a 0) d)+ | not (V a 0 `Core.freeIn` d) =+ Just (Core.shift (-1) (V a 0) d) removeUnusedBindings _ = Nothing -- | Fix `Let` bindings that the user probably meant to be `assert`s fixAssert :: Expr s a -> Maybe (Expr s a)-fixAssert (Let (Binding { value = Equivalent x y, ..}) body) =- Just (Let (Binding { value = Assert (Equivalent x y), .. }) body)-fixAssert (Let binding (Equivalent x y)) =- Just (Let binding (Assert (Equivalent x y)))+fixAssert (Let (Binding { value = v@(Core.shallowDenote -> Equivalent {}), ..}) body) =+ Just (Let (Binding { value = Assert v, .. }) body)+fixAssert (Let binding body@(Core.shallowDenote -> Equivalent {})) =+ Just (Let binding (Assert body)) fixAssert _ = Nothing @@ -109,6 +112,8 @@ -- -- is that in the second expression, the inner 'Let' is wrapped by a 'Note'. ----- Denoting removes that distinction.-removeLetInLet :: Expr s a -> Expr t a-removeLetInLet = Dhall.Core.denote+-- We remove such a 'Note' in order to consolidate nested let-blocks into a+-- single one.+removeLetInLet :: Expr s a -> Maybe (Expr s a)+removeLetInLet (Let binding (Note _ l@Let{})) = Just (Let binding l)+removeLetInLet _ = Nothing
src/Dhall/Main.hs view
@@ -28,7 +28,14 @@ import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty) import Data.Void (Void)-import Dhall.Core (Expr(Annot), Import, pretty)+import Dhall.Core+ ( Expr(Annot)+ , Import(..)+ , ImportHashed(..)+ , ImportType(..)+ , URL(..)+ , pretty+ ) import Dhall.Freeze (Intent(..), Scope(..)) import Dhall.Import (Imported(..), Depends(..), SemanticCacheMode(..), _semanticCacheMode) import Dhall.Parser (Src)@@ -60,6 +67,7 @@ import qualified Dhall.Binary import qualified Dhall.Core import qualified Dhall.Diff+import qualified Dhall.DirectoryTree as DirectoryTree import qualified Dhall.Format import qualified Dhall.Freeze import qualified Dhall.Import@@ -133,6 +141,7 @@ | Encode { file :: Input, json :: Bool } | Decode { file :: Input, json :: Bool } | Text { file :: Input }+ | DirectoryTree { file :: Input, path :: FilePath } | SyntaxTree { file :: Input } data ResolveMode@@ -240,6 +249,10 @@ "text" "Render a Dhall expression that evaluates to a Text literal" (Text <$> parseFile)+ <|> subcommand+ "to-directory-tree"+ "Convert nested records of Text literals into a directory tree"+ (DirectoryTree <$> parseFile <*> parseDirectoryTreeOutput) <|> internalSubcommand "haskell-syntax-tree" "Output the parsed syntax tree (for debugging)"@@ -408,6 +421,13 @@ <> Options.Applicative.help "Only check if the input is formatted" ) + parseDirectoryTreeOutput =+ Options.Applicative.strOption+ ( Options.Applicative.long "output"+ <> Options.Applicative.help "The destination path to create"+ <> Options.Applicative.metavar "PATH"+ )+ parseFormatMode = adapt <$> parseCheck <*> parseInplace where adapt True path = Dhall.Format.Check {..}@@ -422,6 +442,13 @@ <> Options.Applicative.fullDesc ) +noHeaders :: Import -> Import+noHeaders+ (Import { importHashed = ImportHashed { importType = Remote URL{ .. }, ..}, .. }) =+ Import { importHashed = ImportHashed { importType = Remote URL{ headers = Nothing, .. }, .. }, .. }+noHeaders i =+ i+ -- | Run the command specified by the `Options` type command :: Options -> IO () command (Options {..}) = do@@ -561,10 +588,12 @@ let dotNode (i, nodeId) = Text.Dot.userNode nodeId- [ ("label", Data.Text.unpack $ pretty i)+ [ ("label", Data.Text.unpack $ pretty (convert i)) , ("shape", "box") , ("style", "rounded") ]+ where+ convert = noHeaders . Dhall.Import.chainedImport let dotEdge (Depends parent child) = case (Data.Map.lookup parent importIds, Data.Map.lookup child importIds) of@@ -580,9 +609,7 @@ Resolve { resolveMode = Just ListImmediateDependencies, ..} -> do expression <- getExpression file - mapM_ (print- . Pretty.pretty- . Dhall.Core.importHashed) expression+ mapM_ (print . Pretty.pretty . noHeaders) expression Resolve { resolveMode = Just ListTransitiveDependencies, ..} -> do expression <- getExpression file@@ -591,10 +618,10 @@ State.execStateT (Dhall.Import.loadWith expression) (toStatus file) { _semanticCacheMode = semanticCacheMode } mapM_ print- . fmap ( Pretty.pretty- . Dhall.Core.importType- . Dhall.Core.importHashed- . Dhall.Import.chainedImport )+ . fmap ( Pretty.pretty+ . noHeaders+ . Dhall.Import.chainedImport+ ) . reverse . Dhall.Map.keys $ _cache@@ -761,6 +788,18 @@ System.IO.withFile file System.IO.WriteMode (`Data.Text.IO.hPutStr` tags) StandardOutput -> Data.Text.IO.putStrLn tags++ DirectoryTree {..} -> do+ expression <- getExpression file++ resolvedExpression <-+ Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression++ _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)++ let normalizedExpression = Dhall.Core.normalize resolvedExpression++ DirectoryTree.toDirectoryTree path normalizedExpression SyntaxTree {..} -> do expression <- getExpression file
src/Dhall/Normalize.hs view
@@ -920,6 +920,14 @@ Nothing -> Merge x' y' <$> t' _ -> Merge x' y' <$> t'+ Some a ->+ case Dhall.Map.lookup "Some" kvsX of+ Just vX -> loop (App vX a)+ Nothing -> Merge x' y' <$> t'+ App None _ ->+ case Dhall.Map.lookup "None" kvsX of+ Just vX -> return vX+ Nothing -> Merge x' y' <$> t' _ -> Merge x' y' <$> t' _ -> Merge x' y' <$> t' where@@ -1191,7 +1199,14 @@ decide (RecordLit _) (RecordLit _) = False decide l r = not (Eval.judgmentallyEqual l r) RecordCompletion _ _ -> False- Merge x y t -> loop x && loop y && all loop t+ Merge x y t -> loop x && loop y && all loop t && case x of+ RecordLit _ -> case y of+ Field (Union _) _ -> False+ App (Field (Union _) _) _ -> False+ Some _ -> False+ App None _ -> False+ _ -> True+ _ -> True ToMap x t -> case x of RecordLit _ -> False _ -> loop x && all loop t
src/Dhall/Parser/Expression.hs view
@@ -12,7 +12,6 @@ import Data.ByteArray.Encoding (Base(..)) import Data.Foldable (foldl') import Data.Functor (void)-import Data.List.NonEmpty (NonEmpty(..)) import Data.Semigroup (Semigroup(..)) import Data.Text (Text) import Dhall.Syntax@@ -24,7 +23,6 @@ import qualified Data.ByteArray.Encoding import qualified Data.ByteString import qualified Data.Char as Char-import qualified Data.Foldable import qualified Data.List import qualified Data.List.NonEmpty import qualified Data.Sequence@@ -673,7 +671,7 @@ _ <- endOfLine a <- singleQuoteContinue - return (toDoubleQuoted a)+ return (Dhall.Syntax.toDoubleQuoted a) where endOfLine = (void (char '\n') <|> void (text "\r\n")) <?> "newline" @@ -935,89 +933,3 @@ try (whitespace *> _as *> nonemptyWhitespace) (_Text >> pure RawText) <|> (_Location >> pure Location)---- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result-splitOn :: Text -> Text -> NonEmpty Text-splitOn needle haystack =- case Data.Text.splitOn needle haystack of- [] -> "" :| []- t : ts -> t :| ts---- | Split `Chunks` by lines-linesLiteral :: Chunks s a -> NonEmpty (Chunks s a)-linesLiteral (Chunks [] suffix) =- fmap (Chunks []) (splitOn "\n" suffix)-linesLiteral (Chunks ((prefix, interpolation) : pairs₀) suffix₀) =- foldr- Data.List.NonEmpty.cons- (Chunks ((lastLine, interpolation) : pairs₁) suffix₁ :| chunks)- (fmap (Chunks []) initLines)- where- splitLines = splitOn "\n" prefix-- initLines = Data.List.NonEmpty.init splitLines- lastLine = Data.List.NonEmpty.last splitLines-- Chunks pairs₁ suffix₁ :| chunks = linesLiteral (Chunks pairs₀ suffix₀)---- | Flatten several `Chunks` back into a single `Chunks` by inserting newlines-unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a-unlinesLiteral chunks =- Data.Foldable.fold (Data.List.NonEmpty.intersperse "\n" chunks)---- | Returns `True` if the `Chunks` represents a blank line-emptyLine :: Chunks s a -> Bool-emptyLine (Chunks [] "" ) = True-emptyLine (Chunks [] "\r") = True -- So that `\r\n` is treated as a blank line-emptyLine _ = False---- | Return the leading whitespace for a `Chunks` literal-leadingSpaces :: Chunks s a -> Text-leadingSpaces chunks = Data.Text.takeWhile isSpace firstText- where- isSpace c = c == '\x20' || c == '\x09'-- firstText =- case chunks of- Chunks [] suffix -> suffix- Chunks ((prefix, _) : _ ) _ -> prefix---- | Drop the first @n@ characters for a `Chunks` literal-dropLiteral :: Int -> Chunks s a -> Chunks s a-dropLiteral n (Chunks [] suffix) =- Chunks [] (Data.Text.drop n suffix)-dropLiteral n (Chunks ((prefix, interpolation) : rest) suffix) =- Chunks ((Data.Text.drop n prefix, interpolation) : rest) suffix--{-| Convert a single-quoted `Chunks` literal to the equivalent double-quoted- `Chunks` literal--}-toDoubleQuoted :: Chunks Src a -> Chunks Src a-toDoubleQuoted literal =- unlinesLiteral (fmap (dropLiteral indent) literals)- where- literals = linesLiteral literal-- sharedPrefix ab ac =- case Data.Text.commonPrefixes ab ac of- Just (a, _b, _c) -> a- Nothing -> ""-- -- The standard specifies to filter out blank lines for all lines *except*- -- for the last line- filteredLines = newInit <> pure oldLast- where- oldInit = Data.List.NonEmpty.init literals-- oldLast = Data.List.NonEmpty.last literals-- newInit = filter (not . emptyLine) oldInit-- longestSharedPrefix =- case filteredLines of- l : ls ->- Data.Foldable.foldl' sharedPrefix (leadingSpaces l) (fmap leadingSpaces ls)- [] ->- ""-- indent = Data.Text.length longestSharedPrefix
src/Dhall/Parser/Token.hs view
@@ -213,8 +213,8 @@ integerLiteral :: Parser Integer integerLiteral = (do sign <- signPrefix- a <- Text.Megaparsec.Char.Lexer.decimal- return (sign a) ) <?> "literal"+ a <- naturalLiteral+ return (sign (fromIntegral a)) ) <?> "literal" {-| Parse a `Natural` literal @@ -222,7 +222,8 @@ -} naturalLiteral :: Parser Natural naturalLiteral = (do- a <- Text.Megaparsec.Char.Lexer.decimal+ a <- try (char '0' >> char 'x' >> Text.Megaparsec.Char.Lexer.hexadecimal)+ <|> Text.Megaparsec.Char.Lexer.decimal return a ) <?> "literal" {-| Parse an identifier (i.e. a variable or built-in)@@ -239,8 +240,8 @@ whitespace _at whitespace- n <- Text.Megaparsec.Char.Lexer.decimal- return n+ n <- naturalLiteral+ return (fromIntegral n) n <- indexed <|> pure 0 return (V x n)@@ -339,10 +340,13 @@ Control.Monad.guard (allowReserved || not (Data.HashSet.member t reservedIdentifiers)) return t ) where- headCharacter c = alpha c || c == '_' - tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/'+headCharacter :: Char -> Bool+headCharacter c = alpha c || c == '_' +tailCharacter :: Char -> Bool+tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/'+ backtickLabel :: Parser Text backtickLabel = do _ <- char '`'@@ -1119,7 +1123,9 @@ -- | Parse the @missing@ keyword _missing :: Parser ()-_missing = keyword "missing"+_missing =+ keyword "missing"+ *> Text.Megaparsec.notFollowedBy (Text.Parser.Char.satisfy tailCharacter) -- | Parse the @?@ symbol _importAlt :: Parser ()
src/Dhall/Pretty.hs view
@@ -12,6 +12,9 @@ , Dhall.Pretty.Internal.layout , Dhall.Pretty.Internal.layoutOpts++ , escapeEnvironmentVariable+ , escapeLabel ) where import Dhall.Pretty.Internal
src/Dhall/Pretty/Internal.hs view
@@ -21,9 +21,11 @@ , prettyVar , pretty_ , escapeText_+ , escapeEnvironmentVariable , prettyEnvironmentVariable , prettyConst+ , escapeLabel , prettyLabel , prettyAnyLabel , prettyLabels@@ -211,7 +213,7 @@ builtin = Pretty.annotate Builtin operator = Pretty.annotate Operator -comma, lbracket, rbracket, langle, rangle, lbrace, rbrace, lparen, rparen, pipe, backtick, dollar, colon, equals, dot :: Doc Ann+comma, lbracket, rbracket, langle, rangle, lbrace, rbrace, lparen, rparen, pipe, dollar, colon, equals, dot :: Doc Ann comma = syntax Pretty.comma lbracket = syntax Pretty.lbracket rbracket = syntax Pretty.rbracket@@ -222,7 +224,6 @@ lparen = syntax Pretty.lparen rparen = syntax Pretty.rparen pipe = syntax Pretty.pipe-backtick = syntax "`" dollar = syntax "$" colon = syntax ":" equals = syntax "="@@ -282,16 +283,18 @@ rbrace docs -hangingBraces :: [(Doc Ann, Doc Ann)] -> Doc Ann-hangingBraces [] =+hangingBraces :: Int -> [(Doc Ann, Doc Ann)] -> Doc Ann+hangingBraces _ [] = lbrace <> rbrace-hangingBraces docs =+hangingBraces n docs = Pretty.group (Pretty.flatAlt ( lbrace <> Pretty.hardline- <> mconcat (zipWith combineLong (repeat separator) docsLong)- <> rbrace+ <> Pretty.indent n+ ( mconcat (zipWith combineLong (repeat separator) docsLong)+ <> rbrace+ ) ) (mconcat (zipWith (<>) (beginShort : repeat separator) docsShort) <> space <> rbrace) )@@ -420,15 +423,17 @@ tailCharacter :: Char -> Bool tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/' +-- | Escape a label if it is not valid when unquoted+escapeLabel :: Bool -> Text -> Text+escapeLabel allowReserved l =+ case Text.uncons l of+ Just (h, t)+ | headCharacter h && Text.all tailCharacter t && (allowReserved || not (Data.HashSet.member l reservedIdentifiers))+ -> l+ _ -> "`" <> l <> "`"+ prettyLabelShared :: Bool -> Text -> Doc Ann-prettyLabelShared allowReserved a = label doc- where- doc =- case Text.uncons a of- Just (h, t)- | headCharacter h && Text.all tailCharacter t && (allowReserved || not (Data.HashSet.member a reservedIdentifiers))- -> Pretty.pretty a- _ -> backtick <> Pretty.pretty a <> backtick+prettyLabelShared b l = label (Pretty.pretty (escapeLabel b l)) prettyLabel :: Text -> Doc Ann prettyLabel = prettyLabelShared False@@ -465,9 +470,13 @@ prettyVar (V x n) = label (Pretty.unAnnotate (prettyLabel x <> "@" <> prettyInt n)) prettyEnvironmentVariable :: Text -> Doc ann-prettyEnvironmentVariable t- | validBashEnvVar t = Pretty.pretty t- | otherwise = Pretty.pretty ("\"" <> escapeText_ t <> "\"")+prettyEnvironmentVariable t = Pretty.pretty (escapeEnvironmentVariable t)++-- | Escape an environment variable if not a valid Bash environment variable+escapeEnvironmentVariable :: Text -> Text+escapeEnvironmentVariable t+ | validBashEnvVar t = t+ | otherwise = "\"" <> escapeText_ t <> "\"" where validBashEnvVar v = case Text.uncons v of Nothing -> False@@ -918,7 +927,7 @@ Pretty.align ( prettySelectorExpression a <> doubleColon- <> prettyCompletionLit kvs+ <> prettyCompletionLit 0 kvs ) _ -> prettySelectorExpression a <> doubleColon@@ -1048,18 +1057,46 @@ prettyKeyValue separator (key, val) = duplicate (Pretty.group (Pretty.flatAlt long short)) where+ completion _T r =+ " "+ <> prettySelectorExpression _T+ <> doubleColon+ <> case shallowDenote r of+ RecordLit kvs ->+ prettyCompletionLit 2 kvs+ _ ->+ prettySelectorExpression r+ short = prettyAnyLabel key <> " " <> separator <> " " <> prettyExpression val - long = prettyAnyLabel key+ long =+ prettyAnyLabel key <> " " <> separator- <> Pretty.hardline- <> " "- <> prettyExpression val+ <> case shallowDenote val of+ Some val' ->+ " Some"+ <> case shallowDenote val' of+ RecordCompletion _T r ->+ completion _T r+ _ -> Pretty.hardline+ <> " "+ <> prettyImportExpression val'+ RecordCompletion _T r ->+ completion _T r+ ListLit _ xs+ | not (null xs) ->+ Pretty.hardline+ <> " "+ <> prettyExpression val+ _ -> + Pretty.hardline+ <> " "+ <> prettyExpression val prettyRecord :: Pretty a => Map Text (Expr Src a) -> Doc Ann prettyRecord =@@ -1073,12 +1110,12 @@ braces (map (prettyKeyValue equals) (Dhall.Map.toList a)) prettyCompletionLit- :: Pretty a => Map Text (Expr Src a) -> Doc Ann- prettyCompletionLit a+ :: Pretty a => Int -> Map Text (Expr Src a) -> Doc Ann+ prettyCompletionLit n a | Data.Foldable.null a = lbrace <> equals <> rbrace | otherwise =- hangingBraces (map (prettyKeyValue equals) (Dhall.Map.toList a))+ hangingBraces n (map (prettyKeyValue equals) (Dhall.Map.toList a)) prettyAlternative (key, Just val) = prettyKeyValue colon (key, val) prettyAlternative (key, Nothing ) = duplicate (prettyAnyLabel key)@@ -1151,53 +1188,46 @@ multilineChunks = escapeTrailingSingleQuote . escapeControlCharacters- . escapeLastLineLeadingWhitespace+ . escapeSharedWhitespacePrefix --- | Escape leading whitespace on the last line by moving it into a string--- interpolation+-- | Escape any leading whitespace shared by all lines ----- This ensures that the parser can find the correct indentation level, no matter--- what the other lines contain.-+-- This ensures that significant shared leading whitespace is not stripped ----- >>> escapeLastLineLeadingWhitespace (Chunks [] "\n \tx")+-- >>> escapeSharedWhitespacePrefix (Chunks [] "\n \tx") -- Chunks [("\n",TextLit (Chunks [] " \t"))] "x"--- >>> escapeLastLineLeadingWhitespace (Chunks [("\n",Var (V "x" 0))] " ")+-- >>> escapeSharedWhitespacePrefix (Chunks [("\n",Var (V "x" 0))] " ") -- Chunks [("\n",Var (V "x" 0))] " "--- >>> escapeLastLineLeadingWhitespace (Chunks [("\n ",Var (V "x" 0))] "")+-- >>> escapeSharedWhitespacePrefix (Chunks [("\n ",Var (V "x" 0))] "") -- Chunks [("\n",TextLit (Chunks [] " ")),("",Var (V "x" 0))] ""--- >>> escapeLastLineLeadingWhitespace (Chunks [("\n ",Var (V "x" 0))] "\n")+-- >>> escapeSharedWhitespacePrefix (Chunks [("\n ",Var (V "x" 0))] "\n") -- Chunks [("\n ",Var (V "x" 0))] "\n"------ We assume that there's at least one newline and may therefore ignore leading--- whitespace on the first line:------ >>> escapeLastLineLeadingWhitespace (Chunks [] " ")--- Chunks [] " "-escapeLastLineLeadingWhitespace :: Chunks s a -> Chunks s a-escapeLastLineLeadingWhitespace (Chunks as0 b0) =- case escape1 b0 of- Nothing -> Chunks (escapeChunks as0) b0- Just (Chunks cs b1) -> Chunks (as0 ++ cs) b1+-- >>> escapeSharedWhitespacePrefix (Chunks [] " ")+-- Chunks [("",TextLit (Chunks [] " "))] ""+escapeSharedWhitespacePrefix :: Chunks s a -> Chunks s a+escapeSharedWhitespacePrefix literal_ = unlinesLiteral literals₁ where- -- Nothing: No newline found- -- Just chunks: Newline was found!- escape1 :: Text -> Maybe (Chunks s a)- escape1 t = case Text.breakOnEnd "\n" t of- ("", _) -> Nothing- (a , b) -> Just $ case Text.span predicate b of- ("", _) -> Chunks [] t- (c , d) -> Chunks [(a, TextLit (Chunks [] c))] d+ literals₀ = linesLiteral literal_ - predicate c = c == ' ' || c == '\t'+ sharedPrefix = longestSharedWhitespacePrefix literals₀ - escapeChunks = snd . foldr f (NotDone, [])+ stripPrefix = Text.drop (Text.length sharedPrefix) - f chunk (Done , chunks) = (Done, chunk : chunks)- f (t, e) (NotDone, chunks) = case escape1 t of- Nothing -> (NotDone, (t, e) : chunks)- Just (Chunks as b) -> (Done, as ++ (b, e) : chunks)+ escapeSharedPrefix (Chunks [] prefix₀)+ | Text.isPrefixOf sharedPrefix prefix₀ =+ Chunks [ ("", TextLit (Chunks [] sharedPrefix)) ] prefix₁+ where+ prefix₁ = stripPrefix prefix₀+ escapeSharedPrefix (Chunks ((prefix₀, y) : xys) z)+ | Text.isPrefixOf sharedPrefix prefix₀ =+ Chunks (("", TextLit (Chunks [] sharedPrefix)) : (prefix₁, y) : xys) z+ where+ prefix₁ = stripPrefix prefix₀+ escapeSharedPrefix line = line -data Done = NotDone | Done+ literals₁+ | not (Text.null sharedPrefix) = fmap escapeSharedPrefix literals₀+ | otherwise = literals₀ -- | Escape control characters by moving them into string interpolations --@@ -1320,7 +1350,6 @@ layoutOpts = Pretty.defaultLayoutOptions { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }- {- $setup >>> import Test.QuickCheck (Fun(..))
src/Dhall/Syntax.hs view
@@ -56,6 +56,12 @@ -- * Reserved identifiers , reservedIdentifiers++ -- * `Text` manipulation+ , toDoubleQuoted+ , longestSharedWhitespacePrefix+ , linesLiteral+ , unlinesLiteral ) where import Control.DeepSeq (NFData)@@ -1204,3 +1210,93 @@ , "Kind" , "Sort" ]++-- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result+splitOn :: Text -> Text -> NonEmpty Text+splitOn needle haystack =+ case Data.Text.splitOn needle haystack of+ [] -> "" :| []+ t : ts -> t :| ts++-- | Split `Chunks` by lines+linesLiteral :: Chunks s a -> NonEmpty (Chunks s a)+linesLiteral (Chunks [] suffix) =+ fmap (Chunks []) (splitOn "\n" suffix)+linesLiteral (Chunks ((prefix, interpolation) : pairs₀) suffix₀) =+ foldr+ Data.List.NonEmpty.cons+ (Chunks ((lastLine, interpolation) : pairs₁) suffix₁ :| chunks)+ (fmap (Chunks []) initLines)+ where+ splitLines = splitOn "\n" prefix++ initLines = Data.List.NonEmpty.init splitLines+ lastLine = Data.List.NonEmpty.last splitLines++ Chunks pairs₁ suffix₁ :| chunks = linesLiteral (Chunks pairs₀ suffix₀)++-- | Flatten several `Chunks` back into a single `Chunks` by inserting newlines+unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a+unlinesLiteral chunks =+ Data.Foldable.fold (Data.List.NonEmpty.intersperse "\n" chunks)++-- | Returns `True` if the `Chunks` represents a blank line+emptyLine :: Chunks s a -> Bool+emptyLine (Chunks [] "" ) = True+emptyLine (Chunks [] "\r") = True -- So that `\r\n` is treated as a blank line+emptyLine _ = False++-- | Return the leading whitespace for a `Chunks` literal+leadingSpaces :: Chunks s a -> Text+leadingSpaces chunks = Data.Text.takeWhile isSpace firstText+ where+ isSpace c = c == ' ' || c == '\t'++ firstText =+ case chunks of+ Chunks [] suffix -> suffix+ Chunks ((prefix, _) : _ ) _ -> prefix++{-| Compute the longest shared whitespace prefix for the purposes of stripping+ leading indentation+-}+longestSharedWhitespacePrefix :: NonEmpty (Chunks s a) -> Text+longestSharedWhitespacePrefix literals =+ case fmap leadingSpaces filteredLines of+ l : ls -> Data.Foldable.foldl' sharedPrefix l ls+ [] -> ""+ where+ sharedPrefix ab ac =+ case Data.Text.commonPrefixes ab ac of+ Just (a, _b, _c) -> a+ Nothing -> ""++ -- The standard specifies to filter out blank lines for all lines *except*+ -- for the last line+ filteredLines = newInit <> pure oldLast+ where+ oldInit = Data.List.NonEmpty.init literals++ oldLast = Data.List.NonEmpty.last literals++ newInit = filter (not . emptyLine) oldInit++-- | Drop the first @n@ characters for a `Chunks` literal+dropLiteral :: Int -> Chunks s a -> Chunks s a+dropLiteral n (Chunks [] suffix) =+ Chunks [] (Data.Text.drop n suffix)+dropLiteral n (Chunks ((prefix, interpolation) : rest) suffix) =+ Chunks ((Data.Text.drop n prefix, interpolation) : rest) suffix++{-| Convert a single-quoted `Chunks` literal to the equivalent double-quoted+ `Chunks` literal+-}+toDoubleQuoted :: Chunks Src a -> Chunks Src a+toDoubleQuoted literal =+ unlinesLiteral (fmap (dropLiteral indent) literals)+ where+ literals = linesLiteral literal++ longestSharedPrefix = longestSharedWhitespacePrefix literals++ indent = Data.Text.length longestSharedPrefix
src/Dhall/TH.hs view
@@ -1,10 +1,54 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} -{-| This module provides `staticDhallExpression` which can be used to resolve- all of an expression’s imports at compile time, allowing one to reference- Dhall expressions from Haskell without having a runtime dependency on the- location of Dhall files.+-- | Template Haskell utilities+module Dhall.TH+ ( -- * Template Haskell+ staticDhallExpression+ , makeHaskellTypeFromUnion+ ) where +import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Text.Prettyprint.Doc (Pretty)+import Dhall.Syntax (Expr(..))+import Language.Haskell.TH.Quote (dataToExpQ) -- 7.10 compatibility.++import Language.Haskell.TH.Syntax+ ( Con(..)+ , Dec(..)+ , Exp(..)+ , Q+ , Type(..)+#if MIN_VERSION_template_haskell(2,11,0)+ , Bang(..)+ , SourceStrictness(..)+ , SourceUnpackedness(..)+#else+ , Strict(..)+#endif+ )++import qualified Data.Text as Text+import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty+import qualified Data.Typeable as Typeable+import qualified Dhall+import qualified Dhall.Map+import qualified Dhall.Pretty+import qualified Dhall.Util+import qualified GHC.IO.Encoding+import qualified Numeric.Natural+import qualified System.IO+import qualified Language.Haskell.TH.Syntax as Syntax++{-| This fully resolves, type checks, and normalizes the expression, so the+ resulting AST is self-contained.++ This can be used to resolve all of an expression’s imports at compile time,+ allowing one to reference Dhall expressions from Haskell without having a+ runtime dependency on the location of Dhall files.+ For example, given a file @".\/Some\/Type.dhall"@ containing > < This : Natural | Other : ../Other/Type.dhall >@@ -22,28 +66,217 @@ at compile time with all imports resolved, making it easy to keep your Dhall configs and Haskell interpreters in sync. -}-module Dhall.TH- ( -- * Template Haskell- staticDhallExpression- ) where--import Data.Typeable-import Language.Haskell.TH.Quote (dataToExpQ) -- 7.10 compatibility.-import Language.Haskell.TH.Syntax+staticDhallExpression :: Text -> Q Exp+staticDhallExpression text = do+ Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) -import qualified Data.Text as Text-import qualified Dhall-import qualified GHC.IO.Encoding-import qualified System.IO+ expression <- Syntax.runIO (Dhall.inputExpr text) --- | This fully resolves, type checks, and normalizes the expression, so the--- resulting AST is self-contained.-staticDhallExpression :: Text.Text -> Q Exp-staticDhallExpression text = do- runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)- expression <- runIO (Dhall.inputExpr text)- dataToExpQ (\a -> liftText <$> cast a) expression+ dataToExpQ (\a -> liftText <$> Typeable.cast a) expression where -- A workaround for a problem in TemplateHaskell (see -- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable)- liftText = fmap (AppE (VarE 'Text.pack)) . lift . Text.unpack+ liftText = fmap (AppE (VarE 'Text.pack)) . Syntax.lift . Text.unpack++{-| Convert a Dhall type to a Haskell type that does not require any new+ data declarations+-}+toSimpleHaskellType :: Pretty a => Expr s a -> Q Type+toSimpleHaskellType dhallType =+ case dhallType of+ Bool -> do+ return (ConT ''Bool)++ Double -> do+ return (ConT ''Double)++ Integer -> do+ return (ConT ''Integer)++ Natural -> do+ return (ConT ''Numeric.Natural.Natural)++ Text -> do+ return (ConT ''Text)++ App List dhallElementType -> do+ haskellElementType <- toSimpleHaskellType dhallElementType++ return (AppT (ConT ''[]) haskellElementType)++ App Optional dhallElementType -> do+ haskellElementType <- toSimpleHaskellType dhallElementType++ return (AppT (ConT ''Maybe) haskellElementType)++ _ -> do+ let document =+ mconcat+ [ "Unsupported simple type\n"+ , " \n"+ , "Explanation: Not all Dhall alternative types can be converted to Haskell \n"+ , "constructor types. Specifically, only the following simple Dhall types are \n"+ , "supported as an alternative type or a field of an alternative type: \n"+ , " \n"+ , "• ❰Bool❱ \n"+ , "• ❰Double❱ \n"+ , "• ❰Integer❱ \n"+ , "• ❰Natural❱ \n"+ , "• ❰Text❱ \n"+ , "• ❰List a❱ (where ❰a❱ is also a simple type) \n"+ , "• ❰Optional a❱ (where ❰a❱ is also a simple type) \n"+ , " \n"+ , "The Haskell datatype generation logic encountered the following complex \n"+ , "Dhall type: \n"+ , " \n"+ , " " <> Dhall.Util.insert dhallType <> "\n"+ , " \n"+ , "... where a simpler type was expected."+ ]++ let message = Pretty.renderString (Dhall.Pretty.layout document)++ fail message++-- | Convert a Dhall type to the corresponding Haskell constructor type+toConstructor :: Pretty a => (Text, Maybe (Expr s a)) -> Q Con+toConstructor (constructorName, maybeAlternativeType) = do+ let name = Syntax.mkName (Text.unpack constructorName)++#if MIN_VERSION_template_haskell(2,11,0)+ let bang = Bang NoSourceUnpackedness NoSourceStrictness+#else+ let bang = NotStrict+#endif++ case maybeAlternativeType of+ Just (Record kts) -> do+ let process (key, dhallFieldType) = do+ haskellFieldType <- toSimpleHaskellType dhallFieldType++ return (Syntax.mkName (Text.unpack key), bang, haskellFieldType)++ varBangTypes <- traverse process (Dhall.Map.toList kts)++ return (RecC name varBangTypes)++ Just dhallAlternativeType -> do+ haskellAlternativeType <- toSimpleHaskellType dhallAlternativeType++ return (NormalC name [ (bang, haskellAlternativeType) ])++ Nothing -> do+ return (NormalC name [])++-- | Generate a Haskell datatype declaration from a Dhall union type where+-- each union alternative corresponds to a Haskell constructor+--+-- This comes in handy if you need to keep a Dhall type and Haskell type in+-- sync. You make the Dhall type the source of truth and use Template Haskell+-- to generate the matching Haskell type declaration from the Dhall type.+--+-- For example, this Template Haskell splice:+--+-- > Dhall.TH.makeHaskellTypeFromUnion "T" "< A : { x : Bool } | B >"+--+-- ... generates this Haskell code:+--+-- > data T = A {x :: GHC.Types.Bool} | B+--+-- If you are starting from an existing record type that you want to convert to+-- a Haskell type, wrap the record type in a union with one alternative, like+-- this:+--+-- > Dhall.TH.makeHaskellTypeFromUnion "T" "< A : ./recordType.dhall >"+--+-- To add any desired instances (such as `Dhall.FromDhall`/`Dhall.ToDhall`),+-- you can use the `StandaloneDeriving` language extension, like this:+--+-- > {-# LANGUAGE DeriveAnyClass #-}+-- > {-# LANGUAGE DeriveGeneric #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE StandaloneDeriving #-}+-- > {-# LANGUAGE TemplateHaskell #-}+-- >+-- > Dhall.TH.makeHaskellTypeFromUnion "T" "< A : { x : Bool } | B >"+-- > +-- > deriving instance Generic T+-- > deriving instance FromDhall T+makeHaskellTypeFromUnion+ :: Text+ -- ^ Name of the generated Haskell type+ -> Text+ -- ^ Dhall code that evaluates to a union type+ -> Q [Dec]+makeHaskellTypeFromUnion typeName text = do+ Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)++ expression <- Syntax.runIO (Dhall.inputExpr text)++ case expression of+ Union kts -> do+ let name = Syntax.mkName (Text.unpack typeName)++ constructors <- traverse toConstructor (Dhall.Map.toList kts )++ let declaration = DataD [] name []+#if MIN_VERSION_template_haskell(2,11,0)+ Nothing+#else+#endif+ constructors []++ return [ declaration ]++ _ -> do+ let document =+ mconcat+ [ "Dhall.TH.makeHaskellTypeFromUnion: Unsupported Dhall type\n"+ , " \n"+ , "Explanation: This function only coverts Dhall union types to Haskell datatype \n"+ , "declarations. \n"+ , " \n"+ , "For example, this is a valid Dhall union type that this function would accept: \n"+ , " \n"+ , " \n"+ , " ┌──────────────────────────────────────────────────────────────────┐ \n"+ , " │ Dhall.TH.makeHaskellTypeFromUnion \"T\" \"< A : { x : Bool } | B >\" │ \n"+ , " └──────────────────────────────────────────────────────────────────┘ \n"+ , " \n"+ , " \n"+ , "... which corresponds to this Haskell type declaration: \n"+ , " \n"+ , " \n"+ , " ┌──────────────────────────────────────┐ \n"+ , " │ data T = A {x :: GHC.Types.Bool} | B │ \n"+ , " └──────────────────────────────────────┘ \n"+ , " \n"+ , " \n"+ , "... but the following Dhall type is rejected due to being a bare record type: \n"+ , " \n"+ , " \n"+ , " ┌──────────────────────────────────────────────────────┐ \n"+ , " │ Dhall.TH.makeHaskellTypeFromUnion \"T\" \"{ x : Bool }\" │ Not valid \n"+ , " └──────────────────────────────────────────────────────┘ \n"+ , " \n"+ , " \n"+ , "If you are starting from a file containing only a record type and you want to \n"+ , "generate a Haskell type from that, then wrap the record type in a union with one\n"+ , "alternative, like this: \n"+ , " \n"+ , " \n"+ , " ┌──────────────────────────────────────────────────────────────────┐ \n"+ , " │ Dhall.TH.makeHaskellTypeFromUnion \"T\" \"< A : ./recordType.dhall >\" │ \n"+ , " └──────────────────────────────────────────────────────────────────┘ \n"+ , " \n"+ , " \n"+ , "The Haskell datatype generation logic encountered the following Dhall type: \n"+ , " \n"+ , " " <> Dhall.Util.insert expression <> "\n"+ , " \n"+ , "... which is not a union type."+ ]++ let message = Pretty.renderString (Dhall.Pretty.layout document)++ fail message
src/Dhall/Tutorial.hs view
@@ -1880,7 +1880,7 @@ -- > let inputSettings = transform Dhall.defaultInputSettings -- > where -- > transform =--- > Lens.set Dhall.normalizer (ReifiedNormalizer (pure . normalizer))+-- > Lens.set Dhall.normalizer (Just (ReifiedNormalizer (pure . normalizer))) -- > . Lens.set Dhall.startingContext startingContext -- > -- > x <- Dhall.inputWithSettings inputSettings Dhall.auto text
src/Dhall/TypeCheck.hs view
@@ -24,6 +24,8 @@ , DetailedTypeError(..) , Censored(..) , TypeMessage(..)+ , prettyTypeMessage+ , ErrorMessages(..) ) where import Control.Exception (Exception)@@ -933,10 +935,15 @@ VUnion yUs' -> do return yUs' + VOptional _O' ->+ -- This is a bit of hack, but it allows us to reuse the+ -- rather complex type-matching logic for Optionals.+ return (Dhall.Map.unorderedFromList [("None", Nothing), ("Some", Just _O')])+ _ -> do let _U'' = quote names _U' - die (MustMergeUnion u _U'')+ die (MustMergeUnionOrOptional u _U'') let ysT = Dhall.Map.keysSet yTs' let ysU = Dhall.Map.keysSet yUs'@@ -1307,7 +1314,7 @@ | 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)+ | MustMergeUnionOrOptional (Expr s a) (Expr s a) | MustMapARecord (Expr s a) (Expr s a) | InvalidToMapRecordKind (Expr s a) (Expr s a) | HeterogenousRecordToMap (Expr s a) (Expr s a) (Expr s a)@@ -1357,6 +1364,9 @@ where ErrorMessages {..} = prettyTypeMessage msg +{-| Output of `prettyTypeMessage`, containing short- and long-form error+ messages+-} data ErrorMessages = ErrorMessages { short :: Doc Ann -- ^ Default succinct 1-line explanation of what went wrong@@ -1370,6 +1380,7 @@ insert :: Pretty a => a -> Doc Ann insert = Dhall.Util.insert +-- | Convert a `TypeMessage` to short- and long-form `ErrorMessages` prettyTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages prettyTypeMessage (UnboundVariable x) = ErrorMessages {..} -- We do not need to print variable name here. For the discussion see:@@ -2969,14 +2980,14 @@ 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\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ in let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -2985,10 +2996,10 @@ \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\+ \ │ let handler = λ(x : Bool) → x │ \n\+ \ │ in merge handler (< Foo : Bool >.Foo True) │ \n\+ \ └─────────────────────────────────────────────┘ \n\ \ ⇧ \n\ \ Invalid: ❰handler❱ isn't a record \n\ \ \n\@@ -3019,40 +3030,50 @@ txt0 = insert expr0 txt1 = insert expr1 -prettyTypeMessage (MustMergeUnion expr0 expr1) = ErrorMessages {..}+prettyTypeMessage (MustMergeUnionOrOptional expr0 expr1) = ErrorMessages {..} where- short = "❰merge❱ expects a union"+ short = "❰merge❱ expects a union or an ❰Optional❱" long =- "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\- \handler per alternative, like this: \n\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\- \... but the second argument to ❰merge❱ must be a union and not some other type. \n\+ \... or this: \n\ \ \n\+ \ \n\+ \ ┌─────────────────────────────────────────────────────────┐ \n\+ \ │ let optional = None Bool │ \n\+ \ │ let handlers = { None = False, Some = λ(x : Bool) → x } │ \n\+ \ │ in merge handlers optional │ \n\+ \ └─────────────────────────────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \... but the second argument to ❰merge❱ must not be some other type. \n\+ \ \n\ \For example, the following expression is " <> _NOT <> " valid: \n\ \ \n\ \ \n\ \ ┌──────────────────────────────────────────┐ \n\ \ │ let handlers = { Foo = λ(x : Bool) → x } │ \n\- \ │ in merge handlers True : True │ \n\+ \ │ in merge handlers True │ \n\ \ └──────────────────────────────────────────┘ \n\ \ ⇧ \n\- \ Invalid: ❰True❱ isn't a union \n\+ \ Invalid: ❰True❱ isn't a union or an ❰Optional❱ \n\ \ \n\ \ \n\ \You tried to ❰merge❱ this expression: \n\ \ \n\ \" <> txt0 <> "\n\ \ \n\- \... which is not a union, but is actually a value of type: \n\+ \... which is not a union or an ❰Optional❱, but is actually a value of type: \n\ \ \n\ \" <> txt1 <> "\n" where@@ -3064,14 +3085,14 @@ 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\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3087,7 +3108,7 @@ \ │ { Left = Natural/even │ \n\ \ │ , Right = λ(x : Bool) → x │ Invalid: ❰Right❱ handler isn't\n\ \ │ } │ used \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └──────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3107,14 +3128,14 @@ . map Dhall.Pretty.Internal.prettyLabel $ exemplar:xs) long =- "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\- \handler per alternative, like this: \n\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3129,7 +3150,7 @@ \ ┌──────────────────────────────────────────────────────────────┐ \n\ \ │ let handlers = { Left = Natural/even } │ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └──────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3155,7 +3176,7 @@ \ ┌─────────────────────────────────────────────────────────────────┐ \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\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3180,14 +3201,14 @@ <> 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\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3214,7 +3235,7 @@ \ ┌──────────────────────────────────────────────────────────────────┐ \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\+ \ │ in merge handlers union │ \n\ \ └──────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3240,14 +3261,14 @@ short = "Disallowed handler type" long =- "Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\- \handler per alternative, like this: \n\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3288,8 +3309,8 @@ <> 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\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\@@ -3352,14 +3373,14 @@ <> 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\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3406,14 +3427,14 @@ short = "Handler for "<> Dhall.Pretty.Internal.prettyLabel k <> " 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\+ "Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\+ \a record with one handler per alternative, like this: \n\ \ \n\ \ \n\ \ ┌─────────────────────────────────────────────────────────────────┐ \n\ \ │ let union = < Left : Natural | Right : Bool >.Left 2 │ \n\ \ │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │ \n\- \ │ in merge handlers union : Bool │ \n\+ \ │ in merge handlers union │ \n\ \ └─────────────────────────────────────────────────────────────────┘ \n\ \ \n\ \ \n\@@ -3422,9 +3443,9 @@ \For example, the following expression is " <> _NOT <> " valid: \n\ \ \n\ \ \n\- \ ┌───────────────────────────────────────────────────────┐ \n\- \ │ merge { Foo = True } (< Foo : Natural >.Foo 1) : Bool │ \n\- \ └───────────────────────────────────────────────────────┘ \n\+ \ ┌────────────────────────────────────────────────┐ \n\+ \ │ merge { Foo = True } (< Foo : Natural >.Foo 1) │ \n\+ \ └────────────────────────────────────────────────┘ \n\ \ ⇧ \n\ \ Invalid: Not a function \n\ \ \n\@@ -4422,8 +4443,8 @@ FieldCollision <$> pure a MustMergeARecord a b -> MustMergeARecord <$> f a <*> f b- MustMergeUnion a b ->- MustMergeUnion <$> f a <*> f b+ MustMergeUnionOrOptional a b ->+ MustMergeUnionOrOptional <$> f a <*> f b MustMapARecord a b -> MustMapARecord <$> f a <*> f b InvalidToMapRecordKind a b ->
tests/Dhall/Test/Dhall.hs view
@@ -92,7 +92,7 @@ case inputEx of Left ex -> assertEqual assertMsg expectedMsg (show ex)- Right _ -> fail "The extraction using a wrong type succeded"+ Right _ -> fail "The extraction using a wrong type succeeded" -- https://github.com/dhall-lang/dhall-haskell/issues/915 shouldHandleUnionLiteral :: TestTree@@ -176,13 +176,13 @@ shouldHandleUnionsCorrectly = testGroup "Handle union literals" [ "λ(x : < N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >) → x"- `shouldPassThrough` [ N0 True, N1 5, N2 "ABC" ]+ `shouldPassThroughWrapped` [ N0 True, N1 5, N2 "ABC" ] , "λ(x : < E0 | E1 | E2 >) → x"- `shouldPassThrough` [ E0, E1, E2 ]+ `shouldPassThroughWrapped` [ E0, E1, E2 ] , "λ(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 } ]+ `shouldPassThroughWrapped` [ R0 {}, R1 { a = () }, R2 { x = 1.0 }, R3 { a = (), b = () }, R4 { x = 1.0, y = 2.0 } ] , "λ(x : < P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >) → x"- `shouldPassThrough` [ P0 , P1 (), P2 1.0, P3 () (), P4 1.0 2.0 ]+ `shouldPassThroughWrapped` [ P0 , P1 (), P2 1.0, P3 () (), P4 1.0 2.0 ] , "λ(x : < N0 : Bool | N1 : Natural | N2 : Text >) → x" `shouldPassThroughSmart` [ N0 True, N1 5, N2 "ABC" ]@@ -192,12 +192,12 @@ `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+ `shouldMarshalIntoWrapped` N0 True , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }"- `shouldMarshalInto` N1 5+ `shouldMarshalIntoWrapped` N1 5 , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }" - `shouldMarshalInto` N2 "ABC"+ `shouldMarshalIntoWrapped` N2 "ABC" , "(< N0 : Bool | N1 : Natural | N2 : Text >).N0 True" `shouldMarshalIntoSmart` N0 True@@ -206,20 +206,20 @@ , "(< 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+ , "(< E0 | E1 | E2>).E0" `shouldMarshalIntoWrapped` E0+ , "(< E0 | E1 | E2>).E1" `shouldMarshalIntoWrapped` E1+ , "(< E0 | E1 | E2>).E2" `shouldMarshalIntoWrapped` E2 , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0"- `shouldMarshalInto` R0+ `shouldMarshalIntoWrapped` R0 , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }"- `shouldMarshalInto` R1 { a = () }+ `shouldMarshalIntoWrapped` 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 }+ `shouldMarshalIntoWrapped` 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 = () }+ `shouldMarshalIntoWrapped` R3 { a = (), b = () } , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }"- `shouldMarshalInto` R4 { x = 1.0, y = 2.0 }+ `shouldMarshalIntoWrapped` R4 { x = 1.0, y = 2.0 } , "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" `shouldMarshalIntoSmart` R0@@ -233,15 +233,15 @@ `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+ `shouldMarshalIntoWrapped` P0 , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }"- `shouldMarshalInto` P1 ()+ `shouldMarshalIntoWrapped` P1 () , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }"- `shouldMarshalInto` P2 1.0+ `shouldMarshalIntoWrapped` P2 1.0 , "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }"- `shouldMarshalInto` P3 () ()+ `shouldMarshalIntoWrapped` 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+ `shouldMarshalIntoWrapped` P4 1.0 2.0 , "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" `shouldMarshalIntoSmart` P0@@ -255,13 +255,13 @@ `shouldMarshalIntoSmart` P4 1.0 2.0 , N0 True- `shouldEmbedAs`+ `shouldEmbedAsWrapped` "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }" , N1 5- `shouldEmbedAs`+ `shouldEmbedAsWrapped` "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }" , N2 "ABC"- `shouldEmbedAs`+ `shouldEmbedAsWrapped` "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }" , N0 True@@ -274,15 +274,15 @@ `shouldEmbedAsSmart` "(< N0 : Bool | N1 : Natural | N2 : Text >).N2 \"ABC\"" - , E0 `shouldEmbedAs` "< E0 | E1 | E2 >.E0"- , E1 `shouldEmbedAs` "< E0 | E1 | E2 >.E1"- , E2 `shouldEmbedAs` "< E0 | E1 | E2 >.E2"+ , E0 `shouldEmbedAsWrapped` "< E0 | E1 | E2 >.E0"+ , E1 `shouldEmbedAsWrapped` "< E0 | E1 | E2 >.E1"+ , E2 `shouldEmbedAsWrapped` "< E0 | E1 | E2 >.E2" - , R0 `shouldEmbedAs` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0"- , R1 { a = () } `shouldEmbedAs` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }"- , R2 { x = 1.0 } `shouldEmbedAs` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0}"- , R3 { a = (), b = () } `shouldEmbedAs` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }"- , R4 { x = 1.0, y = 2.0 } `shouldEmbedAs` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }"+ , R0 `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0"+ , R1 { a = () } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }"+ , R2 { x = 1.0 } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R2 { x = 1.0}"+ , R3 { a = (), b = () } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }"+ , R4 { x = 1.0, y = 2.0 } `shouldEmbedAsWrapped` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" , R0 `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R0" , R1 { a = () } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R1 { a = {=} }"@@ -290,11 +290,11 @@ , R3 { a = (), b = () } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R3 { a = {=}, b = {=} }" , R4 { x = 1.0, y = 2.0 } `shouldEmbedAsSmart` "< R0 | R1 : { a : {} } | R2 : { x : Double } | R3 : { a : {}, b : {} } | R4 : { x : Double, y : Double } >.R4 { x = 1.0, y = 2.0 }" - , P0 `shouldEmbedAs` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0"- , P1 () `shouldEmbedAs` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }"- , P2 1.0 `shouldEmbedAs` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }"- , P3 () () `shouldEmbedAs` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }"- , P4 1.0 2.0 `shouldEmbedAs` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }"+ , P0 `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0"+ , P1 () `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1 { _1 = {=} }"+ , P2 1.0 `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P2 { _1 = 1.0 }"+ , P3 () () `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P3 { _1 = {=}, _2 = {=} }"+ , P4 1.0 2.0 `shouldEmbedAsWrapped` "< P0 | P1 : { _1 : {} } | P2 : { _1 : Double } | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P4 { _1 = 1.0, _2 = 2.0 }" , P0 `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P0" , P1 () `shouldEmbedAsSmart` "< P0 | P1 | P2 : Double | P3 : { _1 : {}, _2 : {} } | P4 : { _1 : Double, _2 : Double } >.P1"@@ -307,9 +307,13 @@ Dhall.defaultInterpretOptions { Dhall.singletonConstructors = Dhall.Smart } - code `shouldPassThrough` values = testCase "Pass through" $ do- f <- Dhall.input Dhall.auto code+ wrappedOptions =+ Dhall.defaultInterpretOptions+ { Dhall.singletonConstructors = Dhall.Wrapped } + code `shouldPassThroughWrapped` values = testCase "Pass through" $ do+ f <- Dhall.input (Dhall.autoWith wrappedOptions) code+ values @=? map f values code `shouldPassThroughSmart` values = testCase "Pass through" $ do@@ -317,8 +321,8 @@ values @=? map f values - code `shouldMarshalInto` expectedValue = testCase "Marshal" $ do- actualValue <- Dhall.input Dhall.auto code+ code `shouldMarshalIntoWrapped` expectedValue = testCase "Marshal" $ do+ actualValue <- Dhall.input (Dhall.autoWith wrappedOptions) code expectedValue @=? actualValue @@ -327,12 +331,12 @@ expectedValue @=? actualValue - value `shouldEmbedAs` expectedCode = testCase "ToDhall" $ do+ value `shouldEmbedAsWrapped` expectedCode = testCase "ToDhall" $ do parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode) resolvedExpression <- Dhall.Import.assertNoImports parsedExpression - Dhall.Core.denote resolvedExpression @=? Dhall.embed Dhall.inject value+ Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.injectWith wrappedOptions) value value `shouldEmbedAsSmart` expectedCode = testCase "ToDhall" $ do parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode)
tests/Dhall/Test/Import.hs view
@@ -11,6 +11,7 @@ import Turtle (FilePath, (</>)) import qualified Control.Exception as Exception+import qualified Control.Monad as Monad import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO@@ -28,7 +29,21 @@ getTests :: IO TestTree getTests = do- successTests <- Test.Util.discover (Turtle.chars <> "A.dhall") successTest (Turtle.lstree (importDirectory </> "success"))+ let flakyTests =+ [ -- This test is flaky, occasionally failing with:+ --+ -- Error: Remote host not found+ --+ -- URL: https://test.dhall-lang.org/Bool/package.dhall+ importDirectory </> "success/headerForwardingA.dhall"+ ]++ successTests <- Test.Util.discover (Turtle.chars <> "A.dhall") successTest (do+ path <- Turtle.lstree (importDirectory </> "success")++ Monad.guard (path `notElem` flakyTests)++ return path ) failureTests <- Test.Util.discover (Turtle.chars <> ".dhall") failureTest (Turtle.lstree (importDirectory </> "failure"))
tests/Dhall/Test/Lint.hs view
@@ -4,17 +4,19 @@ import Data.Monoid (mempty, (<>)) import Data.Text (Text)-import Data.Void (Void)-import Dhall.Core (Expr, Import)+import Dhall.Parser (Header(..)) import Prelude hiding (FilePath) import Test.Tasty (TestTree) import Turtle (FilePath) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO+import qualified Data.Text.Prettyprint.Doc as Doc+import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text import qualified Dhall.Core as Core import qualified Dhall.Lint as Lint import qualified Dhall.Parser as Parser+import qualified Dhall.Pretty as Pretty import qualified Dhall.Test.Util as Test.Util import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as Tasty.HUnit@@ -31,6 +33,16 @@ return testTree +format :: Header -> Core.Expr Parser.Src Core.Import -> Text+format (Header header) expr =+ let doc = Doc.pretty header+ <> Pretty.prettyCharacterSet Pretty.Unicode expr+ <> "\n"++ docStream = Pretty.layout doc+ in+ Doc.Render.Text.renderStrict docStream+ lintTest :: Text -> TestTree lintTest prefix = Tasty.HUnit.testCase (Text.unpack prefix) $ do@@ -39,18 +51,14 @@ inputText <- Text.IO.readFile inputFile - parsedInput <- Core.throws (Parser.exprFromText mempty inputText)-- let actualExpression :: Expr Void Import- actualExpression = Core.denote (Lint.lint parsedInput)+ (header, parsedInput) <- Core.throws (Parser.exprAndHeaderFromText mempty inputText) - outputText <- Text.IO.readFile outputFile+ let actualExpression = Lint.lint parsedInput - parsedOutput <- Core.throws (Parser.exprFromText mempty outputText)+ let actualText = format header actualExpression - let expectedExpression :: Expr Void Import- expectedExpression = Core.denote parsedOutput+ expectedText <- Text.IO.readFile outputFile let message = "The linted expression did not match the expected output" - Tasty.HUnit.assertEqual message expectedExpression actualExpression+ Tasty.HUnit.assertEqual message expectedText actualText
tests/Dhall/Test/Main.hs view
@@ -14,6 +14,7 @@ import qualified Dhall.Test.Parser import qualified Dhall.Test.QuickCheck import qualified Dhall.Test.Regression+import qualified Dhall.Test.TH import qualified Dhall.Test.Tutorial import qualified Dhall.Test.TypeInference import qualified GHC.IO.Encoding@@ -57,6 +58,7 @@ , Dhall.Test.Tutorial.tests , Dhall.Test.QuickCheck.tests , Dhall.Test.Dhall.tests+ , Dhall.Test.TH.tests ] return testTree
tests/Dhall/Test/Parser.hs view
@@ -128,10 +128,6 @@ -- This is a bug created by a parsing performance -- improvement [ parseDirectory </> "success/unit/MergeParenAnnotation"-- -- https://github.com/dhall-lang/dhall-haskell/issues/1454- , parseDirectory </> "success/missingFoo"- , parseDirectory </> "success/missingSlash" ] let pathString = Text.unpack path
tests/Dhall/Test/Regression.hs view
@@ -193,7 +193,7 @@ -- Verify that parsing should not fail -- -- In 267093f8cddf1c2f909f2d997c31fd0a7cb2440a I broke the parser when left- -- factoring the grammer by failing to handle the source tested by this+ -- factoring the grammar by failing to handle the source tested by this -- regression test. The root of the problem was that the parser was trying -- to parse `List ./Node` as `Field List "/Node"` instead of -- `App List (Embed (Path (File Homeless "./Node") Code))`. The latter is
+ tests/Dhall/Test/TH.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module Dhall.Test.TH where++import Dhall (FromDhall(..))+import GHC.Generics+import Test.Tasty (TestTree)++import qualified Dhall+import qualified Dhall.TH+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty.HUnit++Dhall.TH.makeHaskellTypeFromUnion "T" "./tests/th/example.dhall"++deriving instance Eq T+deriving instance Show T+deriving instance Generic T+deriving instance FromDhall T++tests :: TestTree+tests = Tasty.testGroup "Template Haskell" [ makeHaskellTypeFromUnion ]++makeHaskellTypeFromUnion :: TestTree+makeHaskellTypeFromUnion = Tasty.HUnit.testCase "makeHaskellTypeFromUnion" $ do+ t0 <- Dhall.input Dhall.auto "let T = ./tests/th/example.dhall in T.A { x = True, y = [ \"ABC\" ] }"++ Tasty.HUnit.assertEqual "" t0 A{ x = True, y = [ "ABC" ] }++ t1 <- Dhall.input Dhall.auto "let T = ./tests/th/example.dhall in T.B (Some [ 1 ])"++ Tasty.HUnit.assertEqual "" t1 (B (Just [ 1 ]))++ t2 <- Dhall.input Dhall.auto "let T = ./tests/th/example.dhall in T.C"++ Tasty.HUnit.assertEqual "" t2 C
tests/format/applicationMultilineB.dhall view
@@ -12,9 +12,8 @@ b c dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd-, some =- Some- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa+, some = Some+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa , merge = merge aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ tests/format/ipfsA.dhall view
@@ -0,0 +1,163 @@+let name = "ipfs"++let labels =+ { `app.kubernetes.io/name` = name+ , `app.kubernetes.io/instance` = "wintering-rodent"+ , `app.kubernetes.io/version` = "0.4.0"+ , `app.kubernetes.io/managed-by` = "dhall"+ }++let matchLabels =+ labels.{ `app.kubernetes.io/name`, `app.kubernetes.io/instance` }++let k8s =+ https://raw.githubusercontent.com/dhall-lang/dhall-kubernetes/4ab28225a150498aef67c226d3c5f026c95b5a1e/package.dhall sha256:2c7ac35494f16b1f39afcf3467b2f3b0ab579edb0c711cddd2c93f1cbed358bd++let serviceName = "ipfs"++let apiPort = k8s.IntOrString.Int 5001++let gatewayPort = k8s.IntOrString.Int 8080++let toRule =+ λ ( args+ : { host : Text+ , path : Text+ , serviceName : Text+ , servicePort : k8s.IntOrString+ }+ )+ → k8s.IngressRule::{+ , host = Some args.host+ , http =+ Some+ k8s.HTTPIngressRuleValue::{+ , paths =+ [ k8s.HTTPIngressPath::{+ , path = Some args.path+ , backend =+ k8s.IngressBackend::args.{ serviceName, servicePort }+ }+ ]+ }+ }++in [ k8s.Resource.Ingress+ k8s.Ingress::{+ , metadata =+ k8s.ObjectMeta::{ labels = toMap labels, name = "${name}-api" }+ , spec =+ Some+ k8s.IngressSpec::{+ , rules =+ [ toRule+ { host = "localhost"+ , path = "/"+ , serviceName = serviceName+ , servicePort = gatewayPort+ }+ , toRule+ { host = "localhost"+ , path = "/"+ , serviceName = serviceName+ , servicePort = apiPort+ }+ ]+ }+ }+ , k8s.Resource.Service+ k8s.Service::{+ , metadata =+ k8s.ObjectMeta::{ name = serviceName, labels = toMap labels }+ , spec =+ Some+ k8s.ServiceSpec::{+ , ports =+ [ k8s.ServicePort::{+ , port = 5001+ , targetPort = Some apiPort+ , name = Some "api"+ }+ , k8s.ServicePort::{+ , port = 8080+ , targetPort = Some gatewayPort+ , name = Some "api"+ }+ ]+ , selector = toMap matchLabels+ }+ }+ , k8s.Resource.StatefulSet+ k8s.StatefulSet::{+ , metadata = k8s.ObjectMeta::{ name = name, labels = toMap labels }+ , spec =+ Some+ k8s.StatefulSetSpec::{+ , serviceName = serviceName+ , selector =+ k8s.LabelSelector::{ matchLabels = toMap matchLabels }+ , template =+ k8s.PodTemplateSpec::{+ , metadata =+ k8s.ObjectMeta::{ name = name, labels = toMap labels }+ , spec =+ Some+ k8s.PodSpec::{+ , securityContext =+ Some+ k8s.PodSecurityContext::{+ , runAsUser = Some 1000+ , runAsGroup = Some 1000+ , fsGroup = Some 1000+ }+ , containers =+ [ k8s.Container::{+ , name = name+ , image = Some "ipfs/go-ipfs:v0.4.22"+ , livenessProbe =+ k8s.Probe::{+ , httpGet =+ Some+ k8s.HTTPGetAction::{+ , path =+ Some "/debug/metrics/prometheus"+ , port = k8s.IntOrString.String "api"+ }+ , initialDelaySeconds = Some 15+ , periodSeconds = Some 3+ }+ , readinessProbe =+ k8s.Probe::{+ , httpGet =+ Some+ k8s.HTTPGetAction::{+ , path =+ Some "/debug/metrics/prometheus"+ , port = k8s.IntOrString.String "api"+ }+ , initialDelaySeconds = Some 15+ , periodSeconds = Some 3+ }+ , ports =+ [ k8s.ContainerPort::{+ , containerPort = 5001+ , name = Some "api"+ }+ , k8s.ContainerPort::{+ , containerPort = 8080+ , name = Some "gateway"+ }+ ]+ , volumeMounts =+ [ k8s.VolumeMount::{+ , name = "ipfs-storage"+ , mountPath = "/data/ipfs"+ }+ ]+ }+ ]+ }+ }+ }+ }+ ]
+ tests/format/ipfsB.dhall view
@@ -0,0 +1,143 @@+let name = "ipfs"++let labels =+ { `app.kubernetes.io/name` = name+ , `app.kubernetes.io/instance` = "wintering-rodent"+ , `app.kubernetes.io/version` = "0.4.0"+ , `app.kubernetes.io/managed-by` = "dhall"+ }++let matchLabels =+ labels.{ `app.kubernetes.io/name`, `app.kubernetes.io/instance` }++let k8s =+ https://raw.githubusercontent.com/dhall-lang/dhall-kubernetes/4ab28225a150498aef67c226d3c5f026c95b5a1e/package.dhall sha256:2c7ac35494f16b1f39afcf3467b2f3b0ab579edb0c711cddd2c93f1cbed358bd++let serviceName = "ipfs"++let apiPort = k8s.IntOrString.Int 5001++let gatewayPort = k8s.IntOrString.Int 8080++let toRule =+ λ ( args+ : { host : Text+ , path : Text+ , serviceName : Text+ , servicePort : k8s.IntOrString+ }+ )+ → k8s.IngressRule::{+ , host = Some args.host+ , http = Some k8s.HTTPIngressRuleValue::{+ , paths =+ [ k8s.HTTPIngressPath::{+ , path = Some args.path+ , backend = k8s.IngressBackend::args.{ serviceName, servicePort }+ }+ ]+ }+ }++in [ k8s.Resource.Ingress+ k8s.Ingress::{+ , metadata = k8s.ObjectMeta::{+ , labels = toMap labels+ , name = "${name}-api"+ }+ , spec = Some k8s.IngressSpec::{+ , rules =+ [ toRule+ { host = "localhost"+ , path = "/"+ , serviceName = serviceName+ , servicePort = gatewayPort+ }+ , toRule+ { host = "localhost"+ , path = "/"+ , serviceName = serviceName+ , servicePort = apiPort+ }+ ]+ }+ }+ , k8s.Resource.Service+ k8s.Service::{+ , metadata = k8s.ObjectMeta::{+ , name = serviceName+ , labels = toMap labels+ }+ , spec = Some k8s.ServiceSpec::{+ , ports =+ [ k8s.ServicePort::{+ , port = 5001+ , targetPort = Some apiPort+ , name = Some "api"+ }+ , k8s.ServicePort::{+ , port = 8080+ , targetPort = Some gatewayPort+ , name = Some "api"+ }+ ]+ , selector = toMap matchLabels+ }+ }+ , k8s.Resource.StatefulSet+ k8s.StatefulSet::{+ , metadata = k8s.ObjectMeta::{ name = name, labels = toMap labels }+ , spec = Some k8s.StatefulSetSpec::{+ , serviceName = serviceName+ , selector = k8s.LabelSelector::{ matchLabels = toMap matchLabels }+ , template = k8s.PodTemplateSpec::{+ , metadata = k8s.ObjectMeta::{ name = name, labels = toMap labels }+ , spec = Some k8s.PodSpec::{+ , securityContext = Some k8s.PodSecurityContext::{+ , runAsUser = Some 1000+ , runAsGroup = Some 1000+ , fsGroup = Some 1000+ }+ , containers =+ [ k8s.Container::{+ , name = name+ , image = Some "ipfs/go-ipfs:v0.4.22"+ , livenessProbe = k8s.Probe::{+ , httpGet = Some k8s.HTTPGetAction::{+ , path = Some "/debug/metrics/prometheus"+ , port = k8s.IntOrString.String "api"+ }+ , initialDelaySeconds = Some 15+ , periodSeconds = Some 3+ }+ , readinessProbe = k8s.Probe::{+ , httpGet = Some k8s.HTTPGetAction::{+ , path = Some "/debug/metrics/prometheus"+ , port = k8s.IntOrString.String "api"+ }+ , initialDelaySeconds = Some 15+ , periodSeconds = Some 3+ }+ , ports =+ [ k8s.ContainerPort::{+ , containerPort = 5001+ , name = Some "api"+ }+ , k8s.ContainerPort::{+ , containerPort = 8080+ , name = Some "gateway"+ }+ ]+ , volumeMounts =+ [ k8s.VolumeMount::{+ , name = "ipfs-storage"+ , mountPath = "/data/ipfs"+ }+ ]+ }+ ]+ }+ }+ }+ }+ ]
tests/format/issue1400-1A.dhall view
@@ -6,7 +6,7 @@ , content = [ text ''- any line going past the 80 characters boundary (e.g. this one is 82)+ any line going past the 80 characters boundary (e.g. this one is 82) '' ] }
tests/format/issue1400-1B.dhall view
@@ -1,13 +1,13 @@ { conversation =- [ { author = "robert", content = [] }- , { author = "robert", content = [] }- , { author = "bob"- , content =- [ text- ''- any line going past the 80 characters boundary (e.g. this one is 82)- ''- ]- }- ]+ [ { author = "robert", content = [] }+ , { author = "robert", content = [] }+ , { author = "bob"+ , content =+ [ text+ ''+ any line going past the 80 characters boundary (e.g. this one is 82)+ ''+ ]+ }+ ] }
tests/format/largeRecordB.dhall view
@@ -9,22 +9,22 @@ in defaults.Config ⫽ { AUTOCOMPLETE =- [ { enable = True, value = "zap" }- , { enable = False, value = "annotate" }- ]+ [ { 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" }- ]+ [ { pickup = False, name = "chest" }+ , { pickup = True, name = "dagger" }+ ] , BIND =- [ { keybinding = "!", command = "loot" }- , { keybinding = "^v", command = "untrap" }- , { keybinding = "M-x", command = "terrain" }- ]+ [ { keybinding = "!", command = "loot" }+ , { keybinding = "^v", command = "untrap" }+ , { keybinding = "M-x", command = "terrain" }+ ] , catname = Some "Mirri" , checkpoint = Some True , checkspace = Some True@@ -32,17 +32,16 @@ , 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 }- }- )+ , 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@@ -56,11 +55,11 @@ , hilite_status = defaults.HiliteStatus ⫽ { gold =- [ { color = types.Color.yellow- , trigger = Some types.Numeric.always- , attributes = None types.Attributes- }- ]+ [ { color = types.Color.yellow+ , trigger = Some types.Numeric.always+ , attributes = None types.Attributes+ }+ ] } , hitpointbar = Some True , horsename = Some "Erhir"@@ -72,11 +71,11 @@ , mail = Some True , mention_walls = Some False , menucolors =- [ { regex = "blessed"- , color = Some types.Color.cyan- , attributes = defaults.Attributes ⫽ { bold = Some True }- }- ]+ [ { 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 "\\"
tests/format/recordCompletionB.dhall view
@@ -1,25 +1,24 @@-{ field0 =- T::{- , a = 1- , b = 1- , c = 1- , d = 1- , e = 1- , f = 1- , g = 1- , h = 1- , i = 1- , j = 1- , k = 1- , l = 1- , m = 1- , n = 1- , o = 1- , p = 1- , q = 1- , r = 1- , s = 1- , t = 1- }+{ field0 = T::{+ , a = 1+ , b = 1+ , c = 1+ , d = 1+ , e = 1+ , f = 1+ , g = 1+ , h = 1+ , i = 1+ , j = 1+ , k = 1+ , l = 1+ , m = 1+ , n = 1+ , o = 1+ , p = 1+ , q = 1+ , r = 1+ , s = 1+ , t = 1+ } , field1 = T::{ a = 1 } }
+ tests/format/significantLeadingSpacesA.dhall view
@@ -0,0 +1,1 @@+" x\n\n y\n "
+ tests/format/significantLeadingSpacesB.dhall view
@@ -0,0 +1,5 @@+''+${" "} x++${" "} y+${" "}''
tests/format/stringWithNullB.dhall view
@@ -1,3 +1,3 @@ '' ${"\u0000"} $ \ -${" "}☺''+ ☺''
tests/lint/success/fixAssertA.dhall view
@@ -1,1 +1,5 @@-let example = 1 ≡ 1 in 1+let example0 = 1 ≡ 1++let example1 = let x = 1 in x ≡ 1++in 1
tests/lint/success/fixAssertB.dhall view
@@ -1,1 +1,1 @@-let example = assert : 1 ≡ 1 in 1+let example0 = assert : 1 ≡ 1 let example1 = let x = 1 in assert : x ≡ 1 in 1
+ tests/lint/success/issue1586A.dhall view
@@ -0,0 +1,1 @@+let {- 1 -} x {- 2 -} : {- 3 -} Natural = {- 4 -} 1 {- 5 -} in x
+ tests/lint/success/issue1586B.dhall view
@@ -0,0 +1,5 @@+let {- 1 -} x+ {- 2 -} : {- 3 -} Natural+ = {- 4 -} 1++in x
tests/lint/success/multiletB.dhall view
@@ -11,25 +11,26 @@ = λ(Person : Type) → λ(MakePerson : { children : List Person, name : Text } → Person) → MakePerson- { children =+ { children = [ MakePerson { children = [] : List Person, name = "Mary" } , MakePerson { children = [] : List Person, name = "Jane" } ]- , name =- "John"- }+ , name = "John"+ } let everybody : Person → List Text = let concat = http://prelude.dhall-lang.org/List/concat- + in λ(x : Person) → x- (List Text)- ( λ(p : { children : List (List Text), name : Text })- → [ p.name ] # concat Text p.children- )+ (List Text)+ ( λ(p : { children : List (List Text), name : Text })+ → [ p.name ] # concat Text p.children+ ) -let result : List Text = everybody example+let result+ : List Text+ = everybody example in result
tests/recursive/expr0.dhall view
@@ -1,20 +1,17 @@ λ(Expr : Type) → let ExprF =- < LitF :- { _1 : Natural }- | AddF :- { _1 : Expr, _2 : Expr }- | MulF :- { _1 : Expr, _2 : Expr }+ < LitF : Natural+ | AddF : { _1 : Expr, _2 : Expr }+ | MulF : { _1 : Expr, _2 : Expr } >- + in λ(Fix : ExprF → Expr)- → let Lit = λ(x : Natural) → Fix (ExprF.LitF { _1 = x })- + → let Lit = λ(x : Natural) → Fix (ExprF.LitF x)+ let Add = λ(x : Expr) → λ(y : Expr) → Fix (ExprF.AddF { _1 = x, _2 = y })- + let Mul = λ(x : Expr) → λ(y : Expr) → Fix (ExprF.MulF { _1 = x, _2 = y })- + in Add (Mul (Lit 3) (Lit 7)) (Add (Lit 1) (Lit 2))
tests/recursive/expr1.dhall view
@@ -1,18 +1,15 @@ λ(a : Type) → let ExprF =- < LitF :- { _1 : Natural }- | AddF :- { _1 : a, _2 : a }- | MulF :- { _1 : a, _2 : a }+ < LitF : Natural+ | AddF : { _1 : a, _2 : a }+ | MulF : { _1 : a, _2 : a } >- + in λ(a : ExprF → a)- → let Lit = λ(x : Natural) → a (ExprF.LitF { _1 = x })- + → let Lit = λ(x : Natural) → a (ExprF.LitF x)+ let Add = λ(x : a@1) → λ(y : a@1) → a (ExprF.AddF { _1 = x, _2 = y })- + let Mul = λ(x : a@1) → λ(y : a@1) → a (ExprF.MulF { _1 = x, _2 = y })- + in Add (Mul (Lit 3) (Lit 7)) (Add (Lit 1) (Lit 2))
+ tests/th/example.dhall view
@@ -0,0 +1,1 @@+< A : { x : Bool, y : List Text } | B : Optional (List Natural) | C >