dhall 1.30.0 → 1.31.0
raw patch · 141 files changed
+2725/−807 lines, 141 filesdep +text-manipulatedep ~QuickCheckdep ~template-haskellbinary-addedPVP ok
version bump matches the API change (PVP)
Dependencies added: text-manipulate
Dependency ranges changed: QuickCheck, template-haskell
API changes (from Hackage documentation)
- Dhall: [inputNormalizer] :: InterpretOptions -> ReifiedNormalizer Void
+ Dhall: functionWith :: InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
+ Dhall: genericAutoWithNormalizer :: GenericFromDhall f => InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
+ Dhall: genericToDhallWithNormalizer :: GenericToDhall f => InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
+ Dhall.Core: PreferFromCompletion :: PreferAnnotation s a
+ Dhall.Core: PreferFromSource :: PreferAnnotation s a
+ Dhall.Core: PreferFromWith :: Expr s a -> PreferAnnotation s a
+ Dhall.Core: With :: Expr s a -> NonEmpty Text -> Expr s a -> Expr s a
+ Dhall.Core: data PreferAnnotation s a
+ Dhall.Core: desugarWith :: Expr s a -> Expr s a
+ Dhall.Deriving: Codec :: a -> Codec tag a
+ Dhall.Deriving: [unCodec] :: Codec tag a -> a
+ Dhall.Deriving: addConstructorModifier :: (Text -> Text) -> InterpretOptions -> InterpretOptions
+ Dhall.Deriving: addFieldModifier :: (Text -> Text) -> InterpretOptions -> InterpretOptions
+ Dhall.Deriving: class ModifyOptions a
+ Dhall.Deriving: class TextFunction a
+ Dhall.Deriving: class ToSingletonConstructors (a :: SingletonConstructors)
+ Dhall.Deriving: data CamelCase
+ Dhall.Deriving: data Constructor a
+ Dhall.Deriving: data DropPrefix (s :: Symbol)
+ Dhall.Deriving: data Field a
+ Dhall.Deriving: data PascalCase
+ Dhall.Deriving: data SetSingletonConstructors a
+ Dhall.Deriving: data SnakeCase
+ Dhall.Deriving: data SpinalCase
+ Dhall.Deriving: data TitleCase
+ Dhall.Deriving: data TrainCase
+ Dhall.Deriving: data a <<< b
+ Dhall.Deriving: dropPrefix :: Text -> Text -> Text
+ Dhall.Deriving: infixr 1 <<<
+ Dhall.Deriving: instance Dhall.Deriving.ModifyOptions Dhall.Deriving.AsIs
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.AsIs
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.CamelCase
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.PascalCase
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.SnakeCase
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.SpinalCase
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.TitleCase
+ Dhall.Deriving: instance Dhall.Deriving.TextFunction Dhall.Deriving.TrainCase
+ Dhall.Deriving: instance Dhall.Deriving.ToSingletonConstructors Dhall.Deriving.Bare
+ Dhall.Deriving: instance Dhall.Deriving.ToSingletonConstructors Dhall.Deriving.Smart
+ Dhall.Deriving: instance Dhall.Deriving.ToSingletonConstructors Dhall.Deriving.Wrapped
+ Dhall.Deriving: instance Dhall.Deriving.ToSingletonConstructors a => Dhall.Deriving.ModifyOptions (Dhall.Deriving.SetSingletonConstructors a)
+ Dhall.Deriving: instance GHC.TypeLits.KnownSymbol s => Dhall.Deriving.TextFunction (Dhall.Deriving.DropPrefix s)
+ Dhall.Deriving: instance forall k (a :: k). Dhall.Deriving.TextFunction a => Dhall.Deriving.ModifyOptions (Dhall.Deriving.Constructor a)
+ Dhall.Deriving: instance forall k (a :: k). Dhall.Deriving.TextFunction a => Dhall.Deriving.ModifyOptions (Dhall.Deriving.Field a)
+ Dhall.Deriving: instance forall k a (tag :: k). (GHC.Generics.Generic a, Dhall.GenericFromDhall (GHC.Generics.Rep a), Dhall.Deriving.ModifyOptions tag) => Dhall.FromDhall (Dhall.Deriving.Codec tag a)
+ Dhall.Deriving: instance forall k a (tag :: k). (GHC.Generics.Generic a, Dhall.GenericToDhall (GHC.Generics.Rep a), Dhall.Deriving.ModifyOptions tag) => Dhall.ToDhall (Dhall.Deriving.Codec tag a)
+ Dhall.Deriving: instance forall k1 k2 (a :: k2) (b :: k1). (Dhall.Deriving.ModifyOptions a, Dhall.Deriving.ModifyOptions b) => Dhall.Deriving.ModifyOptions (a Dhall.Deriving.<<< b)
+ Dhall.Deriving: instance forall k1 k2 (a :: k2) (b :: k1). (Dhall.Deriving.TextFunction a, Dhall.Deriving.TextFunction b) => Dhall.Deriving.TextFunction (a Dhall.Deriving.<<< b)
+ Dhall.Deriving: modifyOptions :: ModifyOptions a => InterpretOptions -> InterpretOptions
+ Dhall.Deriving: newtype Codec tag a
+ Dhall.Deriving: setSingletonConstructors :: SingletonConstructors -> InterpretOptions -> InterpretOptions
+ Dhall.Deriving: textFunction :: TextFunction a => Text -> Text
+ Dhall.Deriving: type AsIs = ()
+ Dhall.Deriving: type Bare = 'Bare
+ Dhall.Deriving: type Smart = 'Smart
+ Dhall.Deriving: type Wrapped = 'Wrapped
+ Dhall.Parser.Token: _with :: Parser ()
+ Dhall.TypeCheck: MustUpdateARecord :: Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
- Dhall: InterpretOptions :: (Text -> Text) -> (Text -> Text) -> SingletonConstructors -> ReifiedNormalizer Void -> InterpretOptions
+ Dhall: InterpretOptions :: (Text -> Text) -> (Text -> Text) -> SingletonConstructors -> InterpretOptions
- Dhall: autoWith :: (FromDhall a, Generic a, GenericFromDhall (Rep a)) => InterpretOptions -> Decoder a
+ Dhall: autoWith :: (FromDhall a, Generic a, GenericFromDhall (Rep a)) => InputNormalizer -> Decoder a
- Dhall: function :: InterpretOptions -> Encoder a -> Decoder b -> Decoder (a -> b)
+ Dhall: function :: Encoder a -> Decoder b -> Decoder (a -> b)
- Dhall: genericAutoWith :: GenericFromDhall f => InterpretOptions -> State Int (Decoder (f a))
+ Dhall: genericAutoWith :: (Generic a, GenericFromDhall (Rep a)) => InterpretOptions -> Decoder a
- Dhall: genericToDhallWith :: GenericToDhall f => InterpretOptions -> State Int (Encoder (f a))
+ Dhall: genericToDhallWith :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a
- Dhall: injectWith :: (ToDhall a, Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a
+ Dhall: injectWith :: (ToDhall a, Generic a, GenericToDhall (Rep a)) => InputNormalizer -> Encoder a
- Dhall.Core: Prefer :: Expr s a -> Expr s a -> Expr s a
+ Dhall.Core: Prefer :: PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Files
- CHANGELOG.md +62/−0
- LICENSE +1/−1
- benchmark/deep-nested-large-record/Main.hs +1/−1
- dhall-lang/Prelude/JSON/Format +7/−0
- dhall-lang/Prelude/JSON/package.dhall +2/−2
- dhall-lang/Prelude/JSON/render +32/−40
- dhall-lang/Prelude/JSON/renderAs +443/−0
- dhall-lang/Prelude/JSON/renderYAML +10/−136
- dhall-lang/Prelude/package.dhall +1/−1
- dhall-lang/tests/import/data/fieldOrder/1.dhall +0/−1
- dhall-lang/tests/import/data/fieldOrder/2.dhall +0/−1
- dhall-lang/tests/import/data/referentiallyOpaque.dhall +6/−8
- dhall-lang/tests/import/success/alternativeEnvNaturalA.dhall +0/−1
- dhall-lang/tests/import/success/alternativeEnvNaturalB.dhall +0/−1
- dhall-lang/tests/import/success/alternativeEnvSimpleA.dhall +0/−1
- dhall-lang/tests/import/success/alternativeEnvSimpleB.dhall +0/−1
- dhall-lang/tests/import/success/alternativeHashMismatchA.dhall +0/−2
- dhall-lang/tests/import/success/alternativeHashMismatchB.dhall +0/−1
- dhall-lang/tests/import/success/alternativeNaturalA.dhall +0/−1
- dhall-lang/tests/import/success/alternativeNaturalB.dhall +0/−1
- dhall-lang/tests/import/success/alternativeParseErrorA.dhall +0/−1
- dhall-lang/tests/import/success/alternativeParseErrorB.dhall +0/−1
- dhall-lang/tests/import/success/alternativeTypeErrorA.dhall +0/−1
- dhall-lang/tests/import/success/alternativeTypeErrorB.dhall +0/−1
- dhall-lang/tests/import/success/asLocationA.dhall +0/−8
- dhall-lang/tests/import/success/asLocationB.dhall +0/−20
- dhall-lang/tests/import/success/asTextA.dhall +0/−1
- dhall-lang/tests/import/success/asTextB.dhall +0/−3
- dhall-lang/tests/import/success/fieldOrderA.dhall +0/−5
- dhall-lang/tests/import/success/fieldOrderB.dhall +0/−1
- dhall-lang/tests/import/success/referentiallyTransparentMissing.dhall +0/−9
- dhall-lang/tests/normalization/success/WithRecordValueA.dhall +12/−0
- dhall-lang/tests/normalization/success/WithRecordValueB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsA.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RecordLitPun1A.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RecordLitPun1B.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RecordLitPun2A.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RecordLitPun2B.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall +1/−1
- dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall +1/−1
- dhall-lang/tests/normalization/success/unit/TextLitNested1A.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextLitNested1B.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextLitNested2A.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextLitNested2B.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextLitNested3A.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextLitNested3B.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextShowEmptyA.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextShowEmptyB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/TextShowInterpolatedA.dhall +1/−1
- dhall-lang/tests/normalization/success/unit/TextShowInterpolatedB.dhall +1/−1
- dhall-lang/tests/normalization/success/unit/WithA.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/WithB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/WithChainedA.dhall +4/−0
- dhall-lang/tests/normalization/success/unit/WithChainedB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/WithNestedA.dhall +12/−0
- dhall-lang/tests/normalization/success/unit/WithNestedB.dhall +1/−0
- dhall-lang/tests/normalization/success/unit/WithPriorityA.dhall +6/−0
- dhall-lang/tests/normalization/success/unit/WithPriorityB.dhall +1/−0
- dhall-lang/tests/parser/failure/assertBinding.dhall +1/−0
- dhall-lang/tests/parser/success/text/singleQuoteConcatA.dhall +5/−0
- dhall-lang/tests/parser/success/text/singleQuoteConcatB.dhallb +1/−0
- dhall-lang/tests/parser/success/unit/EmptyRecordLiteralA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/EmptyRecordLiteralB.dhallb +1/−0
- dhall-lang/tests/parser/success/unit/LetAnnotA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/LetAnnotB.dhallb binary
- dhall-lang/tests/parser/success/unit/LetNoAnnotA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/LetNoAnnotB.dhallb binary
- dhall-lang/tests/parser/success/unit/RecordLitPunA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/RecordLitPunB.dhallb binary
- dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateB.dhallb binary
- dhall-lang/tests/parser/success/unit/RecordLitPunMixedA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/RecordLitPunMixedB.dhallb binary
- dhall-lang/tests/parser/success/unit/RecordLitPunSomeA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/RecordLitPunSomeB.dhallb binary
- dhall-lang/tests/parser/success/unit/ToMapA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/ToMapAnnotA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/ToMapAnnotB.dhallb binary
- dhall-lang/tests/parser/success/unit/ToMapB.dhallb binary
- dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceA.dhall +1/−0
- dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceB.dhallb binary
- dhall-lang/tests/parser/success/unit/WithA.dhall +6/−0
- dhall-lang/tests/parser/success/unit/WithB.dhallb +1/−0
- dhall-lang/tests/parser/success/unit/WithMultipleA.dhall +8/−0
- dhall-lang/tests/parser/success/unit/WithMultipleB.dhallb +1/−0
- dhall-lang/tests/parser/success/unit/WithPrecedenceA.dhall +13/−0
- dhall-lang/tests/parser/success/unit/WithPrecedenceB.dhallb +1/−0
- dhall-lang/tests/parser/success/usingToMapA.dhall +1/−0
- dhall-lang/tests/parser/success/usingToMapB.dhallb binary
- dhall-lang/tests/type-inference/failure/SortInLet.dhall +1/−0
- dhall-lang/tests/type-inference/success/CacheImportsA.dhall +6/−0
- dhall-lang/tests/type-inference/success/CacheImportsB.dhall +1/−0
- dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeA.dhall +5/−0
- dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeB.dhall +1/−0
- dhall-lang/tests/type-inference/success/preludeB.dhall +1/−1
- dhall-lang/tests/type-inference/success/unit/RecordLitPunA.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/RecordLitPunB.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureA.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureB.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeA.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeB.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/WithNewFieldA.dhall +4/−0
- dhall-lang/tests/type-inference/success/unit/WithNewFieldB.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/WithNewTypeA.dhall +4/−0
- dhall-lang/tests/type-inference/success/unit/WithNewTypeB.dhall +1/−0
- dhall.cabal +12/−5
- doctest/Main.hs +11/−0
- man/dhall.1 +100/−0
- src/Dhall.hs +196/−144
- src/Dhall/Binary.hs +9/−5
- src/Dhall/Core.hs +4/−1
- src/Dhall/Deriving.hs +548/−0
- src/Dhall/Diff.hs +31/−14
- src/Dhall/DirectoryTree.hs +60/−16
- src/Dhall/Eval.hs +14/−10
- src/Dhall/Import.hs +9/−2
- src/Dhall/Main.hs +66/−39
- src/Dhall/Normalize.hs +37/−17
- src/Dhall/Parser.hs +11/−12
- src/Dhall/Parser/Expression.hs +75/−43
- src/Dhall/Parser/Token.hs +60/−2
- src/Dhall/Pretty/Internal.hs +323/−125
- src/Dhall/Syntax.hs +76/−18
- src/Dhall/TH.hs +51/−10
- src/Dhall/Tutorial.hs +27/−1
- src/Dhall/TypeCheck.hs +114/−28
- tests/Dhall/Test/Dhall.hs +17/−7
- tests/Dhall/Test/Import.hs +20/−9
- tests/Dhall/Test/Main.hs +2/−0
- tests/Dhall/Test/QuickCheck.hs +26/−5
- tests/Dhall/Test/TH.hs +11/−14
- tests/Dhall/Test/TypeInference.hs +10/−1
- tests/format/doubleRoundB.dhall +22/−22
- tests/format/issue1687A.dhall +7/−0
- tests/format/issue1687B.dhall +7/−0
- tests/format/largeExponentB.dhall +1/−1
- tests/format/numericLiteralsA.dhall +1/−0
- tests/format/numericLiteralsB.dhall +1/−0
- tests/format/withA.dhall +5/−0
- tests/format/withB.dhall +58/−0
CHANGELOG.md view
@@ -1,3 +1,65 @@+1.31.0++* [Supports version 15.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v15.0.0)+ * [Implement `with` keyword](https://github.com/dhall-lang/dhall-haskell/pull/1685)+ * You can now write `someRecord with a.b.c = x` to update a nested+ fields+ * [Add support for record puns](https://github.com/dhall-lang/dhall-haskell/pull/1710)+ * You can now write `{ x, y }` as a shorthand for `{ x = x, y = y }`+* BREAKING CHANGE TO THE API: [Auto-derive `Generic`/`FromDhall`/`ToDhall` with Template Haskell](https://github.com/dhall-lang/dhall-haskell/pull/1682)+ * Now the `Dhall.TH.makeHaskell*` utilities will include these derived+ instances in the generated declarations+ * This is a breaking change since users were likely already generating these+ instances separately, which will now conflict with the included instances+* BREAKING CHANGE TO THE API: [`From/ToDhall` no longer takes `InterpretOptions` argument](https://github.com/dhall-lang/dhall-haskell/pull/1696)+ * The types of the `autoWith` and `injectWith` methods have changed to+ take an `InputNormalizer` instead of an `InterpretOptions`+ * Note that `InputNormalizer` is a subset of `InterpretOptions`+ * This is a breaking change to how derived `FromDhall` / `ToDhall` instances+ are customized to more closely match how other Haskell packages customize+ derived instances (e.g. `aeson` with `FromJSON` / `ToJSON`)+ * Previously you would customize the behavior globally by passing in+ a top-level `InterpretOptions` record to `autoWith`+ * Now you can customize the behavior locally on a per-instance basis+ * This change enables the following change ...+* [Add `Dhall.Deriving` module for `deriving-via` helpers](https://github.com/dhall-lang/dhall-haskell/pull/1700)+ * Now you can take advantage of the `-XDerivingVia` language extension to+ customize derived `FromDhall`/`ToDhall` instances, like this:+ * `deriving (FromDhall, ToDhall) via Codec (SetSingletonConstructors Bare) Name`+* BREAKING CHANGE TO THE LANGUAGE: [Match standard with respect to `using toMap`](https://github.com/dhall-lang/dhall-haskell/pull/1673)+ * `https://example.com using toMap customHeaders` is now a parse error+ and needs to be explicitly parenthesized as+ `https://example.com using (toMap customHeaders)`+ * The language standard had always required the parentheses, but the Haskell+ implementation was not correctly matching the standard+* [Fix formatting of indented comments containing empty lines](https://github.com/dhall-lang/dhall-haskell/pull/1688)+ * `dhall format` was previously not idempotent when formatting indented+ comments with empty lines+ * Specifically, the formatter kept indenting things further with each+ format, which this change fixes+* [Fix pretty-printer to preserve original numeric literals](https://github.com/dhall-lang/dhall-haskell/pull/1674)+ * Now `dhall format` will preserve numeric literals exactly how you wrote+ them+ * For example, `0xFF` will no longer be reformatted as `255`+* [Add `dhall to-directory-tree` support for `Map`s](https://github.com/dhall-lang/dhall-haskell/pull/1705)+ * `Map`s are now converted to directories (just like records)+* [Add manpage](https://github.com/dhall-lang/dhall-haskell/pull/1677)+ * ... mainly for the benefit of people packaging Dhall for various+ distributions+* [Group commands in CLI](https://github.com/dhall-lang/dhall-haskell/pull/1692)+ * The command-line `--help` output now groups commands into useful+ sections+* [Fix numeric parsing for GHCJS](https://github.com/dhall-lang/dhall-haskell/pull/1681)+ * The GHCJS backend for Dhall was failing to parse numbers, which this+ change fixes+* Fixes and improvements to error messages:+ * [#1656](https://github.com/dhall-lang/dhall-haskell/pull/1656)+ * [#1698](https://github.com/dhall-lang/dhall-haskell/pull/1698)+ * [#1702](https://github.com/dhall-lang/dhall-haskell/pull/1702)+* Fixes and improvements to the haddocks:+ * [#1708](https://github.com/dhall-lang/dhall-haskell/pull/1708)+ * [#1712](https://github.com/dhall-lang/dhall-haskell/pull/1712)+ 1.30.0 * [Supports version 14.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v14.0.0)
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2018 Gabriel Gonzalez+Copyright (c) 2020 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without
benchmark/deep-nested-large-record/Main.hs view
@@ -50,7 +50,7 @@ Nothing (prelude `Core.Field` "types" `Core.Field` "Big") )- (Core.Prefer "big" "big")+ (Core.Prefer Core.PreferFromSource "big" "big") ) ) "x"
+ dhall-lang/Prelude/JSON/Format view
@@ -0,0 +1,7 @@+{- An internal type used by `./renderAs` to select the output format.++ You should not need to use this type directly, simply use `./render`+ or `./renderYAML` as appropriate.+-}++< YAML | JSON >
dhall-lang/Prelude/JSON/package.dhall view
@@ -1,8 +1,8 @@ { render =- ./render sha256:f7c372fcc954bfbbc7f83deec2006608a48efa2b08e8753bfdf73dc0aa7b4faf+ ./render sha256:eb26e0a4eee530dcda9d73974e9e9256fbad264916101866406a1647e28e280d ? ./render , renderYAML =- ./renderYAML sha256:b3a9d9b0349c90af9a4985c615c60ac4a85031a7bf9de78f2883126481d35aa0+ ./renderYAML sha256:d406a8744b81ced6a485da3cdb40a357fdd37338f4f134b00e7da3684054ebd3 ? ./renderYAML , omitNullFields = ./omitNullFields sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0
dhall-lang/Prelude/JSON/render view
@@ -2,56 +2,48 @@ This is useful for debugging `JSON` values or for tests. For anything more sophisticated you should use `dhall-to-json` or `dhall-to-yaml`+ -} let JSON = ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall -let Text/concatMapSep =- ../Text/concatMapSep sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840- ? ../Text/concatMapSep+let renderAs =+ ./renderAs sha256:f16238edec4c6dd846f19677c6675b27c579999dcff91db6193c10ade1d83174+ ? ./renderAs +let Format =+ ./Format sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac+ ? ./Format+ let render : JSON.Type → Text- = λ(j : JSON.Type)- → j- Text- { string = λ(x : Text) → Text/show x- , double = λ(x : Double) → Double/show x- , integer = λ(x : Integer) → JSON.renderInteger x- , object =- λ(x : List { mapKey : Text, mapValue : Text })- → let body =- Text/concatMapSep- ","- { mapKey : Text, mapValue : Text }- ( λ(e : { mapKey : Text, mapValue : Text })- → " ${Text/show e.mapKey}: ${e.mapValue}"- )- x-- in "{${body} }"- , array =- λ(x : List Text)- → let body = Text/concatMapSep "," Text (λ(y : Text) → " ${y}") x-- in "[${body} ]"- , bool = λ(x : Bool) → if x then "true" else "false"- , null = "null"- }+ = renderAs Format.JSON let example0 =- assert- : render- ( JSON.array- [ JSON.bool True- , JSON.string "Hello"- , JSON.object- [ { mapKey = "foo", mapValue = JSON.null }- , { mapKey = "bar", mapValue = JSON.double 1.0 }- ]+ let data =+ assert+ : render+ ( JSON.array+ [ JSON.bool True+ , JSON.string "Hello"+ , JSON.object+ [ { mapKey = "foo", mapValue = JSON.null }+ , { mapKey = "bar", mapValue = JSON.double 1.0 }+ ]+ ]+ )+ ≡ ''+ [+ true,+ "Hello",+ {+ "foo": null,+ "bar": 1.0+ } ]- )- ≡ "[ true, \"Hello\", { \"foo\": null, \"bar\": 1.0 } ]"+ ''++ in True in render
+ dhall-lang/Prelude/JSON/renderAs view
@@ -0,0 +1,443 @@+{- Render a `JSON` value as `Text` in either JSON or YAML format. -}++let JSON =+ ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5+ ? ./core.dhall++let Function/identity =+ ../Function/identity sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4+ ? ../Function/identity++let Text/concatMap =+ ../Text/concatMap sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f+ ? ../Text/concatMap++let List/take =+ ../List/take sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa+ ? ../List/take++let List/drop =+ ../List/drop sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf+ ? ../List/drop++let List/null =+ ../List/null sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80+ ? ../List/null++let List/map =+ ../List/map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680+ ? ../List/map++let List/concatMap =+ ../List/concatMap sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64+ ? ../List/concatMap++let Optional/map =+ ../Optional/map sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa+ ? ../Optional/map++let NonEmpty+ : Type → Type+ = λ(a : Type) → { head : a, tail : List a }++let List/uncons+ : ∀(a : Type) → List a → Optional (NonEmpty a)+ = λ(a : Type)+ → λ(ls : List a)+ → Optional/map+ a+ (NonEmpty a)+ (λ(head : a) → { head = head, tail = List/drop 1 a ls })+ (List/head a ls)++let NonEmpty/singleton+ : ∀(a : Type) → a → NonEmpty a+ = λ(a : Type) → λ(x : a) → { head = x, tail = [] : List a }++let NonEmpty/toList+ : ∀(a : Type) → NonEmpty a → List a+ = λ(a : Type) → λ(nonEmpty : NonEmpty a) → [ nonEmpty.head ] # nonEmpty.tail++let NonEmpty/concat+ : ∀(a : Type) → NonEmpty (NonEmpty a) → NonEmpty a+ = λ(a : Type)+ → λ(lss : NonEmpty (NonEmpty a))+ → { head = lss.head.head+ , tail =+ lss.head.tail+ # List/concatMap (NonEmpty a) a (NonEmpty/toList a) lss.tail+ }++let NonEmpty/map+ : ∀(a : Type) → ∀(b : Type) → (a → b) → NonEmpty a → NonEmpty b+ = λ(a : Type)+ → λ(b : Type)+ → λ(fn : a → b)+ → λ(ls : NonEmpty a)+ → { head = fn ls.head, tail = List/map a b fn ls.tail }++let NonEmpty/mapHead+ : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a+ = λ(a : Type)+ → λ(fn : a → a)+ → λ(ls : NonEmpty a)+ → ls ⫽ { head = fn ls.head }++let NonEmpty/mapTail+ : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a+ = λ(a : Type)+ → λ(fn : a → a)+ → λ(ls : NonEmpty a)+ → ls ⫽ { tail = List/map a a fn ls.tail }++let List/splitAt+ : Natural → ∀(a : Type) → List a → { head : List a, tail : List a }+ = λ(index : Natural)+ → λ(a : Type)+ → λ(ls : List a)+ → { head = List/take index a ls, tail = List/drop index a ls }++let _testSplitAt0 =+ assert+ : List/splitAt 0 Natural [ 1, 2, 3 ]+ ≡ { head = [] : List Natural, tail = [ 1, 2, 3 ] }++let _testSplitAt1 =+ assert+ : List/splitAt 1 Natural [ 1, 2, 3 ] ≡ { head = [ 1 ], tail = [ 2, 3 ] }++let _testSplitAt3 =+ assert+ : List/splitAt 3 Natural [ 1, 2, 3 ]+ ≡ { head = [ 1, 2, 3 ], tail = [] : List Natural }++let _testSplitAt =+ assert+ : List/splitAt 1 Natural ([] : List Natural)+ ≡ { head = [] : List Natural, tail = [] : List Natural }++let List/splitLast =+ λ(a : Type)+ → λ(ls : List a)+ → List/splitAt (Natural/subtract 1 (List/length a ls)) a ls++let NonEmpty/prepend+ : ∀(a : Type) → a → NonEmpty a → NonEmpty a+ = λ(a : Type)+ → λ(prefix : a)+ → λ(ls : NonEmpty a)+ → { head = prefix, tail = NonEmpty/toList a ls }++let NonEmpty/append+ : ∀(a : Type) → a → NonEmpty a → NonEmpty a+ = λ(a : Type)+ → λ(suffix : a)+ → λ(ls : NonEmpty a)+ → { head = ls.head, tail = ls.tail # [ suffix ] }++let NonEmpty/mapLast+ : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a+ = λ(a : Type)+ → λ(fn : a → a)+ → λ(ls : NonEmpty a)+ → if List/null a ls.tail++ then { head = fn ls.head, tail = [] : List a }++ else let split = List/splitLast a ls.tail++ in { head = ls.head+ , tail = split.head # List/map a a fn split.tail+ }++let NonEmpty/mapLeading+ : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a+ = λ(a : Type)+ → λ(fn : a → a)+ → λ(ls : NonEmpty a)+ → if List/null a ls.tail++ then ls++ else let split = List/splitLast a ls.tail++ in { head = fn ls.head+ , tail = List/map a a fn split.head # split.tail+ }++let Lines+ : Type+ = NonEmpty Text++let Block+ : Type+ = < Simple : Text | Complex : Lines >++let Block/toLines+ : Block → Lines+ = λ(block : Block)+ → merge+ { Simple = NonEmpty/singleton Text+ , Complex = Function/identity Lines+ }+ block++let manyBlocks+ : ∀(a : Type) → Text → (NonEmpty a → Lines) → List a → Block+ = λ(a : Type)+ → λ(ifEmpty : Text)+ → λ(render : NonEmpty a → Lines)+ → λ(inputs : List a)+ → merge+ { Some = λ(inputs : NonEmpty a) → Block.Complex (render inputs)+ , None = Block.Simple ifEmpty+ }+ (List/uncons a inputs)++let blockToText+ : Block → Text+ = λ(block : Block)+ → Text/concatMap+ Text+ (λ(line : Text) → line ++ "\n")+ (NonEmpty/toList Text (Block/toLines block))++let addPrefix = λ(prefix : Text) → λ(line : Text) → prefix ++ line++let addIndent = addPrefix " "++let indentTail = NonEmpty/mapTail Text addIndent++let Format =+ ./Format sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac+ ? ./Format++let ObjectField = { mapKey : Text, mapValue : Block }++let renderJSONStruct =+ λ(prefix : Text)+ → λ(suffix : Text)+ → λ(blocks : NonEmpty Lines)+ → let indent = NonEmpty/map Text Text addIndent++ let appendComma+ : Lines → Lines+ = NonEmpty/mapLast Text (λ(line : Text) → line ++ ",")++ let blocks = NonEmpty/mapLeading Lines appendComma blocks++ let block = NonEmpty/concat Text blocks++ in if List/null Text block.tail++ then NonEmpty/singleton Text "${prefix} ${block.head} ${suffix}"++ else NonEmpty/prepend+ Text+ prefix+ (NonEmpty/append Text suffix (indent block))++let renderObject =+ λ(format : Format)+ → λ(fields : NonEmpty ObjectField)+ → let keystr = λ(field : ObjectField) → "${Text/show field.mapKey}:"++ let prefixKeyOnFirst =+ λ(field : ObjectField)+ → NonEmpty/mapHead+ Text+ (addPrefix "${keystr field} ")+ (Block/toLines field.mapValue)++ let prependKeyLine =+ λ(field : ObjectField)+ → NonEmpty/prepend+ Text+ (keystr field)+ (Block/toLines field.mapValue)++ let renderYAMLField =+ λ(field : ObjectField)+ → merge+ { Simple =+ λ(line : Text)+ → NonEmpty/singleton Text "${keystr field} ${line}"+ , Complex = λ(_ : Lines) → indentTail (prependKeyLine field)+ }+ field.mapValue++ in merge+ { JSON =+ renderJSONStruct+ "{"+ "}"+ (NonEmpty/map ObjectField Lines prefixKeyOnFirst fields)+ , YAML =+ NonEmpty/concat+ Text+ (NonEmpty/map ObjectField Lines renderYAMLField fields)+ }+ format++let renderYAMLArrayField =+ λ(block : Block)+ → NonEmpty/mapHead+ Text+ (addPrefix "- ")+ (indentTail (Block/toLines block))++let renderArray =+ λ(format : Format)+ → λ(fields : NonEmpty Block)+ → merge+ { JSON =+ renderJSONStruct+ "["+ "]"+ (NonEmpty/map Block Lines Block/toLines fields)+ , YAML =+ NonEmpty/concat+ Text+ (NonEmpty/map Block Lines renderYAMLArrayField fields)+ }+ format++let renderAs+ : Format → JSON.Type → Text+ = λ(format : Format)+ → λ(json : JSON.Type)+ → blockToText+ ( json+ Block+ { string = λ(x : Text) → Block.Simple (Text/show x)+ , double = λ(x : Double) → Block.Simple (Double/show x)+ , integer = λ(x : Integer) → Block.Simple (JSON.renderInteger x)+ , object = manyBlocks ObjectField "{}" (renderObject format)+ , array = manyBlocks Block "[]" (renderArray format)+ , bool =+ λ(x : Bool) → Block.Simple (if x then "true" else "false")+ , null = Block.Simple "null"+ }+ )++let example0 =+ let data =+ JSON.array+ [ JSON.bool True+ , JSON.string "Hello"+ , JSON.object+ [ { mapKey = "foo", mapValue = JSON.null }+ , { mapKey = "bar", mapValue = JSON.double 1.0 }+ ]+ ]++ let yaml =+ assert+ : renderAs Format.YAML data+ ≡ ''+ - true+ - "Hello"+ - "foo": null+ "bar": 1.0+ ''++ let json =+ assert+ : renderAs Format.JSON data+ ≡ ''+ [+ true,+ "Hello",+ {+ "foo": null,+ "bar": 1.0+ }+ ]+ ''++ in True++let example1 =+ let data =+ JSON.object+ [ { mapKey = "zero", mapValue = JSON.array ([] : List JSON.Type) }+ , { mapKey = "one", mapValue = JSON.array [ JSON.string "a" ] }+ , { mapKey = "two"+ , mapValue = JSON.array [ JSON.string "a", JSON.string "b" ]+ }+ ]++ let yaml =+ assert+ : renderAs Format.YAML data+ ≡ ''+ "zero": []+ "one":+ - "a"+ "two":+ - "a"+ - "b"+ ''++ let json =+ assert+ : renderAs Format.JSON data+ ≡ ''+ {+ "zero": [],+ "one": [ "a" ],+ "two": [+ "a",+ "b"+ ]+ }+ ''++ in True++let example2 =+ let data =+ JSON.object+ [ { mapKey = "zero"+ , mapValue =+ JSON.object+ (toMap {=} : List { mapKey : Text, mapValue : JSON.Type })+ }+ , { mapKey = "one"+ , mapValue = JSON.object (toMap { a = JSON.null })+ }+ , { mapKey = "two"+ , mapValue =+ JSON.object (toMap { a = JSON.null, b = JSON.null })+ }+ ]++ let yaml =+ assert+ : renderAs Format.YAML data+ ≡ ''+ "zero": {}+ "one":+ "a": null+ "two":+ "a": null+ "b": null+ ''++ let json =+ assert+ : renderAs Format.JSON data+ ≡ ''+ {+ "zero": {},+ "one": { "a": null },+ "two": {+ "a": null,+ "b": null+ }+ }+ ''++ in True++in renderAs
dhall-lang/Prelude/JSON/renderYAML view
@@ -6,150 +6,24 @@ However, it is useful for debugging `JSON` values or for tests. For anything more sophisticated you should use `dhall-to-json` or `dhall-to-yaml`.+ -} let JSON = ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall -let Text/concatSep =- ../Text/concatSep sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58- ? ../Text/concatSep--let List/drop =- ../List/drop sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf- ? ../List/drop--let List/null =- ../List/null sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80- ? ../List/null--let List/map =- ../List/map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680- ? ../List/map--let List/concatMap =- ../List/concatMap sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64- ? ../List/concatMap--let Optional/map =- ../Optional/map sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa- ? ../Optional/map--let NonEmpty- : Type → Type- = λ(a : Type) → { head : a, tail : List a }--let uncons- : ∀(a : Type) → List a → Optional (NonEmpty a)- = λ(a : Type)- → λ(ls : List a)- → Optional/map- a- (NonEmpty a)- (λ(head : a) → { head = head, tail = List/drop 1 a ls })- (List/head a ls)--let nonEmptyToList- : ∀(a : Type) → NonEmpty a → List a- = λ(a : Type) → λ(nonEmpty : NonEmpty a) → [ nonEmpty.head ] # nonEmpty.tail--let concatNonEmpty- : ∀(a : Type) → NonEmpty (NonEmpty a) → NonEmpty a- = λ(a : Type)- → λ(lss : NonEmpty (NonEmpty a))- → { head = lss.head.head- , tail =- lss.head.tail- # List/concatMap (NonEmpty a) a (nonEmptyToList a) lss.tail- }--let Block- : Type- = NonEmpty Text--let indentBlockWith- : Text → Text → Block → Block- = λ(headIndent : Text)- → λ(tailIndent : Text)- → λ(block : Block)- → { head = headIndent ++ block.head- , tail = List/map Text Text (λ(t : Text) → tailIndent ++ t) block.tail- }--let manyBlocks- : Block → List Block → Block- = λ(ifEmpty : Block)- → λ(blocks : List Block)- → merge- { Some = concatNonEmpty Text, None = ifEmpty }- (uncons Block blocks)--let singleLine- : Text → Block- = λ(text : Text) → { head = text, tail = [] : List Text }--let indentKeyedBlock- : Text → Text → Text → Block → Block- = λ(key : Text)- → λ(spacer : Text)- → λ(indentation : Text)- → λ(block : Block)- → if List/null Text block.tail-- then singleLine (key ++ spacer ++ block.head)-- else indentBlockWith- key- indentation- { head = "", tail = nonEmptyToList Text block }+let renderAs =+ ./renderAs sha256:f16238edec4c6dd846f19677c6675b27c579999dcff91db6193c10ade1d83174+ ? ./renderAs -let blockToText- : Block → Text- = λ(block : Block) → Text/concatSep "\n" (nonEmptyToList Text block) ++ "\n"+let Format =+ ./Format sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac+ ? ./Format let renderYAML : JSON.Type → Text- = λ(json : JSON.Type)- → let ObjectField = { mapKey : Text, mapValue : Block }-- in blockToText- ( json- Block- { string = λ(x : Text) → singleLine (Text/show x)- , double = λ(x : Double) → singleLine (Double/show x)- , integer = λ(x : Integer) → singleLine (JSON.renderInteger x)- , object =- λ(fields : List ObjectField)- → manyBlocks- (singleLine "{}")- ( List/map- ObjectField- Block- ( λ(e : ObjectField)- → indentKeyedBlock- "! ${Text/show e.mapKey}:"- " "- " "- e.mapValue- )- fields- )- , array =- λ(elements : List Block)- → manyBlocks- (singleLine "[]")- ( List/map- Block- Block- (indentBlockWith "- " " ")- elements- )- , bool =- λ(x : Bool) → singleLine (if x then "true" else "false")- , null = singleLine "null"- }- )+ = renderAs Format.YAML let example0 = assert@@ -166,8 +40,8 @@ ≡ '' - true - "Hello"- - ! "foo": null- ! "bar": 1.0+ - "foo": null+ "bar": 1.0 '' in renderYAML
dhall-lang/Prelude/package.dhall view
@@ -29,7 +29,7 @@ ./Optional/package.dhall sha256:4324b2bf84ded40f67485f14355e4cb7b237a8f173e713c791ec44cebebc552c ? ./Optional/package.dhall , JSON =- ./JSON/package.dhall sha256:88c358783defee9bbd65aea224cdac56c7666ba367b0dd5f7f6d56de73911292+ ./JSON/package.dhall sha256:1b02c5ff4710f90ee3f8dc1a2565f1b52b45e5317e2df4775307e2ba0cadcf21 ? ./JSON/package.dhall , Text = ./Text/package.dhall sha256:3a5e3acde76fe5f90bd296e6c9d2e43e6ae81c56f804029b39352d2f1664b769
− dhall-lang/tests/import/data/fieldOrder/1.dhall
@@ -1,1 +0,0 @@-{ foo = 1, bar = True }
− dhall-lang/tests/import/data/fieldOrder/2.dhall
@@ -1,1 +0,0 @@-{ bar = True, foo = 1 }
dhall-lang/tests/import/data/referentiallyOpaque.dhall view
@@ -9,12 +9,10 @@ this file attempts to import a referentially opaque import (an environment variable in this case) to verify that the import fails. - For this test file we need to select a referentially opaque import that would- likely succeed if imported on its own, so that a non-compliant implementation- doesn't fail this test for the wrong reason (i.e. due to the referentially- opaque not being present). In general, we can't guarantee that referentially- opaque imports exist (because they are referentially opaque!), but the- `HOME` environment variable has a high likelihood of bring present on a POSIX- system.+ For this test file we need to select a referentially opaque import that+ would succeed if imported on its own, so that a non-compliant implementation+ doesn't fail this test for the wrong reason (i.e. due to the import not+ being present). We thus use the `DHALL_TEST_VAR` environment variable, that+ is expected to be set when running import tests. -}-env:HOME as Text+env:DHALL_TEST_VAR as Text
− dhall-lang/tests/import/success/alternativeEnvNaturalA.dhall
@@ -1,1 +0,0 @@-env:UNSET1 as Text ? env:UNSET2 ? missing ? env:UNSET3 ? 2
− dhall-lang/tests/import/success/alternativeEnvNaturalB.dhall
@@ -1,1 +0,0 @@-2
− dhall-lang/tests/import/success/alternativeEnvSimpleA.dhall
@@ -1,1 +0,0 @@-env:UNSET ? 3
− dhall-lang/tests/import/success/alternativeEnvSimpleB.dhall
@@ -1,1 +0,0 @@-3
− dhall-lang/tests/import/success/alternativeHashMismatchA.dhall
@@ -1,2 +0,0 @@- ../data/simple.dhall sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-? 42
− dhall-lang/tests/import/success/alternativeHashMismatchB.dhall
@@ -1,1 +0,0 @@-42
− dhall-lang/tests/import/success/alternativeNaturalA.dhall
@@ -1,1 +0,0 @@-4 ? missing
− dhall-lang/tests/import/success/alternativeNaturalB.dhall
@@ -1,1 +0,0 @@-4
− dhall-lang/tests/import/success/alternativeParseErrorA.dhall
@@ -1,1 +0,0 @@-(../data/example.txt) ? 42
− dhall-lang/tests/import/success/alternativeParseErrorB.dhall
@@ -1,1 +0,0 @@-42
− dhall-lang/tests/import/success/alternativeTypeErrorA.dhall
@@ -1,1 +0,0 @@-../data/doesNotTypecheck.dhall ? 42
− dhall-lang/tests/import/success/alternativeTypeErrorB.dhall
@@ -1,1 +0,0 @@-42
− dhall-lang/tests/import/success/asLocationA.dhall
@@ -1,8 +0,0 @@-{ _1 = ./some/import.dhall as Location-, _2 = ../data/simpleLocation.dhall-, _3 = /absolute/import sha256:f9340badf94a684e652e0a384f64363293d8b632d971f3453f7ee22f10ab6e75 as Location-, _4 = https://prelude.dhall-lang.org/package.dhall as Location-, _5 = env:HOME as Location-, _6 = missing as Location-, _7 = (missing as Location) ? 42 -- `missing` fails as an import, but definitely resolves as Location-}
− dhall-lang/tests/import/success/asLocationB.dhall
@@ -1,20 +0,0 @@-{ _1 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Local- "./dhall-lang/tests/import/success/some/import.dhall"-, _2 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Local- "./dhall-lang/tests/import/data/simple.dhall"-, _3 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Local- "/absolute/import"-, _4 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Remote- "https://prelude.dhall-lang.org/package.dhall"-, _5 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Environment- "env:HOME"-, _6 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Missing-, _7 =- < Local : Text | Remote : Text | Environment : Text | Missing >.Missing-}
− dhall-lang/tests/import/success/asTextA.dhall
@@ -1,1 +0,0 @@-../data/example.txt as Text
− dhall-lang/tests/import/success/asTextB.dhall
@@ -1,3 +0,0 @@-''-Hello, world!-''
− dhall-lang/tests/import/success/fieldOrderA.dhall
@@ -1,5 +0,0 @@-{ example0 =- ../data/fieldOrder/1.dhall sha256:d8ae15ff5a40ee7973a23ba75cd98f8e39d14aeb6e1e3f18aadb092fcb825194-, example1 =- ../data/fieldOrder/2.dhall sha256:d8ae15ff5a40ee7973a23ba75cd98f8e39d14aeb6e1e3f18aadb092fcb825194-}
− dhall-lang/tests/import/success/fieldOrderB.dhall
@@ -1,1 +0,0 @@-{ example0 = { bar = True, foo = 1 }, example1 = { bar = True, foo = 1 } }
− dhall-lang/tests/import/success/referentiallyTransparentMissing.dhall
@@ -1,9 +0,0 @@-{- This test verifies that `missing` is treated as a referentially transparent- import. The following import contains a `missing as Location` in its- test assertion that should succeed since:-- * The `missing` is never actually resolved (due to the `as Location`)- * The `missing` should be treated as referentially transparent (and therefore- be a valid transitive dependency of a remote import)--}-https://prelude.dhall-lang.org/v11.0.0/Location/Type
+ dhall-lang/tests/normalization/success/WithRecordValueA.dhall view
@@ -0,0 +1,12 @@+{- This test illustrates that `with a = { c = 2 }` is not the same thing as+ `with a.c = 2`:++ * `with a = { c = 2 }` overrides the entire value of the field `a` with a new+ record containing only `c = 2`++ * `with a.c = 2` extends or updates the record stored underneath `a` to+ set the field `c` to `2`.++ Compare this to the `WithNested` test, which contains the `a.c = 2` case+-}+{ a.b = 1 } with a = { c = 2 }
+ dhall-lang/tests/normalization/success/WithRecordValueB.dhall view
@@ -0,0 +1,1 @@+{ a = { c = 2 } }
+ dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsA.dhall view
@@ -0,0 +1,1 @@+let x = { y = 1 } in { x, x.z = 2 }
+ dhall-lang/tests/normalization/success/unit/RecordLitAllSugarsB.dhall view
@@ -0,0 +1,1 @@+{ x = { y = 1, z = 2 } }
+ dhall-lang/tests/normalization/success/unit/RecordLitPun1A.dhall view
@@ -0,0 +1,1 @@+let x = 0 in { x }
+ dhall-lang/tests/normalization/success/unit/RecordLitPun1B.dhall view
@@ -0,0 +1,1 @@+{ x = 0 }
+ dhall-lang/tests/normalization/success/unit/RecordLitPun2A.dhall view
@@ -0,0 +1,1 @@+let x = 0 let y = 1 in { x, y, z = 2 }
+ dhall-lang/tests/normalization/success/unit/RecordLitPun2B.dhall view
@@ -0,0 +1,1 @@+{ x = 0, y = 1, z = 2 }
dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionA.dhall view
@@ -1,1 +1,1 @@-(x ⫽ { a = v, b = w }).{ a, c }+λ(x : { c : Natural }) → (x ⫽ { a = 1, b = 2 }).{ a, c }
dhall-lang/tests/normalization/success/unit/RightBiasedRecordMergeWithinRecordProjectionB.dhall view
@@ -1,1 +1,1 @@-x.{ c } ⫽ { a = v }+λ(x : { c : Natural }) → x.{ c } ⫽ { a = 1 }
+ dhall-lang/tests/normalization/success/unit/TextLitNested1A.dhall view
@@ -0,0 +1,1 @@+λ(x: Text) → "${""}${x}"
+ dhall-lang/tests/normalization/success/unit/TextLitNested1B.dhall view
@@ -0,0 +1,1 @@+λ(x : Text) → x
+ dhall-lang/tests/normalization/success/unit/TextLitNested2A.dhall view
@@ -0,0 +1,1 @@+λ(x: Text) → "${"${x}"}"
+ dhall-lang/tests/normalization/success/unit/TextLitNested2B.dhall view
@@ -0,0 +1,1 @@+λ(x : Text) → x
+ dhall-lang/tests/normalization/success/unit/TextLitNested3A.dhall view
@@ -0,0 +1,1 @@+λ(x: Text) → "${"${""}"}${x}"
+ dhall-lang/tests/normalization/success/unit/TextLitNested3B.dhall view
@@ -0,0 +1,1 @@+λ(x : Text) → x
+ dhall-lang/tests/normalization/success/unit/TextShowEmptyA.dhall view
@@ -0,0 +1,1 @@+Text/show ""
+ dhall-lang/tests/normalization/success/unit/TextShowEmptyB.dhall view
@@ -0,0 +1,1 @@+"\"\""
dhall-lang/tests/normalization/success/unit/TextShowInterpolatedA.dhall view
@@ -1,1 +1,1 @@-λ(with : Text) → Text/show "text ${with} interpolation"+λ(containing : Text) → Text/show "text ${containing} interpolation"
dhall-lang/tests/normalization/success/unit/TextShowInterpolatedB.dhall view
@@ -1,1 +1,1 @@-λ(with : Text) → Text/show "text ${with} interpolation"+λ(containing: Text) → Text/show "text ${containing} interpolation"
+ dhall-lang/tests/normalization/success/unit/WithA.dhall view
@@ -0,0 +1,1 @@+{ a = 1 } with b = 2
+ dhall-lang/tests/normalization/success/unit/WithB.dhall view
@@ -0,0 +1,1 @@+{ a = 1, b = 2 }
+ dhall-lang/tests/normalization/success/unit/WithChainedA.dhall view
@@ -0,0 +1,4 @@+{- This test verifies that an implementation correctly handles chained+ `with` expressions+-}+{ a = 1 } with b = 2 with c = 3
+ dhall-lang/tests/normalization/success/unit/WithChainedB.dhall view
@@ -0,0 +1,1 @@+{ a = 1, b = 2, c = 3 }
+ dhall-lang/tests/normalization/success/unit/WithNestedA.dhall view
@@ -0,0 +1,12 @@+{- This test verifies that an implementation handles `with` expressions that+ update nested labels correctly++ A common mistake an implementation might make is to produce the following+ result:++ { a.c = 2 }++ ... due to the nested update clobbering the inner record. A compliant+ implementation extends inner records.+-}+{ a.b = 1 } with a.c = 2
+ dhall-lang/tests/normalization/success/unit/WithNestedB.dhall view
@@ -0,0 +1,1 @@+{ a = { b = 1, c = 2 } }
+ dhall-lang/tests/normalization/success/unit/WithPriorityA.dhall view
@@ -0,0 +1,6 @@+{- This test ensures that updates are ordered and latter updates take priority+ when the same field is updated more than one time++ In this example, the `a` field is updated twice, and the latter update wins+-}+{ a = 1 } with a = 2 with a = 3
+ dhall-lang/tests/normalization/success/unit/WithPriorityB.dhall view
@@ -0,0 +1,1 @@+{ a = 3 }
+ dhall-lang/tests/parser/failure/assertBinding.dhall view
@@ -0,0 +1,1 @@+let assert = 2 in 1
+ dhall-lang/tests/parser/success/text/singleQuoteConcatA.dhall view
@@ -0,0 +1,5 @@+''+a''++++''+b''
+ dhall-lang/tests/parser/success/text/singleQuoteConcatB.dhallb view
@@ -0,0 +1,1 @@+aaab
+ dhall-lang/tests/parser/success/unit/EmptyRecordLiteralA.dhall view
@@ -0,0 +1,1 @@+{=}
+ dhall-lang/tests/parser/success/unit/EmptyRecordLiteralB.dhallb view
@@ -0,0 +1,1 @@+
+ dhall-lang/tests/parser/success/unit/LetAnnotA.dhall view
@@ -0,0 +1,1 @@+let x: T = y in e
+ dhall-lang/tests/parser/success/unit/LetAnnotB.dhallb view
binary file changed (absent → 17 bytes)
+ dhall-lang/tests/parser/success/unit/LetNoAnnotA.dhall view
@@ -0,0 +1,1 @@+let x = y in e
+ dhall-lang/tests/parser/success/unit/LetNoAnnotB.dhallb view
binary file changed (absent → 14 bytes)
+ dhall-lang/tests/parser/success/unit/RecordLitPunA.dhall view
@@ -0,0 +1,1 @@+{ x, y, z }
+ dhall-lang/tests/parser/success/unit/RecordLitPunB.dhallb view
binary file changed (absent → 21 bytes)
+ dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateA.dhall view
@@ -0,0 +1,1 @@+{ x, y, x }
+ dhall-lang/tests/parser/success/unit/RecordLitPunDuplicateB.dhallb view
binary file changed (absent → 22 bytes)
+ dhall-lang/tests/parser/success/unit/RecordLitPunMixedA.dhall view
@@ -0,0 +1,1 @@+{ x, y = 1, z, w.a.b = 2 }
+ dhall-lang/tests/parser/success/unit/RecordLitPunMixedB.dhallb view
binary file changed (absent → 35 bytes)
+ dhall-lang/tests/parser/success/unit/RecordLitPunSomeA.dhall view
@@ -0,0 +1,1 @@+{ Some }
+ dhall-lang/tests/parser/success/unit/RecordLitPunSomeB.dhallb view
binary file changed (absent → 15 bytes)
+ dhall-lang/tests/parser/success/unit/ToMapA.dhall view
@@ -0,0 +1,1 @@+toMap x
+ dhall-lang/tests/parser/success/unit/ToMapAnnotA.dhall view
@@ -0,0 +1,1 @@+toMap x : T
+ dhall-lang/tests/parser/success/unit/ToMapAnnotB.dhallb view
binary file changed (absent → 11 bytes)
+ dhall-lang/tests/parser/success/unit/ToMapB.dhallb view
binary file changed (absent → 7 bytes)
+ dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceA.dhall view
@@ -0,0 +1,1 @@+` x `
+ dhall-lang/tests/parser/success/unit/VariableQuotedWithSpaceB.dhallb view
binary file changed (absent → 6 bytes)
+ dhall-lang/tests/parser/success/unit/WithA.dhall view
@@ -0,0 +1,6 @@+{- The purpose of this test is to verify that an implementation correctly+ desugars the base case of a non-nested update. Specifically, an+ implementation should not use an intermediate `let` when desugaring this+ base case.+-}+{ a = 1 } with a = 2
+ dhall-lang/tests/parser/success/unit/WithB.dhallb view
@@ -0,0 +1,1 @@+ ¡aa¡aa
+ dhall-lang/tests/parser/success/unit/WithMultipleA.dhall view
@@ -0,0 +1,8 @@+{- This test ensures that `with` is purely syntactic sugar, meaning that it is+ desugared before encoding and therefore is encoded as the desugared expression+ in the CBOR encoding.++ This test also ensures that implementations desugar the code exactly as+ specified (e.g. using an intermediate `let` binding)+-}+{ a.b = 1, c.d = 2 } with a.b = 3 with c.e = 4
+ dhall-lang/tests/parser/success/unit/WithMultipleB.dhallb view
@@ -0,0 +1,1 @@+ ¢aa¡abac¡ad¡aa ¢aa¡abac¡adaa¡ab¡ac ¢aa¡abac¡ad¡aa ¢aa¡abac¡adaa¡abac¡ae
+ dhall-lang/tests/parser/success/unit/WithPrecedenceA.dhall view
@@ -0,0 +1,13 @@+{- The purpose of this test is to illustrate that function application has+ higher precedence than `with` so that chained with expressions parse+ correctly++ The following expression should parse as:++ ({ a = Some 1 } with a = Some 2) with a = Some 3++ ... and not parse as:++ { a = Some 1 } with a = (Some 2 with a = Some 3)+-}+{ a = Some 1 } with a = Some 2 with a = Some 3
+ dhall-lang/tests/parser/success/unit/WithPrecedenceB.dhallb view
@@ -0,0 +1,1 @@+ ¡aaö¡aaö¡aaö
+ dhall-lang/tests/parser/success/usingToMapA.dhall view
@@ -0,0 +1,1 @@+https://example.com using (toMap { Foo = "Bar" })
+ dhall-lang/tests/parser/success/usingToMapB.dhallb view
binary file changed (absent → 36 bytes)
+ dhall-lang/tests/type-inference/failure/SortInLet.dhall view
@@ -0,0 +1,1 @@+let x = Sort in 0
+ dhall-lang/tests/type-inference/success/CacheImportsA.dhall view
@@ -0,0 +1,6 @@+{-+ This URL returns (probably) a different result for each request. This test+ ensures that import results for a given URL are correctly cached within an+ execution of dhall.+-}+let _ = assert : https://csrng.net/csrng/csrng.php?min=0&max=1000 as Text === https://csrng.net/csrng/csrng.php?min=0&max=1000 as Text in 0
+ dhall-lang/tests/type-inference/success/CacheImportsB.dhall view
@@ -0,0 +1,1 @@+Natural
+ dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeA.dhall view
@@ -0,0 +1,5 @@+{-+ This URL returns (probably) a different result for each request. This test+ ensures that import locations are canonicalized before being cached.+-}+let _ = assert : https://csrng.net/csrng/csrng.php?min=0&max=1000 as Text === https://csrng.net/csrng/../csrng/csrng.php?min=0&max=1000 as Text in 0
+ dhall-lang/tests/type-inference/success/CacheImportsCanonicalizeB.dhall view
@@ -0,0 +1,1 @@+Natural
dhall-lang/tests/type-inference/success/preludeB.dhall view
@@ -226,7 +226,7 @@ ) → JSON , render :- ∀ ( j+ ∀ ( json : ∀(JSON : Type) → ∀ ( json : { array : List JSON → JSON
+ dhall-lang/tests/type-inference/success/unit/RecordLitPunA.dhall view
@@ -0,0 +1,1 @@+\(x: Bool) -> { x }
+ dhall-lang/tests/type-inference/success/unit/RecordLitPunB.dhall view
@@ -0,0 +1,1 @@+∀(x : Bool) → { x : Bool }
+ dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureA.dhall view
@@ -0,0 +1,1 @@+\(x: Bool) -> \(x: Natural) -> { x }
+ dhall-lang/tests/type-inference/success/unit/RecordLitPunCaptureB.dhall view
@@ -0,0 +1,1 @@+∀(x : Bool) → ∀(x : Natural) → { x : Natural }
+ dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeA.dhall view
@@ -0,0 +1,1 @@+let `None` = 0 let `Some` = \(_: Bool) -> 1 in { None, Some }
+ dhall-lang/tests/type-inference/success/unit/RecordLitPunSomeB.dhall view
@@ -0,0 +1,1 @@+{ None : Natural, Some : Bool → Natural }
+ dhall-lang/tests/type-inference/success/unit/WithNewFieldA.dhall view
@@ -0,0 +1,4 @@+{- This test illustrates how the `with` keyword is permitted to extend a record+ with new fields+-}+{ a = 1 } with b = 2
+ dhall-lang/tests/type-inference/success/unit/WithNewFieldB.dhall view
@@ -0,0 +1,1 @@+{ a : Natural, b : Natural }
+ dhall-lang/tests/type-inference/success/unit/WithNewTypeA.dhall view
@@ -0,0 +1,4 @@+{- This test illustrates that the `with` keyword is permitted to override+ existing fields with a value of a new type (just like the `//` operator)+-}+{ a = 1 } with a = True
+ dhall-lang/tests/type-inference/success/unit/WithNewTypeB.dhall view
@@ -0,0 +1,1 @@+{ a : Bool }
dhall.cabal view
@@ -1,8 +1,8 @@ Name: dhall-Version: 1.30.0+Version: 1.31.0 Cabal-Version: >=1.10 Build-Type: Simple-Tested-With: GHC == 8.0.2, GHC == 8.4.3, GHC == 8.6.1+Tested-With: GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1 License: BSD3 License-File: LICENSE Copyright: 2017 Gabriel Gonzalez@@ -26,6 +26,7 @@ benchmark/deep-nested-large-record/*.dhall benchmark/examples/*.dhall benchmark/examples/normalize/*.dhall+ man/dhall.1 CHANGELOG.md dhall-lang/Prelude/Bool/and dhall-lang/Prelude/Bool/build@@ -60,6 +61,7 @@ dhall-lang/Prelude/Integer/subtract dhall-lang/Prelude/Integer/toDouble dhall-lang/Prelude/Integer/toNatural+ dhall-lang/Prelude/JSON/Format dhall-lang/Prelude/JSON/Nesting dhall-lang/Prelude/JSON/Tagged dhall-lang/Prelude/JSON/Type@@ -77,6 +79,7 @@ dhall-lang/Prelude/JSON/omitNullFields dhall-lang/Prelude/JSON/package.dhall dhall-lang/Prelude/JSON/render+ dhall-lang/Prelude/JSON/renderAs dhall-lang/Prelude/JSON/renderInteger.dhall dhall-lang/Prelude/JSON/renderYAML dhall-lang/Prelude/JSON/string@@ -181,7 +184,6 @@ dhall-lang/tests/import/cache/dhall/1220efc43103e49b56c5bf089db8e0365bbfc455b8a2f0dc6ee5727a3586f85969fd 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 dhall-lang/tests/normalization/success/*.dhall@@ -448,7 +450,7 @@ filepath >= 1.4 && < 1.5 , haskeline >= 0.7.2.1 && < 0.9 , hashable >= 1.2 && < 1.4 ,- lens-family-core >= 1.0.0 && < 2.1 ,+ lens-family-core >= 1.0.0 && < 2.2 , megaparsec >= 7 && < 8.1 , memory >= 0.14 && < 0.16, mtl >= 2.2.1 && < 2.3 ,@@ -465,6 +467,7 @@ scientific >= 0.3.0.0 && < 0.4 , template-haskell >= 2.11.1.0 && < 2.16, text >= 0.11.1.0 && < 1.3 ,+ text-manipulate >= 0.2.0.1 && < 0.3 , th-lift-instances >= 0.1.13 && < 0.2 , transformers >= 0.2.0.0 && < 0.6 , transformers-compat >= 0.6.2 && < 0.7 ,@@ -552,6 +555,9 @@ if !flag(cross) Exposed-Modules: Dhall.TH+ if impl(ghc >= 8.6.1)+ Exposed-Modules:+ Dhall.Deriving Other-Modules: Dhall.Eval Dhall.Import.Types@@ -613,7 +619,7 @@ filepath , foldl < 1.5 , generic-random >= 1.3.0.0 && < 1.4 ,- lens-family-core >= 1.0.0 && < 2.1 ,+ lens-family-core , megaparsec , prettyprinter , QuickCheck >= 2.10 && < 2.14,@@ -627,6 +633,7 @@ tasty-expected-failure < 0.12, tasty-hunit >= 0.10 && < 0.11, tasty-quickcheck >= 0.9.2 && < 0.11,+ template-haskell , text >= 0.11.1.0 && < 1.3 , transformers , turtle < 1.6 ,
doctest/Main.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Main where import Data.Monoid ((<>))@@ -23,6 +25,12 @@ writeFile "both" "./bool1 && ./bool2" writeFile "file2" "./file1" writeFile "file1" "./file2"+ writeFile "simon.dhall" $ unlines+ [ "let Name = Text"+ , "let Font = < Arial | `Comic Sans` | Helvetica | `Times New Roman` >"+ , "let Person = { name : Name, favoriteFont : Font }"+ , "in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person"+ ] Test.DocTest.doctest [ "-DWITH_HTTP"@@ -38,6 +46,9 @@ -- , prefix </> "src" , "-i" <> (prefix </> "src")+#if __GLASGOW_HASKELL__ >= 806+ , prefix </> "src/Dhall/Deriving.hs"+#endif , prefix </> "src/Dhall/Tags.hs" , prefix </> "src/Dhall/Tutorial.hs" ]
+ man/dhall.1 view
@@ -0,0 +1,100 @@+.\" Automatically generated by Pandoc 2.9.2+.\"+.TH "dhall (1)" "" "" "" ""+.hy+.SH NAME+.PP+dhall - a programmable configuration language+.SH DESCRIPTION+.PP+\f[B]dhall\f[R] is the command-line interface to the Dhall language+.SH SYNOPSIS+.PP+dhall --file check.dhall+.PP+dhall --file error.dhall --explain+.PP+dhall hash --file to-hash.dhall+.PP+dhall freeze --file with-imports.dhall+.PP+dhall repl+.PP+dhall diff \[aq]./file1.dhall\[cq] \[aq]./file2.dhall\[cq]+.PP+dhall type --quiet --file check-ci.dhall+.SH SUBCOMMANDS+.PP+\f[B]version\f[R] - Display version information+.PP+\f[B]resolve\f[R] - Resolve imports+.PP+\f[B]type\f[R] - Infer type of expression+.PP+\f[B]normalize\f[R] - Normalize an expression+.PP+\f[B]repl\f[R] - Open a REPL+.PP+\f[B]diff\f[R] - Show difference between two expressions+.PP+\f[B]hash\f[R] - Compute hash of expression+.PP+\f[B]lint\f[R] - Lint an expression, removing dead code+.PP+\f[B]tags\f[R] - Generate etags (Emacs) file+.PP+\f[B]format\f[R] - Format an expression+.PP+\f[B]freeze\f[R] - Add hashes to import statements+.PP+\f[B]encode\f[R] - Encode a Dhall expression (CBOR)+.PP+\f[B]decode\f[R] - Decode a Dhall expression+.PP+\f[B]text\f[R] - Render a Dhall expression to text+.PP+\f[B]to-directory-tree\f[R] - Convert nested record of Text into a+directory+.SH OPTIONS+.TP+\f[B]-h\f[R] \f[B]--help\f[R]+Display help+.TP+\f[B]--file\f[R]+Name of file containing Dhall source+.TP+\f[B]--output\f[R]+Output file+.TP+\f[B]--annotate\f[R]+Add type annotation to output+.TP+\f[B]--alpha\f[R]+alpha-normalize output+.TP+\f[B]--no-cache\f[R]+Don\[cq]t use cache to resolve imports+.TP+\f[B]--explain\f[R]+Explain error messages in detail+.TP+\f[B]--version\f[R]+Display version information+.TP+\f[B]--plain\f[R]+Disable syntax highlighting in output+.TP+\f[B]--ascii\f[R]+Format code using only ASCII syntax+.TP+\f[B]--censor\f[R]+Hide source code from error messages+.SH EDITOR INTEGRATION+.PP+Up-to-date information on editor integration is available at:+.PP+https://docs.dhall-lang.org/howtos/Text-Editor-Configuration.html+.SH BUGS+.PP+Please report any bugs you may come across to+https://github.com/dhall-language/dhall-haskell/issues.
src/Dhall.hs view
@@ -59,6 +59,7 @@ , fromMonadic , auto , genericAuto+ , genericAutoWith , InterpretOptions(..) , SingletonConstructors(..) , defaultInterpretOptions@@ -74,6 +75,7 @@ , list , vector , function+ , functionWith , setFromDistinctList , setIgnoringDuplicates , hashSetFromDistinctList@@ -96,6 +98,7 @@ , Inject , inject , genericToDhall+ , genericToDhallWith , RecordEncoder(..) , encodeFieldWith , encodeField@@ -841,21 +844,35 @@ {-| Decode a Dhall function into a Haskell function ->>> f <- input (function defaultInterpretOptions inject bool) "Natural/even" :: IO (Natural -> Bool)+>>> f <- input (function inject bool) "Natural/even" :: IO (Natural -> Bool) >>> f 0 True >>> f 1 False -} function- :: InterpretOptions+ :: Encoder a+ -> Decoder b+ -> Decoder (a -> b)+function = functionWith defaultInputNormalizer++{-| Decode a Dhall function into a Haskell function using the specified normalizer++>>> f <- input (functionWith defaultInputNormalizer inject bool) "Natural/even" :: IO (Natural -> Bool)+>>> f 0+True+>>> f 1+False+-}+functionWith+ :: InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)-function options (Encoder {..}) (Decoder extractIn expectedIn) =+functionWith inputNormalizer (Encoder {..}) (Decoder extractIn expectedIn) = Decoder extractOut expectedOut where- normalizer_ = Just (inputNormalizer options)+ normalizer_ = Just (getInputNormalizer inputNormalizer) extractOut e = pure (\i -> case extractIn (Dhall.Core.normalizeWith normalizer_ (App e (embed i))) of Success o -> o@@ -1092,15 +1109,20 @@ >>> input auto "toMap { a = False, b = True }" :: IO (Map Text Bool) fromList [("a",False),("b",True)] - This class auto-generates a default implementation for records that+ This class auto-generates a default implementation for types that implement `Generic`. This does not auto-generate an instance for recursive types.++ The default instance can be tweaked using 'genericAutoWith' and custom+ 'InterpretOptions', or using+ [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia)+ and 'Dhall.Deriving.Codec' from "Dhall.Deriving". -} class FromDhall a where- autoWith:: InterpretOptions -> Decoder a+ autoWith :: InputNormalizer -> Decoder a default autoWith- :: (Generic a, GenericFromDhall (Rep a)) => InterpretOptions -> Decoder a- autoWith options = fmap GHC.Generics.to (evalState (genericAutoWith options) 1)+ :: (Generic a, GenericFromDhall (Rep a)) => InputNormalizer -> Decoder a+ autoWith _ = genericAuto {-| A compatibility alias for `FromDhall` @@ -1160,29 +1182,29 @@ the list. To ignore duplicates, use `hashSetIgnoringDuplicates`. -} instance (FromDhall a, Hashable a, Ord a, Show a) => FromDhall (Data.HashSet.HashSet a) where- autoWith opts = hashSetFromDistinctList (autoWith opts)+ autoWith inputNormalizer = hashSetFromDistinctList (autoWith inputNormalizer) instance (Ord k, FromDhall k, FromDhall v) => FromDhall (Map k v) where- autoWith opts = Dhall.map (autoWith opts) (autoWith opts)+ autoWith inputNormalizer = Dhall.map (autoWith inputNormalizer) (autoWith inputNormalizer) instance (Eq k, Hashable k, FromDhall k, FromDhall v) => FromDhall (HashMap k v) where- autoWith opts = Dhall.hashMap (autoWith opts) (autoWith opts)+ autoWith inputNormalizer = Dhall.hashMap (autoWith inputNormalizer) (autoWith inputNormalizer) instance (ToDhall a, FromDhall b) => FromDhall (a -> b) where- autoWith opts =- function opts (injectWith opts) (autoWith opts)+ autoWith inputNormalizer =+ functionWith inputNormalizer (injectWith inputNormalizer) (autoWith inputNormalizer) instance (FromDhall a, FromDhall b) => FromDhall (a, b) -{-| Use the default options for interpreting a configuration file+{-| Use the default input normalizer for interpreting a configuration file -> auto = autoWith defaultInterpretOptions+> auto = autoWith defaultInputNormalizer -} auto :: FromDhall a => Decoder a-auto = autoWith defaultInterpretOptions+auto = autoWith defaultInputNormalizer {-| This type is exactly the same as `Data.Fix.Fix` except with a different- `FromDhall` instance. This intermediate type simplies the implementation+ `FromDhall` instance. This intermediate type simplifies the implementation of the inner loop for the `FromDhall` instance for `Fix` -} newtype Result f = Result { _unResult :: f (Result f) }@@ -1191,12 +1213,12 @@ resultToFix (Result x) = Fix (fmap resultToFix x) instance FromDhall (f (Result f)) => FromDhall (Result f) where- autoWith options = Decoder { expected = expected_, extract = extract_ }+ autoWith inputNormalizer = Decoder { expected = expected_, extract = extract_ } where expected_ = "result" extract_ (App _ expression) = do- fmap Result (extract (autoWith options) expression)+ fmap Result (extract (autoWith inputNormalizer) expression) extract_ expression = do typeError expression expected_ @@ -1275,18 +1297,18 @@ -- > -- > print (convert x :: Expr) instance (Functor f, FromDhall (f (Result f))) => FromDhall (Fix f) where- autoWith options = Decoder { expected = expected_, extract = extract_ }+ autoWith inputNormalizer = Decoder { expected = expected_, extract = extract_ } where expected_ = Pi "result" (Const Dhall.Core.Type)- (Pi "Make" (Pi "_" (expected (autoWith options :: Decoder (f (Result f)))) "result")+ (Pi "Make" (Pi "_" (expected (autoWith inputNormalizer :: Decoder (f (Result f)))) "result") "result" ) extract_ expression0 = go0 (Dhall.Core.alphaNormalize expression0) where go0 (Lam _ _ (Lam _ _ expression1)) =- fmap resultToFix (extract (autoWith options) expression1)+ fmap resultToFix (extract (autoWith inputNormalizer) expression1) go0 _ = typeError expected_ expression0 {-| `genericAuto` is the default implementation for `auto` if you derive@@ -1295,8 +1317,14 @@ the type derives `Generic` -} genericAuto :: (Generic a, GenericFromDhall (Rep a)) => Decoder a-genericAuto = fmap to (evalState (genericAutoWith defaultInterpretOptions) 1)+genericAuto = genericAutoWith defaultInterpretOptions +{-| `genericAutoWith` is a configurable version of `genericAuto`.+-}+genericAutoWith :: (Generic a, GenericFromDhall (Rep a)) => InterpretOptions -> Decoder a+genericAutoWith options = fmap to (evalState (genericAutoWithNormalizer defaultInputNormalizer options) 1)++ {-| Use these options to tweak how Dhall derives a generic implementation of `FromDhall` -}@@ -1310,12 +1338,18 @@ , singletonConstructors :: SingletonConstructors -- ^ Specify how to handle constructors with only one field. The default is -- `Smart`- , inputNormalizer :: Dhall.Core.ReifiedNormalizer Void- -- ^ This is only used by the `FromDhall` instance for functions in order- -- to normalize the function input before marshaling the input into a- -- Dhall expression } +-- | This is only used by the `FromDhall` instance for functions in order+-- to normalize the function input before marshaling the input into a+-- Dhall expression+newtype InputNormalizer = InputNormalizer+ { getInputNormalizer :: Dhall.Core.ReifiedNormalizer Void }++defaultInputNormalizer :: InputNormalizer+defaultInputNormalizer = InputNormalizer+ { getInputNormalizer = Dhall.Core.ReifiedNormalizer (const (pure Nothing)) }+ {-| This type specifies how to model a Haskell constructor with 1 field in Dhall @@ -1339,9 +1373,10 @@ | Smart -- ^ Only fields in a record if they are named -{-| Default interpret options, which you can tweak or override, like this:+{-| Default interpret options for generics-based instances,+ which you can tweak or override, like this: -> autoWith+> genericAutoWith > (defaultInterpretOptions { fieldModifier = Data.Text.Lazy.dropWhile (== '_') }) -} defaultInterpretOptions :: InterpretOptions@@ -1352,23 +1387,21 @@ id , singletonConstructors = Smart- , inputNormalizer =- Dhall.Core.ReifiedNormalizer (const (pure Nothing)) } {-| This is the underlying class that powers the `FromDhall` class's support for automatically deriving a generic implementation -} class GenericFromDhall f where- genericAutoWith :: InterpretOptions -> State Int (Decoder (f a))+ genericAutoWithNormalizer :: InputNormalizer -> InterpretOptions -> State Int (Decoder (f a)) instance GenericFromDhall f => GenericFromDhall (M1 D d f) where- genericAutoWith options = do- res <- genericAutoWith options+ genericAutoWithNormalizer inputNormalizer options = do+ res <- genericAutoWithNormalizer inputNormalizer options pure (fmap M1 res) instance GenericFromDhall V1 where- genericAutoWith _ = pure Decoder {..}+ genericAutoWithNormalizer _ _ = pure Decoder {..} where extract expr = typeError expected expr @@ -1429,7 +1462,7 @@ empty instance (Constructor c1, Constructor c2, GenericFromDhall f1, GenericFromDhall f2) => GenericFromDhall (M1 C c1 f1 :+: M1 C c2 f2) where- genericAutoWith options@(InterpretOptions {..}) = pure (Decoder {..})+ genericAutoWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Decoder {..}) where nL :: M1 i c1 f1 a nL = undefined@@ -1457,11 +1490,11 @@ ] ) - Decoder extractL expectedL = evalState (genericAutoWith options) 1- Decoder extractR expectedR = evalState (genericAutoWith options) 1+ Decoder extractL expectedL = evalState (genericAutoWithNormalizer inputNormalizer options) 1+ Decoder extractR expectedR = evalState (genericAutoWithNormalizer inputNormalizer options) 1 instance (Constructor c, GenericFromDhall (f :+: g), GenericFromDhall h) => GenericFromDhall ((f :+: g) :+: M1 C c h) where- genericAutoWith options@(InterpretOptions {..}) = pure (Decoder {..})+ genericAutoWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Decoder {..}) where n :: M1 i c h a n = undefined@@ -1478,13 +1511,13 @@ expected = Union (Dhall.Map.insert name (notEmptyRecord expectedR) ktsL) - Decoder extractL expectedL = evalState (genericAutoWith options) 1- Decoder extractR expectedR = evalState (genericAutoWith options) 1+ Decoder extractL expectedL = evalState (genericAutoWithNormalizer inputNormalizer options) 1+ Decoder extractR expectedR = evalState (genericAutoWithNormalizer inputNormalizer options) 1 - ktsL = unsafeExpectUnion "genericAutoWith (:+:)" expectedL+ ktsL = unsafeExpectUnion "genericAutoWithNormalizer (:+:)" expectedL instance (Constructor c, GenericFromDhall f, GenericFromDhall (g :+: h)) => GenericFromDhall (M1 C c f :+: (g :+: h)) where- genericAutoWith options@(InterpretOptions {..}) = pure (Decoder {..})+ genericAutoWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Decoder {..}) where n :: M1 i c f a n = undefined@@ -1501,31 +1534,31 @@ expected = Union (Dhall.Map.insert name (notEmptyRecord expectedL) ktsR) - Decoder extractL expectedL = evalState (genericAutoWith options) 1- Decoder extractR expectedR = evalState (genericAutoWith options) 1+ Decoder extractL expectedL = evalState (genericAutoWithNormalizer inputNormalizer options) 1+ Decoder extractR expectedR = evalState (genericAutoWithNormalizer inputNormalizer options) 1 - ktsR = unsafeExpectUnion "genericAutoWith (:+:)" expectedR+ ktsR = unsafeExpectUnion "genericAutoWithNormalizer (:+:)" expectedR instance (GenericFromDhall (f :+: g), GenericFromDhall (h :+: i)) => GenericFromDhall ((f :+: g) :+: (h :+: i)) where- genericAutoWith options = pure (Decoder {..})+ genericAutoWithNormalizer inputNormalizer options = pure (Decoder {..}) where extract e = fmap L1 (extractL e) `ealt` fmap R1 (extractR e) expected = Union (Dhall.Map.union ktsL ktsR) - Decoder extractL expectedL = evalState (genericAutoWith options) 1- Decoder extractR expectedR = evalState (genericAutoWith options) 1+ Decoder extractL expectedL = evalState (genericAutoWithNormalizer inputNormalizer options) 1+ Decoder extractR expectedR = evalState (genericAutoWithNormalizer inputNormalizer options) 1 - ktsL = unsafeExpectUnion "genericAutoWith (:+:)" expectedL- ktsR = unsafeExpectUnion "genericAutoWith (:+:)" expectedR+ ktsL = unsafeExpectUnion "genericAutoWithNormalizer (:+:)" expectedL+ ktsR = unsafeExpectUnion "genericAutoWithNormalizer (:+:)" expectedR instance GenericFromDhall f => GenericFromDhall (M1 C c f) where- genericAutoWith options = do- res <- genericAutoWith options+ genericAutoWithNormalizer inputNormalizer options = do+ res <- genericAutoWithNormalizer inputNormalizer options pure (fmap M1 res) instance GenericFromDhall U1 where- genericAutoWith _ = pure (Decoder {..})+ genericAutoWithNormalizer _ _ = pure (Decoder {..}) where extract _ = pure U1 @@ -1539,12 +1572,12 @@ nn -> pure (Data.Text.pack nn) instance (GenericFromDhall (f :*: g), GenericFromDhall (h :*: i)) => GenericFromDhall ((f :*: g) :*: (h :*: i)) where- genericAutoWith options = do- Decoder extractL expectedL <- genericAutoWith options- Decoder extractR expectedR <- genericAutoWith options+ genericAutoWithNormalizer inputNormalizer options = do+ Decoder extractL expectedL <- genericAutoWithNormalizer inputNormalizer options+ Decoder extractR expectedR <- genericAutoWithNormalizer inputNormalizer options - let ktsL = unsafeExpectRecord "genericAutoWith (:*:)" expectedL- let ktsR = unsafeExpectRecord "genericAutoWith (:*:)" expectedR+ let ktsL = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" expectedL+ let ktsR = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" expectedR let expected = Record (Dhall.Map.union ktsL ktsR) @@ -1554,17 +1587,17 @@ return (Decoder {..}) instance (GenericFromDhall (f :*: g), Selector s, FromDhall a) => GenericFromDhall ((f :*: g) :*: M1 S s (K1 i a)) where- genericAutoWith options@InterpretOptions{..} = do+ genericAutoWithNormalizer inputNormalizer options@InterpretOptions{..} = do let nR :: M1 S s (K1 i a) r nR = undefined nameR <- fmap fieldModifier (getSelName nR) - Decoder extractL expectedL <- genericAutoWith options+ Decoder extractL expectedL <- genericAutoWithNormalizer inputNormalizer options - let Decoder extractR expectedR = autoWith options+ let Decoder extractR expectedR = autoWith inputNormalizer - let ktsL = unsafeExpectRecord "genericAutoWith (:*:)" expectedL+ let ktsL = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" expectedL let expected = Record (Dhall.Map.insert nameR expectedR ktsL) @@ -1584,17 +1617,17 @@ return (Decoder {..}) instance (Selector s, FromDhall a, GenericFromDhall (f :*: g)) => GenericFromDhall (M1 S s (K1 i a) :*: (f :*: g)) where- genericAutoWith options@InterpretOptions{..} = do+ genericAutoWithNormalizer inputNormalizer options@InterpretOptions{..} = do let nL :: M1 S s (K1 i a) r nL = undefined nameL <- fmap fieldModifier (getSelName nL) - let Decoder extractL expectedL = autoWith options+ let Decoder extractL expectedL = autoWith inputNormalizer - Decoder extractR expectedR <- genericAutoWith options+ Decoder extractR expectedR <- genericAutoWithNormalizer inputNormalizer options - let ktsR = unsafeExpectRecord "genericAutoWith (:*:)" expectedR+ let ktsR = unsafeExpectRecord "genericAutoWithNormalizer (:*:)" expectedR let expected = Record (Dhall.Map.insert nameL expectedL ktsR) @@ -1614,7 +1647,7 @@ return (Decoder {..}) instance (Selector s1, Selector s2, FromDhall a1, FromDhall a2) => GenericFromDhall (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where- genericAutoWith options@InterpretOptions{..} = do+ genericAutoWithNormalizer inputNormalizer InterpretOptions{..} = do let nL :: M1 S s1 (K1 i1 a1) r nL = undefined @@ -1624,8 +1657,8 @@ nameL <- fmap fieldModifier (getSelName nL) nameR <- fmap fieldModifier (getSelName nR) - let Decoder extractL expectedL = autoWith options- let Decoder extractR expectedR = autoWith options+ let Decoder extractL expectedL = autoWith inputNormalizer+ let Decoder extractR expectedR = autoWith inputNormalizer let expected = Record@@ -1651,13 +1684,13 @@ return (Decoder {..}) instance (Selector s, FromDhall a) => GenericFromDhall (M1 S s (K1 i a)) where- genericAutoWith options@InterpretOptions{..} = do+ genericAutoWithNormalizer inputNormalizer InterpretOptions{..} = do let n :: M1 S s (K1 i a) r n = undefined name <- fmap fieldModifier (getSelName n) - let Decoder { extract = extract', expected = expected'} = autoWith options+ let Decoder { extract = extract', expected = expected'} = autoWith inputNormalizer let expected = case singletonConstructors of@@ -1720,13 +1753,21 @@ (i.e. @App f x@) * Normalizing the syntax tree (i.e. @normalize (App f x)@) * Marshaling the resulting Dhall expression back into a Haskell value++ This class auto-generates a default implementation for types that+ implement `Generic`. This does not auto-generate an instance for recursive+ types.++ The default instance can be tweaked using 'genericToDhallWith' and custom+ 'InterpretOptions', or using+ [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia)+ and 'Dhall.Deriving.Codec' from "Dhall.Deriving". -} class ToDhall a where- injectWith :: InterpretOptions -> Encoder a+ injectWith :: InputNormalizer -> Encoder a default injectWith- :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a- injectWith options- = contramap GHC.Generics.from (evalState (genericToDhallWith options) 1)+ :: (Generic a, GenericToDhall (Rep a)) => InputNormalizer -> Encoder a+ injectWith _ = genericToDhall {-| A compatibility alias for `ToDhall` @@ -1734,12 +1775,12 @@ -} type Inject = ToDhall -{-| Use the default options for injecting a value+{-| Use the default input normalizer for injecting a value -> inject = injectWith defaultInterpretOptions+> inject = injectWith defaultInputNormalizer -} inject :: ToDhall a => Encoder a-inject = injectWith defaultInterpretOptions+inject = injectWith defaultInputNormalizer {-| Use the default options for injecting a value, whose structure is determined generically.@@ -1750,8 +1791,19 @@ genericToDhall :: (Generic a, GenericToDhall (Rep a)) => Encoder a genericToDhall- = contramap GHC.Generics.from (evalState (genericToDhallWith defaultInterpretOptions) 1)+ = genericToDhallWith defaultInterpretOptions +{-| Use custom options for injecting a value, whose structure is+determined generically.++This can be used when you want to use 'ToDhall' on types that you don't+want to define orphan instances for.+-}+genericToDhallWith+ :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a+genericToDhallWith options+ = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer defaultInputNormalizer options) 1)+ instance ToDhall Void where injectWith _ = Encoder {..} where@@ -1782,8 +1834,8 @@ declared = Text instance {-# OVERLAPS #-} ToDhall String where- injectWith options =- contramap Data.Text.pack (injectWith options :: Encoder Text)+ injectWith inputNormalizer =+ contramap Data.Text.pack (injectWith inputNormalizer :: Encoder Text) instance ToDhall Natural where injectWith _ = Encoder {..}@@ -1879,8 +1931,8 @@ declared = Double instance ToDhall Scientific where- injectWith options =- contramap Data.Scientific.toRealFloat (injectWith options :: Encoder Double)+ injectWith inputNormalizer =+ contramap Data.Scientific.toRealFloat (injectWith inputNormalizer :: Encoder Double) instance ToDhall () where injectWith _ = Encoder {..}@@ -1890,17 +1942,17 @@ declared = Record mempty instance ToDhall a => ToDhall (Maybe a) where- injectWith options = Encoder embedOut declaredOut+ injectWith inputNormalizer = Encoder embedOut declaredOut where embedOut (Just x ) = Some (embedIn x) embedOut Nothing = App None declaredIn - Encoder embedIn declaredIn = injectWith options+ Encoder embedIn declaredIn = injectWith inputNormalizer declaredOut = App Optional declaredIn instance ToDhall a => ToDhall (Seq a) where- injectWith options = Encoder embedOut declaredOut+ injectWith inputNormalizer = Encoder embedOut declaredOut where embedOut xs = ListLit listType (fmap embedIn xs) where@@ -1910,7 +1962,7 @@ declaredOut = App List declaredIn - Encoder embedIn declaredIn = injectWith options+ Encoder embedIn declaredIn = injectWith inputNormalizer instance ToDhall a => ToDhall [a] where injectWith = fmap (contramap Data.Sequence.fromList) injectWith@@ -1918,7 +1970,7 @@ instance ToDhall a => ToDhall (Vector a) where injectWith = fmap (contramap Data.Vector.toList) injectWith -{-| Note that the ouput list will be sorted+{-| Note that the output list will be sorted >>> let x = Data.Set.fromList ["mom", "hi" :: Text] >>> prettyExpr $ embed inject x@@ -1928,7 +1980,7 @@ instance ToDhall a => ToDhall (Data.Set.Set a) where injectWith = fmap (contramap Data.Set.toAscList) injectWith -{-| Note that the ouput list may not be sorted+{-| Note that the output list may not be sorted >>> let x = Data.HashSet.fromList ["hi", "mom" :: Text] >>> prettyExpr $ embed inject x@@ -1950,7 +2002,7 @@ -} instance (ToDhall k, ToDhall v) => ToDhall (Data.Map.Map k v) where- injectWith options = Encoder embedOut declaredOut+ injectWith inputNormalizer = Encoder embedOut declaredOut where embedOut m = ListLit listType (mapEntries m) where@@ -1965,8 +2017,8 @@ recordPair (k, v) = RecordLit (Dhall.Map.fromList [("mapKey", embedK k), ("mapValue", embedV v)]) - Encoder embedK declaredK = injectWith options- Encoder embedV declaredV = injectWith options+ Encoder embedK declaredK = injectWith inputNormalizer+ Encoder embedV declaredV = injectWith inputNormalizer {-| Embed a `Data.HashMap` as a @Prelude.Map.Type@ @@ -1978,7 +2030,7 @@ -} instance (ToDhall k, ToDhall v) => ToDhall (HashMap k v) where- injectWith options = Encoder embedOut declaredOut+ injectWith inputNormalizer = Encoder embedOut declaredOut where embedOut m = ListLit listType (mapEntries m) where@@ -1993,29 +2045,29 @@ recordPair (k, v) = RecordLit (Dhall.Map.fromList [("mapKey", embedK k), ("mapValue", embedV v)]) - Encoder embedK declaredK = injectWith options- Encoder embedV declaredV = injectWith options+ Encoder embedK declaredK = injectWith inputNormalizer+ Encoder embedV declaredV = injectWith inputNormalizer {-| This is the underlying class that powers the `FromDhall` class's support for automatically deriving a generic implementation -} class GenericToDhall f where- genericToDhallWith :: InterpretOptions -> State Int (Encoder (f a))+ genericToDhallWithNormalizer :: InputNormalizer -> InterpretOptions -> State Int (Encoder (f a)) instance GenericToDhall f => GenericToDhall (M1 D d f) where- genericToDhallWith options = do- res <- genericToDhallWith options+ genericToDhallWithNormalizer inputNormalizer options = do+ res <- genericToDhallWithNormalizer inputNormalizer options pure (contramap unM1 res) instance GenericToDhall f => GenericToDhall (M1 C c f) where- genericToDhallWith options = do- res <- genericToDhallWith options+ genericToDhallWithNormalizer inputNormalizer options = do+ res <- genericToDhallWithNormalizer inputNormalizer options pure (contramap unM1 res) instance (Selector s, ToDhall a) => GenericToDhall (M1 S s (K1 i a)) where- genericToDhallWith options@InterpretOptions{..} = do+ genericToDhallWithNormalizer inputNormalizer InterpretOptions{..} = do let Encoder { embed = embed', declared = declared' } =- injectWith options+ injectWith inputNormalizer let n :: M1 S s (K1 i a) r n = undefined@@ -2045,7 +2097,7 @@ return (Encoder {..}) instance (Constructor c1, Constructor c2, GenericToDhall f1, GenericToDhall f2) => GenericToDhall (M1 C c1 f1 :+: M1 C c2 f2) where- genericToDhallWith options@(InterpretOptions {..}) = pure (Encoder {..})+ genericToDhallWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Encoder {..}) where embed (L1 (M1 l)) = case notEmptyRecordLit (embedL l) of@@ -2078,11 +2130,11 @@ keyL = constructorModifier (Data.Text.pack (conName nL)) keyR = constructorModifier (Data.Text.pack (conName nR)) - Encoder embedL declaredL = evalState (genericToDhallWith options) 1- Encoder embedR declaredR = evalState (genericToDhallWith options) 1+ Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1+ Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 instance (Constructor c, GenericToDhall (f :+: g), GenericToDhall h) => GenericToDhall ((f :+: g) :+: M1 C c h) where- genericToDhallWith options@(InterpretOptions {..}) = pure (Encoder {..})+ genericToDhallWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Encoder {..}) where embed (L1 l) = case maybeValL of@@ -2090,7 +2142,7 @@ Just valL -> App (Field declared keyL) valL where (keyL, maybeValL) =- unsafeExpectUnionLit "genericToDhallWith (:+:)" (embedL l)+ unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedL l) embed (R1 (M1 r)) = case notEmptyRecordLit (embedR r) of Nothing -> Field declared keyR@@ -2103,13 +2155,13 @@ declared = Union (Dhall.Map.insert keyR (notEmptyRecord declaredR) ktsL) - Encoder embedL declaredL = evalState (genericToDhallWith options) 1- Encoder embedR declaredR = evalState (genericToDhallWith options) 1+ Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1+ Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 - ktsL = unsafeExpectUnion "genericToDhallWith (:+:)" declaredL+ ktsL = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredL instance (Constructor c, GenericToDhall f, GenericToDhall (g :+: h)) => GenericToDhall (M1 C c f :+: (g :+: h)) where- genericToDhallWith options@(InterpretOptions {..}) = pure (Encoder {..})+ genericToDhallWithNormalizer inputNormalizer options@(InterpretOptions {..}) = pure (Encoder {..}) where embed (L1 (M1 l)) = case notEmptyRecordLit (embedL l) of@@ -2121,7 +2173,7 @@ Just valR -> App (Field declared keyR) valR where (keyR, maybeValR) =- unsafeExpectUnionLit "genericToDhallWith (:+:)" (embedR r)+ unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedR r) nL :: M1 i c f a nL = undefined@@ -2130,13 +2182,13 @@ declared = Union (Dhall.Map.insert keyL (notEmptyRecord declaredL) ktsR) - Encoder embedL declaredL = evalState (genericToDhallWith options) 1- Encoder embedR declaredR = evalState (genericToDhallWith options) 1+ Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1+ Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 - ktsR = unsafeExpectUnion "genericToDhallWith (:+:)" declaredR+ ktsR = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredR instance (GenericToDhall (f :+: g), GenericToDhall (h :+: i)) => GenericToDhall ((f :+: g) :+: (h :+: i)) where- genericToDhallWith options = pure (Encoder {..})+ genericToDhallWithNormalizer inputNormalizer options = pure (Encoder {..}) where embed (L1 l) = case maybeValL of@@ -2144,92 +2196,92 @@ Just valL -> App (Field declared keyL) valL where (keyL, maybeValL) =- unsafeExpectUnionLit "genericToDhallWith (:+:)" (embedL l)+ unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedL l) embed (R1 r) = case maybeValR of Nothing -> Field declared keyR Just valR -> App (Field declared keyR) valR where (keyR, maybeValR) =- unsafeExpectUnionLit "genericToDhallWith (:+:)" (embedR r)+ unsafeExpectUnionLit "genericToDhallWithNormalizer (:+:)" (embedR r) declared = Union (Dhall.Map.union ktsL ktsR) - Encoder embedL declaredL = evalState (genericToDhallWith options) 1- Encoder embedR declaredR = evalState (genericToDhallWith options) 1+ Encoder embedL declaredL = evalState (genericToDhallWithNormalizer inputNormalizer options) 1+ Encoder embedR declaredR = evalState (genericToDhallWithNormalizer inputNormalizer options) 1 - ktsL = unsafeExpectUnion "genericToDhallWith (:+:)" declaredL- ktsR = unsafeExpectUnion "genericToDhallWith (:+:)" declaredR+ ktsL = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredL+ ktsR = unsafeExpectUnion "genericToDhallWithNormalizer (:+:)" declaredR instance (GenericToDhall (f :*: g), GenericToDhall (h :*: i)) => GenericToDhall ((f :*: g) :*: (h :*: i)) where- genericToDhallWith options = do- Encoder embedL declaredL <- genericToDhallWith options- Encoder embedR declaredR <- genericToDhallWith options+ genericToDhallWithNormalizer inputNormalizer options = do+ Encoder embedL declaredL <- genericToDhallWithNormalizer inputNormalizer options+ Encoder embedR declaredR <- genericToDhallWithNormalizer inputNormalizer options let embed (l :*: r) = RecordLit (Dhall.Map.union mapL mapR) where mapL =- unsafeExpectRecordLit "genericToDhallWith (:*:)" (embedL l)+ unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedL l) mapR =- unsafeExpectRecordLit "genericToDhallWith (:*:)" (embedR r)+ unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedR r) let declared = Record (Dhall.Map.union mapL mapR) where- mapL = unsafeExpectRecord "genericToDhallWith (:*:)" declaredL- mapR = unsafeExpectRecord "genericToDhallWith (:*:)" declaredR+ mapL = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredL+ mapR = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredR pure (Encoder {..}) instance (GenericToDhall (f :*: g), Selector s, ToDhall a) => GenericToDhall ((f :*: g) :*: M1 S s (K1 i a)) where- genericToDhallWith options@InterpretOptions{..} = do+ genericToDhallWithNormalizer inputNormalizer options@InterpretOptions{..} = do let nR :: M1 S s (K1 i a) r nR = undefined nameR <- fmap fieldModifier (getSelName nR) - Encoder embedL declaredL <- genericToDhallWith options+ Encoder embedL declaredL <- genericToDhallWithNormalizer inputNormalizer options - let Encoder embedR declaredR = injectWith options+ let Encoder embedR declaredR = injectWith inputNormalizer let embed (l :*: M1 (K1 r)) = RecordLit (Dhall.Map.insert nameR (embedR r) mapL) where mapL =- unsafeExpectRecordLit "genericToDhallWith (:*:)" (embedL l)+ unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedL l) let declared = Record (Dhall.Map.insert nameR declaredR mapL) where- mapL = unsafeExpectRecord "genericToDhallWith (:*:)" declaredL+ mapL = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredL return (Encoder {..}) instance (Selector s, ToDhall a, GenericToDhall (f :*: g)) => GenericToDhall (M1 S s (K1 i a) :*: (f :*: g)) where- genericToDhallWith options@InterpretOptions{..} = do+ genericToDhallWithNormalizer inputNormalizer options@InterpretOptions{..} = do let nL :: M1 S s (K1 i a) r nL = undefined nameL <- fmap fieldModifier (getSelName nL) - let Encoder embedL declaredL = injectWith options+ let Encoder embedL declaredL = injectWith inputNormalizer - Encoder embedR declaredR <- genericToDhallWith options+ Encoder embedR declaredR <- genericToDhallWithNormalizer inputNormalizer options let embed (M1 (K1 l) :*: r) = RecordLit (Dhall.Map.insert nameL (embedL l) mapR) where mapR =- unsafeExpectRecordLit "genericToDhallWith (:*:)" (embedR r)+ unsafeExpectRecordLit "genericToDhallWithNormalizer (:*:)" (embedR r) let declared = Record (Dhall.Map.insert nameL declaredL mapR) where- mapR = unsafeExpectRecord "genericToDhallWith (:*:)" declaredR+ mapR = unsafeExpectRecord "genericToDhallWithNormalizer (:*:)" declaredR return (Encoder {..}) instance (Selector s1, Selector s2, ToDhall a1, ToDhall a2) => GenericToDhall (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where- genericToDhallWith options@InterpretOptions{..} = do+ genericToDhallWithNormalizer inputNormalizer InterpretOptions{..} = do let nL :: M1 S s1 (K1 i1 a1) r nL = undefined @@ -2239,8 +2291,8 @@ nameL <- fmap fieldModifier (getSelName nL) nameR <- fmap fieldModifier (getSelName nR) - let Encoder embedL declaredL = injectWith options- let Encoder embedR declaredR = injectWith options+ let Encoder embedL declaredL = injectWith inputNormalizer+ let Encoder embedR declaredR = injectWith inputNormalizer let embed (M1 (K1 l) :*: M1 (K1 r)) = RecordLit@@ -2257,7 +2309,7 @@ return (Encoder {..}) instance GenericToDhall U1 where- genericToDhallWith _ = pure (Encoder {..})+ genericToDhallWithNormalizer _ _ = pure (Encoder {..}) where embed _ = RecordLit mempty
src/Dhall/Binary.hs view
@@ -44,6 +44,7 @@ , ImportMode(..) , ImportType(..) , MultiLet(..)+ , PreferAnnotation(..) , Scheme(..) , URL(..) , Var(..)@@ -65,10 +66,10 @@ import qualified Data.ByteString.Lazy import qualified Data.Sequence import qualified Data.Text as Text-import qualified Dhall.Syntax import qualified Dhall.Crypto import qualified Dhall.Map import qualified Dhall.Set+import qualified Dhall.Syntax as Syntax import qualified Text.Printf as Printf {-| Supported version strings@@ -306,7 +307,7 @@ 6 -> return TextAppend 7 -> return ListAppend 8 -> return (Combine Nothing)- 9 -> return Prefer+ 9 -> return (Prefer PreferFromSource) 10 -> return CombineTypes 11 -> return ImportAlt 12 -> return Equivalent@@ -759,7 +760,7 @@ Combine _ l r -> encodeOperator 8 l r - Prefer l r ->+ Prefer _ l r -> encodeOperator 9 l r CombineTypes l r ->@@ -910,7 +911,7 @@ : concatMap encodeBinding (toList as) ++ [ go b₁ ] ) where- MultiLet as b₁ = Dhall.Syntax.multiLet a₀ b₀+ MultiLet as b₁ = Syntax.multiLet a₀ b₀ encodeBinding (Binding _ x _ mA₀ _ a) = [ Encoding.encodeString x@@ -939,6 +940,9 @@ (go t) (go _T) + a@With{} ->+ go (Syntax.desugarWith a)+ Note _ b -> go b @@ -1104,7 +1108,7 @@ Nothing -> Encoding.encodeNull Just h ->- encodeExpressionInternal encodeImport (Dhall.Syntax.denote h)+ encodeExpressionInternal encodeImport (Syntax.denote h) scheme₁ = case scheme₀ of HTTP -> 0
src/Dhall/Core.hs view
@@ -24,6 +24,7 @@ , Binding(..) , makeBinding , Chunks(..)+ , PreferAnnotation(..) , Expr(..) -- * Normalization@@ -66,6 +67,7 @@ , Eval.textShow , censorExpression , censorText+ , Syntax.desugarWith ) where import Control.Exception (Exception)@@ -82,8 +84,9 @@ import Prelude hiding (succ) import qualified Control.Exception-import qualified Dhall.Eval as Eval import qualified Data.Text+import qualified Dhall.Eval as Eval+import qualified Dhall.Syntax as Syntax -- | Pretty-print a value pretty :: Pretty a => a -> Text
+ src/Dhall/Deriving.hs view
@@ -0,0 +1,548 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++{-| Newtypes for writing customizable 'FromDhall' and 'ToDhall' instances+ through the DerivingVia strategy.++ Inspired by Matt Parson's blog post+ [Mirror Mirror: Reflection and Encoding Via](https://www.parsonsmatt.org/2020/02/04/mirror_mirror.html),+ but applied to Dhall instead of JSON.++ This module is intended to be used with+ [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia)+ so it's only available for GHC >= v8.6.1.++ Check the section /Letting DerivingVia do the work/ if you want to see this module in action. (Click "Dhall.Deriving#derivingVia" to jump there)++-}++module Dhall.Deriving+ (+ -- * Introduction+ -- $introduction++ -- * Writing FromDhall instances by hand+ -- $instancesByHand++ -- * Letting DerivingVia do the work+ -- $derivingVia++ -- * Behind the scenes of Codec+ -- $behindTheScenes++ -- * DerivingVia newtype+ Codec (..)++ -- * Type-level functions on InterpretOptions+ , ModifyOptions (..)+ , Field+ , Constructor+ , SetSingletonConstructors++ -- * Type-level functions on Text+ , TextFunction (..)+ , DropPrefix+ , TitleCase+ , CamelCase+ , PascalCase+ , SnakeCase+ , SpinalCase+ , TrainCase++ -- * Type-level versions of SingletonConstructors+ , ToSingletonConstructors+ , Bare+ , Wrapped+ , Smart++ -- * Identity and Composition for ModifyOptions and TextFunction+ , AsIs+ , type (<<<)++ -- * Helper function on Text+ , dropPrefix++ -- * InterpretOptions setters+ , addFieldModifier+ , addConstructorModifier+ , setSingletonConstructors++ ) where++import Data.Proxy (Proxy (..))+import Dhall+import GHC.Generics (Generic (Rep))+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)++import qualified Data.Text as Text+import qualified Data.Text.Manipulate as Case++-- | Intended for use on @deriving via@ clauses for types with a+-- 'Generic' instance. The @tag@ argument is used to construct an+-- 'InterpretOptions' value which is used as the first argument+-- to 'genericAutoWith'.+newtype Codec tag a = Codec { unCodec :: a }++instance (Generic a, GenericFromDhall (Rep a), ModifyOptions tag) => FromDhall (Codec tag a) where+ autoWith _ = Codec <$> genericAutoWith (modifyOptions @tag defaultInterpretOptions)++instance (Generic a, GenericToDhall (Rep a), ModifyOptions tag) => ToDhall (Codec tag a) where+ injectWith _ = unCodec >$< genericToDhallWith (modifyOptions @tag defaultInterpretOptions)++-- | Convert a type into a @InterpretOptions -> InterpretOptions@ function+class ModifyOptions a where+ modifyOptions :: InterpretOptions -> InterpretOptions+++-- | The identity for functions on 'InterpretOptions' and on @Text@.+-- Useful for deriving @FromDhall@ and @ToDhall@ with the default options.+type AsIs = ()++instance ModifyOptions AsIs where+ modifyOptions = id++instance TextFunction AsIs where+ textFunction = id+++-- | Composition for functions on 'InterpretOptions' and on @Text@.+-- We use @<<<@ since @.@ isn't a valid type operator yet+-- (it will be valid starting from ghc-8.8.1)+data a <<< b+infixr 1 <<<++instance (ModifyOptions a, ModifyOptions b) => ModifyOptions (a <<< b) where+ modifyOptions = modifyOptions @a . modifyOptions @b++instance (TextFunction a, TextFunction b) => TextFunction (a <<< b) where+ textFunction = textFunction @a . textFunction @b+++-- | @Field t@ post-composes the @fieldModifier@ from @options@ with the+-- value-level version of @t@, obtained with @TextFunction@+data Field a+instance TextFunction a => ModifyOptions (Field a) where+ modifyOptions = addFieldModifier (textFunction @a)++-- | @Constructor t@ post-composes the @constructorModifier@ from @options@+-- with the value-level version of @t@, obtained with @TextFunction@+data Constructor a+instance TextFunction a => ModifyOptions (Constructor a) where+ modifyOptions = addConstructorModifier (textFunction @a)+++-- * Text Functions++-- | Convert a type into a @Text -> Text@ function+class TextFunction a where+ textFunction :: Text -> Text++-- | @DropPrefix prefix@ corresponds to the value level+-- function @'dropPrefix' prefix@+data DropPrefix (s :: Symbol)+instance KnownSymbol s => TextFunction (DropPrefix s) where+ textFunction = dropPrefix (Text.pack (symbolVal @s Proxy))++-- | Convert casing to @Title Cased Phrase@+data TitleCase+instance TextFunction TitleCase where+ textFunction = Case.toTitle++-- | Convert casing to @camelCasedPhrase@+data CamelCase+instance TextFunction CamelCase where+ textFunction = Case.toCamel++-- | Convert casing to @PascalCasedPhrase@+data PascalCase+instance TextFunction PascalCase where+ textFunction = Case.toPascal++-- | Convert casing to @snake_cased_phrase@+data SnakeCase+instance TextFunction SnakeCase where+ textFunction = Case.toSnake++-- | Convert casing to @spinal-cased-phrase@+data SpinalCase+instance TextFunction SpinalCase where+ textFunction = Case.toSpinal++-- | Convert casing to @Train-Cased-Phrase@+data TrainCase+instance TextFunction TrainCase where+ textFunction = Case.toTrain+++-- | @SetSingletonConstructors t@ replaces the @singletonConstructors@+-- from @options@ with the value-level version of @t@.+data SetSingletonConstructors a+instance ToSingletonConstructors a => ModifyOptions (SetSingletonConstructors a) where+ modifyOptions = setSingletonConstructors (asSingletonConstructors @a)++-- | Convert a type of kind @SingletonConstructors@+-- into a value of type @SingletonConstructors@+class ToSingletonConstructors (a :: SingletonConstructors) where+ asSingletonConstructors :: SingletonConstructors++-- | Type-level version of 'Dhall.Bare'.+-- Never wrap the field of a singleton constructor in a record+type Bare = 'Bare+instance ToSingletonConstructors Bare where+ asSingletonConstructors = Bare++-- | Type-level version of 'Dhall.Wrapped'+-- Always wrap the field of a singleton constructor in a record+type Wrapped = 'Wrapped+instance ToSingletonConstructors Wrapped where+ asSingletonConstructors = Wrapped++-- | Type-level version of 'Dhall.Smart'+-- Wrap the field of a singleton constructor in a record+-- only if the field is named+type Smart = 'Smart+instance ToSingletonConstructors Smart where+ asSingletonConstructors = Smart+++-- * Text helper++-- | @dropPrefix prefix text@ returns the suffix of @text@ if its prefix+-- matches @prefix@, or the entire @text@ otherwise+dropPrefix :: Text -> (Text -> Text)+dropPrefix prefix text = case Text.stripPrefix prefix text of+ Just stripped -> stripped+ Nothing -> text++-- * InterpretOptions setters++-- | @addFieldModifier f options@ post-composes the @fieldModifier@+-- from @options@ with @f@.+addFieldModifier :: (Text -> Text) -> InterpretOptions -> InterpretOptions+addFieldModifier f options = options+ { fieldModifier = f . fieldModifier options }++-- | @addConstructorModifier f options@ post-composes the @constructorModifier@+-- from @options@ with @f@.+addConstructorModifier :: (Text -> Text) -> InterpretOptions -> InterpretOptions+addConstructorModifier f options = options+ { constructorModifier = f . constructorModifier options }++-- | @setSingletonConstructors v options@ replaces the @singletonConstructors@+-- from @options@ with @v@.+setSingletonConstructors :: SingletonConstructors -> InterpretOptions -> InterpretOptions+setSingletonConstructors v options = options+ { singletonConstructors = v }++{- $introduction++Let's take the following Haskell data types:++>>> :set -XDerivingStrategies++>>> :{+newtype Name = Name { getName :: Text }+ deriving stock (Show)+:}++>>> :{+data Font = Arial | ComicSans | Helvetica | TimesNewRoman+ deriving stock (Show)+:}++>>> :{+data Person = Person+ { personName :: Name+ , personFavoriteFont :: Font+ }+ deriving stock (Show)+:}++And assume we want to read the following Dhall file as a @Person@:++@+-- ./simon.dhall+let Name = Text+let Font = \< Arial | `Comic Sans` | Helvetica | `Times New Roman` \>+let Person = { name : Name, favoriteFont : Font }+in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person+@++Usually, you would build a 'Decoder' by hand, like this++>>> :{+font :: Decoder Font+font =+ union+ ( (Arial <$ constructor "Arial" unit)+ <> (ComicSans <$ constructor "Comic Sans" unit)+ <> (Helvetica <$ constructor "Helvetica" unit)+ <> (TimesNewRoman <$ constructor "Times New Roman" unit)+ )+:}++>>> :{+name :: Decoder Name+name = Name <$> strictText+:}++>>> :{+person :: Decoder Person+person =+ record+ ( Person <$> field "name" name+ <*> field "favoriteFont" font+ )+:}++and then you use it like this++>>> input person "./simon.dhall"+Person {personName = Name {getName = "Simon"}, personFavoriteFont = ComicSans}++So, it works! However, this is quite mechanic, and the compiler has pretty+much all the information it needs to do it for you. Besides, you'd like to+provide an instance of 'FromDhall' so you can use the polymorphic 'Decoder'+'auto' instead of explicitly calling @person@.+-}++{- $instancesByHand+"Aha!," you think, "I'll write an empty @instance 'FromDhall' Person@".+That in turn requires you to add two other instances for @Font@ and for @Name@,+plus 'Generic' instances for each of those, but that's okay.++>>> :set -XStandaloneDeriving+>>> :set -XDeriveGeneric++>>> :{+deriving stock instance Generic Name+deriving stock instance Generic Font+deriving stock instance Generic Person+:}++>>> :{+instance FromDhall Name+instance FromDhall Font+instance FromDhall Person+:}++However, when you try to read the same file with 'auto', you get this:++>>> input auto "./simon.dhall" :: IO Person+*** Exception:+...Error...: Expression doesn't match annotation+...+{ - personFavoriteFont : …+, - personName : …+, + favoriteFont : …+, + name : …+}+...+1│ ./simon.dhall : { personName : { getName : Text }+2│ , personFavoriteFont : < Arial | ComicSans | Helvetica | TimesNewRoman >+3│ }+...++What happened? The field names don't quite match, since we're using prefixed+field names in Haskell but no prefixes in Dhall. "Okay," you think,+"I can write a custom instance which builds on 'Generic' thanks to+'genericAutoWith', I only need to supply a function to drop the prefixes+and @camelCase@ the rest". So, using 'Data.Text.Manipulate.toCamel':++>>> import Data.Text.Manipulate (toCamel)+>>> import qualified Data.Text as Text+>>> :{+instance FromDhall Person where+ autoWith _ =+ genericAutoWith defaultInterpretOptions+ { fieldModifier = toCamel . Text.drop (Text.length "person") }+:}++Let's try to read that again:++>>> input auto "./simon.dhall":: IO Person+*** Exception:+...Error...: Expression doesn't match annotation+...+{ favoriteFont : < - ComicSans : …+ | - TimesNewRoman : …+ | + `Comic Sans` : …+ | + `Times New Roman` : …+ | …+ >+, name : - { … : … }+ + Text+}+...+1│ ./simon.dhall : { name : { getName : Text }+2│ , favoriteFont : < Arial | ComicSans | Helvetica | TimesNewRoman >+3│ }+...++Okay, we're almost there. We have two things to solve now.+First, the @Font@ constructors are @PascalCased@ in Haskell,+but @Title Cased@ in Dhall. We can communicate this to our+'FromDhall' instance using 'Data.Text.Manipulate.toTitle':++>>> import Data.Text.Manipulate (toTitle)+>>> :{+instance FromDhall Font where+ autoWith _ =+ genericAutoWith defaultInterpretOptions+ { constructorModifier = toTitle }+:}++Second, we defined the @Name@ type in Haskell as a newtype over @Text@, with a+@getName@ field for unwrapping. In Dhall, however, @Name@ is a synonym of+'Text', which is why 'input' above was expecting a record.+The 'Dhall.Bare' option for 'singletonConstructors' is a perfect fit here:+it translates Haskell singleton constructors into the Dhall version of the+nested type, without wrapping it into a record.+We can then tweak our 'FromDhall' instance like this:++>>> :{+instance FromDhall Name where+ autoWith _ =+ genericAutoWith defaultInterpretOptions+ { singletonConstructors = Bare }+:}++Since we're running this interactively, we also need to update the+instance for @Person@, but it's the same as before.++>>> :{+instance FromDhall Person where+ autoWith _ =+ genericAutoWith defaultInterpretOptions+ { fieldModifier = toCamel . Text.drop (Text.length "person") }+:}++Now, for the moment of truth:++>>> input auto "./simon.dhall":: IO Person+Person {personName = Name {getName = "Simon"}, personFavoriteFont = ComicSans}++That took a bit more work than we wanted, though, and a lot of it was just+boilerplate for defining the instances through `genericAutoWith`, tweaking+a single parameter at a time. Even worse, if we also wanted to provide+'ToDhall' instances we would need to keep the options in sync between both+instances, since otherwise the values wouldn't be able to round-trip from+Dhall to Dhall through Haskell.++-}++{- $derivingVia+ #derivingVia#++Starting with this dhall file:++@+-- ./simon.dhall+let Name = Text+let Font = \< Arial | `Comic Sans` | Helvetica | `Times New Roman` \>+let Person = { name : Name, favoriteFont : Font }+in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person+@++We can define the equivalent Haskell types as follows. Note that we+derive the 'FromDhall' and 'ToDhall' instances @via 'Codec' tag TheType@,+using a different @tag@ depending on the transformations we need to apply to+the Haskell type to get the Dhall equivalent:++>>> :set -XDataKinds+>>> :set -XDeriveGeneric+>>> :set -XDerivingVia+>>> :set -XTypeOperators++>>> :{+newtype Name = Name { getName :: Text }+ deriving stock (Generic, Show)+ deriving (FromDhall, ToDhall)+ via Codec (SetSingletonConstructors Bare) Name+:}++>>> :{+data Font = Arial | ComicSans | Helvetica | TimesNewRoman+ deriving stock (Generic, Show)+ deriving (FromDhall, ToDhall)+ via Codec (Constructor TitleCase) Font+:}++>>> :{+data Person = Person+ { personName :: Name+ , personFavoriteFont :: Font+ }+ deriving stock (Generic, Show)+ deriving (FromDhall, ToDhall)+ via Codec (Field (CamelCase <<< DropPrefix "person")) Person+:}++we can then read the file using 'auto':++>>> simon <- input auto "./simon.dhall":: IO Person+>>> print simon+Person {personName = Name {getName = "Simon"}, personFavoriteFont = ComicSans}++And using 'inject' we can get @simon@ back as a Dhall value:++>>> import qualified Data.Text.IO as Text+>>> import Dhall.Core (pretty)+>>> Text.putStrLn . pretty . embed inject $ simon+{ name = "Simon"+, favoriteFont =+ < Arial | `Comic Sans` | Helvetica | `Times New Roman` >.`Comic Sans`+}++-}++{- $behindTheScenes++@'Codec' tag a@ is really just a newtype over @a@, equipped with a+phantom @tag@. The 'FromDhall' instance for 'Codec' uses the generic+representation of @a@, together with the 'InterpretOptions' defined by @tag@ as+a series of modifications to be applied on 'defaultInterpretOptions'.++For the default behavior, using 'AsIs' (a synonym for @()@) as the @tag@+leaves the interpret options alone, so it's equivalent to the empty instance+we first tried to use.++@'Field' a@ and @'Constructor' a@ can be used to modify, respectively, the+'fieldModifier' and 'constructorModifier' options of 'InterpretOptions', by+post-composing the modifier with @'textFunction' \@a@, that is, the value-level+equivalent of @a@, obtained through the 'TextFunction' class.++In the case of @Person@, we used++@+ Codec (Field (CamelCase <<< DropPrefix "person")) Person+@++which means that the @Text -> Text@ version of++@+ CamelCase <<< DropPrefix "person"+@++was used to modify the @fieldModifier@ option.++In the value level, this translates to composing ('<<<')+'Data.Text.Manipulate.toCamel' ('CamelCase') with @'dropPrefix' "person"@+(@'DropPrefix' "person"@).++Finally, @'SetSingletonConstructors' a@ can be used to set the+'singletonConstructors' option of 'InterpretOptions', by replacing the option+with the value-level equivalent of @a@.+-}++{- $setup+>>> :set -XOverloadedStrings+-}
src/Dhall/Diff.hs view
@@ -31,15 +31,16 @@ import Dhall.Pretty.Internal (Ann) import Numeric.Natural (Natural) -import qualified Data.Algorithm.Diff as Algo.Diff+import qualified Data.Algorithm.Diff as Algo.Diff import qualified Data.List.NonEmpty import qualified Data.Set import qualified Data.Text-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Dhall.Normalize+import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Dhall.Map+import qualified Dhall.Normalize as Normalize+import qualified Dhall.Pretty.Internal as Internal import qualified Dhall.Set-import qualified Dhall.Pretty.Internal as Internal+import qualified Dhall.Syntax as Syntax {-| This type is a `Doc` enriched with a `same` flag to efficiently track if any difference was detected@@ -158,8 +159,8 @@ diffNormalized :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff diffNormalized l0 r0 = Dhall.Diff.diff l1 r1 where- l1 = Dhall.Normalize.alphaNormalize (Dhall.Normalize.normalize l0)- r1 = Dhall.Normalize.alphaNormalize (Dhall.Normalize.normalize r0)+ l1 = Normalize.alphaNormalize (Normalize.normalize l0)+ r1 = Normalize.alphaNormalize (Normalize.normalize r0) diffPrimitive :: Eq a => (a -> Diff) -> a -> a -> Diff diffPrimitive f l r@@ -619,6 +620,12 @@ <> ignore <> " " <> rbrace+skeleton (With {}) =+ ignore+ <> " "+ <> keyword "with"+ <> " "+ <> ignore skeleton x = token (Pretty.pretty x) mismatch :: Pretty a => Expr s a -> Expr s a -> Diff@@ -729,8 +736,8 @@ where doc = keyword "merge" <> " "- <> format " " (diffImportExpression aL aR)- <> format " " (diffImportExpression bL bR)+ <> format " " (diffWithExpression aL aR)+ <> format " " (diffWithExpression bL bR) <> diffMaybe (colon <> " ") diffApplicationExpression cL cR diffAnnotatedExpression l@(Merge {}) r = mismatch l r@@ -740,7 +747,7 @@ where doc = keyword "toMap" <> " "- <> format " " (diffImportExpression aL aR)+ <> format " " (diffWithExpression aL aR) <> diffMaybe (colon <> " ") diffApplicationExpression bL bR diffAnnotatedExpression l@(ToMap {}) r = mismatch l r@@ -897,7 +904,7 @@ diffPreferExpression l@(Prefer {}) r@(Prefer {}) = enclosed' " " (operator "⫽" <> " ") (docs l r) where- docs (Prefer aL bL) (Prefer aR bR) =+ docs (Prefer _ aL bL) (Prefer _ aR bR) = Data.List.NonEmpty.cons (diffCombineTypesExpression aL aR) (docs bL bR) docs aL aR = pure (diffCombineTypesExpression aL aR)@@ -989,26 +996,36 @@ enclosed' mempty mempty (Data.List.NonEmpty.reverse (docs l r)) where docs (App aL bL) (App aR bR) =- Data.List.NonEmpty.cons (diffImportExpression bL bR) (docs aL aR)+ Data.List.NonEmpty.cons (diffWithExpression bL bR) (docs aL aR) docs (Some aL) (Some aR) =- diffImportExpression aL aR :| [ builtin "Some" ]+ diffWithExpression aL aR :| [ builtin "Some" ] docs aL aR@(Some {}) = pure (mismatch aL aR) docs aL@(Some {}) aR = pure (mismatch aL aR) docs aL aR =- pure (diffImportExpression aL aR)+ pure (diffWithExpression aL aR) diffApplicationExpression l@(App {}) r = mismatch l r diffApplicationExpression l r@(App {}) = mismatch l r diffApplicationExpression (Some l) (Some r) =- enclosed' mempty mempty (builtin "Some" :| [ diffImportExpression l r ])+ enclosed' mempty mempty (builtin "Some" :| [ diffWithExpression l r ]) diffApplicationExpression l@(Some {}) r = mismatch l r diffApplicationExpression l r@(Some {}) = mismatch l r diffApplicationExpression l r =+ diffWithExpression l r++diffWithExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff+diffWithExpression l@With{} r@With{} =+ diffWithExpression (Syntax.desugarWith l) (Syntax.desugarWith r)+diffWithExpression l r@With{} =+ mismatch l r+diffWithExpression l@With{} r =+ mismatch l r+diffWithExpression l r = diffImportExpression l r diffImportExpression :: (Eq a, Pretty a) => Expr Void a -> Expr Void a -> Diff
src/Dhall/DirectoryTree.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -8,6 +9,7 @@ , FilesystemError(..) ) where +import Control.Applicative (empty) import Control.Exception (Exception) import Data.Monoid ((<>)) import Data.Void (Void)@@ -15,18 +17,22 @@ import System.FilePath ((</>)) import qualified Control.Exception as Exception+import qualified Data.Foldable as Foldable+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty-import qualified Dhall.Util as Util import qualified Dhall.Map as Map import qualified Dhall.Pretty+import qualified Dhall.Util as Util import qualified System.Directory as Directory-import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO+import qualified System.FilePath as FilePath {-| Attempt to transform a Dhall record into a directory tree where: * Records are translated into directories + * @Map@s are also translated into directories+ * @Text@ values or fields are translated into files * @Optional@ values are omitted if @None@@@ -77,17 +83,20 @@ 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`.+ encountering an expression that cannot be converted as-is. -} toDirectoryTree :: FilePath -> Expr Void Void -> IO () toDirectoryTree path expression = case expression of RecordLit keyValues -> do- let process key value = do- Directory.createDirectoryIfMissing False path+ Map.unorderedTraverseWithKey_ process keyValues - toDirectoryTree (path </> Text.unpack key) value+ ListLit (Just (Record [ ("mapKey", Text), ("mapValue", _) ])) [] -> do+ return () - Map.unorderedTraverseWithKey_ process keyValues+ ListLit _ records+ | not (null records)+ , Just keyValues <- extract (Foldable.toList records) -> do+ Foldable.traverse_ (uncurry process) keyValues TextLit (Chunks [] text) -> do Text.IO.writeFile path text@@ -99,10 +108,30 @@ return () _ -> do- let unexpectedExpression = expression+ die+ where+ extract [] = do+ return [] - Exception.throwIO FilesystemError{..}+ extract (RecordLit [("mapKey", TextLit (Chunks [] key)), ("mapValue", value)]:records) = do+ fmap ((key, value) :) (extract records) + extract _ = do+ empty++ process key value = do+ if Text.isInfixOf (Text.pack [ FilePath.pathSeparator ]) key+ then die+ else return ()++ Directory.createDirectoryIfMissing False path++ toDirectoryTree (path </> Text.unpack key) value++ die = Exception.throwIO FilesystemError{..}+ where+ unexpectedExpression = expression+ {- | 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.@@ -118,10 +147,10 @@ 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\+ \tree. Specifically, record literals or maps can be converted to directories, \n\+ \❰Text❱ literals can be converted to files, and ❰Optional❱ values are included if\n\+ \❰Some❱ and omitted if ❰None❱. No other type of value can be translated to a \n\+ \directory tree. \n\ \ \n\ \For example, this is a valid expression that can be translated to a directory \n\ \tree: \n\@@ -141,11 +170,26 @@ \ └───────────────────────┘ \n\ \ \n\ \ \n\+ \Note that key names cannot contain path separators: \n\+ \ \n\+ \ \n\+ \ ┌───────────────────────────────────┐ \n\+ \ │ { `directory/example.txt` = \"ABC\" │ Invalid: Key contains a forward slash \n\+ \ └───────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \Instead, you need to refactor the expression to use nested records instead: \n\+ \ \n\+ \ \n\+ \ ┌───────────────────────────────────────────┐ \n\+ \ │ { directory = { `example.txt` = \"ABC\" } } │ \n\+ \ └───────────────────────────────────────────┘ \n\+ \ \n\+ \ \n\ \You tried to translate the following expression to a directory tree: \n\ \ \n\ \" <> Util.insert unexpectedExpression <> "\n\ \ \n\- \... which is neither a ❰Text❱ literal, a record literal, nor an ❰Optional❱ \n\- \value. \n"+ \... which is not an expression that can be translated to a directory tree. \n" instance Exception FilesystemError
src/Dhall/Eval.hs view
@@ -57,6 +57,10 @@ import Data.Sequence (Seq, ViewL(..), ViewR(..)) import Data.Text (Text) import Data.Void (Void)+import Dhall.Map (Map)+import Dhall.Set (Set)+import GHC.Natural (Natural)+import Prelude hiding (succ) import Dhall.Syntax ( Binding(..)@@ -64,14 +68,10 @@ , Chunks(..) , Const(..) , DhallDouble(..)+ , PreferAnnotation(..) , Var(..) ) -import Dhall.Map (Map)-import Dhall.Set (Set)-import GHC.Natural (Natural)-import Prelude hiding (succ)- import qualified Data.Char import qualified Data.Sequence as Sequence import qualified Data.Set@@ -688,10 +688,10 @@ vCombine mk (eval env t) (eval env u) CombineTypes t u -> vCombineTypes (eval env t) (eval env u)- Prefer t u ->+ Prefer _ t u -> vPrefer env (eval env t) (eval env u) RecordCompletion t u ->- eval env (Annot (Prefer (Field t "default") u) (Field t "Type"))+ eval env (Annot (Prefer PreferFromCompletion (Field t "default") u) (Field t "Type")) Merge x y ma -> case (eval env x, eval env y, fmap (eval env) ma) of (VRecordLit m, VInject _ k mt, _)@@ -736,6 +736,8 @@ VAssert (eval env t) Equivalent t u -> VEquivalent (eval env t) (eval env u)+ e@With{} ->+ eval env (Syntax.desugarWith e) Note _ e -> eval env e ImportAlt t _ ->@@ -1117,7 +1119,7 @@ VCombineTypes t u -> CombineTypes (quote env t) (quote env u) VPrefer t u ->- Prefer (quote env t) (quote env u)+ Prefer PreferFromSource (quote env t) (quote env u) VMerge t u ma -> Merge (quote env t) (quote env u) (fmap (quote env) ma) VToMap t ma ->@@ -1296,8 +1298,8 @@ Combine m (go t) (go u) CombineTypes t u -> CombineTypes (go t) (go u)- Prefer t u ->- Prefer (go t) (go u)+ Prefer b t u ->+ Prefer b (go t) (go u) RecordCompletion t u -> RecordCompletion (go t) (go u) Merge x y ma ->@@ -1312,6 +1314,8 @@ Assert (go t) Equivalent t u -> Equivalent (go t) (go u)+ With e k v ->+ With (go e) k (go v) Note s e -> Note s (go e) ImportAlt t u ->
src/Dhall/Import.hs view
@@ -164,6 +164,7 @@ , ImportType(..) , ImportMode(..) , Import(..)+ , PreferAnnotation(..) , URL(..) , bindingExprs , chunkExprs@@ -989,7 +990,7 @@ let referentiallySane = not (local child) || local parent - if referentiallySane+ if importMode import₀ == Location || referentiallySane then return () else throwMissingImport (Imported _stack (ReferentiallyOpaque import₀)) @@ -1080,7 +1081,12 @@ Union a -> Union <$> mapM (mapM loadWith) a Combine m a b -> Combine m <$> loadWith a <*> loadWith b CombineTypes a b -> CombineTypes <$> loadWith a <*> loadWith b- Prefer a b -> Prefer <$> loadWith a <*> loadWith b+ Prefer a b c -> Prefer <$> a' <*> loadWith b <*> loadWith c+ where+ a' = case a of+ PreferFromSource -> pure PreferFromSource+ PreferFromWith e -> PreferFromWith <$> loadWith e+ PreferFromCompletion -> pure PreferFromCompletion RecordCompletion a b -> RecordCompletion <$> loadWith a <*> loadWith b Merge a b c -> Merge <$> loadWith a <*> loadWith b <*> mapM loadWith c ToMap a b -> ToMap <$> loadWith a <*> mapM loadWith b@@ -1088,6 +1094,7 @@ Project a b -> Project <$> loadWith a <*> mapM loadWith b Assert a -> Assert <$> loadWith a Equivalent a b -> Equivalent <$> loadWith a <*> loadWith b+ With a b c -> With <$> loadWith a <*> pure b <*> loadWith c Note a b -> do let handler e = throwM (SourcedException a (e :: MissingImports))
src/Dhall/Main.hs view
@@ -159,7 +159,24 @@ | ListTransitiveDependencies | ListImmediateDependencies +-- | Groups of subcommands+data Group+ = Manipulate+ | Generate+ | Interpret+ | Convert+ | Miscellaneous+ | Debugging +groupDescription :: Group -> String+groupDescription group = case group of+ Manipulate -> "Manipulate Dhall code"+ Generate -> "Generate other formats from Dhall"+ Interpret -> "Interpret Dhall"+ Convert -> "Convert Dhall to and from its binary representation"+ Miscellaneous -> "Miscellaneous"+ Debugging -> "Debugging this interpreter"+ -- | `Parser` for the `Options` type parseOptions :: Parser Options parseOptions =@@ -181,12 +198,12 @@ f True = Censor f False = NoCensor -subcommand' :: Bool -> String -> String -> Parser a -> Parser a-subcommand' internal name description parser =+subcommand :: Group -> String -> String -> Parser a -> Parser a+subcommand group name description parser = Options.Applicative.hsubparser ( Options.Applicative.command name parserInfo <> Options.Applicative.metavar name- <> if internal then Options.Applicative.internal else mempty+ <> Options.Applicative.commandGroup (groupDescription group) ) where parserInfo =@@ -195,75 +212,85 @@ <> Options.Applicative.progDesc description ) -subcommand :: String -> String -> Parser a -> Parser a-subcommand = subcommand' False--internalSubcommand :: String -> String -> Parser a -> Parser a-internalSubcommand = subcommand' True- parseMode :: Parser Mode parseMode = subcommand- "version"- "Display version"- (pure Version)+ Manipulate+ "format"+ "Standard code formatter for the Dhall language"+ (Format <$> parseInplace <*> parseCheck) <|> subcommand+ Manipulate+ "freeze"+ "Add integrity checks to remote import statements of an expression"+ (Freeze <$> parseInplace <*> parseAllFlag <*> parseCacheFlag <*> parseCheck)+ <|> subcommand+ Manipulate+ "lint"+ "Improve Dhall code by using newer language features and removing dead code"+ (Lint <$> parseInplace <*> parseCheck)+ <|> subcommand+ Generate+ "text"+ "Render a Dhall expression that evaluates to a Text literal"+ (Text <$> parseFile)+ <|> subcommand+ Generate+ "to-directory-tree"+ "Convert nested records of Text literals into a directory tree"+ (DirectoryTree <$> parseFile <*> parseDirectoryTreeOutput)+ <|> subcommand+ Interpret "resolve" "Resolve an expression's imports" (Resolve <$> parseFile <*> parseResolveMode <*> parseSemanticCacheMode) <|> subcommand+ Interpret "type" "Infer an expression's type" (Type <$> parseFile <*> parseQuiet <*> parseSemanticCacheMode) <|> subcommand+ Interpret "normalize" "Normalize an expression" (Normalize <$> parseFile <*> parseAlpha) <|> subcommand+ Convert+ "encode"+ "Encode a Dhall expression to binary"+ (Encode <$> parseFile <*> parseJSONFlag)+ <|> subcommand+ Convert+ "decode"+ "Decode a Dhall expression from binary"+ (Decode <$> parseFile <*> parseJSONFlag)+ <|> subcommand+ Miscellaneous "repl" "Interpret expressions in a REPL" (pure Repl) <|> subcommand+ Miscellaneous "diff" "Render the difference between the normal form of two expressions" (Diff <$> argument "expr1" <*> argument "expr2") <|> subcommand+ Miscellaneous "hash" "Compute semantic hashes for Dhall expressions" (Hash <$> parseFile) <|> subcommand- "lint"- "Improve Dhall code by using newer language features and removing dead code"- (Lint <$> parseInplace <*> parseCheck)- <|> subcommand+ Miscellaneous "tags" "Generate etags file" (Tags <$> parseInput <*> parseTagsOutput <*> parseSuffixes <*> parseFollowSymlinks) <|> subcommand- "format"- "Standard code formatter for the Dhall language"- (Format <$> parseInplace <*> parseCheck)- <|> subcommand- "freeze"- "Add integrity checks to remote import statements of an expression"- (Freeze <$> parseInplace <*> parseAllFlag <*> parseCacheFlag <*> parseCheck)- <|> subcommand- "encode"- "Encode a Dhall expression to binary"- (Encode <$> parseFile <*> parseJSONFlag)- <|> subcommand- "decode"- "Decode a Dhall expression from binary"- (Decode <$> parseFile <*> parseJSONFlag)- <|> subcommand- "text"- "Render a Dhall expression that evaluates to a Text literal"- (Text <$> parseFile)+ Miscellaneous+ "version"+ "Display version"+ (pure Version) <|> subcommand- "to-directory-tree"- "Convert nested records of Text literals into a directory tree"- (DirectoryTree <$> parseFile <*> parseDirectoryTreeOutput)- <|> internalSubcommand+ Debugging "haskell-syntax-tree" "Output the parsed syntax tree (for debugging)" (SyntaxTree <$> parseFile)
src/Dhall/Normalize.hs view
@@ -24,10 +24,19 @@ import Data.Semigroup (Semigroup(..)) import Data.Sequence (ViewL(..), ViewR(..)) import Data.Traversable-import Dhall.Syntax (Expr(..), Var(..), Binding(Binding), Chunks(..), DhallDouble(..), Const(..)) import Instances.TH.Lift () import Prelude hiding (succ) +import Dhall.Syntax+ ( Expr(..)+ , Var(..)+ , Binding(Binding)+ , Chunks(..)+ , DhallDouble(..)+ , Const(..)+ , PreferAnnotation(..)+ )+ import qualified Data.Sequence import qualified Data.Set import qualified Data.Text@@ -240,10 +249,10 @@ where a' = shift d v a b' = shift d v b-shift d v (Prefer a b) = Prefer a' b'+shift d v (Prefer a b c) = Prefer a b' c' where- a' = shift d v a b' = shift d v b+ c' = shift d v c shift d v (RecordCompletion a b) = RecordCompletion a' b' where a' = shift d v a@@ -271,6 +280,10 @@ where a' = shift d v a b' = fmap (shift d v) b+shift d v (With a b c) = With a' b c'+ where+ a' = shift d v a+ c' = shift d v c shift d v (Note a b) = Note a b' where b' = shift d v b@@ -415,10 +428,10 @@ where a' = subst x e a b' = subst x e b-subst x e (Prefer a b) = Prefer a' b'+subst x e (Prefer a b c) = Prefer a b' c' where- a' = subst x e a b' = subst x e b+ c' = subst x e c subst x e (RecordCompletion a b) = RecordCompletion a' b' where a' = subst x e a@@ -446,6 +459,10 @@ where a' = subst x e a b' = subst x e b+subst x e (With a b c) = With a' b c'+ where+ a' = subst x e a+ c' = subst x e c subst x e (Note a b) = Note a b' where b' = subst x e b@@ -884,7 +901,7 @@ Record (Dhall.Map.unionWith decide m n) decide l r = CombineTypes l r- Prefer x y -> decide <$> loop x <*> loop y+ Prefer _ x y -> decide <$> loop x <*> loop y where decide (RecordLit m) r | Data.Foldable.null m = r@@ -895,9 +912,9 @@ decide l r | Eval.judgmentallyEqual l r = l decide l r =- Prefer l r+ Prefer PreferFromSource l r RecordCompletion x y -> do- loop (Annot (Prefer (Field x "default") y) (Field x "Type"))+ loop (Annot (Prefer PreferFromCompletion (Field x "default") y) (Field x "Type")) Merge x y t -> do x' <- loop x y' <- loop y@@ -966,10 +983,10 @@ Just v -> pure v Nothing -> Field <$> (RecordLit <$> traverse loop kvs) <*> pure x Project r_ _ -> loop (Field r_ x)- Prefer (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of- Just v -> pure (Field (Prefer (singletonRecordLit v) r_) x)+ Prefer _ (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of+ Just v -> pure (Field (Prefer PreferFromSource (singletonRecordLit v) r_) x) Nothing -> loop (Field r_ x)- Prefer l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of+ Prefer _ l (RecordLit kvs) -> case Dhall.Map.lookup x kvs of Just v -> pure v Nothing -> loop (Field l x) Combine m (RecordLit kvs) r_ -> case Dhall.Map.lookup x kvs of@@ -987,11 +1004,11 @@ pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet)) Project y _ -> loop (Project y (Left fields))- Prefer l (RecordLit rKvs) -> do+ Prefer _ l (RecordLit rKvs) -> do let rKs = Dhall.Map.keysSet rKvs let l' = Project l (Left (Dhall.Set.fromSet (Data.Set.difference fieldsSet rKs))) let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet)- loop (Prefer l' r')+ loop (Prefer PreferFromSource l' r') _ | null fields -> pure (RecordLit mempty) | otherwise -> pure (Project x' (Left (Dhall.Set.sort fields))) Project r (Right e1) -> do@@ -1012,6 +1029,8 @@ r' <- loop r pure (Equivalent l' r')+ With e' k v -> do+ loop (Syntax.desugarWith (With e' k v)) Note _ e' -> loop e' ImportAlt l _r -> loop l Embed a -> pure (Embed a)@@ -1192,7 +1211,7 @@ decide _ (Record n) | Data.Foldable.null n = False decide (Record _) (Record _) = False decide _ _ = True- Prefer x y -> loop x && loop y && decide x y+ Prefer _ x y -> loop x && loop y && decide x y where decide (RecordLit m) _ | Data.Foldable.null m = False decide _ (RecordLit n) | Data.Foldable.null n = False@@ -1213,8 +1232,8 @@ Field r k -> case r of RecordLit _ -> False Project _ _ -> False- Prefer (RecordLit m) _ -> Dhall.Map.keys m == [k] && loop r- Prefer _ (RecordLit _) -> False+ Prefer _ (RecordLit m) _ -> Dhall.Map.keys m == [k] && loop r+ Prefer _ _ (RecordLit _) -> False Combine _ (RecordLit m) _ -> Dhall.Map.keys m == [k] && loop r Combine _ _ (RecordLit m) -> Dhall.Map.keys m == [k] && loop r _ -> loop r@@ -1223,13 +1242,14 @@ Left s -> case r of RecordLit _ -> False Project _ _ -> False- Prefer _ (RecordLit _) -> False+ Prefer _ _ (RecordLit _) -> False _ -> not (Dhall.Set.null s) && Dhall.Set.isSorted s Right e' -> case e' of Record _ -> False _ -> loop e' Assert t -> loop t Equivalent l r -> loop l && loop r+ With{} -> False Note _ e' -> loop e' ImportAlt _ _ -> False Embed _ -> True
src/Dhall/Parser.hs view
@@ -96,18 +96,17 @@ createHeader = Header . Data.Text.dropWhile Data.Char.isSpace . Data.Text.dropWhileEnd (/= '\n') -{-| Like `exprFromText` but also returns the leading comments and whitespace- (i.e. header) up to the last newline before the code begins-- In other words, if you have a Dhall file of the form:--> -- Comment 1-> {- Comment -} 2-- Then this will preserve @Comment 1@, but not @Comment 2@-- This is used by @dhall-format@ to preserve leading comments and whitespace--}+-- | Like `exprFromText` but also returns the leading comments and whitespace+-- (i.e. header) up to the last newline before the code begins+--+-- In other words, if you have a Dhall file of the form:+--+-- > -- Comment 1+-- > {- Comment -} 2+--+-- Then this will preserve @Comment 1@, but not @Comment 2@+--+-- This is used by @dhall-format@ to preserve leading comments and whitespace exprAndHeaderFromText :: String -- ^ User-friendly name describing the input expression, -- used in parsing error messages
src/Dhall/Parser/Expression.hs view
@@ -11,6 +11,7 @@ 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@@ -257,7 +258,7 @@ alternative4A <|> alternative4B <|> pure a operatorExpression =- foldr makeOperatorExpression applicationExpression operatorParsers+ foldr makeOperatorExpression withExpression operatorParsers makeOperatorExpression operatorParser subExpression = noted (do@@ -277,29 +278,69 @@ operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)] operatorParsers =- [ ImportAlt <$ _importAlt <* nonemptyWhitespace- , BoolOr <$ _or <* whitespace- , NaturalPlus <$ _plus <* nonemptyWhitespace- , TextAppend <$ _textAppend <* whitespace- , ListAppend <$ _listAppend <* whitespace- , BoolAnd <$ _and <* whitespace- , Combine Nothing <$ _combine <* whitespace- , Prefer <$ _prefer <* whitespace- , CombineTypes <$ _combineTypes <* whitespace- , NaturalTimes <$ _times <* whitespace- , BoolEQ <$ _doubleEqual <* whitespace- , BoolNE <$ _notEqual <* whitespace- , Equivalent <$ _equivalent <* whitespace+ [ ImportAlt <$ _importAlt <* nonemptyWhitespace+ , BoolOr <$ _or <* whitespace+ , NaturalPlus <$ _plus <* nonemptyWhitespace+ , TextAppend <$ _textAppend <* whitespace+ , ListAppend <$ _listAppend <* whitespace+ , BoolAnd <$ _and <* whitespace+ , Combine Nothing <$ _combine <* whitespace+ , Prefer PreferFromSource <$ _prefer <* whitespace+ , CombineTypes <$ _combineTypes <* whitespace+ , NaturalTimes <$ _times <* whitespace+ , BoolEQ <$ _doubleEqual <* whitespace+ , BoolNE <$ _notEqual <* whitespace+ , Equivalent <$ _equivalent <* whitespace ] + withExpression = noted (do+ a <- applicationExpression++ bs <- many (do+ try (nonemptyWhitespace *> _with *> nonemptyWhitespace)++ keys <- Combinators.NonEmpty.sepBy1 anyLabel (try (whitespace *> _dot) *> whitespace)++ whitespace++ _equal++ whitespace++ value <- applicationExpression++ return (\e -> With e keys value) )++ return (foldl (\e f -> f e) a bs) )+ applicationExpression = do- f <- (Some <$ try (_Some <* nonemptyWhitespace))- <|> return id- a <- noted importExpression_+ let alternative0 = do+ _ <- try (_Some <* nonemptyWhitespace)++ return (Some, Just "argument to ❰Some❱")++ let alternative1 = do+ _ <- try (_toMap *> nonemptyWhitespace)++ return (\a -> ToMap a Nothing, Just "argument to ❰toMap❱")++ let alternative2 = do+ return (id, Nothing)++ (f, maybeMessage) <- alternative0 <|> alternative1 <|> alternative2++ let adapt parser =+ case maybeMessage of+ Nothing -> parser+ Just message -> parser <?> message++ a <- adapt (noted importExpression_)+ bs <- Text.Megaparsec.many . try $ do (sep, _) <- Text.Megaparsec.match nonemptyWhitespace b <- importExpression_ return (sep, b)+ return (foldl' app (f a) bs) where app a (sep, b)@@ -359,7 +400,6 @@ , alternative05 , alternative06 , alternative07- , alternative08 , alternative37 , alternative09 , builtin@@ -411,11 +451,6 @@ b <- importExpression_ <?> "second argument to ❰merge❱" return (Merge a b Nothing) - alternative08 = do- try (_toMap *> nonemptyWhitespace)- a <- importExpression_- return (ToMap a Nothing)- alternative09 = do a <- try doubleInfinity return (DoubleLit (DhallDouble a))@@ -730,34 +765,31 @@ let keysValue = do keys <- Combinators.NonEmpty.sepBy1 anyLabel (try (whitespace *> _dot) *> whitespace) - whitespace-- _equal-- whitespace-- value <- expression+ let normalRecordEntry = do+ try (whitespace *> _equal) - whitespace+ whitespace - let cons key (key', values) =- (key, RecordLit [ (key', values) ])+ value <- expression - let nil = (NonEmpty.last keys, value)+ whitespace - return (foldr cons nil (NonEmpty.init keys))+ let cons key (key', values) =+ (key, RecordLit [ (key', values) ]) - let nonEmptyRecordLiteral = do- (a, b) <- keysValue+ let nil = (NonEmpty.last keys, value) - e <- Text.Megaparsec.many (do- _comma+ return (foldr cons nil (NonEmpty.init keys)) - whitespace+ let punnedEntry =+ case keys of+ x :| [] -> return (x, Var (V x 0))+ _ -> empty - (c, d) <- keysValue+ normalRecordEntry <|> punnedEntry - return (c, d) )+ let nonEmptyRecordLiteral = do+ as <- Text.Megaparsec.sepBy1 keysValue (_comma *> whitespace) {- The `flip` is necessary because `toMapWith` is internally based on `Data.Map.fromListWithKey` which combines keys@@ -765,7 +797,7 @@ -} let combine k = liftA2 (flip (Combine (Just k))) - m <- toMapWith combine ((a, b) : e)+ m <- toMapWith combine as return (RecordLit m)
src/Dhall/Parser/Token.hs view
@@ -105,6 +105,7 @@ _forall, _arrow, _doubleColon,+ _with, ) where import Dhall.Parser.Combinators@@ -123,13 +124,16 @@ import qualified Data.Char as Char import qualified Data.Foldable import qualified Data.HashSet+import qualified Data.List as List import qualified Data.List.NonEmpty+import qualified Data.Scientific as Scientific import qualified Data.Text import qualified Dhall.Set import qualified Network.URI.Encode as URI.Encode import qualified Text.Megaparsec import qualified Text.Megaparsec.Char.Lexer import qualified Text.Parser.Char+import qualified Text.Parser.Token import qualified Text.Parser.Combinators import Numeric.Natural (Natural)@@ -189,10 +193,60 @@ -} doubleLiteral :: Parser Double doubleLiteral = (do+ -- We don't use `Text.Parser.Token.double` since that consumes trailing+ -- whitespace and there is no whitespace-free alternative. See:+ --+ -- https://github.com/dhall-lang/dhall-haskell/pull/1646+ -- https://github.com/dhall-lang/dhall-haskell/pull/1647+ --+ -- We also don't use `Text.Megaparsec.Char.Lexer.float` because that+ -- transitively depends on `Data.Char.toTitle` which is broken on older+ -- versions of GHCJS that we still support. See:+ --+ -- https://github.com/dhall-lang/dhall-haskell/pull/1681+ -- https://github.com/ghcjs/ghcjs-base/issues/62+ --+ -- Also, hand-writing the parser code for `Double` literals helps to better+ -- ensure that we follow the standard exactly as written. sign <- signPrefix <|> pure id- a <- Text.Megaparsec.Char.Lexer.float- return (sign a) ) <?> "literal" + x <- Text.Parser.Token.decimal++ let alternative0 = do+ y <- fraction++ e <- exponent' <|> pure 1++ return ((fromInteger x + y) * e)++ let alternative1 = do+ expo <- exponent'++ return (fromInteger x * expo)++ n <- alternative0 <|> alternative1++ return (sign (Scientific.toRealFloat n)) ) <?> "literal"+ where+ fraction = do+ _ <- Text.Parser.Char.char '.'++ digits <- some Text.Parser.Char.digit++ let snoc y d =+ y + Scientific.scientific (fromIntegral (Char.digitToInt d)) (Scientific.base10Exponent y - 1)++ return (List.foldl' snoc 0 digits)++ exponent' = do+ _ <- Text.Parser.Char.oneOf "eE"++ sign <- signPrefix <|> pure id++ x <- Text.Parser.Token.decimal++ return (Scientific.scientific 1 (fromInteger (sign x)))+ {-| Parse a signed @Infinity@ This corresponds to the @minus-infinity-literal@ and @plus-infinity-literal@@@ -775,6 +829,10 @@ -} _assert :: Parser () _assert = keyword "assert"++-- | Parse the @with@ keyword+_with :: Parser ()+_with = keyword "with" {-| Parse the @Some@ built-in
src/Dhall/Pretty/Internal.hs view
@@ -178,24 +178,25 @@ Nothing -> "" Just (c, _, _) -> c + sharedSpacePrefix [] = ""+ sharedSpacePrefix (l : ls) = foldl' commonPrefix (spacePrefix l) ls+ blank = Text.all horizontalSpace newLines = case oldLines of [] -> []- l0 : [] ->- Pretty.pretty l0 : []- l0 : l1 : ls ->+ l0 : ls -> let sharedPrefix =- foldl' commonPrefix (spacePrefix l1) (map spacePrefix (filter (not . blank) ls))+ sharedSpacePrefix (filter (not . blank) ls) perLine l = case Text.stripPrefix sharedPrefix l of Nothing -> Pretty.pretty l Just l' -> Pretty.pretty l' - in Pretty.pretty l0 : map perLine (l1 : ls)+ in Pretty.pretty l0 : map perLine ls f x y = x <> Pretty.hardline <> y renderSrc _ _ =@@ -438,7 +439,7 @@ prettyAnyLabel :: Text -> Doc Ann prettyAnyLabel = prettyLabelShared True -prettyAnyLabels :: NonEmpty Text -> Doc Ann+prettyAnyLabels :: Foldable list => list Text -> Doc Ann prettyAnyLabels = mconcat . Pretty.punctuate dot . fmap prettyAnyLabel . toList @@ -473,6 +474,12 @@ prettyEnvironmentVariable :: Text -> Doc ann prettyEnvironmentVariable t = Pretty.pretty (escapeEnvironmentVariable t) +preserveSource :: Expr Src a -> Maybe (Doc Ann)+preserveSource (Note Src{..} (DoubleLit {})) = Just (Pretty.pretty srcText)+preserveSource (Note Src{..} (IntegerLit {})) = Just (Pretty.pretty srcText)+preserveSource (Note Src{..} (NaturalLit {})) = Just (Pretty.pretty srcText)+preserveSource _ = Nothing+ -- | Escape an environment variable if not a valid Bash environment variable escapeEnvironmentVariable :: Text -> Text escapeEnvironmentVariable t@@ -534,8 +541,13 @@ <> (space <> colon <> space) <> prettyExpression b <> rparen- docs (Note _ c) = docs c- docs c = [ prettyExpression c ]+ docs c+ | Just doc <- preserveSource c =+ [ doc ]+ | Note _ d <- c =+ docs d+ | otherwise =+ [ prettyExpression c ] prettyExpression a0@(BoolIf _ _ _) = Pretty.group (Pretty.flatAlt long short) where@@ -567,8 +579,13 @@ [ keyword "if" <> " " <> prettyExpression a , prettyExpression b ]- docsLong (Note _ c) = docsLong c- docsLong c = [ prettyExpression c ]+ docsLong c+ | Just doc <- preserveSource c =+ [ doc ]+ | Note _ d <- c =+ docsLong d+ | otherwise =+ [ prettyExpression c ] docsShort (BoolIf a b c) = docShort ++ docsShort c@@ -577,8 +594,13 @@ [ keyword "if" <> " " <> prettyExpression a , prettyExpression b ]- docsShort (Note _ c) = docsShort c- docsShort c = [ prettyExpression c ]+ docsShort c+ | Just doc <- preserveSource c =+ [ doc ]+ | Note _ d <- c =+ docsShort d+ | otherwise =+ [ prettyExpression c ] prettyExpression (Let a0 b0) = enclose' "" "" space Pretty.hardline (fmap duplicate (fmap docA (toList as)) ++ [ docB ])@@ -646,8 +668,13 @@ <> space <> colon <> space <> prettyExpression b <> rparen- docs (Note _ c) = docs c- docs c = [ prettyExpression c ]+ docs c+ | Just doc <- preserveSource c =+ [ doc ]+ | Note _ d <- c =+ docs d+ | otherwise =+ [ prettyExpression c ] prettyExpression (Assert a) = Pretty.group (Pretty.flatAlt long short) where@@ -658,10 +685,13 @@ ( " " <> keyword "assert" <> Pretty.hardline <> colon <> " " <> prettyExpression a )- prettyExpression (Note _ a) =- prettyExpression a- prettyExpression a0 =- prettyAnnotatedExpression a0+ prettyExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyExpression b+ | otherwise =+ prettyAnnotatedExpression a prettyAnnotatedExpression :: Pretty a => Expr Src a -> Doc Ann prettyAnnotatedExpression (Merge a b (Just c)) =@@ -711,16 +741,24 @@ (fmap duplicate (docs a0)) where docs (Annot a b) = prettyOperatorExpression a : docs b- docs (Note _ b) = docs b- docs b = [ prettyExpression b ]+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyExpression a ] prettyAnnotatedExpression (ListLit (Just a) b) = list (map prettyExpression (Data.Foldable.toList b)) <> " : " <> prettyApplicationExpression a- prettyAnnotatedExpression (Note _ a) =- prettyAnnotatedExpression a- prettyAnnotatedExpression a0 =- prettyOperatorExpression a0+ prettyAnnotatedExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyAnnotatedExpression b+ | otherwise =+ prettyOperatorExpression a prettyOperatorExpression :: Pretty a => Expr Src a -> Doc Ann prettyOperatorExpression = prettyImportAltExpression@@ -743,157 +781,281 @@ prettyOperator "?" (docs a0) where docs (ImportAlt a b) = prettyOrExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyOrExpression b ]- prettyImportAltExpression (Note _ a) =- prettyImportAltExpression a- prettyImportAltExpression a0 =- prettyOrExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyOrExpression a ]+ prettyImportAltExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyImportAltExpression b+ | otherwise =+ prettyOrExpression a prettyOrExpression :: Pretty a => Expr Src a -> Doc Ann prettyOrExpression a0@(BoolOr _ _) = prettyOperator "||" (docs a0) where docs (BoolOr a b) = prettyPlusExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyPlusExpression b ]- prettyOrExpression (Note _ a) =- prettyOrExpression a- prettyOrExpression a0 =- prettyPlusExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyPlusExpression a ]+ prettyOrExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyOrExpression b+ | otherwise =+ prettyPlusExpression a prettyPlusExpression :: Pretty a => Expr Src a -> Doc Ann prettyPlusExpression a0@(NaturalPlus _ _) = prettyOperator "+" (docs a0) where docs (NaturalPlus a b) = prettyTextAppendExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyTextAppendExpression b ]- prettyPlusExpression (Note _ a) =- prettyPlusExpression a- prettyPlusExpression a0 =- prettyTextAppendExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyTextAppendExpression a ]+ prettyPlusExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyPlusExpression b+ | otherwise =+ prettyTextAppendExpression a prettyTextAppendExpression :: Pretty a => Expr Src a -> Doc Ann prettyTextAppendExpression a0@(TextAppend _ _) = prettyOperator "++" (docs a0) where docs (TextAppend a b) = prettyListAppendExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyListAppendExpression b ]- prettyTextAppendExpression (Note _ a) =- prettyTextAppendExpression a- prettyTextAppendExpression a0 =- prettyListAppendExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyListAppendExpression a ]+ prettyTextAppendExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyTextAppendExpression b+ | otherwise =+ prettyListAppendExpression a prettyListAppendExpression :: Pretty a => Expr Src a -> Doc Ann prettyListAppendExpression a0@(ListAppend _ _) = prettyOperator "#" (docs a0) where docs (ListAppend a b) = prettyAndExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyAndExpression b ]- prettyListAppendExpression (Note _ a) =- prettyListAppendExpression a- prettyListAppendExpression a0 =- prettyAndExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyAndExpression a ]+ prettyListAppendExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyListAppendExpression b+ | otherwise =+ prettyAndExpression a prettyAndExpression :: Pretty a => Expr Src a -> Doc Ann prettyAndExpression a0@(BoolAnd _ _) = prettyOperator "&&" (docs a0) where docs (BoolAnd a b) = prettyCombineExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyCombineExpression b ]- prettyAndExpression (Note _ a) =- prettyAndExpression a- prettyAndExpression a0 =- prettyCombineExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyCombineExpression a ]+ prettyAndExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyAndExpression b+ | otherwise =+ prettyCombineExpression a prettyCombineExpression :: Pretty a => Expr Src a -> Doc Ann prettyCombineExpression a0@(Combine _ _ _) = prettyOperator (combine characterSet) (docs a0) where docs (Combine _ a b) = prettyPreferExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyPreferExpression b ]- prettyCombineExpression (Note _ a) =- prettyCombineExpression a- prettyCombineExpression a0 =- prettyPreferExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyPreferExpression a ]+ prettyCombineExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyCombineExpression b+ | otherwise =+ prettyPreferExpression a prettyPreferExpression :: Pretty a => Expr Src a -> Doc Ann- prettyPreferExpression a0@(Prefer _ _) =+ prettyPreferExpression a0@(Prefer {}) = prettyOperator (prefer characterSet) (docs a0) where- docs (Prefer a b) = prettyCombineTypesExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyCombineTypesExpression b ]- prettyPreferExpression (Note _ a) =- prettyPreferExpression a- prettyPreferExpression a0 =- prettyCombineTypesExpression a0+ docs (Prefer _ a b) = prettyCombineTypesExpression b : docs a+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyCombineTypesExpression a ]+ prettyPreferExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyPreferExpression b+ | otherwise =+ prettyCombineTypesExpression a prettyCombineTypesExpression :: Pretty a => Expr Src a -> Doc Ann prettyCombineTypesExpression a0@(CombineTypes _ _) = prettyOperator (combineTypes characterSet) (docs a0) where docs (CombineTypes a b) = prettyTimesExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyTimesExpression b ]- prettyCombineTypesExpression (Note _ a) =- prettyCombineTypesExpression a- prettyCombineTypesExpression a0 =- prettyTimesExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyTimesExpression a ]+ prettyCombineTypesExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyCombineTypesExpression b+ | otherwise =+ prettyTimesExpression a prettyTimesExpression :: Pretty a => Expr Src a -> Doc Ann prettyTimesExpression a0@(NaturalTimes _ _) = prettyOperator "*" (docs a0) where docs (NaturalTimes a b) = prettyEqualExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyEqualExpression b ]- prettyTimesExpression (Note _ a) =- prettyTimesExpression a- prettyTimesExpression a0 =- prettyEqualExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyEqualExpression a ]+ prettyTimesExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyTimesExpression b+ | otherwise =+ prettyEqualExpression a prettyEqualExpression :: Pretty a => Expr Src a -> Doc Ann prettyEqualExpression a0@(BoolEQ _ _) = prettyOperator "==" (docs a0) where docs (BoolEQ a b) = prettyNotEqualExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyNotEqualExpression b ]- prettyEqualExpression (Note _ a) =- prettyEqualExpression a- prettyEqualExpression a0 =- prettyNotEqualExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyNotEqualExpression a ]+ prettyEqualExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyEqualExpression b+ | otherwise =+ prettyNotEqualExpression a prettyNotEqualExpression :: Pretty a => Expr Src a -> Doc Ann prettyNotEqualExpression a0@(BoolNE _ _) = prettyOperator "!=" (docs a0) where docs (BoolNE a b) = prettyEquivalentExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyEquivalentExpression b ]- prettyNotEqualExpression (Note _ a) =- prettyNotEqualExpression a- prettyNotEqualExpression a0 =- prettyEquivalentExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyEquivalentExpression a ]+ prettyNotEqualExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyNotEqualExpression b+ | otherwise =+ prettyEquivalentExpression a prettyEquivalentExpression :: Pretty a => Expr Src a -> Doc Ann prettyEquivalentExpression a0@(Equivalent _ _) = prettyOperator (equivalent characterSet) (docs a0) where docs (Equivalent a b) = prettyApplicationExpression b : docs a- docs (Note _ b) = docs b- docs b = [ prettyApplicationExpression b ]- prettyEquivalentExpression (Note _ a) =- prettyEquivalentExpression a- prettyEquivalentExpression a0 =- prettyApplicationExpression a0+ docs a+ | Just doc <- preserveSource a =+ [ doc ]+ | Note _ b <- a =+ docs b+ | otherwise =+ [ prettyApplicationExpression a ]+ prettyEquivalentExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyEquivalentExpression b+ | otherwise =+ prettyWithExpression a + prettyWithExpression :: Pretty a => Expr Src a -> Doc Ann+ prettyWithExpression (With a b c) =+ prettyWithExpression a+ <> Pretty.flatAlt long short+ where+ short = " " <> keyword "with" <> " " <> update++ long = Pretty.hardline+ <> " "+ <> Pretty.align (keyword "with" <> " " <> update)++ (update, _ ) = prettyKeyValue prettyAnyLabels equals (b, c)+ prettyWithExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyWithExpression b+ | otherwise =+ prettyApplicationExpression a+ prettyApplicationExpression :: Pretty a => Expr Src a -> Doc Ann prettyApplicationExpression = go [] where@@ -902,9 +1064,14 @@ Some a -> app (builtin "Some") (a : args) Merge a b Nothing -> app (keyword "merge") (a : b : args) ToMap a Nothing -> app (keyword "toMap") (a : args)- Note _ b -> go args b- e | null args -> prettyImportExpression e -- just a performance optimization- | otherwise -> app (prettyImportExpression e) args+ e | Note _ b <- e ->+ go args b+ | null args ->+ prettyImportExpression e -- just a performance optimization+ | Just doc <- preserveSource e ->+ app doc args+ | otherwise ->+ app (prettyImportExpression e) args app f args = enclose'@@ -916,10 +1083,13 @@ prettyImportExpression :: Pretty a => Expr Src a -> Doc Ann prettyImportExpression (Embed a) = Pretty.pretty a- prettyImportExpression (Note _ a) =- prettyImportExpression a- prettyImportExpression a0 =- prettyCompletionExpression a0+ prettyImportExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyImportExpression b+ | otherwise =+ prettyCompletionExpression a prettyCompletionExpression :: Pretty a => Expr Src a -> Doc Ann prettyCompletionExpression (RecordCompletion a b) =@@ -933,11 +1103,13 @@ _ -> prettySelectorExpression a <> doubleColon <> prettySelectorExpression b-- prettyCompletionExpression (Note _ a) =- prettyCompletionExpression a- prettyCompletionExpression a0 =- prettySelectorExpression a0+ prettyCompletionExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyCompletionExpression b+ | otherwise =+ prettySelectorExpression a prettySelectorExpression :: Pretty a => Expr Src a -> Doc Ann prettySelectorExpression (Field a b) =@@ -950,10 +1122,13 @@ <> lparen <> prettyExpression b <> rparen- prettySelectorExpression (Note _ b) =- prettySelectorExpression b- prettySelectorExpression a0 =- prettyPrimitiveExpression a0+ prettySelectorExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettySelectorExpression b+ | otherwise =+ prettyPrimitiveExpression a prettyPrimitiveExpression :: Pretty a => Expr Src a -> Doc Ann prettyPrimitiveExpression (Var a) =@@ -1043,10 +1218,13 @@ prettyUnion a prettyPrimitiveExpression (ListLit Nothing b) = list (map prettyExpression (Data.Foldable.toList b))- prettyPrimitiveExpression (Note _ b) =- prettyPrimitiveExpression b- prettyPrimitiveExpression a =- Pretty.group (Pretty.flatAlt long short)+ prettyPrimitiveExpression a+ | Just doc <- preserveSource a =+ doc+ | Note _ b <- a =+ prettyPrimitiveExpression b+ | otherwise =+ Pretty.group (Pretty.flatAlt long short) where long = Pretty.align@@ -1055,7 +1233,11 @@ short = lparen <> prettyExpression a <> rparen prettyKeyValue- :: Pretty a => (k -> Doc Ann) -> Doc Ann -> (k, Expr Src a) -> (Doc Ann, Doc Ann)+ :: Pretty a+ => (k -> Doc Ann)+ -> Doc Ann+ -> (k, Expr Src a)+ -> (Doc Ann, Doc Ann) prettyKeyValue prettyKey separator (key, val) = duplicate (Pretty.group (Pretty.flatAlt long short)) where@@ -1085,14 +1267,22 @@ <> case shallowDenote val' of RecordCompletion _T r -> completion _T r++ RecordLit _ ->+ Pretty.hardline+ <> " "+ <> prettyImportExpression val'+ ListLit _ xs | not (null xs) -> Pretty.hardline <> " " <> prettyExpression val'+ _ -> Pretty.hardline <> " " <> prettyImportExpression val'+ ToMap val' Nothing -> " " <> keyword "toMap" <> case shallowDenote val' of@@ -1101,13 +1291,21 @@ _ -> Pretty.hardline <> " " <> prettyImportExpression val'+ RecordCompletion _T r -> completion _T r++ RecordLit _ ->+ Pretty.hardline+ <> " "+ <> prettyExpression val+ ListLit _ xs | not (null xs) -> Pretty.hardline <> " " <> prettyExpression val+ _ -> Pretty.hardline <> " "
src/Dhall/Syntax.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -25,6 +26,7 @@ , makeBinding , Chunks(..) , DhallDouble(..)+ , PreferAnnotation(..) , Expr(..) -- ** 'Let'-blocks@@ -62,6 +64,9 @@ , longestSharedWhitespacePrefix , linesLiteral , unlinesLiteral++ -- * Desugaring+ , desugarWith ) where import Control.DeepSeq (NFData)@@ -91,10 +96,11 @@ import qualified Control.Monad import qualified Data.HashSet-import qualified Data.List.NonEmpty+import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Dhall.Crypto+import qualified Dhall.Optics as Optics import qualified Language.Haskell.TH.Syntax as Syntax import qualified Network.URI as URI @@ -260,6 +266,22 @@ instance IsString (Chunks s a) where fromString str = Chunks [] (fromString str) +-- | Used to record the origin of a @//@ operator (i.e. from source code or a+-- product of desugaring)+data PreferAnnotation s a+ = PreferFromSource+ | PreferFromWith (Expr s a)+ -- ^ Stores the original @with@ expression+ | PreferFromCompletion+ deriving (Data, Eq, Foldable, Functor, Generic, NFData, Ord, Show, Traversable)++instance Bifunctor PreferAnnotation where+ first _ PreferFromSource = PreferFromSource+ first f (PreferFromWith e ) = PreferFromWith (first f e)+ first _ PreferFromCompletion = PreferFromCompletion++ second = fmap+ {-| Syntax tree for expressions The @s@ type parameter is used to track the presence or absence of `Src`@@ -348,9 +370,9 @@ | Integer -- | > IntegerLit n ~ ±n | IntegerLit Integer- -- | IntegerClamp ~ Integer/clamp+ -- | > IntegerClamp ~ Integer/clamp | IntegerClamp- -- | IntegerNegate ~ Integer/negate+ -- | > IntegerNegate ~ Integer/negate | IntegerNegate -- | > IntegerShow ~ Integer/show | IntegerShow@@ -428,8 +450,11 @@ | Combine (Maybe Text) (Expr s a) (Expr s a) -- | > CombineTypes x y ~ x ⩓ y | CombineTypes (Expr s a) (Expr s a)- -- | > Prefer x y ~ x ⫽ y- | Prefer (Expr s a) (Expr s a)+ -- | > Prefer False x y ~ x ⫽ y+ --+ -- The first field is a `True` when the `Prefer` operator is introduced as a+ -- result of desugaring a @with@ expression+ | Prefer (PreferAnnotation s a) (Expr s a) (Expr s a) -- | > RecordCompletion x y ~ x::y | RecordCompletion (Expr s a) (Expr s a) -- | > Merge x y (Just t ) ~ merge x y : t@@ -441,12 +466,14 @@ -- | > Field e x ~ e.x | Field (Expr s a) Text -- | > Project e (Left xs) ~ e.{ xs }- -- | > Project e (Right t) ~ e.(t)+ -- > Project e (Right t) ~ e.(t) | Project (Expr s a) (Either (Set Text) (Expr s a)) -- | > Assert e ~ assert : e | Assert (Expr s a) -- | > Equivalent x y ~ x ≡ y | Equivalent (Expr s a) (Expr s a)+ -- | > With x y ~ x with y+ | With (Expr s a) (NonEmpty Text) (Expr s a) -- | > Note s x ~ e | Note s (Expr s a) -- | > ImportAlt ~ e1 ? e2@@ -537,7 +564,7 @@ fmap f (Union u) = Union (fmap (fmap (fmap f)) u) fmap f (Combine m e1 e2) = Combine m (fmap f e1) (fmap f e2) fmap f (CombineTypes e1 e2) = CombineTypes (fmap f e1) (fmap f e2)- fmap f (Prefer e1 e2) = Prefer (fmap f e1) (fmap f e2)+ fmap f (Prefer a e1 e2) = Prefer (fmap f a) (fmap f e1) (fmap f e2) fmap f (RecordCompletion e1 e2) = RecordCompletion (fmap f e1) (fmap f e2) fmap f (Merge e1 e2 maybeE) = Merge (fmap f e1) (fmap f e2) (fmap (fmap f) maybeE) fmap f (ToMap e maybeE) = ToMap (fmap f e) (fmap (fmap f) maybeE)@@ -545,6 +572,7 @@ fmap f (Project e1 vs) = Project (fmap f e1) (fmap (fmap f) vs) fmap f (Assert t) = Assert (fmap f t) fmap f (Equivalent e1 e2) = Equivalent (fmap f e1) (fmap f e2)+ fmap f (With e k v) = With (fmap f e) k (fmap f v) fmap f (Note s e1) = Note s (fmap f e1) fmap f (ImportAlt e1 e2) = ImportAlt (fmap f e1) (fmap f e2) fmap f (Embed a) = Embed (f a)@@ -622,7 +650,12 @@ Union a >>= k = Union (fmap (fmap (>>= k)) a) Combine a b c >>= k = Combine a (b >>= k) (c >>= k) CombineTypes a b >>= k = CombineTypes (a >>= k) (b >>= k)- Prefer a b >>= k = Prefer (a >>= k) (b >>= k)+ Prefer a b c >>= k = Prefer a' (b >>= k) (c >>= k)+ where+ a' = case a of+ PreferFromSource -> PreferFromSource+ PreferFromWith e -> PreferFromWith (e >>= k)+ PreferFromCompletion -> PreferFromCompletion RecordCompletion a b >>= k = RecordCompletion (a >>= k) (b >>= k) Merge a b c >>= k = Merge (a >>= k) (b >>= k) (fmap (>>= k) c) ToMap a b >>= k = ToMap (a >>= k) (fmap (>>= k) b)@@ -630,6 +663,7 @@ Project a b >>= k = Project (a >>= k) (fmap (>>= k) b) Assert a >>= k = Assert (a >>= k) Equivalent a b >>= k = Equivalent (a >>= k) (b >>= k)+ With a b c >>= k = With (a >>= k) b (c >>= k) Note a b >>= k = Note a (b >>= k) ImportAlt a b >>= k = ImportAlt (a >>= k) (b >>= k) Embed a >>= k = k a@@ -694,7 +728,7 @@ first k (Union a ) = Union (fmap (fmap (first k)) a) first k (Combine a b c ) = Combine a (first k b) (first k c) first k (CombineTypes a b ) = CombineTypes (first k a) (first k b)- first k (Prefer a b ) = Prefer (first k a) (first k b)+ first k (Prefer a b c ) = Prefer (first k a) (first k b) (first k c) first k (RecordCompletion a b) = RecordCompletion (first k a) (first k b) first k (Merge a b c ) = Merge (first k a) (first k b) (fmap (first k) c) first k (ToMap a b ) = ToMap (first k a) (fmap (first k) b)@@ -702,6 +736,7 @@ first k (Assert a ) = Assert (first k a) first k (Equivalent a b ) = Equivalent (first k a) (first k b) first k (Project a b ) = Project (first k a) (fmap (first k) b)+ first k (With a b c ) = With (first k a) b (first k c) first k (Note a b ) = Note (k a) (first k b) first k (ImportAlt a b ) = ImportAlt (first k a) (first k b) first _ (Embed a ) = Embed a@@ -746,7 +781,7 @@ multiLet b0 = \case Let b1 e1 -> let MultiLet bs e = multiLet b1 e1- in MultiLet (Data.List.NonEmpty.cons b0 bs) e+ in MultiLet (NonEmpty.cons b0 bs) e e -> MultiLet (b0 :| []) e {-| Wrap let-'Binding's around an 'Expr'.@@ -827,7 +862,7 @@ subExpressions f (Union a) = Union <$> traverse (traverse f) a subExpressions f (Combine a b c) = Combine a <$> f b <*> f c subExpressions f (CombineTypes a b) = CombineTypes <$> f a <*> f b-subExpressions f (Prefer a b) = Prefer <$> f a <*> f b+subExpressions f (Prefer a b c) = Prefer <$> pure a <*> f b <*> f c subExpressions f (RecordCompletion a b) = RecordCompletion <$> f a <*> f b subExpressions f (Merge a b t) = Merge <$> f a <*> f b <*> traverse f t subExpressions f (ToMap a t) = ToMap <$> f a <*> traverse f t@@ -835,6 +870,7 @@ subExpressions f (Project a b) = Project <$> f a <*> traverse f b subExpressions f (Assert a) = Assert <$> f a subExpressions f (Equivalent a b) = Equivalent <$> f a <*> f b+subExpressions f (With a b c) = With <$> f a <*> pure b <*> f c subExpressions f (Note a b) = Note a <$> f b subExpressions f (ImportAlt l r) = ImportAlt <$> f l <*> f r subExpressions _ (Embed a) = pure (Embed a)@@ -1133,7 +1169,12 @@ denote (Union a ) = Union (fmap (fmap denote) a) denote (Combine _ b c ) = Combine Nothing (denote b) (denote c) denote (CombineTypes a b ) = CombineTypes (denote a) (denote b)-denote (Prefer a b ) = Prefer (denote a) (denote b)+denote (Prefer a b c ) = Prefer a' (denote b) (denote c)+ where+ a' = case a of+ PreferFromSource -> PreferFromSource+ PreferFromWith e -> PreferFromWith (denote e)+ PreferFromCompletion -> PreferFromCompletion denote (RecordCompletion a b) = RecordCompletion (denote a) (denote b) denote (Merge a b c ) = Merge (denote a) (denote b) (fmap denote c) denote (ToMap a b ) = ToMap (denote a) (fmap denote b)@@ -1141,6 +1182,7 @@ denote (Project a b ) = Project (denote a) (fmap denote b) denote (Assert a ) = Assert (denote a) denote (Equivalent a b ) = Equivalent (denote a) (denote b)+denote (With a b c ) = With (denote a) b (denote c) denote (ImportAlt a b ) = ImportAlt (denote a) (denote b) denote (Embed a ) = Embed a @@ -1178,6 +1220,7 @@ , "toMap" , "assert" , "forall"+ , "with" -- Builtins according to the `builtin` rule in the grammar , "Natural/fold"@@ -1234,21 +1277,21 @@ fmap (Chunks []) (splitOn "\n" suffix) linesLiteral (Chunks ((prefix, interpolation) : pairs₀) suffix₀) = foldr- Data.List.NonEmpty.cons+ 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+ initLines = NonEmpty.init splitLines+ lastLine = NonEmpty.last splitLines Chunks pairs₁ suffix₁ :| chunks = linesLiteral (Chunks pairs₀ suffix₀) -- | Flatten several `Chunks` back into a single `Chunks` by inserting newlines unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a unlinesLiteral chunks =- Data.Foldable.fold (Data.List.NonEmpty.intersperse "\n" chunks)+ Data.Foldable.fold (NonEmpty.intersperse "\n" chunks) -- | Returns `True` if the `Chunks` represents a blank line emptyLine :: Chunks s a -> Bool@@ -1285,9 +1328,9 @@ -- for the last line filteredLines = newInit <> pure oldLast where- oldInit = Data.List.NonEmpty.init literals+ oldInit = NonEmpty.init literals - oldLast = Data.List.NonEmpty.last literals+ oldLast = NonEmpty.last literals newInit = filter (not . emptyLine) oldInit @@ -1310,3 +1353,18 @@ longestSharedPrefix = longestSharedWhitespacePrefix literals indent = Data.Text.length longestSharedPrefix++-- | Desugar all @with@ expressions+desugarWith :: Expr s a -> Expr s a+desugarWith = Optics.rewriteOf subExpressions rewrite+ where+ rewrite e@(With record (key :| []) value) =+ Just (Prefer (PreferFromWith e) record (RecordLit [ (key, value) ]))+ rewrite e@(With record (key0 :| key1 : keys) value) =+ Just+ (Prefer (PreferFromWith e) record+ (RecordLit+ [ (key0, With (Field record key0) (key1 :| keys) value) ]+ )+ )+ rewrite _ = Nothing
src/Dhall/TH.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-}@@ -17,6 +18,8 @@ import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty) import Dhall.Syntax (Expr(..))+import Dhall (FromDhall, ToDhall)+import GHC.Generics (Generic) import Language.Haskell.TH.Quote (dataToExpQ) -- 7.10 compatibility. import Language.Haskell.TH.Syntax@@ -28,6 +31,12 @@ , Bang(..) , SourceStrictness(..) , SourceUnpackedness(..)+#if MIN_VERSION_template_haskell(2,12,0)+ , DerivClause(..)+ , DerivStrategy(..)+#else+ , Pred+#endif ) import qualified Data.List as List@@ -140,8 +149,8 @@ , "• ❰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"+ , "• ❰List a❱ (where ❰a❱ is also a valid nested type) \n"+ , "• ❰Optional a❱ (where ❰a❱ is also a valid nested type) \n" , "• Another matching datatype declaration \n" , " \n" , "The Haskell datatype generation logic encountered the following Dhall type: \n"@@ -158,6 +167,17 @@ predicate haskellType = Core.judgmentallyEqual (code haskellType) dhallType +#if MIN_VERSION_template_haskell(2,12,0)+derivingClauses :: [DerivClause]+derivingClauses =+ [ DerivClause (Just StockStrategy) [ ConT ''Generic ]+ , DerivClause (Just AnyclassStrategy) [ ConT ''FromDhall, ConT ''ToDhall ]+ ]+#else+derivingClauses :: [Pred]+derivingClauses = [ ConT ''Generic, ConT ''FromDhall, ConT ''ToDhall ]+#endif+ -- | Convert a Dhall type to the corresponding Haskell datatype declaration toDeclaration :: (Eq a, Pretty a)@@ -171,7 +191,7 @@ constructors <- traverse (toConstructor haskellTypes) (Dhall.Map.toList kts ) - return (DataD [] name [] Nothing constructors [])+ return (DataD [] name [] Nothing constructors derivingClauses) _ -> do let document =@@ -220,7 +240,7 @@ constructor <- toConstructor haskellTypes (constructorName, Just code) - return (DataD [] name [] Nothing [constructor] [])+ return (DataD [] name [] Nothing [constructor] derivingClauses) -- | Convert a Dhall type to the corresponding Haskell constructor toConstructor@@ -318,6 +338,12 @@ -- -- ... this Template Haskell splice: --+-- > {-# LANGUAGE DeriveAnyClass #-}+-- > {-# LANGUAGE DeriveGeneric #-}+-- > {-# LANGUAGE DerivingStrategies #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE TemplateHaskell #-}+-- > -- > Dhall.TH.makeHaskellTypes -- > [ MultipleConstructors "Department" "./tests/th/Department.dhall" -- > , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall"@@ -326,21 +352,34 @@ -- ... generates this Haskell code: -- -- > data Department = Engineering | Marketing | Sales+-- > deriving stock (GHC.Generics.Generic)+-- > deriving anyclass (Dhall.FromDhall, Dhall.ToDhall) -- > -- > data Employee -- > = MakeEmployee {department :: Department, -- > name :: Data.Text.Internal.Text}+-- > deriving stock (GHC.Generics.Generic)+-- > deriving anyclass (Dhall.FromDhall, Dhall.ToDhall) -- -- Carefully note that the conversion makes a best-effort attempt to -- auto-detect when a Dhall type (like @./Employee.dhall@) refers to another -- Dhall type (like @./Department.dhall@) and replaces that reference with the -- corresponding Haskell type. ----- To add any desired instances (such as `Dhall.FromDhall`/`Dhall.ToDhall`),--- you can use the `StandaloneDeriving` language extension, like this:+-- This Template Haskell splice requires you to enable the following extensions: --+-- * @DeriveGeneric@+-- * @DerivingAnyClass@+-- * @DerivingStrategies@+--+-- By default, the generated types only derive `GHC.Generics.Generic`,+-- `Dhall.FromDhall`, and `Dhall.ToDhall`. To add any desired instances (such+-- as `Eq`\/`Ord`\/`Show`), you can use the `StandaloneDeriving` language+-- extension, like this:+-- -- > {-# LANGUAGE DeriveAnyClass #-} -- > {-# LANGUAGE DeriveGeneric #-}+-- > {-# LANGUAGE DerivingStrategies #-} -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE StandaloneDeriving #-} -- > {-# LANGUAGE TemplateHaskell #-}@@ -350,11 +389,13 @@ -- > , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall" -- > ] -- >--- > deriving instance Generic Department--- > deriving instance FromDhall Department+-- > deriving instance Eq Department+-- > deriving instance Ord Department+-- > deriving instance Show Department -- >--- > deriving instance Generic Employee--- > deriving instance FromDhall Employee+-- > deriving instance Eq Employee+-- > deriving instance Ord Employee+-- > deriving instance Show Employee makeHaskellTypes :: [HaskellType Text] -> Q [Dec] makeHaskellTypes haskellTypes = do Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)
src/Dhall/Tutorial.hs view
@@ -544,8 +544,16 @@ -- > } -- > } ----- You can access a field of a record using the following syntax:+-- You can specify nested fields using dot-separated keys, like this: --+-- > { foo = 1, bar.baz = 2.0, bar.qux = True }+--+-- ... which is equivalent to:+--+-- > { foo = 1, bar = { baz = 2.0, qux = True } }+--+-- You can also access a field of a record using the following syntax:+-- -- > record.fieldName -- -- ... which means to access the value of the field named @fieldName@ from the@@ -827,6 +835,24 @@ -- -- Note that the order of record fields does not matter. The compiler -- automatically sorts the fields.+--+-- If you need to set or add a deeply nested field you can use the @with@+-- keyword, like this:+--+-- > $ dhall <<< '{ x.y = 1 } with x.z = True'+-- > { x = { y = 1, z = True } }+--+-- > $ dhall <<< '{ x.y = 1 } with x.y = 2'+-- > { x.y = 2 }+--+-- The @with@ keyword is syntactic sugar for the @//@ operator which follows+-- these rules:+--+-- > -- Nested case+-- > record with k.ks… = value ⇒ record // { k = record.k with ks… = value }+-- >+-- > -- Base case+-- > record with k = value ⇒ record // { k = value } -- -- The @(/\\)@ operator (or @(∧)@ U+2227) also lets you combine records, but -- behaves differently if the records share fields in common. The operator
src/Dhall/TypeCheck.hs view
@@ -41,13 +41,20 @@ import Data.Typeable (Typeable) import Data.Void (Void, absurd) import Dhall.Context (Context)-import Dhall.Syntax (Binding(..), Const(..), Chunks(..), Expr(..), Var(..))-import Dhall.Eval- (Environment(..), Names(..), Val(..), (~>))+import Dhall.Eval (Environment(..), Names(..), Val(..), (~>)) import Dhall.Pretty (Ann) import Dhall.Src (Src) import Lens.Family (over) +import Dhall.Syntax+ ( Binding(..)+ , Const(..)+ , Chunks(..)+ , Expr(..)+ , PreferAnnotation(..)+ , Var(..)+ )+ import qualified Data.Foldable import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map@@ -62,9 +69,10 @@ import qualified Dhall.Diff import qualified Dhall.Eval as Eval import qualified Dhall.Map-import qualified Dhall.Set import qualified Dhall.Pretty import qualified Dhall.Pretty.Internal+import qualified Dhall.Set+import qualified Dhall.Syntax as Syntax import qualified Dhall.Util import qualified Lens.Family @@ -298,7 +306,7 @@ else do let _A₀'' = quote names _A₀' let _A₁'' = quote names _A₁'- die (AnnotMismatch a₀ _A₀'' _A₁'')+ Left (TypeError context a₀ (AnnotMismatch a₀ _A₀'' _A₁'')) return (addTypeValue x _A₀' a₀' ctx) @@ -600,8 +608,6 @@ -- to just the offending element let err = MismatchedListElements (i+1) _T₀'' t₁ _T₁'' - let context = ctxToContext ctx- Left (TypeError context t₁ err) traverseWithIndex_ process ts₁@@ -808,6 +814,12 @@ Combine mk l r -> do _L' <- loop ctx l + let l'' = quote names (eval values l)++ _R' <- loop ctx r++ let r'' = quote names (eval values l)+ xLs' <- case _L' of VRecord xLs' -> do return xLs'@@ -816,11 +828,9 @@ let _L'' = quote names _L' case mk of- Nothing -> die (MustCombineARecord '∧' l _L'')+ Nothing -> die (MustCombineARecord '∧' l'' _L'') Just t -> die (InvalidDuplicateField t l _L'') - _R' <- loop ctx r- xRs' <- case _R' of VRecord xRs' -> do return xRs'@@ -829,7 +839,7 @@ let _R'' = quote names _R' case mk of- Nothing -> die (MustCombineARecord '∧' r _R'')+ Nothing -> die (MustCombineARecord '∧' r'' _R'') Just t -> die (InvalidDuplicateField t r _R'') let combineTypes xs xLs₀' xRs₀' = do@@ -897,19 +907,35 @@ return (VConst c) - Prefer l r -> do+ Prefer a l r -> do _L' <- loop ctx l + _R' <- loop ctx r+ xLs' <- case _L' of VRecord xLs' -> return xLs'- _ -> die (MustCombineARecord '⫽' l r) - _R' <- loop ctx r+ _ -> do+ let _L'' = quote names _L' + let l'' = quote names (eval values l)++ case a of+ PreferFromWith withExpression ->+ die (MustUpdateARecord withExpression l'' _L'')+ _ ->+ die (MustCombineARecord '⫽' l'' _L'')+ xRs' <- case _R' of VRecord xRs' -> return xRs'- _ -> die (MustCombineARecord '⫽' l r) + _ -> do+ let _R'' = quote names _R'++ let r'' = quote names (eval values r)++ die (MustCombineARecord '⫽' r'' _R'')+ return (VRecord (Dhall.Map.union xRs' xLs')) RecordCompletion l r -> do@@ -922,7 +948,7 @@ | not (Dhall.Map.member "Type" xLs') -> die (InvalidRecordCompletion "Type" l) | otherwise- -> loop ctx (Annot (Prefer (Field l "default") r) (Field l "Type"))+ -> loop ctx (Annot (Prefer PreferFromCompletion (Field l "default") r) (Field l "Type")) _ -> die (CompletionSchemaMustBeARecord l (quote names _L')) Merge t u mT₁ -> do@@ -1261,6 +1287,9 @@ return (VConst Type) + e@With{} -> do+ loop ctx (Syntax.desugarWith e)+ Note s e -> case loop ctx e of Left (TypeError ctx' (Note s' e') m) ->@@ -1277,9 +1306,9 @@ return (eval values (typer p)) where die err = Left (TypeError context expression err)- where- context = ctxToContext ctx + context = ctxToContext ctx+ names = typesToNames types eval vs e = Eval.eval vs (Dhall.Core.denote e)@@ -1315,6 +1344,7 @@ | InvalidAlternativeType Text (Expr s a) | AlternativeAnnotationMismatch Text (Expr s a) Const Text (Expr s a) Const | ListAppendMismatch (Expr s a) (Expr s a)+ | MustUpdateARecord (Expr s a) (Expr s a) (Expr s a) | MustCombineARecord Char (Expr s a) (Expr s a) | InvalidDuplicateField Text (Expr s a) (Expr s a) | InvalidRecordCompletion Text (Expr s a)@@ -2763,14 +2793,68 @@ txt0 = insert expr0 txt1 = pretty fieldName -prettyTypeMessage (MustCombineARecord c expr0 expr1) = ErrorMessages {..}+prettyTypeMessage (MustUpdateARecord withExpression expression typeExpression) =+ ErrorMessages {..} where- short = "You can only combine records"+ short = "You can only update records" long =- "Explanation: You can combine records using the ❰" <> op <> "❱ operator, like this:\n\+ "Explanation: You can update records using the ❰with❱ keyword, like this: \n\ \ \n\ \ \n\+ \ ┌────────────────────────────────┐ \n\+ \ │ { x = { y = 1 } } with x.y = 2 │ \n\+ \ └────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \ ┌────────────────────────────────────────────────────────────┐ \n\+ \ │ λ(r : { foo : { bar : Bool } }) → r with foo.bar = False } │ \n\+ \ └────────────────────────────────────────────────────────────┘ \n\+ \ \n\+ \ \n\+ \... but you cannot update values that are not records. \n\+ \ \n\+ \For example, the following expression is " <> _NOT <> " valid: \n\+ \ \n\+ \ \n\+ \ ┌─────────────────┐ \n\+ \ │ 1 with x = True │ \n\+ \ └─────────────────┘ \n\+ \ ⇧ \n\+ \ Invalid: Not a record \n\+ \ \n\+ \ \n\+ \────────────────────────────────────────────────────────────────────────────────\n\+ \ \n\+ \The following expression is not permitted: \n\+ \ \n\+ \" <> insert withExpression' <> "\n\+ \ \n\+ \... because the left argument to ❰with❱: \n\+ \ \n\+ \" <> insert expression <> "\n\+ \ \n\+ \... is not a record, but is actually a: \n\+ \ \n\+ \" <> insert typeExpression <> "\n"+ where+ withExpression' = case withExpression of+ With record keys value -> With (Dhall.Core.normalize record) keys value+ _ -> withExpression++prettyTypeMessage (MustCombineARecord c expression typeExpression) =+ ErrorMessages {..}+ where+ action = case c of+ '∧' -> "combine"+ _ -> "override"++ short = "You can only " <> action <> " records"++ long =+ "Explanation: You can " <> action <> " records using the ❰" <> op <> "❱ operator, like this:\n\+ \ \n\+ \ \n\ \ ┌───────────────────────────────────────────┐ \n\ \ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz = True } │ \n\ \ └───────────────────────────────────────────┘ \n\@@ -2781,7 +2865,7 @@ \ └─────────────────────────────────────────────┘ \n\ \ \n\ \ \n\- \... but you cannot combine values that are not records. \n\+ \... but you cannot " <> action <> " values that are not records. \n\ \ \n\ \For example, the following expressions are " <> _NOT <> " valid: \n\ \ \n\@@ -2807,17 +2891,17 @@ \ Invalid: This is a union type and not a record \n\ \ \n\ \ \n\- \You tried to combine the following value: \n\+ \────────────────────────────────────────────────────────────────────────────────\n\ \ \n\- \" <> txt0 <> "\n\+ \You supplied this expression as one of the arguments: \n\ \ \n\+ \" <> insert expression <> "\n\+ \ \n\ \... which is not a record, but is actually a: \n\ \ \n\- \" <> txt1 <> "\n"+ \" <> insert typeExpression <> "\n" where- op = pretty c- txt0 = insert expr0- txt1 = insert expr1+ op = pretty c prettyTypeMessage (InvalidDuplicateField k expr0 expr1) = ErrorMessages {..}@@ -4598,6 +4682,8 @@ ListAppendMismatch <$> f a <*> f b InvalidDuplicateField a b c -> InvalidDuplicateField a <$> f b <*> f c+ MustUpdateARecord a b c ->+ MustUpdateARecord <$> f a <*> f b <*> f c MustCombineARecord a b c -> MustCombineARecord <$> pure a <*> f b <*> f c InvalidRecordCompletion a l ->
tests/Dhall/Test/Dhall.hs view
@@ -24,7 +24,7 @@ import Data.Vector (Vector) import Dhall (ToDhall, FromDhall) import Dhall.Core (Expr(..))-import GHC.Generics (Generic)+import GHC.Generics (Generic, Rep) import Numeric.Natural (Natural) import Test.Tasty import Test.Tasty.HUnit@@ -311,23 +311,33 @@ Dhall.defaultInterpretOptions { Dhall.singletonConstructors = Dhall.Wrapped } + functionWithOptions+ :: ( Generic a+ , Dhall.GenericToDhall (Rep a)+ , Generic b+ , Dhall.GenericFromDhall (Rep b)+ )+ => Dhall.InterpretOptions -> Dhall.Decoder (a -> b)+ functionWithOptions options =+ Dhall.function (Dhall.genericToDhallWith options) (Dhall.genericAutoWith options)+ code `shouldPassThroughWrapped` values = testCase "Pass through" $ do- f <- Dhall.input (Dhall.autoWith wrappedOptions) code+ f <- Dhall.input (functionWithOptions wrappedOptions) code values @=? map f values code `shouldPassThroughSmart` values = testCase "Pass through" $ do- f <- Dhall.input (Dhall.autoWith smartOptions) code+ f <- Dhall.input (functionWithOptions smartOptions) code values @=? map f values code `shouldMarshalIntoWrapped` expectedValue = testCase "Marshal" $ do- actualValue <- Dhall.input (Dhall.autoWith wrappedOptions) code+ actualValue <- Dhall.input (Dhall.genericAutoWith wrappedOptions) code expectedValue @=? actualValue code `shouldMarshalIntoSmart` expectedValue = testCase "Marshal" $ do- actualValue <- Dhall.input (Dhall.autoWith smartOptions) code+ actualValue <- Dhall.input (Dhall.genericAutoWith smartOptions) code expectedValue @=? actualValue @@ -336,14 +346,14 @@ resolvedExpression <- Dhall.Import.assertNoImports parsedExpression - Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.injectWith wrappedOptions) value+ Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.genericToDhallWith wrappedOptions) value value `shouldEmbedAsSmart` expectedCode = testCase "ToDhall" $ do parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode) resolvedExpression <- Dhall.Import.assertNoImports parsedExpression - Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.injectWith smartOptions) value+ Dhall.Core.denote resolvedExpression @=? Dhall.embed (Dhall.genericToDhallWith smartOptions) value shouldConvertDhallToHaskellCorrectly :: TestTree shouldConvertDhallToHaskellCorrectly =
tests/Dhall/Test/Import.hs view
@@ -2,6 +2,7 @@ module Dhall.Test.Import where +import Control.Exception (SomeException) import Data.Monoid ((<>)) import Data.Text (Text) import Dhall.Import (MissingImports(..))@@ -61,8 +62,12 @@ let directoryString = FilePath.takeDirectory pathString - Tasty.HUnit.testCase pathString (do+ let expectedFailures =+ [ importDirectory </> "success/unit/asLocation/HashA.dhall"+ ] + Test.Util.testCase path expectedFailures (do+ text <- Text.IO.readFile pathString actualExpr <- Core.throws (Parser.exprFromText mempty text)@@ -75,14 +80,20 @@ let load = State.evalStateT (Test.Util.loadWith actualExpr) (Import.emptyStatus directoryString) - if Turtle.filename (Turtle.fromText path) == "hashFromCacheA.dhall"- then do- setCache- _ <- load- unsetCache- else do- _ <- load- return ()+ let runTest = do+ if Turtle.filename (Turtle.fromText path) == "hashFromCacheA.dhall"+ then do+ setCache+ _ <- load+ unsetCache+ else do+ _ <- load+ return ()++ let handler :: SomeException -> IO ()+ handler exception = Tasty.HUnit.assertFailure (show exception)++ Exception.handle handler runTest return () )
tests/Dhall/Test/Main.hs view
@@ -71,6 +71,8 @@ System.Environment.setEnv "XDG_CACHE_HOME" (pwd </> ".cache") + System.Environment.setEnv "DHALL_TEST_VAR" "6 * 7"+ allTests <- getAllTests Test.Tasty.defaultMain allTests
tests/Dhall/Test/QuickCheck.hs view
@@ -29,6 +29,7 @@ , ImportHashed(..) , ImportMode(..) , ImportType(..)+ , PreferAnnotation(..) , Scheme(..) , URL(..) , Var(..)@@ -219,6 +220,14 @@ shrink = genericShrink +instance (Arbitrary s, Arbitrary a) => Arbitrary (PreferAnnotation s a) where+ arbitrary =+ Test.QuickCheck.oneof+ [ pure PreferFromSource+ , PreferFromWith <$> arbitrary+ , pure PreferFromCompletion+ ]+ instance (Arbitrary s, Arbitrary a) => Arbitrary (Expr s a) where arbitrary = Test.QuickCheck.suchThat@@ -313,6 +322,7 @@ % (7 :: W "Project") % (1 :: W "Assert") % (1 :: W "Equivalent")+ % (1 :: W "With") % (0 :: W "Note") % (7 :: W "ImportAlt") % (7 :: W "Embed")@@ -321,11 +331,22 @@ shrink expression = filter standardizedExpression (genericShrink expression) standardizedExpression :: Expr s a -> Bool-standardizedExpression (ListLit Nothing xs) = not (Data.Sequence.null xs)-standardizedExpression (ListLit (Just _ ) xs) = Data.Sequence.null xs-standardizedExpression (Note _ _ ) = False-standardizedExpression (Combine (Just _) _ _) = False-standardizedExpression _ = True+standardizedExpression (ListLit Nothing xs) =+ not (Data.Sequence.null xs)+standardizedExpression (ListLit (Just _ ) xs) =+ Data.Sequence.null xs+standardizedExpression (Note _ _) =+ False+standardizedExpression (Combine (Just _) _ _) =+ False+standardizedExpression With{} =+ False+standardizedExpression (Prefer PreferFromCompletion _ _) =+ False+standardizedExpression (Prefer (PreferFromWith _) _ _) =+ False+standardizedExpression _ =+ True instance Arbitrary File where arbitrary = lift2 File
tests/Dhall/Test/TH.hs view
@@ -1,14 +1,17 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} +#if MIN_VERSION_template_haskell(2,12,0)+{-# LANGUAGE DerivingStrategies #-}+#endif+ module Dhall.Test.TH where -import Dhall (FromDhall(..)) import Dhall.TH (HaskellType(..))-import GHC.Generics import Test.Tasty (TestTree) import qualified Dhall@@ -18,25 +21,19 @@ Dhall.TH.makeHaskellTypeFromUnion "T" "./tests/th/example.dhall" -deriving instance Eq T-deriving instance Show T-deriving instance Generic T-deriving instance FromDhall T+deriving instance Eq T+deriving instance Show T Dhall.TH.makeHaskellTypes [ MultipleConstructors "Department" "./tests/th/Department.dhall" , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall" ] -deriving instance Eq Department-deriving instance Show Department-deriving instance Generic Department-deriving instance FromDhall Department+deriving instance Eq Department+deriving instance Show Department -deriving instance Eq Employee-deriving instance Show Employee-deriving instance Generic Employee-deriving instance FromDhall Employee+deriving instance Eq Employee+deriving instance Show Employee tests :: TestTree tests = Tasty.testGroup "Template Haskell" [ makeHaskellTypeFromUnion ]
tests/Dhall/Test/TypeInference.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Dhall.Test.TypeInference where@@ -44,7 +45,15 @@ successTest :: Text -> TestTree successTest prefix = do- let expectedFailures = []+ let expectedFailures =+ []++#ifdef WITH_HTTP+#else+ ++ [ typeInferenceDirectory </> "success/CacheImports"+ , typeInferenceDirectory </> "success/CacheImportsCanonicalize"+ ]+#endif Test.Util.testCase prefix expectedFailures $ do let prefixFP = Text.unpack prefix
tests/format/doubleRoundB.dhall view
@@ -1,37 +1,37 @@-[ 1.0-, 1.0-, 1.0000000000000002+[ 1.0000000000000000+, 1.0000000000000001 , 1.0000000000000002-, 1.0000000000000004+, 1.0000000000000003 , 1.0000000000000004-, 1.0000000000000007+, 1.0000000000000005+, 1.0000000000000006 , 1.0000000000000007-, 1.0000000000000009+, 1.0000000000000008 , 1.0000000000000009-, 1.0e64-, 1.0000000000000002e64+, 1.0000000000000000e64+, 1.0000000000000001e64 , 1.0000000000000002e64 , 1.0000000000000003e64-, 1.0000000000000005e64+, 1.0000000000000004e64 , 1.0000000000000005e64 , 1.0000000000000006e64-, 1.0000000000000008e64+, 1.0000000000000007e64 , 1.0000000000000008e64 , 1.0000000000000009e64-, 1.0e100-, 1.0e100-, 1.0000000000000002e100+, 1.0000000000000000e100+, 1.0000000000000001e100 , 1.0000000000000002e100-, 1.0000000000000004e100+, 1.0000000000000003e100 , 1.0000000000000004e100+, 1.0000000000000005e100 , 1.0000000000000006e100-, 1.0000000000000008e100+, 1.0000000000000007e100 , 1.0000000000000008e100-, 1.000000000000001e100-, 1.7976931348623157e308-, 1.7976931348623157e308-, 1.7976931348623155e308-, -1.7976931348623157e308-, -1.7976931348623157e308-, -1.7976931348623155e308+, 1.0000000000000009e100+, 179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791.0+, 179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945.0+, 179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944.0+, -179769313486231580793728971405303415079934132710037826936173778980444968292764750946649017977587207096330286416692887910946555547851940402630657488671505820681908902000708383676273854845817711531764475730270069855571366959622842914819860834936475292719074168444365510704342711559699508093042880177904174497791.0+, -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218945.0+, -179769313486231560835325876058105298516207002341652166261661174625869553267292326574530099287946549246750631490335877017522087105926987962906277604735569213290190919152394180476217125334960946356387261286640198029037799514183602981511756283727771403830521483963923935633133642802139091669457927874464075218944.0 ]
+ tests/format/issue1687A.dhall view
@@ -0,0 +1,7 @@+let {- foo++ bar -}+ x =+ 1++in x
+ tests/format/issue1687B.dhall view
@@ -0,0 +1,7 @@+let {- foo++ bar -}+ x =+ 1++in x
tests/format/largeExponentB.dhall view
@@ -1,1 +1,1 @@-[ 1.0, 1.0e100, 1.0e-100 ]+[ 1.0, 1e100, 1e-100 ]
+ tests/format/numericLiteralsA.dhall view
@@ -0,0 +1,1 @@+{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 }
+ tests/format/numericLiteralsB.dhall view
@@ -0,0 +1,1 @@+{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 }
+ tests/format/withA.dhall view
@@ -0,0 +1,5 @@+r with a = Some { b = 1, c = 1, d = 1, e = 1, f = 1, g = 1, h = 1, i = 1, j = 1, k = 1, l = 1 }+ with b = T::{ b = 1, c = 1, d = 1, e = 1, f = 1, g = 1, h = 1, i = 1, j = 1, k = 1, l = 1 }+ with c = [ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ]+ with d = 1+ with e = 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+ tests/format/withB.dhall view
@@ -0,0 +1,58 @@+r+ with a = Some+ { b = 1+ , c = 1+ , d = 1+ , e = 1+ , f = 1+ , g = 1+ , h = 1+ , i = 1+ , j = 1+ , k = 1+ , l = 1+ }+ with b = T::{+ , b = 1+ , c = 1+ , d = 1+ , e = 1+ , f = 1+ , g = 1+ , h = 1+ , i = 1+ , j = 1+ , k = 1+ , l = 1+ }+ with c =+ [ 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ , 1+ ]+ with d = 1+ with e =+ 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111