packages feed

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 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 @@+„‚aa‚ab
+ 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‚¡ab‚ac‚¡ad‚‚¡aa„	ƒ	‚¢aa‚¡ab‚ac‚¡ad‚aa‚¡ab‚‚¡ac„	ƒ	„	‚¢aa‚¡ab‚ac‚¡ad‚‚¡aa„	ƒ	‚¢aa‚¡ab‚ac‚¡ad‚aa‚¡ab‚ac‚¡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