dhall 1.36.0 → 1.37.0

raw patch · 67 files changed

+784/−442 lines, 67 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−0
• dhall-lang/Prelude/Integer/multiply.dhall +0/−1
• dhall-lang/Prelude/JSON/Format.dhall +0/−1
• dhall-lang/Prelude/JSON/package.dhall +5/−2
• dhall-lang/Prelude/JSON/render +1/−1
• dhall-lang/Prelude/JSON/render.dhall +1/−1
• dhall-lang/Prelude/JSON/renderAs +1/−1
• dhall-lang/Prelude/JSON/renderAs.dhall +37/−3
• dhall-lang/Prelude/JSON/renderCompact.dhall +58/−0
• dhall-lang/Prelude/JSON/renderInteger.dhall +0/−1
• dhall-lang/Prelude/JSON/renderYAML +1/−1
• dhall-lang/Prelude/JSON/renderYAML.dhall +1/−2
• dhall-lang/Prelude/List/unpackOptionals.dhall +0/−1
• dhall-lang/Prelude/Map/unpackOptionals.dhall +0/−1
• dhall-lang/Prelude/Operator/package.dhall +85/−0
• dhall-lang/Prelude/Optional/concatMap.dhall +23/−0
• dhall-lang/Prelude/Optional/package.dhall +3/−0
• dhall-lang/Prelude/Text/package.dhall +3/−0
• dhall-lang/Prelude/Text/replicate.dhall +0/−1
• dhall-lang/Prelude/Text/spaces.dhall +0/−1
• dhall-lang/Prelude/XML/Type.dhall +0/−1
• dhall-lang/Prelude/XML/attribute.dhall +0/−1
• dhall-lang/Prelude/XML/element.dhall +0/−2
• dhall-lang/Prelude/XML/emptyAttributes.dhall +0/−1
• dhall-lang/Prelude/XML/leaf.dhall +0/−1
• dhall-lang/Prelude/XML/package.dhall +1/−1
• dhall-lang/Prelude/XML/render +1/−1
• dhall-lang/Prelude/XML/render.dhall +70/−3
• dhall-lang/Prelude/XML/text.dhall +0/−1
• dhall-lang/Prelude/package.dhall +7/−4
• dhall-lang/tests/normalization/success/unit/TextReplaceAbstractA.dhall +2/−3
• dhall-lang/tests/normalization/success/unit/TextReplaceAbstractB.dhall +1/−1
• dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackA.dhall +4/−0
• dhall-lang/tests/normalization/success/unit/TextReplaceAbstractHaystackB.dhall +1/−0
• dhall-lang/tests/normalization/success/unit/TextReplaceEmptyA.dhall +3/−1
• dhall-lang/tests/normalization/success/unit/TextReplaceEmptyB.dhall +1/−1
• dhall-lang/tests/normalization/success/unit/TextReplaceVarA.dhall +3/−0
• dhall-lang/tests/normalization/success/unit/TextReplaceVarB.dhall +1/−0
• dhall-lang/tests/type-inference/success/preludeB.dhall +34/−0
• dhall-lang/tests/type-inference/success/unit/IfBranchesKindA.dhall +1/−0
• dhall-lang/tests/type-inference/success/unit/IfBranchesKindB.dhall +1/−0
• dhall-lang/tests/type-inference/success/unit/IfBranchesTypeA.dhall +1/−0
• dhall-lang/tests/type-inference/success/unit/IfBranchesTypeB.dhall +1/−0
• dhall.cabal +5/−2
• doctest/Main.hs +3/−0
• ghc-src/Dhall/Import/HTTP.hs +9/−1
• src/Dhall.hs +4/−8
• src/Dhall/Binary.hs +4/−5
• src/Dhall/Diff.hs +7/−8
• src/Dhall/Eval.hs +22/−51
• src/Dhall/Import.hs +67/−30
• src/Dhall/Import/Types.hs +15/−2
• src/Dhall/Main.hs +12/−11
• src/Dhall/Normalize.hs +5/−6
• src/Dhall/Parser/Combinators.hs +0/−14
• src/Dhall/Parser/Expression.hs +20/−13
• src/Dhall/Parser/Token.hs +4/−10
• src/Dhall/Pretty/Internal.hs +69/−36
• src/Dhall/Syntax.hs +88/−89
• src/Dhall/Tutorial.hs +4/−4
• src/Dhall/TypeCheck.hs +50/−108
• tests/Dhall/Test/QuickCheck.hs +2/−2
• tests/Dhall/Test/Regression.hs +9/−0
• tests/Dhall/Test/TypeInference.hs +1/−2
• tests/format/issue2078A.dhall +1/−0
• tests/format/issue2078B.dhall +3/−0
• tests/regression/issue2088.dhall +1/−0

@@ -1,3 +1,30 @@+1.37.0++* [Supports version 20.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v20.0.0)+    * [Implement revised `Text/replace` β-normalization](https://github.com/dhall-lang/dhall-haskell/pull/2072)+    * [Allow `Text/replace ""` to support an abstract haystack](https://github.com/dhall-lang/dhall-haskell/pull/2084)+    * [Support `if` expressions returning a type or kind](https://github.com/dhall-lang/dhall-haskell/pull/2080)+* BREAKING CHANGE TO THE API: [Improve error message for duplicate projection label](https://github.com/dhall-lang/dhall-haskell/pull/2097)+    * This also makes the implementation more standards-compliant, by treating+      a duplicate label as a type error instead of a parse error+    * This is a breaking change since the `Project` constructor now stores a+      `[Text]` instead of `Set Text`+* [Add `--cache` flag to `dhall hash`](https://github.com/dhall-lang/dhall-haskell/pull/2093)+    * This flag adds the hashed expression to the cache when enabled+* [Deprecate `Inject` / `Interpret`](https://github.com/dhall-lang/dhall-haskell/pull/2099)+    * You should instead use `ToDhall` / `FromDhall`, respectively+* Fixes and improvements to the haddocks:+    * [#2098](https://github.com/dhall-lang/dhall-haskell/pull/2098)+    * [#2100](https://github.com/dhall-lang/dhall-haskell/pull/2100)+* Fixes and improvements to error messages:+    * [#2082](https://github.com/dhall-lang/dhall-haskell/pull/2082)+    * [#2095](https://github.com/dhall-lang/dhall-haskell/pull/2095)+* Fixes and improvements to the parser:+    * [#2083](https://github.com/dhall-lang/dhall-haskell/pull/2089)+* Fixes and improvements to the pretty printer:+    * [#2083](https://github.com/dhall-lang/dhall-haskell/pull/2083)+    * [#2101](https://github.com/dhall-lang/dhall-haskell/pull/2101)+ 1.36.0  * [Supports version 19.0.0 of the standard](https://github.com/dhall-lang/dhall-lang/releases/tag/v19.0.0)

@@ -1,5 +1,4 @@ --| `multiply m n` computes `m * n`.- let nonPositive =         ./nonPositive.dhall sha256:e00a852eed5b84ff60487097d8aadce53c9e5301f53ff4954044bd68949fac3b       ? ./nonPositive.dhall

@@ -4,5 +4,4 @@ You should not need to use this type directly, simply use `./render` or `./renderYAML` as appropriate. -}- < YAML | JSON >

@@ -1,8 +1,11 @@   { render =-        ./render.dhall sha256:b5e5aee66b8fc018b50e1019a76340deafe5f8176854ea3611476d79990785da+        ./render.dhall sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836       ? ./render.dhall+  , renderCompact =+        ./renderCompact.dhall sha256:e6c8809fbe193fddd430f94350d69cefd45e7aaf8bd379e51b750fde75008562+      ? ./renderCompact.dhall   , renderYAML =-        ./renderYAML.dhall sha256:dad92a120956ae852be7496d1e1955bbf3f60834ab2ad32641269098f2846477+        ./renderYAML.dhall sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478       ? ./renderYAML.dhall   , omitNullFields =         ./omitNullFields.dhall sha256:e6850e70094540b75edeb46f4d6038324a62def8d63544a1e9541f79739db6f0

@@ -1,2 +1,2 @@-  ./render.dhall sha256:b5e5aee66b8fc018b50e1019a76340deafe5f8176854ea3611476d79990785da+  ./render.dhall sha256:36befdd8bb5a1c2b372709da245a8d074533b86429e137b894c08ad16fa34836 ? ./render.dhall

@@ -9,7 +9,7 @@       ? ./core.dhall  let renderAs =-        ./renderAs.dhall sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043+        ./renderAs.dhall sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471       ? ./renderAs.dhall  let Format =

@@ -1,2 +1,2 @@-  ./renderAs.dhall sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043+  ./renderAs.dhall sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471 ? ./renderAs.dhall

@@ -1,5 +1,4 @@ --| Render a `JSON` value as `Text` in either JSON or YAML format.- let JSON =         ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5       ? ./core.dhall@@ -195,6 +194,22 @@  let ObjectField = { mapKey : Text, mapValue : Block } +let -- Essentially the same thing as `Text/show`, except that this does not+    -- escape `$`+    escape =+      List/fold+        (Text → Text)+        [ Text/replace "\"" "\\\""+        , Text/replace "\b" "\\b"+        , Text/replace "\f" "\\f"+        , Text/replace "\n" "\\n"+        , Text/replace "\r" "\\r"+        , Text/replace "\t" "\\t"+        , Text/replace "\\" "\\\\"+        ]+        Text+        (λ(replace : Text → Text) → λ(text : Text) → replace text)+ let renderJSONStruct =       λ(prefix : Text) →       λ(suffix : Text) →@@ -225,7 +240,7 @@ let renderObject =       λ(format : Format) →       λ(fields : NonEmpty ObjectField) →-        let keystr = λ(field : ObjectField) → "${Text/show field.mapKey}:"+        let keystr = λ(field : ObjectField) → "\"${escape field.mapKey}\":"          let prefixKeyOnFirst =               λ(field : ObjectField) →@@ -294,7 +309,7 @@         blockToText           ( json               Block-              { string = λ(x : Text) → Block.Simple (Text/show x)+              { string = λ(x : Text) → Block.Simple "\"${escape x}\""               , double = λ(x : Double) → Block.Simple (Double/show x)               , integer = λ(x : Integer) → Block.Simple (JSON.renderInteger x)               , object = manyBlocks ObjectField "{}" (renderObject format)@@ -424,5 +439,24 @@                 ''        in  True++let example3 =+      let specialCharacters =+            ''+            "\${"\b\f"}+            ${"\r"}	$''++      let data =+            JSON.object+              [ { mapKey = specialCharacters+                , mapValue = JSON.string specialCharacters+                }+              ]++      in    assert+          :   renderAs Format.JSON data+            ≡ ''+              { "\"\\\b\f\n\r\t$": "\"\\\b\f\n\r\t$" }+              ''  in  renderAs

@@ -0,0 +1,58 @@+--| This renders JSON on a single line+let JSON =+        ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5+      ? ./core.dhall++let Text/concatMapSep =+        ../Text/concatMapSep sha256:c272aca80a607bc5963d1fcb38819e7e0d3e72ac4d02b1183b1afb6a91340840+      ? ../Text/concatMapSep++let renderInteger =+        ./renderInteger.dhall sha256:15b8d2ae46d5002832741927af787761df49798c911e2bf85db7a7b9cb5c078c+      ? ./renderInteger.dhall++let renderCompact+    : JSON.Type → Text+    = λ(j : JSON.Type) →+        j+          Text+          { string = Text/show+          , double = Double/show+          , integer = renderInteger+          , 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"+          }++let example =+        assert+      :   renderCompact+            ( JSON.array+                [ JSON.bool True+                , JSON.string "Hello"+                , JSON.object+                    [ { mapKey = "foo", mapValue = JSON.null }+                    , { mapKey = "bar", mapValue = JSON.double 1.1 }+                    , { mapKey = "baz", mapValue = JSON.integer +2 }+                    ]+                ]+            )+        ≡ "[ true, \"Hello\", { \"foo\": null, \"bar\": 1.1, \"baz\": 2 } ]"++in  renderCompact

@@ -2,7 +2,6 @@ Render an `Integer` value as a `JSON number`, according to the JSON standard, in which a number may not start with a plus sign (`+`). -}- let Integer/nonNegative =         ../Integer/nonNegative.dhall sha256:b463373f070df6b1c8c7082051e0810fee38b360bab35256187c8c2b6af5c663       ? ../Integer/nonNegative.dhall

@@ -1,2 +1,2 @@-  ./renderYAML.dhall sha256:dad92a120956ae852be7496d1e1955bbf3f60834ab2ad32641269098f2846477+  ./renderYAML.dhall sha256:bc71449397bbf48103c3ebbdd570cd27313115e94b2b1b96761d257d5c02d478 ? ./renderYAML.dhall

@@ -8,13 +8,12 @@ For anything more sophisticated you should use `dhall-to-json` or `dhall-to-yaml`. -}- let JSON =         ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5       ? ./core.dhall  let renderAs =-        ./renderAs.dhall sha256:5576473c02bc447d40d08bf103aaeca9637c1040367fdf07ff70032ba3e28043+        ./renderAs.dhall sha256:c23be039c9601a33d6546fd99a8d72bee8dde5f46176d57cc96613b31a3bb471       ? ./renderAs.dhall  let Format =

@@ -1,5 +1,4 @@ --| Unpack Optionals in a List, omitting None items.- let List/concatMap =         ./concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64       ? ./concatMap.dhall

@@ -1,6 +1,5 @@ --| Turn a `Map k (Optional v)` into a `Map k v` by dropping all --  entries with value `None`.- let List/concatMap =         ../List/concatMap.dhall sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64       ? ../List/concatMap.dhall

@@ -0,0 +1,85 @@+{-+Note: This package does not use one file per function because the operator+names contain symbols such as `*` that may cause problems.+-}+let {-+        `+` m n++    computes `m + n`+    -} `+`+    : Natural → Natural → Natural+    = λ(m : Natural) → λ(n : Natural) → m + n++let example1 = assert : `+` 2 1 ≡ 3++let {-+        `*` m n++    computes `m * n`+    -} `*`+    : Natural → Natural → Natural+    = λ(m : Natural) → λ(n : Natural) → m * n++let example2 = assert : `*` 21 2 ≡ 42++let {-+        `++` m n++    computes `m ++ n`+    -} `++`+    : Text → Text → Text+    = λ(m : Text) → λ(n : Text) → m ++ n++let example3 = assert : `++` "Hello" "Dhall" ≡ "HelloDhall"++let {-+        `#` Type m n++    computes `m # n`+    -} `#`+    : ∀(type : Type) → List type → List type → List type+    = λ(type : Type) → λ(m : List type) → λ(n : List type) → m # n++let example4 = assert : `#` Natural [ 1, 2 ] [ 3 ] ≡ [ 1, 2, 3 ]++let {-+        `==` m n++    computes `m == n`+    -} `==`+    : Bool → Bool → Bool+    = λ(m : Bool) → λ(n : Bool) → m == n++let example5 = assert : `==` True False ≡ False++let {-+        `!=` m n++    computes `m != n`+    -} `!=`+    : Bool → Bool → Bool+    = λ(m : Bool) → λ(n : Bool) → m != n++let example6 = assert : `!=` True False ≡ True++let {-+        `&&` m n++    computes `m && n`+    -} `&&`+    : Bool → Bool → Bool+    = λ(m : Bool) → λ(n : Bool) → m && n++let example7 = assert : `&&` False True ≡ False++let {-+        `||` m n++    computes `m || n`+    -} `||`+    : Bool → Bool → Bool+    = λ(m : Bool) → λ(n : Bool) → m || n++let example8 = assert : `||` False True ≡ True++in  { `+`, `*`, `++`, `#`, `==`, `!=`, `&&`, `||` }

@@ -0,0 +1,23 @@+--| Transform the value with a function and flatten the resulting `Optional`+let concatMap+    : ∀(a : Type) → ∀(b : Type) → (a → Optional b) → Optional a → Optional b+    = λ(a : Type) →+      λ(b : Type) →+      λ(f : a → Optional b) →+      λ(o : Optional a) →+        merge { Some = f, None = None b } o++let exampleFun+    : Natural → Optional Natural+    = λ(n : Natural) → if Natural/even n then Some (n + 1) else None Natural++let example0 =+      assert : concatMap Natural Natural exampleFun (Some 1) ≡ None Natural++let example1 = assert : concatMap Natural Natural exampleFun (Some 2) ≡ Some 3++let example2 =+        assert+      : concatMap Natural Natural exampleFun (None Natural) ≡ None Natural++in  concatMap

@@ -10,6 +10,9 @@ , concat =       ./concat.dhall sha256:b7736bd3ebeab14c3912dfb534d0c970a025b001d06c2d5461d4b0e289e3cb7a     ? ./concat.dhall+, concatMap =+      ./concatMap.dhall sha256:c06ae93e900a99299c9b4ec4912ca5395a0103ea88292205b08dd7e345632818+    ? ./concatMap.dhall , default =       ./default.dhall sha256:5bd665b0d6605c374b3c4a7e2e2bd3b9c1e39323d41441149ed5e30d86e889ad     ? ./default.dhall

@@ -16,6 +16,9 @@ , defaultMap =       ./defaultMap.dhall sha256:3a3fa1264f6198800c27483cb144de2c5366484876d60b9c739a710ce0288588     ? ./defaultMap.dhall+, replace =+      ./replace.dhall sha256:7d132df0e091a43817bba8afa06d1bb487ee51c091430404ad6f8c78bc0328a6+    ? ./replace.dhall , replicate =       ./replicate.dhall sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f     ? ./replicate.dhall

@@ -1,5 +1,4 @@ --| Build a Text by copying the given Text the specified number of times- let concat =         ./concat.dhall sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0       ? ./concat.dhall

@@ -4,7 +4,6 @@ This function is particularly helpful when trying to generate Text where whitespace is significant, i.e. with nested indentation. -}- let replicate =         ./replicate.dhall sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f       ? ./replicate.dhall

@@ -44,7 +44,6 @@    } ``` -}- let XML/Type     : Type     = ∀(XML : Type) →

@@ -1,5 +1,4 @@ --| Builds a key-value record with a Text key and value.- let attribute     : Text → Text → { mapKey : Text, mapValue : Text }     = λ(key : Text) → λ(value : Text) → { mapKey = key, mapValue = value }

@@ -18,8 +18,6 @@ = "<foo><bar n=\"1\"/><baz n=\"2\"/></foo>" ``` -}-- let XML =         ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c       ? ./Type.dhall

@@ -1,3 +1,2 @@ --| Create an empty XML attribute List.- [] : List { mapKey : Text, mapValue : Text }

@@ -9,7 +9,6 @@ = "<foobar/>" ``` -}- let XML =         ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c       ? ./Type.dhall

@@ -5,7 +5,7 @@       ./attribute.dhall sha256:f7b6c802ca5764d03d5e9a6e48d9cb167c01392f775d9c2c87b83cdaa60ea0cc     ? ./attribute.dhall , render =-      ./render.dhall sha256:8d034f7f97cded14a96147565d489be840e5678480d175b962b2600d85a3230e+      ./render.dhall sha256:aff7efe61ce299381edca023e24bb5aaa0656c41bfa45dd705dab63519b7c5db     ? ./render.dhall , element =       ./element.dhall sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b

@@ -1,2 +1,2 @@-  ./render.dhall sha256:8d034f7f97cded14a96147565d489be840e5678480d175b962b2600d85a3230e+  ./render.dhall sha256:aff7efe61ce299381edca023e24bb5aaa0656c41bfa45dd705dab63519b7c5db ? ./render.dhall

@@ -22,7 +22,6 @@ ```  -}- let XML =         ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c       ? ./Type.dhall@@ -35,16 +34,38 @@         ../Text/concat.dhall sha256:731265b0288e8a905ecff95c97333ee2db614c39d69f1514cb8eed9259745fc0       ? ../Text/concat.dhall +let element =+        ./element.dhall sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b+      ? ./element.dhall++let text =+        ./text.dhall sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f+      ? ./text.dhall++let emptyAttributes =+        ./emptyAttributes.dhall sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5+      ? ./emptyAttributes.dhall+ let Attr = { mapKey : Text, mapValue : Text } -let renderAttr = λ(x : Attr) → " ${x.mapKey}=\"${x.mapValue}\""+let `escape"` = Text/replace "\"" "\\\"" +let `escape<` = Text/replace "<" "\\<"++let `escape&` = Text/replace "&" "\\&"++let escapeText = λ(text : Text) → `escape<` (`escape&` text)++let escapeAttr = λ(text : Text) → `escape"` (`escape<` (`escape&` text))++let renderAttr = λ(x : Attr) → " ${x.mapKey}=\"${escapeAttr x.mapValue}\""+ let render     : XML → Text     = λ(x : XML) →         x           Text-          { text = λ(d : Text) → d+          { text = escapeText           , element =               λ ( elem                 : { attributes : List { mapKey : Text, mapValue : Text }@@ -60,5 +81,51 @@                           else  ">${Text/concat elem.content}</${elem.name}>"                         )           }++let simple =+      λ(name : Text) →+      λ(content : List XML) →+        element { name, attributes = emptyAttributes, content }++let example0 =+        assert+      :   render+            ( simple+                "note"+                [ simple "to" [ text "Tove" ]+                , simple "from" [ text "Jani" ]+                , simple "heading" [ text "Reminder" ]+                , simple "body" [ text "Don't forget me this weekend!" ]+                ]+            )+        ≡ Text/replace+            "\n"+            ""+            ''+            <note>+            <to>Tove</to>+            <from>Jani</from>+            <heading>Reminder</heading>+            <body>Don't forget me this weekend!</body>+            </note>+            ''++let example1 =+        assert+      :   render+            ( element+                { name = "escape"+                , attributes = toMap { attribute = "<>'\"&" }+                , content = [ text "<>'\"&" ]+                }+            )+        ≡ Text/replace+            "\n"+            ""+            ''+            <escape attribute="\<>'\"\&">+            \<>'"\&+            </escape>+            ''  in  render

@@ -14,7 +14,6 @@ = "<location>/foo/bar</location>" ``` -}- let XML =         ./Type.dhall sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c       ? ./Type.dhall

@@ -25,16 +25,19 @@ , Natural =       ./Natural/package.dhall sha256:ee9ed2b28a417ed4e9a0c284801b928bf91b3fbdc1a68616347678c1821f1ddf     ? ./Natural/package.dhall+, Operator =+      ./Operator/package.dhall sha256:861f724704a7b4755c96f173e54d03f314492a2d046723404c31ff612b7bf2e6+    ? ./Operator/package.dhall , Optional =-      ./Optional/package.dhall sha256:4324b2bf84ded40f67485f14355e4cb7b237a8f173e713c791ec44cebebc552c+      ./Optional/package.dhall sha256:37b84d6fe94c591d603d7b06527a2d3439ba83361e9326bc7b72517c7dc54d4e     ? ./Optional/package.dhall , JSON =-      ./JSON/package.dhall sha256:79dfc281a05bc7b78f927e0da0c274ee5709b1c55c9e5f59499cb28e9d6f3ec0+      ./JSON/package.dhall sha256:5f98b7722fd13509ef448b075e02b9ff98312ae7a406cf53ed25012dbc9990ac     ? ./JSON/package.dhall , Text =-      ./Text/package.dhall sha256:819a967038fbf6f28cc289fa2651e42835f70b326210c86e51acf48f46f913d8+      ./Text/package.dhall sha256:46c53957c10bd4c332a5716d6e06068cd24ae1392ca171e6da31e30b9b33c07c     ? ./Text/package.dhall , XML =-      ./XML/package.dhall sha256:137e7b106b2e9743970e5d37b21a165f2e40f56ab593a4dd10605c9acd686fc6+      ./XML/package.dhall sha256:8f57bda3087cbb34568d58e5dd5ee6860a50576caf48ebe49a5fc60b9af9a1fa     ? ./XML/package.dhall }

@@ -1,4 +1,3 @@-{- This test verifies that an implementation correctly permits both the-   "replacement" and the "haystack" to be abstract.+{- This test verifies that an implementation works with an abstract "replacement". -}-λ(x : Text) → λ(y : Text) → Text/replace "a" "-${x}-" "_a_${y}_a_"+λ(x : Text) → Text/replace "a" "-${x}-" "_a__a_"

@@ -1,1 +1,1 @@-λ(x : Text) → λ(y : Text) → "_-${x}-_${y}_-${x}-_"+λ(x : Text) → "_-${x}-__-${x}-_"

@@ -0,0 +1,4 @@+{- This test verifies that an implementation does not beta normalize with an+   abstract "haystack".+-}+λ(x : Text) → λ(y : Text) → Text/replace "a" "-${x}-" "_a_${y}_a_"

@@ -0,0 +1,1 @@+λ(x : Text) → λ(y : Text) → Text/replace "a" "-${x}-" "_a_${y}_a_"

@@ -1,1 +1,3 @@-Text/replace "" "bar" "foo"+λ(replacement : Text) →+λ(haystack : Text) →+  Text/replace "" replacement haystack

@@ -1,1 +1,1 @@-"foo"+λ(replacement : Text) → λ(haystack : Text) → haystack

@@ -0,0 +1,3 @@+{- This test verifies that an implementation works with a variable as "replacement".+-}+λ(x : Text) → Text/replace "a" x "aaa"

@@ -0,0 +1,1 @@+λ(x : Text) → "${x}${x}${x}"

@@ -239,6 +239,22 @@               JSON           ) →           Text+    , renderCompact :+        ∀ ( j+          : ∀(JSON : Type) →+            ∀ ( json+              : { array : List JSON → JSON+                , bool : Bool → JSON+                , double : Double → JSON+                , integer : Integer → JSON+                , null : JSON+                , object : List { mapKey : Text, mapValue : JSON } → JSON+                , string : Text → JSON+                }+              ) →+              JSON+          ) →+          Text     , renderInteger : ∀(integer : Integer) → Text     , renderYAML :         ∀ ( json@@ -408,6 +424,16 @@     , toDouble : ∀(n : Natural) → Double     , toInteger : Natural → Integer     }+, Operator :+    { `!=` : ∀(m : Bool) → ∀(n : Bool) → Bool+    , `#` : ∀(type : Type) → ∀(m : List type) → ∀(n : List type) → List type+    , `&&` : ∀(m : Bool) → ∀(n : Bool) → Bool+    , `*` : ∀(m : Natural) → ∀(n : Natural) → Natural+    , `+` : ∀(m : Natural) → ∀(n : Natural) → Natural+    , `++` : ∀(m : Text) → ∀(n : Text) → Text+    , `==` : ∀(m : Bool) → ∀(n : Bool) → Bool+    , `||` : ∀(m : Bool) → ∀(n : Bool) → Bool+    } , Optional :     { all : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool     , any : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Bool@@ -421,6 +447,12 @@           ) →           Optional a     , concat : ∀(a : Type) → ∀(x : Optional (Optional a)) → Optional a+    , concatMap :+        ∀(a : Type) →+        ∀(b : Type) →+        ∀(f : a → Optional b) →+        ∀(o : Optional a) →+          Optional b     , default : ∀(a : Type) → ∀(default : a) → ∀(o : Optional a) → a     , filter : ∀(a : Type) → ∀(f : a → Bool) → ∀(xs : Optional a) → Optional a     , fold :@@ -459,6 +491,8 @@     , concatSep : ∀(separator : Text) → ∀(elements : List Text) → Text     , default : ∀(o : Optional Text) → Text     , defaultMap : ∀(a : Type) → ∀(f : a → Text) → ∀(o : Optional a) → Text+    , replace :+        ∀(needle : Text) → ∀(replacement : Text) → ∀(haystack : Text) → Text     , replicate : ∀(num : Natural) → ∀(text : Text) → Text     , show : Text → Text     , spaces : ∀(a : Natural) → Text

@@ -0,0 +1,1 @@+if True then (Type -> Type) else Type

@@ -0,0 +1,1 @@+Kind

@@ -0,0 +1,1 @@+if True then Bool else Natural

@@ -0,0 +1,1 @@+Type

@@ -1,5 +1,5 @@ Name: dhall-Version: 1.36.0+Version: 1.37.0 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 8.4.3, GHC == 8.6.1@@ -85,6 +85,7 @@     dhall-lang/Prelude/JSON/package.dhall     dhall-lang/Prelude/JSON/render     dhall-lang/Prelude/JSON/renderAs+    dhall-lang/Prelude/JSON/renderCompact.dhall     dhall-lang/Prelude/JSON/renderInteger.dhall     dhall-lang/Prelude/JSON/renderYAML     dhall-lang/Prelude/JSON/string@@ -158,6 +159,7 @@     dhall-lang/Prelude/Natural/toDouble     dhall-lang/Prelude/Natural/toInteger     dhall-lang/Prelude/Natural/*.dhall+    dhall-lang/Prelude/Operator/package.dhall     dhall-lang/Prelude/Optional/all     dhall-lang/Prelude/Optional/any     dhall-lang/Prelude/Optional/build@@ -181,6 +183,7 @@     dhall-lang/Prelude/Text/default     dhall-lang/Prelude/Text/defaultMap     dhall-lang/Prelude/Text/package.dhall+    dhall-lang/Prelude/Text/replace.dhall     dhall-lang/Prelude/Text/replicate     dhall-lang/Prelude/Text/show     dhall-lang/Prelude/Text/spaces@@ -509,7 +512,7 @@         scientific                  >= 0.3.0.0  && < 0.4 ,         template-haskell            >= 2.13.0.0 && < 2.17,         text                        >= 0.11.1.0 && < 1.3 ,-        text-manipulate             >= 0.2.0.1  && < 0.3 ,+        text-manipulate             >= 0.2.0.1  && < 0.4 ,         th-lift-instances           >= 0.1.13   && < 0.2 ,         transformers                >= 0.2.0.0  && < 0.6 ,         transformers-compat         >= 0.6.2    && < 0.7 ,

@@ -6,6 +6,7 @@  import qualified GHC.IO.Encoding import qualified System.Directory+import qualified System.Environment import qualified System.IO import qualified Test.DocTest import qualified Test.Mockery.Directory@@ -16,6 +17,8 @@     GHC.IO.Encoding.setLocaleEncoding System.IO.utf8     pwd    <- System.Directory.getCurrentDirectory     prefix <- System.Directory.makeAbsolute pwd++    System.Environment.setEnv "XDG_CACHE_HOME" (pwd </> ".cache")      Test.Mockery.Directory.inTempDirectory $ do         writeFile "makeBools.dhall" "λ(n : Bool) → [ n && True, n && False, n || True, n || False ]"

@@ -65,6 +65,11 @@       <>  "\ESC[1;31mError\ESC[0m: The remote host took too long to respond\n"       <>  "\n"       <>  "URL: " <> url <> "\n"+    ConnectionTimeout ->+          "\n"+      <>  "\ESC[1;31mError\ESC[0m: Connection establishment took too long\n"+      <>  "\n"+      <>  "URL: " <> url <> "\n"     StatusCodeException response body -> prefix <> suffix       where         prefix@@ -141,7 +146,10 @@                      prefixedText = Text.unlines prefixedLines -    e' -> "\n" <> show e' <> "\n"+    e' -> "\n"+      <>  "\ESC[1;31mError\ESC[0m: " <> show e'+      <>  "\n"+      <>  "URL: " <> url <> "\n"  newManager :: StateT Status IO Manager newManager = do

@@ -1326,11 +1326,9 @@         :: (Generic a, GenericFromDhall a (Rep a)) => InputNormalizer -> Decoder a     autoWith _ = genericAuto -{-| A compatibility alias for `FromDhall`--This will eventually be removed.--}+-- | A compatibility alias for `FromDhall` type Interpret = FromDhall+{-# DEPRECATED Interpret "Use FromDhall instead" #-}  instance FromDhall Void where     autoWith _ = void@@ -1967,11 +1965,9 @@         :: (Generic a, GenericToDhall (Rep a)) => InputNormalizer -> Encoder a     injectWith _ = genericToDhall -{-| A compatibility alias for `ToDhall`--This will eventually be removed.--}+-- | A compatibility alias for `ToDhall` type Inject = ToDhall+{-# DEPRECATED Inject "Use ToDhall instead" #-}  {-| Use the default input normalizer for injecting a value 

@@ -73,7 +73,6 @@ import qualified Data.Sequence import qualified Dhall.Crypto import qualified Dhall.Map-import qualified Dhall.Set import qualified Dhall.Syntax          as Syntax import qualified Text.Printf           as Printf @@ -415,7 +414,7 @@                                              TypeString -> do                                                 x <- Decoding.decodeString-                                                return (Left (Dhall.Set.fromList [x]))+                                                return (Left [x])                                              _ ->                                                 die ("Unexpected token type for projection: " <> show tokenType₂)@@ -423,7 +422,7 @@                                     _ -> do                                         xs <- replicateDecoder (len - 2) Decoding.decodeString -                                        return (Left (Dhall.Set.fromList xs))+                                        return (Left xs)                                  return (Project t xs) @@ -852,10 +851,10 @@          Project t (Left xs) ->             encodeListN-                (2 + Dhall.Set.size xs)+                (2 + length xs)                 ( Encoding.encodeInt 10                 : go t-                : map Encoding.encodeString (Dhall.Set.toList xs)+                : map Encoding.encodeString xs                 )          Project t (Right _T) ->

@@ -26,7 +26,6 @@ import Data.Void                 (Void) import Dhall.Map                 (Map) import Dhall.Pretty.Internal     (Ann)-import Dhall.Set                 (Set) import Dhall.Syntax     ( Binding (..)     , Chunks (..)@@ -47,7 +46,6 @@ import qualified Dhall.Map import qualified Dhall.Normalize           as Normalize import qualified Dhall.Pretty.Internal     as Internal-import qualified Dhall.Set import qualified Dhall.Syntax              as Syntax  {-| This type is a `Doc` enriched with a `same` flag to efficiently track if@@ -174,20 +172,21 @@ diffLabel :: Text -> Text -> Diff diffLabel = diffPrimitive (token . Internal.prettyLabel) -diffLabels :: Set Text -> Set Text -> Diff+diffLabels :: [Text] -> [Text] -> Diff diffLabels ksL ksR =     braced (diffFieldNames <> (if anyEqual then [ ignore ] else []))   where-    extraL = Dhall.Set.difference ksL ksR-    extraR = Dhall.Set.difference ksR ksL+    setL = Data.Set.fromList ksL+    setR = Data.Set.fromList ksR +    extraL = Data.Set.difference setL setR+    extraR = Data.Set.difference setR setL+     diffFieldNames = foldMap (adapt minus) extraL <> foldMap (adapt plus) extraR       where         adapt sign key = [ sign (token (Internal.prettyLabel key)) ] -    anyEqual = not (Data.Set.null (Data.Set.intersection-                                   (Dhall.Set.toSet ksL)-                                   (Dhall.Set.toSet ksR)))+    anyEqual = not (Data.Set.null (Data.Set.intersection setL setR))  diffNatural :: Natural -> Natural -> Diff diffNatural = diffPrimitive (token . Internal.prettyNatural)

@@ -50,6 +50,7 @@   , textShow   ) where +import Data.Bifunctor     (first) import Data.Foldable      (foldr', toList) import Data.List.NonEmpty (NonEmpty(..)) import Data.Sequence      (Seq, ViewL (..), ViewR (..))@@ -363,16 +364,15 @@     singletonVRecordLit v = VRecordLit (Map.singleton k v) {-# INLINE vField #-} -vTextReplaceSlow :: Text -> Val a -> VChunks a -> VChunks a-vTextReplaceSlow needle replacement haystack = go haystack+vTextReplace :: Text -> Val a -> Text -> VChunks a+vTextReplace needle replacement haystack = go haystack   where-    go (VChunks [] lastText) =-        if Text.null suffix-        then VChunks [] lastText-        else+    go t+        | Text.null suffix = VChunks [] t+        | otherwise =             let remainder = Text.drop (Text.length needle) suffix -                rest = go (VChunks [] remainder)+                rest = go remainder              in  case replacement of                     VTextLit replacementChunks ->@@ -380,36 +380,7 @@                     _ ->                         VChunks [(prefix, replacement)] "" <> rest       where-        (prefix, suffix) = Text.breakOn needle lastText-    go (VChunks ((firstText, firstInterpolation) : chunks) lastText) =-       if Text.null suffix-       then-           let rest = go (VChunks chunks lastText)--           in  VChunks [(firstText, firstInterpolation)] "" <> rest-       else-           let remainder = Text.drop (Text.length needle) suffix--               rest =-                   go (VChunks ((remainder, firstInterpolation) : chunks) lastText)--           in  case replacement of-                   VTextLit replacementChunks ->-                       VChunks [] prefix <> replacementChunks <> rest-                   _ ->-                       VChunks [(prefix, replacement)] "" <> rest-      where-        (prefix, suffix) = Text.breakOn needle firstText--vTextReplaceFast :: Text -> Text -> VChunks a -> VChunks a-vTextReplaceFast needle replacement (VChunks xys z) = VChunks xys' z'-  where-    xys' = do-       (x, y) <- xys--       return (Text.replace needle replacement x, y)--    z' = Text.replace needle replacement z+        (prefix, suffix) = Text.breakOn needle t  vProjectByFields :: Eq a => Environment a -> Val a -> Set Text -> Val a vProjectByFields env t ks =@@ -633,26 +604,26 @@             VPrim $ \needle ->             VPrim $ \replacement ->             VPrim $ \haystack ->-                case haystack of-                    VTextLit haystackChunks ->-                        case needle of-                            VTextLit (VChunks [] "") ->-                                haystack-                            VTextLit (VChunks [] needleText) ->+                case needle of+                    VTextLit (VChunks [] "") ->+                        haystack+                    VTextLit (VChunks [] needleText) ->+                        case haystack of+                            VTextLit (VChunks [] haystackText) ->                                 case replacement of                                     VTextLit (VChunks [] replacementText) ->-                                        VTextLit-                                            (vTextReplaceFast+                                        VTextLit $ VChunks []+                                            (Text.replace                                                 needleText                                                 replacementText-                                                haystackChunks+                                                haystackText                                             )                                     _ ->                                         VTextLit-                                            (vTextReplaceSlow+                                            (vTextReplace                                                 needleText                                                 replacement-                                                haystackChunks+                                                haystackText                                             )                             _ ->                                 VTextReplace needle replacement haystack@@ -806,11 +777,11 @@         Field t (Syntax.fieldSelectionLabel -> k) ->             vField (eval env t) k         Project t (Left ks) ->-            vProjectByFields env (eval env t) (Dhall.Set.sort ks)+            vProjectByFields env (eval env t) (Dhall.Set.sort (Dhall.Set.fromList ks))         Project t (Right e) ->             case eval env e of                 VRecord kts ->-                    eval env (Project t (Left (Dhall.Set.fromSet (Map.keysSet kts))))+                    vProjectByFields env (eval env t) (Dhall.Set.fromSet (Map.keysSet kts))                 e' ->                     VProject (eval env t) (Right e')         Assert t ->@@ -1209,7 +1180,7 @@         VField t k ->             Field (quote env t) $ Syntax.makeFieldSelection k         VProject t p ->-            Project (quote env t) (fmap (quote env) p)+            Project (quote env t) (first Dhall.Set.toList (fmap (quote env) p))         VAssert t ->             Assert (quote env t)         VEquivalent t u ->

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                 #-} {-# LANGUAGE DeriveAnyClass      #-} {-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE NamedFieldPuns      #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RankNTypes          #-}@@ -111,10 +112,10 @@     , hashExpression     , hashExpressionToCode     , writeExpressionToSemanticCache-    , warnAboutMissingCaches     , assertNoImports     , Manager     , defaultNewManager+    , CacheWarning(..)     , Status(..)     , SemanticCacheMode(..)     , Chained@@ -154,12 +155,10 @@     , SomeException     , toException     )-import Control.Monad                    (when) import Control.Monad.Catch              (MonadCatch (catch), handle, throwM) import Control.Monad.IO.Class           (MonadIO (..)) import Control.Monad.Morph              (hoist)-import Control.Monad.Trans.Class        (lift)-import Control.Monad.Trans.State.Strict (StateT)+import Control.Monad.State.Strict       (MonadState, StateT) import Data.ByteString                  (ByteString) import Data.CaseInsensitive             (CI) import Data.List.NonEmpty               (NonEmpty (..))@@ -202,8 +201,8 @@ import qualified Codec.CBOR.Encoding                         as Encoding import qualified Codec.CBOR.Write                            as Write import qualified Codec.Serialise+import qualified Control.Monad.State.Strict                  as State import qualified Control.Monad.Trans.Maybe                   as Maybe-import qualified Control.Monad.Trans.State.Strict            as State import qualified Data.ByteString import qualified Data.ByteString.Lazy import qualified Data.CaseInsensitive@@ -536,8 +535,10 @@     Status { .. } <- State.get     mCached <-         case _semanticCacheMode of-            UseSemanticCache -> liftIO $ fetchFromSemanticCache semanticHash-            IgnoreSemanticCache -> pure Nothing+            UseSemanticCache ->+                zoom cacheWarning (fetchFromSemanticCache semanticHash)+            IgnoreSemanticCache ->+                pure Nothing      case mCached of         Just bytesStrict -> do@@ -568,7 +569,7 @@             let variants = map (\version -> encodeExpression version (Core.alphaNormalize importSemantics))                                 [ minBound .. maxBound ]             case Data.Foldable.find ((== semanticHash). Dhall.Crypto.sha256Hash) variants of-                Just bytes -> liftIO $ writeToSemanticCache semanticHash bytes+                Just bytes -> zoom cacheWarning (writeToSemanticCache semanticHash bytes)                 Nothing -> do                     let expectedHash = semanticHash                     Status { _stack } <- State.get@@ -580,7 +581,10 @@   -- Fetch encoded normal form from "semantic cache"-fetchFromSemanticCache :: Dhall.Crypto.SHA256Digest -> IO (Maybe Data.ByteString.ByteString)+fetchFromSemanticCache+    :: (MonadState CacheWarning m, MonadCatch m, MonadIO m)+    => Dhall.Crypto.SHA256Digest+    -> m (Maybe Data.ByteString.ByteString) fetchFromSemanticCache expectedHash = Maybe.runMaybeT $ do     cacheFile <- getCacheFile "dhall" expectedHash     True <- liftIO (Directory.doesFileExist cacheFile)@@ -589,12 +593,19 @@ -- | Ensure that the given expression is present in the semantic cache. The --   given expression should be alpha-beta-normal. writeExpressionToSemanticCache :: Expr Void Void -> IO ()-writeExpressionToSemanticCache expression = writeToSemanticCache hash bytes+writeExpressionToSemanticCache expression =+    -- Defaulting to not displaying the warning is for backwards compatibility+    -- with the old behavior+    State.evalStateT (writeToSemanticCache hash bytes) CacheWarned   where     bytes = encodeExpression NoVersion expression     hash = Dhall.Crypto.sha256Hash bytes -writeToSemanticCache :: Dhall.Crypto.SHA256Digest -> Data.ByteString.ByteString -> IO ()+writeToSemanticCache+    :: (MonadState CacheWarning m, MonadCatch m, MonadIO m)+    => Dhall.Crypto.SHA256Digest+    -> Data.ByteString.ByteString+    -> m () writeToSemanticCache hash bytes = do     _ <- Maybe.runMaybeT $ do         cacheFile <- getCacheFile "dhall" hash@@ -637,8 +648,9 @@     -- https://github.com/dhall-lang/dhall-haskell/issues/1098 for the reasoning     -- behind semi-semantic caching.     let semisemanticHash = computeSemisemanticHash (Core.denote resolvedExpr)-    mCached <- lift $ fetchFromSemisemanticCache semisemanticHash +    mCached <- zoom cacheWarning (fetchFromSemisemanticCache semisemanticHash)+     importSemantics <- case mCached of         Just bytesStrict -> do             let bytesLazy = Data.ByteString.Lazy.fromStrict bytesStrict@@ -670,7 +682,7 @@                      let bytes = encodeExpression NoVersion betaNormal -                    lift (writeToSemisemanticCache semisemanticHash bytes)+                    zoom cacheWarning (writeToSemisemanticCache semisemanticHash bytes)                      return betaNormal @@ -718,13 +730,20 @@ computeSemisemanticHash resolvedExpr = hashExpression resolvedExpr  -- Fetch encoded normal form from "semi-semantic cache"-fetchFromSemisemanticCache :: Dhall.Crypto.SHA256Digest -> IO (Maybe Data.ByteString.ByteString)+fetchFromSemisemanticCache+    :: (MonadState CacheWarning m, MonadCatch m, MonadIO m)+    => Dhall.Crypto.SHA256Digest+    -> m (Maybe Data.ByteString.ByteString) fetchFromSemisemanticCache semisemanticHash = Maybe.runMaybeT $ do     cacheFile <- getCacheFile "dhall-haskell" semisemanticHash     True <- liftIO (Directory.doesFileExist cacheFile)     liftIO (Data.ByteString.readFile cacheFile) -writeToSemisemanticCache :: Dhall.Crypto.SHA256Digest -> Data.ByteString.ByteString -> IO ()+writeToSemisemanticCache+    :: (MonadState CacheWarning m, MonadCatch m, MonadIO m)+    => Dhall.Crypto.SHA256Digest+    -> Data.ByteString.ByteString+    -> m () writeToSemisemanticCache semisemanticHash bytes = do     _ <- Maybe.runMaybeT $ do         cacheFile <- getCacheFile "dhall-haskell" semisemanticHash@@ -799,24 +818,28 @@     empty  getCacheFile-    :: (MonadCatch m, Alternative m, MonadIO m) => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath+    :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m)+    => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath getCacheFile cacheName hash = do-    cacheDirectory <- getOrCreateCacheDirectory False cacheName+    cacheDirectory <- getOrCreateCacheDirectory cacheName      let cacheFile = cacheDirectory </> ("1220" <> show hash)      return cacheFile --- | Warn if no cache directory is available-warnAboutMissingCaches :: (MonadCatch m, Alternative m, MonadIO m) => m ()-warnAboutMissingCaches = warn <|> return ()-    where warn = Data.Foldable.traverse_ (getOrCreateCacheDirectory True) ["dhall", "dhall-haskell"]--getOrCreateCacheDirectory :: (MonadCatch m, Alternative m, MonadIO m) => Bool -> FilePath -> m FilePath-getOrCreateCacheDirectory showWarning cacheName = do+getOrCreateCacheDirectory+    :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m)+    => FilePath -> m FilePath+getOrCreateCacheDirectory cacheName = do     let warn message = do-            when showWarning (printWarning message)+            cacheWarningStatus <- State.get +            case cacheWarningStatus of+                CacheWarned    -> printWarning message+                CacheNotWarned -> return ()++            State.put CacheWarned+             empty      let handler action dir (ioex :: IOException) = do@@ -857,14 +880,19 @@                 then                     return ()                 else do+                    let render f = if f permissions then "✓" else "✗"                     let message =                              "The directory:\n"                           <> "\n"                           <> "↳ " <> dir <> "\n"                           <> "\n"                           <> "... does not give you permission to read, write, or search files.\n\n"+                          <> "\n"                           <> "The directory's current permissions are:\n"-                          <> show permissions <> "\n"+                          <> "\n"+                          <> "• " <> render Directory.readable <> " readable\n"+                          <> "• " <> render Directory.writable <> " writable\n"+                          <> "• " <> render Directory.searchable <> " searchable\n"                      warn message @@ -908,7 +936,7 @@                              setPermissions dir -    cacheBaseDirectory <- getCacheBaseDirectory showWarning+    cacheBaseDirectory <- getCacheBaseDirectory      let directory = cacheBaseDirectory </> cacheName @@ -926,8 +954,9 @@      return directory -getCacheBaseDirectory :: (Alternative m, MonadIO m) => Bool -> m FilePath-getCacheBaseDirectory showWarning = alternative₀ <|> alternative₁ <|> alternative₂+getCacheBaseDirectory+    :: (MonadState CacheWarning m, Alternative m, MonadIO m) => m FilePath+getCacheBaseDirectory = alternative₀ <|> alternative₁ <|> alternative₂   where     alternative₀ = do         maybeXDGCacheHome <-@@ -957,6 +986,8 @@         where isWindows = System.Info.os == "mingw32"      alternative₂ = do+        cacheWarningStatus <- State.get+         let message =                 "\n"              <> "\ESC[1;33mWarning\ESC[0m: "@@ -965,7 +996,13 @@              <> "You can provide a cache base directory by pointing the $XDG_CACHE_HOME\n"              <> "environment variable to a directory with read and write permissions.\n" -        when showWarning (liftIO (System.IO.hPutStrLn System.IO.stderr message))+        case cacheWarningStatus of+            CacheNotWarned ->+                liftIO (System.IO.hPutStrLn System.IO.stderr message)+            CacheWarned ->+                return ()++        State.put CacheWarned          empty 

@@ -84,6 +84,10 @@   pure () #endif +{-| Used internally to track whether or not we've already warned the user about+    caching issues+-}+data CacheWarning = CacheNotWarned | CacheWarned  -- | State threaded throughout the import process data Status = Status@@ -114,6 +118,10 @@     , _startingContext :: Context (Expr Src Void)      , _semanticCacheMode :: SemanticCacheMode++    , _cacheWarning :: CacheWarning+    -- ^ Records whether or not we already warned the user about issues with+    --   cache directory     }  -- | Initial `Status`, parameterised over the HTTP 'Manager' and the remote resolver,@@ -137,6 +145,8 @@      _semanticCacheMode = UseSemanticCache +    _cacheWarning = CacheNotWarned+     prefix = if isRelative rootDirectory       then Here       else Absolute@@ -173,8 +183,7 @@  -- | Lens from a `Status` to its `_substitutions` field substitutions :: Functor f => LensLike' f Status (Dhall.Substitution.Substitutions Src Void)-substitutions k s =-    fmap (\x -> s { _substitutions = x }) (k (_substitutions s))+substitutions k s = fmap (\x -> s { _substitutions = x }) (k (_substitutions s))  -- | Lens from a `Status` to its `_normalizer` field normalizer :: Functor f => LensLike' f Status (Maybe (ReifiedNormalizer Void))@@ -184,6 +193,10 @@ startingContext :: Functor f => LensLike' f Status (Context (Expr Src Void)) startingContext k s =     fmap (\x -> s { _startingContext = x }) (k (_startingContext s))++-- | Lens from a `Status` to its `_cacheWarning` field+cacheWarning :: Functor f => LensLike' f Status CacheWarning+cacheWarning k s = fmap (\x -> s { _cacheWarning = x }) (k (_cacheWarning s))  {-| This exception indicates that there was an internal error in Dhall's     import-related logic

@@ -23,7 +23,6 @@  import Control.Applicative       (optional, (<|>)) import Control.Exception         (Handler (..), SomeException)-import Control.Monad             (when) import Data.Foldable             (for_) import Data.List.NonEmpty        (NonEmpty (..)) import Data.Text                 (Text)@@ -120,12 +119,6 @@     , censor  :: Censor     } -ignoreSemanticCache :: Mode -> Bool-ignoreSemanticCache Default {..} = semanticCacheMode == IgnoreSemanticCache-ignoreSemanticCache Resolve {..} = semanticCacheMode == IgnoreSemanticCache-ignoreSemanticCache Type {..}    = semanticCacheMode == IgnoreSemanticCache-ignoreSemanticCache _            = False- -- | The subcommands for the @dhall@ executable data Mode     = Default@@ -151,7 +144,7 @@     | Repl     | Format { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode }     | Freeze { possiblyTransitiveInput :: PossiblyTransitiveInput, all_ :: Bool, cache :: Bool, outputMode :: OutputMode }-    | Hash { file :: Input }+    | Hash { file :: Input, cache :: Bool }     | Diff { expr1 :: Text, expr2 :: Text }     | Lint { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode }     | Tags@@ -300,7 +293,7 @@             Miscellaneous             "hash"             "Compute semantic hashes for Dhall expressions"-            (Hash <$> parseFile)+            (Hash <$> parseFile <*> parseCache)     <|> subcommand             Miscellaneous             "tags"@@ -524,6 +517,12 @@             <>  Options.Applicative.help "Print `Note` constructors"             ) +    parseCache =+        Options.Applicative.switch+            (   Options.Applicative.long "cache"+            <>  Options.Applicative.help "Cache the hashed expression"+            )+ -- | `ParserInfo` for the `Options` type parserInfoOptions :: ParserInfo Options parserInfoOptions =@@ -625,8 +624,6 @@              AtomicWrite.LazyText.atomicWriteFile file (Pretty.Text.renderLazy stream) -    when (not $ ignoreSemanticCache mode) Dhall.Import.warnAboutMissingCaches-     handle $ case mode of         Version ->             putStrLn dhallVersionString@@ -789,6 +786,10 @@              let normalizedExpression =                     Dhall.Core.alphaNormalize (Dhall.Core.normalize resolvedExpression)++            if cache+                then Dhall.Import.writeExpressionToSemanticCache normalizedExpression+                else return ()              Data.Text.IO.putStrLn (Dhall.Import.hashExpressionToCode normalizedExpression) 

@@ -46,7 +46,6 @@ import qualified Data.Text     as Text import qualified Dhall.Eval    as Eval import qualified Dhall.Map-import qualified Dhall.Set import qualified Dhall.Syntax  as Syntax import qualified Lens.Family   as Lens @@ -642,7 +641,7 @@             _ -> pure (Field r' k)     Project x (Left fields)-> do         x' <- loop x-        let fieldsSet = Dhall.Set.toSet fields+        let fieldsSet = Data.Set.fromList fields         case x' of             RecordLit kvs ->                 pure (RecordLit (Dhall.Map.restrictKeys kvs fieldsSet))@@ -650,17 +649,17 @@                 loop (Project y (Left fields))             Prefer _ l (RecordLit rKvs) -> do                 let rKs = Dhall.Map.keysSet rKvs-                let l' = Project l (Left (Dhall.Set.fromSet (Data.Set.difference fieldsSet rKs)))+                let l' = Project l (Left (Data.Set.toList (Data.Set.difference fieldsSet rKs)))                 let r' = RecordLit (Dhall.Map.restrictKeys rKvs fieldsSet)                 loop (Prefer PreferFromSource l' r')             _ | null fields -> pure (RecordLit mempty)-              | otherwise   -> pure (Project x' (Left (Dhall.Set.sort fields)))+              | otherwise   -> pure (Project x' (Left (Data.Set.toList (Data.Set.fromList fields))))     Project r (Right e1) -> do         e2 <- loop e1          case e2 of             Record kts ->-                loop (Project r (Left (Dhall.Set.fromSet (Dhall.Map.keysSet kts))))+                loop (Project r (Left (Data.Set.toList (Dhall.Map.keysSet kts))))             _ -> do                 r' <- loop r                 pure (Project r' (Right e2))@@ -912,7 +911,7 @@                   RecordLit _ -> False                   Project _ _ -> False                   Prefer _ _ (RecordLit _) -> False-                  _ -> not (Dhall.Set.null s) && Dhall.Set.isSorted s+                  _ -> not (null s) && Data.Set.toList (Data.Set.fromList s) == s               Right e' -> case e' of                   Record _ -> False                   _ -> loop e'

@@ -17,7 +17,6 @@     , satisfy     , Dhall.Parser.Combinators.takeWhile     , takeWhile1-    , noDuplicates     , toMap     , toMapWith     ) where@@ -31,19 +30,16 @@ import Data.Text.Prettyprint.Doc (Pretty (..)) import Data.Void                 (Void) import Dhall.Map                 (Map)-import Dhall.Set                 (Set) import Dhall.Src                 (Src (..)) import Text.Parser.Combinators   (try, (<?>)) import Text.Parser.Token         (TokenParsing (..))  import qualified Control.Monad.Fail import qualified Data.Char-import qualified Data.Set import qualified Data.Text import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty import qualified Dhall.Map import qualified Dhall.Pretty-import qualified Dhall.Set import qualified Text.Megaparsec import qualified Text.Megaparsec.Char import qualified Text.Parser.Char@@ -263,16 +259,6 @@ --   that match the given predicate. It fails when no character was consumed takeWhile1 :: (Char -> Bool) -> Parser Text takeWhile1 predicate = Parser (Text.Megaparsec.takeWhile1P Nothing predicate)---- | Construct a 'Set a' from a '[a]', failing if there was a duplicate element-noDuplicates :: Ord a => [a] -> Parser (Set a)-noDuplicates = go Dhall.Set.empty-  where-    go found    []  = return found-    go found (x:xs) =-        if Data.Set.member x (Dhall.Set.toSet found)-        then fail "Duplicate key"-        else go (Dhall.Set.append x found) xs  -- | Creates a map with the given key-value pairs, failing if there was a --   duplicate key.

@@ -437,29 +437,36 @@     selectorExpression = noted (do             a <- primitiveExpression -            let recordType = whitespace *> _openParens *> whitespace *> expression <* whitespace <* _closeParens+            let recordType = _openParens *> whitespace *> expression <* whitespace <* _closeParens              let field               x  e = Field   e  x             let projectBySet        xs e = Project e (Left  xs)             let projectByExpression xs e = Project e (Right xs) -            let fieldSelection = do+            let alternatives = do                     src0 <- src whitespace-                    l <- anyLabel-                    pos <- Text.Megaparsec.getSourcePos -                    -- FIXME: Suffix whitespace can't be parsed given our limitation-                    -- about whitespace treatment, but for @dhall-docs@ this-                    -- is enough-                    let src1 = Src pos pos ""-                    return (FieldSelection (Just src0) l (Just src1))+                    let fieldSelection = do+                            l <- anyLabel -            let alternatives =-                        fmap field               fieldSelection-                    <|> fmap projectBySet        (whitespace *> labels)-                    <|> fmap projectByExpression recordType+                            pos <- Text.Megaparsec.getSourcePos +                            -- FIXME: Suffix whitespace can't be parsed given our limitation+                            -- about whitespace treatment, but for @dhall-docs@ this+                            -- is enough+                            let src1 = Src pos pos ""++                            return (FieldSelection (Just src0) l (Just src1))++                    let result =+                                fmap field               fieldSelection+                            <|> fmap projectBySet        labels+                            <|> fmap projectByExpression recordType++                    result+             b <- Text.Megaparsec.many (try (whitespace *> _dot *> alternatives))+             return (foldl' (\e k -> k e) a b) )      primitiveExpression =

@@ -116,7 +116,6 @@ import Data.Bits               ((.&.)) import Data.Functor            (void, ($>)) import Data.Text               (Text)-import Dhall.Set               (Set) import Dhall.Syntax import Text.Parser.Combinators (choice, try, (<?>)) @@ -128,7 +127,6 @@ import qualified Data.List.NonEmpty import qualified Data.Scientific            as Scientific import qualified Data.Text-import qualified Dhall.Set import qualified Text.Megaparsec import qualified Text.Megaparsec.Char.Lexer import qualified Text.Parser.Char@@ -443,22 +441,18 @@      This corresponds to the @labels@ rule in the official grammar -}-labels :: Parser (Set Text)+labels :: Parser [Text] labels = do     _openBrace      whitespace -    xs <- nonEmptyLabels <|> emptyLabels--    _ <- optional (_comma *> whitespace)--    return xs+    nonEmptyLabels <|> emptyLabels   where     emptyLabels = do         try (optional (_comma *> whitespace) *> _closeBrace) -        pure Dhall.Set.empty+        pure []      nonEmptyLabels = do         x  <- try (optional (_comma *> whitespace) *> anyLabelOrSome)@@ -471,7 +465,7 @@          _closeBrace -        noDuplicates (x : xs)+        return (x : xs)  {-| Parse a label (e.g. a variable\/field\/alternative name) 

@@ -70,7 +70,6 @@ import Data.Text                 (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty, space) import Dhall.Map                 (Map)-import Dhall.Set                 (Set) import Dhall.Src                 (Src (..)) import Dhall.Syntax import Numeric.Natural           (Natural)@@ -80,14 +79,12 @@ import qualified Data.List import qualified Data.List.NonEmpty                        as NonEmpty import qualified Data.Maybe-import qualified Data.Set import qualified Data.Text                                 as Text import qualified Data.Text.Prettyprint.Doc                 as Pretty import qualified Data.Text.Prettyprint.Doc.Render.String   as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal import qualified Data.Text.Prettyprint.Doc.Render.Text     as Pretty import qualified Dhall.Map                                 as Map-import qualified Dhall.Set  {-| Annotation type used to tag elements in a pretty-printed document for     syntax highlighting purposes@@ -509,12 +506,10 @@           , renderSrcMaybe mSrc1           ] -prettyLabels :: Set Text -> Doc Ann+prettyLabels :: [Text] -> Doc Ann prettyLabels a-    | Data.Set.null (Dhall.Set.toSet a) =-        lbrace <> rbrace-    | otherwise =-        braces (map (duplicate . prettyAnyLabel) (Dhall.Set.toList a))+    | null a    = lbrace <> rbrace+    | otherwise = braces (map (duplicate . prettyAnyLabel) a)  prettyNumber :: Integer -> Doc Ann prettyNumber = literal . Pretty.pretty@@ -697,7 +692,12 @@       where         MultiLet as b = multiLet a0 b0 -        stripSpaces = Text.dropAround (\c -> c == ' ' || c == '\t')+        isSpace c = c == ' ' || c == '\t'+        stripSpaces =+            Text.dropAround isSpace+          . Text.intercalate "\n"+          . map (Text.dropWhileEnd isSpace)+          . Text.splitOn "\n"          -- Strip a single newline character. Needed to ensure idempotency in         -- cases where we add hard line breaks.@@ -1497,7 +1497,7 @@          prettyMultilineText text = mconcat docs           where-            lines_ = Text.splitOn "\n" (escapeSingleQuotedText text)+            lines_ = Text.splitOn "\n" text              -- Annotate only non-empty lines so trailing whitespace can be             -- removed on empty ones.@@ -1526,8 +1526,10 @@ -- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t" multilineChunks :: Chunks s a -> Chunks s a multilineChunks =-     escapeTrailingSingleQuote+     escapeSingleQuotedText+   . escapeTrailingSingleQuote    . escapeControlCharacters+   . escapeSingleQuoteBeforeInterpolation    . escapeSharedWhitespacePrefix  -- | Escape any leading whitespace shared by all lines@@ -1574,38 +1576,68 @@ -- >>> escapeControlCharacters (Chunks [] "\n\NUL\b\f\t") -- Chunks [("\n",TextLit (Chunks [] "\NUL\b\f"))] "\t" escapeControlCharacters :: Chunks s a -> Chunks s a-escapeControlCharacters (Chunks as0 b0) = Chunks as1 b1+escapeControlCharacters = splitWith (splitOnPredicate predicate)   where-    as1 = foldr f (map toChunk bs) as0+    predicate c = Data.Char.isControl c && c /= ' ' && c /= '\t' && c /= '\n' -    (bs, b1) = splitOnPredicate predicate b0+-- | Escape @'${@ correctly+--+-- See: https://github.com/dhall-lang/dhall-haskell/issues/2078+escapeSingleQuoteBeforeInterpolation :: Chunks s a -> Chunks s a+escapeSingleQuoteBeforeInterpolation = splitWith f+  where+    f text =+        case Text.splitOn "'${" text of+            -- `splitOn` should never return an empty list, but just in case…+            []     -> mempty+            t : ts -> loop t ts -    f (t0, e) chunks = map toChunk ts1 ++ (t1, e) : chunks-      where-        (ts1, t1) = splitOnPredicate predicate t0+    loop head_ tail_ =+        case tail_ of+            [] ->+                Chunks [] head_+            newHead : newTail ->+                    Chunks [ (head_, TextLit (Chunks [] "'")) ] "${"+                <>  loop newHead newTail -    predicate c = Data.Char.isControl c && c /= ' ' && c /= '\t' && c /= '\n'+{-| You can think of this as sort of like `concatMap` for `Chunks` -    toChunk (t0, t1) = (t0, TextLit (Chunks [] t1))+    Given a function that splits plain text into interpolated chunks, apply+    that function to each uninterpolated span to yield a new+    possibly-interpolated span, and flatten the results.+-}+splitWith :: (Text -> Chunks s a) -> Chunks s a -> Chunks s a+splitWith splitter (Chunks xys z) = mconcat (xys' ++ [ splitter z ])+  where+    xys' = do+        (x, y) <- xys --- | Split `Data.Text.Text` on a predicate, preserving all parts of the original--- string.+        [ splitter x, Chunks [ ("", y) ] "" ]++-- | Split `Data.Text.Text` into interpolated chunks, where all characters+-- matching the predicate are pushed into a string interpolation. -- -- >>> splitOnPredicate (== 'x') ""--- ([],"")+-- Chunks [] "" -- >>> splitOnPredicate (== 'x') " xx "--- ([(" ","xx")]," ")+-- Chunks [(" ",TextLit (Chunks [] "xx"))] " " -- >>> splitOnPredicate (== 'x') "xx"--- ([("","xx")],"")+-- Chunks [("",TextLit (Chunks [] "xx"))] "" ----- prop> \(Fun _ p) s -> let {t = Text.pack s; (as, b) = splitOnPredicate p t} in foldMap (uncurry (<>)) as <> b == t-splitOnPredicate :: (Char -> Bool) -> Text -> ([(Text, Text)], Text)-splitOnPredicate p t = case Text.break p t of-    (a, "") -> ([], a)-    (a, b)  -> case Text.span p b of-        (c, d) -> case splitOnPredicate p d of-            (e, f) -> ((a, c) : e, f)+-- prop> \(Fun _ p) s -> let {t = Text.pack s; Chunks xys z = splitOnPredicate p t} in foldMap (\(x, TextLit (Chunks [] y)) -> x <> y) xys <> z == t+splitOnPredicate :: (Char -> Bool) -> Text -> Chunks s a+splitOnPredicate predicate text+    | Text.null b =+        Chunks [] a+    | otherwise =+        Chunks ((a, TextLit (Chunks [] c)) : e) f+  where+    (a, b) = Text.break predicate text +    (c, d) = Text.span predicate b++    Chunks e f = splitOnPredicate predicate d+ -- | Escape a trailing single quote by moving it into a string interpolation -- -- Otherwise the multiline-string would end with @'''@, which would be parsed@@ -1656,12 +1688,13 @@  -- | Escape a `Data.Text.Text` literal using Dhall's escaping rules for --   single-quoted @Text@-escapeSingleQuotedText :: Text -> Text-escapeSingleQuotedText inputText = outputText+escapeSingleQuotedText :: Chunks s a -> Chunks s a+escapeSingleQuotedText = splitWith f   where-    outputText = substitute "${" "''${" (substitute "''" "'''" inputText)--    substitute before after = Text.intercalate after . Text.splitOn before+    f inputText = Chunks [] outputText+      where+        outputText =+            Text.replace "${" "''${" (Text.replace "''" "'''" inputText)  {-| Escape a `Data.Text.Text` literal using Dhall's escaping rules 

@@ -100,7 +100,6 @@ import Data.Void                  (Void) import Dhall.Map                  (Map) import {-# SOURCE #-} Dhall.Pretty.Internal-import Dhall.Set                  (Set) import Dhall.Src                  (Src (..)) import GHC.Generics               (Generic) import Instances.TH.Lift          ()@@ -187,21 +186,20 @@ instance Pretty Var where     pretty = Pretty.unAnnotate . prettyVar -{- | Record the binding part of a @let@ expression.--For example,--> let {- A -} x {- B -} : {- C -} Bool = {- D -} True in x--will be instantiated as follows:--* @bindingSrc0@ corresponds to the @A@ comment.-* @variable@ is @"x"@-* @bindingSrc1@ corresponds to the @B@ comment.-* @annotation@ is 'Just' a pair, corresponding to the @C@ comment and @Bool@.-* @bindingSrc2@ corresponds to the @D@ comment.-* @value@ corresponds to @True@.--}+-- | Record the binding part of a @let@ expression.+--+-- For example,+--+-- > let {- A -} x {- B -} : {- C -} Bool = {- D -} True in x+--+-- … will be instantiated as follows:+--+-- * @bindingSrc0@ corresponds to the @A@ comment.+-- * @variable@ is @"x"@+-- * @bindingSrc1@ corresponds to the @B@ comment.+-- * @annotation@ is 'Just' a pair, corresponding to the @C@ comment and @Bool@.+-- * @bindingSrc2@ corresponds to the @D@ comment.+-- * @value@ corresponds to @True@. data Binding s a = Binding     { bindingSrc0 :: Maybe s     , variable    :: Text@@ -288,62 +286,62 @@      second = fmap -{-| Record the field of a record-type and record-literal expression.-    The reason why we use the same ADT for both of them is because they store-    the same information.--For example,--> { {- A -} x {- B -} : {- C -} T }--... or--> { {- A -} x {- B -} = {- C -} T }--will be instantiated as follows:--* @recordFieldSrc0@ corresponds to the @A@ comment.-* @recordFieldValue@ is @"T"@-* @recordFieldSrc1@ corresponds to the @B@ comment.-* @recordFieldSrc2@ corresponds to the @C@ comment.--Although the @A@ comment isn't annotating the @"T"@ Record Field,-this is the best place to keep these comments.--Note that @recordFieldSrc2@ is always 'Nothing' when the 'RecordField' is for-a punned entry, because there is no @=@ sign. For example,--> { {- A -} x {- B -} }--will be instantiated as follows:--* @recordFieldSrc0@ corresponds to the @A@ comment.-* @recordFieldValue@ corresponds to @(Var "x")@-* @recordFieldSrc1@ corresponds to the @B@ comment.-* @recordFieldSrc2@ will be 'Nothing'--The labels involved in a record using dot-syntax like in this example:--> { {- A -} a {- B -} . {- C -} b {- D -} . {- E -} c {- F -} = {- G -} e }--will be instantiated as follows:--* For both the @a@ and @b@ field, @recordfieldSrc2@ is 'Nothing'-* For the @a@ field:-  * @recordFieldSrc0@ corresponds to the @A@ comment-  * @recordFieldSrc1@ corresponds to the @B@ comment-* For the @b@ field:-  * @recordFieldSrc0@ corresponds to the @C@ comment-  * @recordFieldSrc1@ corresponds to the @D@ comment-* For the @c@ field:-  * @recordFieldSrc0@ corresponds to the @E@ comment-  * @recordFieldSrc1@ corresponds to the @F@ comment-  * @recordFieldSrc2@ corresponds to the @G@ comment--That is, for every label except the last one the semantics of @recordFieldSrc0@-and @recordFieldSrc1@ are the same from a regular record label but-@recordFieldSrc2@ is always 'Nothing'. For the last keyword, all srcs are 'Just'--}+-- | Record the field of a record-type and record-literal expression.+-- The reason why we use the same ADT for both of them is because they store+-- the same information.+--+-- For example,+--+-- > { {- A -} x {- B -} : {- C -} T }+--+-- ... or+--+-- > { {- A -} x {- B -} = {- C -} T }+--+-- will be instantiated as follows:+--+-- * @recordFieldSrc0@ corresponds to the @A@ comment.+-- * @recordFieldValue@ is @"T"@+-- * @recordFieldSrc1@ corresponds to the @B@ comment.+-- * @recordFieldSrc2@ corresponds to the @C@ comment.+--+-- Although the @A@ comment isn't annotating the @"T"@ Record Field,+-- this is the best place to keep these comments.+--+-- Note that @recordFieldSrc2@ is always 'Nothing' when the 'RecordField' is for+-- a punned entry, because there is no @=@ sign. For example,+--+-- > { {- A -} x {- B -} }+--+-- will be instantiated as follows:+--+-- * @recordFieldSrc0@ corresponds to the @A@ comment.+-- * @recordFieldValue@ corresponds to @(Var "x")@+-- * @recordFieldSrc1@ corresponds to the @B@ comment.+-- * @recordFieldSrc2@ will be 'Nothing'+--+-- The labels involved in a record using dot-syntax like in this example:+--+-- > { {- A -} a {- B -} . {- C -} b {- D -} . {- E -} c {- F -} = {- G -} e }+--+-- will be instantiated as follows:+--+-- * For both the @a@ and @b@ field, @recordfieldSrc2@ is 'Nothing'+-- * For the @a@ field:+--   * @recordFieldSrc0@ corresponds to the @A@ comment+--   * @recordFieldSrc1@ corresponds to the @B@ comment+-- * For the @b@ field:+--   * @recordFieldSrc0@ corresponds to the @C@ comment+--   * @recordFieldSrc1@ corresponds to the @D@ comment+-- * For the @c@ field:+--   * @recordFieldSrc0@ corresponds to the @E@ comment+--   * @recordFieldSrc1@ corresponds to the @F@ comment+--   * @recordFieldSrc2@ corresponds to the @G@ comment+--+-- That is, for every label except the last one the semantics of+-- @recordFieldSrc0@ and @recordFieldSrc1@ are the same from a regular record+-- label but @recordFieldSrc2@ is always 'Nothing'. For the last keyword, all+-- srcs are 'Just' data RecordField s a = RecordField     { recordFieldSrc0  :: Maybe s     , recordFieldValue :: Expr s a@@ -392,22 +390,23 @@      second = fmap -{-| Record the field on a selector-expression--For example,--> e . {- A -} x {- B -}--will be instantiated as follows:-* @fieldSelectionSrc0@ corresponds to the @A@ comment-* @fieldSelectionLabel@ corresponds to @x@-* @fieldSelectionSrc1@ corresponds to the @B@ comment--Given our limitation that not all expressions recover their whitespaces, the-purpose of @fieldSelectionSrc1@ is to save the 'Text.Megaparsec.SourcePos' where-the @fieldSelectionLabel@ ends, but we /still/ use a 'Maybe Src' (@s = 'Src'@)-to be consistent with similar data types such as 'Binding', for example.--}+-- | Record the field on a selector-expression+--+-- For example,+--+-- > e . {- A -} x {- B -}+--+-- … will be instantiated as follows:+--+-- * @fieldSelectionSrc0@ corresponds to the @A@ comment+-- * @fieldSelectionLabel@ corresponds to @x@+-- * @fieldSelectionSrc1@ corresponds to the @B@ comment+--+-- Given our limitation that not all expressions recover their whitespaces, the+-- purpose of @fieldSelectionSrc1@ is to save the 'Text.Megaparsec.SourcePos'+-- where the @fieldSelectionLabel@ ends, but we /still/ use a 'Maybe Src'+-- (@s = 'Src'@) to be consistent with similar data types such as 'Binding', for+-- example. data FieldSelection s = FieldSelection     { fieldSelectionSrc0 :: Maybe s     , fieldSelectionLabel :: !Text@@ -609,7 +608,7 @@     | Field (Expr s a) (FieldSelection s)     -- | > Project e (Left xs)                      ~  e.{ xs }     --   > Project e (Right t)                      ~  e.(t)-    | Project (Expr s a) (Either (Set Text) (Expr s a))+    | Project (Expr s a) (Either [Text] (Expr s a))     -- | > Assert e                                 ~  assert : e     | Assert (Expr s a)     -- | > Equivalent x y                           ~  x ≡ y

@@ -1980,8 +1980,8 @@ -- -- > -- example.dhall -- >--- > let Result = < Failure : Integer | Success Text >--- > in Result.Failure 1+-- > let Result = < Failure : Integer | Success : Text >+-- > in Result.Failure +1 -- -- Right now it is quite easy to keep these two definitions (the one in Haskell source and the one in the Dhall file) synchronized: -- If we implement a new feature in the Haskell source we update the corresponding type in the Dhall file.@@ -1992,14 +1992,14 @@ -- > resultDecoder = Dhall.auto -- > -- > resultType :: Expr Src Void--- > resultType = Dhall.expected resultDecoder+-- > resultType = maximum $ Dhall.expected resultDecoder -- > -- > resultTypeString :: String -- > resultTypeString = show $ pretty resultType -- -- Now we just have to inject that type into the Dhall code and we are done. One common way to do that is to wrap the import of example.dhall in a let expression: ----- > Dhall.input (Dhall.auto :: Dhall.Decoder Result) ("let Result = " ++ Data.Text.pack resultTypeString ++ " in ./example.dhall")+-- > Dhall.input (Dhall.auto :: Dhall.Decoder Result) ("let Result = " <> Data.Text.pack resultTypeString <> " in ./example.dhall") -- -- Now we can omit the definition of Result in our example.dhall file. While this will work perfectly Dhall provides a cleaner solution for our \"injection problem\": --

@@ -79,7 +79,6 @@ import qualified Dhall.Map 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@@ -417,28 +416,14 @@              _R' <- loop ctx r -            tL' <- loop ctx (quote names _L')+            _ <- loop ctx (quote names _L')              let _L'' = quote names _L' -            case tL' of-                VConst Type ->-                    return ()-                _  -> do-                    let tL'' = quote names tL'-                    die (IfBranchMustBeTerm True l _L'' tL'')--            tR' <- loop ctx (quote names _R')+            _ <- loop ctx (quote names _R')              let _R'' = quote names _R' -            case tR' of-                VConst Type ->-                    return ()-                _ -> do-                    let tR'' = quote names tR'-                    die (IfBranchMustBeTerm True r _R'' tR'')-             if Eval.conv values _L' _R'                 then return ()                 else die (IfBranchMismatch l r _L'' _R'')@@ -1154,6 +1139,12 @@                              die (CantAccess text e'' _E'')         Project e (Left xs) -> do+            case duplicateElement xs of+                Just x -> do+                    die (DuplicateProjectionLabel x)+                Nothing -> do+                    return ()+             _E' <- loop ctx e              let _E'' = quote names _E'@@ -1167,7 +1158,7 @@                      let adapt = VRecord . Dhall.Map.unorderedFromList -                    fmap adapt (traverse process (Dhall.Set.toAscList xs))+                    fmap adapt (traverse process xs)                  _ -> do                     let text =@@ -1332,7 +1323,6 @@     | InvalidSome (Expr s a) (Expr s a) (Expr s a)     | InvalidPredicate (Expr s a) (Expr s a)     | IfBranchMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a)-    | IfBranchMustBeTerm Bool (Expr s a) (Expr s a) (Expr s a)     | InvalidFieldType Text (Expr s a)     | InvalidAlternativeType Text (Expr s a)     | ListAppendMismatch (Expr s a) (Expr s a)@@ -1365,6 +1355,7 @@     | CantAccess Text (Expr s a) (Expr s a)     | CantProject Text (Expr s a) (Expr s a)     | CantProjectByExpression (Expr s a)+    | DuplicateProjectionLabel Text     | MissingField Text (Expr s a)     | MissingConstructor Text (Expr s a)     | ProjectionTypeMismatch Text (Expr s a) (Expr s a) (Expr s a) (Expr s a)@@ -2148,93 +2139,6 @@         txt0 = insert expr0         txt1 = insert expr1 -prettyTypeMessage (IfBranchMustBeTerm b expr0 expr1 expr2) =-    ErrorMessages {..}-  where-    short = "❰if❱ branch is not a term"--    long =-        "Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\-        \is an expression:                                                               \n\-        \                                                                                \n\-        \                                                                                \n\-        \                   Expression for ❰then❱ branch                                 \n\-        \                   ⇩                                                            \n\-        \    ┌────────────────────────────────┐                                          \n\-        \    │ if True then \"Hello, world!\"   │                                        \n\-        \    │         else \"Goodbye, world!\" │                                        \n\-        \    └────────────────────────────────┘                                          \n\-        \                   ⇧                                                            \n\-        \                   Expression for ❰else❱ branch                                 \n\-        \                                                                                \n\-        \                                                                                \n\-        \These expressions must be a “term”, where a “term” is defined as an expression  \n\-        \that has a type thas has kind ❰Type❱                                            \n\-        \                                                                                \n\-        \For example, the following expressions are all valid “terms”:                   \n\-        \                                                                                \n\-        \                                                                                \n\-        \    ┌────────────────────┐                                                      \n\-        \    │ 1 : Natural : Type │  ❰1❱ is a term with a type (❰Natural❱) of kind ❰Type❱\n\-        \    └────────────────────┘                                                      \n\-        \      ⇧                                                                         \n\-        \      term                                                                      \n\-        \                                                                                \n\-        \                                                                                \n\-        \    ┌─────────────────────────────────────┐                                     \n\-        \    │ Natural/odd : Natural → Bool : Type │  ❰Natural/odd❱ is a term with a type\n\-        \    └─────────────────────────────────────┘  (❰Natural → Bool❱) of kind ❰Type❱  \n\-        \      ⇧                                                                         \n\-        \      term                                                                      \n\-        \                                                                                \n\-        \                                                                                \n\-        \However, the following expressions are " <> _NOT <> " valid terms:              \n\-        \                                                                                \n\-        \                                                                                \n\-        \    ┌────────────────────┐                                                      \n\-        \    │ Text : Type : Kind │  ❰Text❱ has kind (❰Type❱) of sort ❰Kind❱ and is      \n\-        \    └────────────────────┘  therefore not a term                                \n\-        \      ⇧                                                                         \n\-        \      type                                                                      \n\-        \                                                                                \n\-        \                                                                                \n\-        \    ┌───────────────────────────┐                                               \n\-        \    │ List : Type → Type : Kind │  ❰List❱ has kind (❰Type → Type❱) of sort      \n\-        \    └───────────────────────────┘  ❰Kind❱ and is therefore not a term           \n\-        \      ⇧                                                                         \n\-        \      type-level function                                                       \n\-        \                                                                                \n\-        \                                                                                \n\-        \This means that you cannot define an ❰if❱ expression that returns a type.  For  \n\-        \example, the following ❰if❱ expression is " <> _NOT <> " valid:                 \n\-        \                                                                                \n\-        \                                                                                \n\-        \    ┌─────────────────────────────┐                                             \n\-        \    │ if True then Text else Bool │  Invalid ❰if❱ expression                    \n\-        \    └─────────────────────────────┘                                             \n\-        \                   ⇧         ⇧                                                  \n\-        \                   type      type                                               \n\-        \                                                                                \n\-        \                                                                                \n\-        \Your ❰" <> txt0 <> "❱ branch of your ❰if❱ expression is:                        \n\-        \                                                                                \n\-        \" <> txt1 <> "\n\-        \                                                                                \n\-        \... which has kind:                                                             \n\-        \                                                                                \n\-        \" <> txt2 <> "\n\-        \                                                                                \n\-        \... of sort:                                                                    \n\-        \                                                                                \n\-        \" <> txt3 <> "\n\-        \                                                                                \n\-        \... and is not a term.  Therefore your ❰if❱ expression is not valid             \n"-      where-        txt0 = if b then "then" else "else"-        txt1 = insert expr0-        txt2 = insert expr1-        txt3 = insert expr2- prettyTypeMessage (IfBranchMismatch expr0 expr1 expr2 expr3) =     ErrorMessages {..}   where@@ -3953,6 +3857,36 @@       where         txt = insert expr +prettyTypeMessage (DuplicateProjectionLabel k) = ErrorMessages {..}+  where+    short = "Duplicate projection label: " <> Dhall.Pretty.Internal.prettyLabel k++    long =+        "Explanation: You can only specify a label once when projecting a record's fields\n\+        \by label.  For example, this is valid:                                          \n\+        \                                                                                \n\+        \                                                                                \n\+        \    ┌─────────────────────────────────────────┐                                 \n\+        \    │ { x = 1.1, y = 2.4, z = -0.3 }.{ x, y } │                                 \n\+        \    └─────────────────────────────────────────┘                                 \n\+        \                                                                                \n\+        \                                                                                \n\+        \... but this is not valid:                                                      \n\+        \                                                                                \n\+        \                                                                                \n\+        \    ┌─────────────────────────────────────────┐                                 \n\+        \    │ { x = 1.1, y = 2.4, z = -0.3 }.{ y, y } │                                 \n\+        \    └─────────────────────────────────────────┘                                 \n\+        \                                          ⇧                                     \n\+        \                                          Invalid: the label ❰y❱ appears twice  \n\+        \                                                                                \n\+        \                                                                                \n\+        \You tried to project the following field twice:                                 \n\+        \                                                                                \n\+        \" <> txt0 <> "\n"+      where+        txt0 = insert k+ prettyTypeMessage (MissingField k expr0) = ErrorMessages {..}   where     short = "Missing record field: " <> Dhall.Pretty.Internal.prettyLabel k@@ -4638,8 +4572,6 @@         InvalidPredicate <$> f a <*> f b     IfBranchMismatch a b c d ->         IfBranchMismatch <$> f a <*> f b <*> f c <*> f d-    IfBranchMustBeTerm a b c d ->-        IfBranchMustBeTerm <$> pure a <*> f b <*> f c <*> f d     InvalidFieldType a b ->         InvalidFieldType <$> pure a <*> f b     InvalidAlternativeType a b ->@@ -4704,6 +4636,8 @@         CantProject <$> pure a <*> f b <*> f c     CantProjectByExpression a ->         CantProjectByExpression <$> f a+    DuplicateProjectionLabel a ->+        pure (DuplicateProjectionLabel a)     MissingField a b ->         MissingField <$> pure a <*> f b     MissingConstructor a b ->@@ -4801,3 +4735,11 @@ toPath ks =     Text.intercalate "."         (Foldable.toList (fmap (Dhall.Pretty.Internal.escapeLabel True) ks))++duplicateElement :: Ord a => [a] -> Maybe a+duplicateElement = go Data.Set.empty+  where+    go _ [] = Nothing+    go found (x : xs)+        | Data.Set.member x found = Just x+        | otherwise               = go (Data.Set.insert x found) xs

@@ -308,7 +308,7 @@             :: ConstrGen "Lam" 0 (FunctionBinding s a)             :+ ConstrGen "Pi" 0 Text             :+ ConstrGen "Field" 1 (FieldSelection s)-            :+ ConstrGen "Project" 1 (Either (Set Text) (Expr s a))+            :+ ConstrGen "Project" 1 (Either [Text] (Expr s a))             :+ Gen Integer  -- Generates all Integer fields in Expr             :+ Gen Text     -- Generates all Text fields in Expr             :+ ()@@ -326,7 +326,7 @@          projection =             Test.QuickCheck.oneof-                [ fmap (Left . Dhall.Set.fromList) (Test.QuickCheck.listOf label)+                [ fmap Left (Test.QuickCheck.listOf label)                 , arbitrary                 ] 

@@ -46,6 +46,8 @@         , issue1584         , issue1646         , issue1732+        , issue1884+        , issue2088         , parsing0         , typeChecking0         , typeChecking1@@ -220,6 +222,13 @@     -- This test ensures that the parser allows a parenthesized application     -- expression as the first argument to a with expression     _ <- Util.code "./tests/regression/issue1884.dhall"+    return () )++issue2088 :: TestTree+issue2088 = Test.Tasty.HUnit.testCase "Issue #2088" (do+    -- This test ensures that the parser for projection by labels doesn't+    -- accidentally swallow trailing commas OUTSIDE of the projection+    _ <- Util.code "./tests/regression/issue2088.dhall"     return () )  parsing0 :: TestTree

@@ -103,8 +103,7 @@                [                -- Duplicate fields are incorrectly caught during parsing:                -- https://github.com/dhall-lang/dhall-haskell/issues/772-                 typeInferenceDirectory </> "failure/unit/RecordProjectionDuplicateFields"-               , typeInferenceDirectory </> "failure/unit/RecordTypeDuplicateFields"+                 typeInferenceDirectory </> "failure/unit/RecordTypeDuplicateFields"                , typeInferenceDirectory </> "failure/unit/UnionTypeDuplicateVariants1"                , typeInferenceDirectory </> "failure/unit/UnionTypeDuplicateVariants2"                ]

@@ -0,0 +1,1 @@+"'\${x}'\n"

@@ -0,0 +1,3 @@+''+${"'"}''${x}'+''

@@ -0,0 +1,1 @@+[ { x = 1 }.{ x }, { x = 1 } ]