dhall 1.14.0 → 1.15.0

raw patch · 80 files changed

+5431/−4088 lines, 80 filesdep +Diffdep +criteriondep +template-haskelldep −formattingdep ~ansi-terminaldep ~basedep ~doctestPVP ok

version bump matches the API change (PVP)

Dependencies added: Diff, criterion, template-haskell

Dependencies removed: formatting

Dependency ranges changed: ansi-terminal, base, doctest, megaparsec, prettyprinter, prettyprinter-ansi-terminal, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +51/−0
• Prelude/Integer/toDouble +12/−0
• Prelude/Natural/toDouble +16/−0
• benchmark/deep-nested-large-record/BigEnum.dhall +302/−0
• benchmark/deep-nested-large-record/LittleEnum.dhall +4/−0
• benchmark/deep-nested-large-record/Main.hs +37/−0
• benchmark/deep-nested-large-record/prelude.dhall +5/−0
• benchmark/examples/issue108.dhall +61/−0
• benchmark/parser/Main.hs +53/−0
• dhall-format/Main.hs +0/−130
• dhall-hash/Main.hs +0/−104
• dhall-repl/Main.hs +0/−251
• dhall.cabal +74/−64
• dhall/Main.hs +2/−202
• doctest/Main.hs +1/−1
• src/Dhall.hs +89/−33
• src/Dhall/Context.hs +1/−1
• src/Dhall/Core.hs +115/−77
• src/Dhall/Diff.hs +465/−323
• src/Dhall/Format.hs +55/−0
• src/Dhall/Freeze.hs +76/−0
• src/Dhall/Hash.hs +28/−0
• src/Dhall/Import.hs +221/−237
• src/Dhall/Import/HTTP.hs +117/−0
• src/Dhall/Import/Types.hs +89/−0
• src/Dhall/Lint.hs +222/−0
• src/Dhall/Main.hs +334/−0
• src/Dhall/Parser.hs +80/−1636
• src/Dhall/Parser/Combinators.hs +161/−0
• src/Dhall/Parser/Expression.hs +863/−0
• src/Dhall/Parser/Token.hs +616/−0
• src/Dhall/Pretty/Internal.hs +327/−639
• src/Dhall/Pretty/Internal.hs-boot +4/−17
• src/Dhall/Repl.hs +258/−0
• src/Dhall/TH.hs +44/−0
• src/Dhall/Tutorial.hs +100/−64
• src/Dhall/TypeCheck.hs +321/−277
• tests/Format.hs +22/−4
• tests/Import.hs +70/−0
• tests/Normalization.hs +14/−7
• tests/Parser.hs +24/−2
• tests/Tests.hs +2/−0
• tests/TypeCheck.hs +3/−3
• tests/Util.hs +10/−12
• tests/format/ifThenElseA.dhall +2/−0
• tests/format/ifThenElseB.dhall +13/−0
• tests/format/importAccessA.dhall +1/−0
• tests/format/importAccessB.dhall +1/−0
• tests/format/importLines2A.dhall +2/−0
• tests/format/importLines2B.dhall +1/−0
• tests/format/importLinesA.dhall +7/−0
• tests/format/importLinesB.dhall +13/−0
• tests/format/importSuffixA.dhall +1/−0
• tests/format/importSuffixB.dhall +1/−0
• tests/format/sha256PrintingA.dhall +2/−0
• tests/format/sha256PrintingB.dhall +4/−0
• tests/import/alternativeEnv.dhall +1/−0
• tests/import/alternativeEnvMissing.dhall +1/−0
• tests/import/alternativeEnvNatural.dhall +1/−0
• tests/import/alternativeEnvSimple.dhall +1/−0
• tests/import/alternativeNatural.dhall +1/−0
• tests/import/missing.dhall +1/−0
• tests/normalization/examples/Integer/toDouble/0A.dhall +1/−0
• tests/normalization/examples/Integer/toDouble/0B.dhall +1/−0
• tests/normalization/examples/Integer/toDouble/1A.dhall +1/−0
• tests/normalization/examples/Integer/toDouble/1B.dhall +1/−0
• tests/normalization/examples/List/indexed/0A.dhall +1/−1
• tests/normalization/examples/List/indexed/0B.dhall +3/−3
• tests/normalization/examples/Natural/toDouble/0A.dhall +1/−0
• tests/normalization/examples/Natural/toDouble/0B.dhall +1/−0
• tests/normalization/examples/Natural/toDouble/1A.dhall +1/−0
• tests/normalization/examples/Natural/toDouble/1B.dhall +1/−0
• tests/normalization/multiLineA.dhall +4/−0
• tests/normalization/multiLineB.dhall +4/−0
• tests/parser/collectionImportType.dhall +3/−0
• tests/parser/failure/duplicateFields.dhall +1/−0
• tests/parser/failure/importAccess.dhall +1/−0
• tests/parser/importAlt.dhall +1/−0
• tests/parser/parenthesizeUsing.dhall +1/−0
• tests/parser/urls.dhall +1/−0

@@ -1,3 +1,54 @@+1.15.0++* BREAKING CHANGE TO THE API: Support alternative imports using new `?` operator+    * This adds a new constructor which affects exhaustive pattern matches+    * See: https://github.com/dhall-lang/dhall-haskell/pull/473+* BREAKING CHANGE TO THE API: Add `Integer/toDouble` built-in function+    * This adds a new constructor which affects exhaustive pattern matches+    * See: https://github.com/dhall-lang/dhall-haskell/pull/434+* BREAKING CHANGE TO THE API: Use strict `Text` instead of lazy `Text`+    * See: https://github.com/dhall-lang/dhall-haskell/pull/455+* BREAKING CHANGE TO THE API: Remove `Buildable` in favor of `Pretty`+    * See: https://github.com/dhall-lang/dhall-haskell/pull/459+* BREAKING CHANGE TO THE API: Removed the `Parent` constructor from `FilePrefix`+    * Instead, use `Here` with a `".."` prefix.+    * See: https://github.com/dhall-lang/dhall-haskell/pull/407+* BUG FIX: Disallow duplicate fields in records+    * See: https://github.com/dhall-lang/dhall-haskell/pull/430+* BUG FIX: Fix stripping of leading whitespace in multi-line strings+    * See: https://github.com/dhall-lang/dhall-haskell/pull/469+* BUG FIX: Fix formatting field access of an import+    * See: https://github.com/dhall-lang/dhall-haskell/pull/471+* Add `dhall freeze` command+    * See: https://github.com/dhall-lang/dhall-haskell/pull/486+* Add `dhall diff` command+    * See: https://github.com/dhall-lang/dhall-haskell/pull/442+* Add `dhall lint` command+    * See: https://github.com/dhall-lang/dhall-haskell/pull/484+* Change `dhall-repl`/`dhall-hash`/`dhall-format` to `dhall` subcommands+    * i.e. `dhall repl`/`dhall hash`/`dhall format`+    * See: https://github.com/dhall-lang/dhall-haskell/pull/435+    * See: https://github.com/dhall-lang/dhall-haskell/pull/452+* Add `with-http` cabal flag to disable support for remote imports+    * See: https://github.com/dhall-lang/dhall-haskell/pull/482+* Added `inputFrom` and `inputFromWith`+    * These allow naming the file that the expression is coming from for better+      error messages+    * See: https://github.com/dhall-lang/dhall-haskell/pull/464+* Performance improvements+    * See: https://github.com/dhall-lang/dhall-haskell/pull/420+* Tutorial recommends GitHub for Prelude instead of IPFS+    * See: https://github.com/dhall-lang/dhall-haskell/pull/479+* Pretty-print expressions in type errors+    * See: https://github.com/dhall-lang/dhall-haskell/pull/429+* Formatting improvements+    * See: https://github.com/dhall-lang/dhall-haskell/pull/398+    * See: https://github.com/dhall-lang/dhall-haskell/pull/458+* Diff improvements+    * See: https://github.com/dhall-lang/dhall-haskell/pull/455+    * See: https://github.com/dhall-lang/dhall-haskell/pull/470+    * See: https://github.com/dhall-lang/dhall-haskell/pull/478+ 1.14.0  * BREAKING CHANGE TO THE LANGUAGE: Switch grammar of `Natural` and `Integer`

@@ -0,0 +1,12 @@+{-+Convert an `Integer` to the corresponding `Double`++Examples:++```+./toDouble -3 = -3.0++./toDouble +2 = 2.0+```+-}+let toDouble : Integer → Double = Integer/toDouble in toDouble

@@ -0,0 +1,16 @@+{-+Convert a `Natural` number to the corresponding `Double`++Examples:++```+./toDouble 3 = 3.0++./toDouble 0 = 0.0+```+-}+    let toDouble+        : Natural → Double+        = λ(n : Natural) → Integer/toDouble (Natural/toInteger n)++in  toDouble

@@ -0,0 +1,302 @@+< A0 : {}+| A1 : {}+| A2 : {}+| A3 : {}+| A4 : {}+| A5 : {}+| A6 : {}+| A7 : {}+| A8 : {}+| A9 : {}+| A10 : {}+| A11 : {}+| A12 : {}+| A13 : {}+| A14 : {}+| A15 : {}+| A16 : {}+| A17 : {}+| A18 : {}+| A19 : {}+| A20 : {}+| A21 : {}+| A22 : {}+| A23 : {}+| A24 : {}+| A25 : {}+| A26 : {}+| A27 : {}+| A28 : {}+| A29 : {}+| A30 : {}+| A31 : {}+| A32 : {}+| A33 : {}+| A34 : {}+| A35 : {}+| A36 : {}+| A37 : {}+| A38 : {}+| A39 : {}+| A40 : {}+| A41 : {}+| A42 : {}+| A43 : {}+| A44 : {}+| A45 : {}+| A46 : {}+| A47 : {}+| A48 : {}+| A49 : {}+| A50 : {}+| A51 : {}+| A52 : {}+| A53 : {}+| A54 : {}+| A55 : {}+| A56 : {}+| A57 : {}+| A58 : {}+| A59 : {}+| A60 : {}+| A61 : {}+| A62 : {}+| A63 : {}+| A64 : {}+| A65 : {}+| A66 : {}+| A67 : {}+| A68 : {}+| A69 : {}+| A70 : {}+| A71 : {}+| A72 : {}+| A73 : {}+| A74 : {}+| A75 : {}+| A76 : {}+| A77 : {}+| A78 : {}+| A79 : {}+| A80 : {}+| A81 : {}+| A82 : {}+| A83 : {}+| A84 : {}+| A85 : {}+| A86 : {}+| A87 : {}+| A88 : {}+| A89 : {}+| A90 : {}+| A91 : {}+| A92 : {}+| A93 : {}+| A94 : {}+| A95 : {}+| A96 : {}+| A97 : {}+| A98 : {}+| A99 : {}+| A100 : {}+| A101 : {}+| A102 : {}+| A103 : {}+| A104 : {}+| A105 : {}+| A106 : {}+| A107 : {}+| A108 : {}+| A109 : {}+| A110 : {}+| A111 : {}+| A112 : {}+| A113 : {}+| A114 : {}+| A115 : {}+| A116 : {}+| A117 : {}+| A118 : {}+| A119 : {}+| A120 : {}+| A121 : {}+| A122 : {}+| A123 : {}+| A124 : {}+| A125 : {}+| A126 : {}+| A127 : {}+| A128 : {}+| A129 : {}+| A130 : {}+| A131 : {}+| A132 : {}+| A133 : {}+| A134 : {}+| A135 : {}+| A136 : {}+| A137 : {}+| A138 : {}+| A139 : {}+| A140 : {}+| A141 : {}+| A142 : {}+| A143 : {}+| A144 : {}+| A145 : {}+| A146 : {}+| A147 : {}+| A148 : {}+| A149 : {}+| A150 : {}+| A151 : {}+| A152 : {}+| A153 : {}+| A154 : {}+| A155 : {}+| A156 : {}+| A157 : {}+| A158 : {}+| A159 : {}+| A160 : {}+| A161 : {}+| A162 : {}+| A163 : {}+| A164 : {}+| A165 : {}+| A166 : {}+| A167 : {}+| A168 : {}+| A169 : {}+| A170 : {}+| A171 : {}+| A172 : {}+| A173 : {}+| A174 : {}+| A175 : {}+| A176 : {}+| A177 : {}+| A178 : {}+| A179 : {}+| A180 : {}+| A181 : {}+| A182 : {}+| A183 : {}+| A184 : {}+| A185 : {}+| A186 : {}+| A187 : {}+| A188 : {}+| A189 : {}+| A190 : {}+| A191 : {}+| A192 : {}+| A193 : {}+| A194 : {}+| A195 : {}+| A196 : {}+| A197 : {}+| A198 : {}+| A199 : {}+| A200 : {}+| A201 : {}+| A202 : {}+| A203 : {}+| A204 : {}+| A205 : {}+| A206 : {}+| A207 : {}+| A208 : {}+| A209 : {}+| A210 : {}+| A211 : {}+| A212 : {}+| A213 : {}+| A214 : {}+| A215 : {}+| A216 : {}+| A217 : {}+| A218 : {}+| A219 : {}+| A220 : {}+| A221 : {}+| A222 : {}+| A223 : {}+| A224 : {}+| A225 : {}+| A226 : {}+| A227 : {}+| A228 : {}+| A229 : {}+| A230 : {}+| A231 : {}+| A232 : {}+| A233 : {}+| A234 : {}+| A235 : {}+| A236 : {}+| A237 : {}+| A238 : {}+| A239 : {}+| A240 : {}+| A241 : {}+| A242 : {}+| A243 : {}+| A244 : {}+| A245 : {}+| A246 : {}+| A247 : {}+| A248 : {}+| A249 : {}+| A250 : {}+| A251 : {}+| A252 : {}+| A253 : {}+| A254 : {}+| A255 : {}+| A256 : {}+| A257 : {}+| A258 : {}+| A259 : {}+| A260 : {}+| A261 : {}+| A262 : {}+| A263 : {}+| A264 : {}+| A265 : {}+| A266 : {}+| A267 : {}+| A268 : {}+| A269 : {}+| A270 : {}+| A271 : {}+| A272 : {}+| A273 : {}+| A274 : {}+| A275 : {}+| A276 : {}+| A277 : {}+| A278 : {}+| A279 : {}+| A280 : {}+| A281 : {}+| A282 : {}+| A283 : {}+| A284 : {}+| A285 : {}+| A286 : {}+| A287 : {}+| A288 : {}+| A289 : {}+| A290 : {}+| A291 : {}+| A292 : {}+| A293 : {}+| A294 : {}+| A295 : {}+| A296 : {}+| A297 : {}+| A298 : {}+| A299 : {}+| A300 : {}+>

@@ -0,0 +1,4 @@+< Foo : {}+| Bar : {}+| Baz : {}+>

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import qualified Criterion as Criterion+import Criterion.Main (defaultMain)+import qualified Data.Sequence as Seq+import qualified Dhall.Core as Core+import qualified Dhall.Import as Import+import qualified Dhall.TypeCheck as TypeCheck++dhallPreludeImport :: Core.Import+dhallPreludeImport = Core.Import+  { Core.importMode = Core.Code+  , Core.importHashed = Core.ImportHashed+    { Core.hash = Nothing+    , Core.importType = Core.Local Core.Here $ Core.File+      { Core.directory = Core.Directory ["deep-nested-large-record", "benchmark"]+      , Core.file = "prelude.dhall"+      }+    }+  }++issue412 :: Core.Expr s TypeCheck.X -> Criterion.Benchmarkable+issue412 prelude = Criterion.whnf TypeCheck.typeOf expr+  where+    expr+      = Core.Let "prelude" Nothing prelude+      $ Core.ListLit Nothing+      $ Seq.replicate 5+      $ Core.Var (Core.V "prelude" 0) `Core.Field` "types" `Core.Field` "Little" `Core.Field` "Foo"++main :: IO ()+main = do+  prelude <- Import.load (Core.Embed dhallPreludeImport)+  defaultMain+    [ Criterion.bench "issue 412" (issue412 prelude)+    ]

@@ -0,0 +1,5 @@+{ types =+  { Big = constructors ./BigEnum.dhall+  , Little = constructors ./LittleEnum.dhall+  }+}

@@ -0,0 +1,61 @@+λ(xs : List { cores : Natural, host : Text, key : Text, mandatoryFeatures : +List Text, platforms : List < AArch64_Linux : {} | ARMv5tel_Linux : {} | +ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} | +PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD : +{} | X86_64_Linux : {} | X86_64_Solaris : {} >, speedFactor : Natural, +supportedFeatures : List Text, user : Optional Text }) → List/fold { cores : +Natural, host : Text, key : Text, mandatoryFeatures : List Text, platforms : +List < AArch64_Linux : {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | +I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} | PowerPC_Linux : {} | +X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : +{} | X86_64_Solaris : {} >, speedFactor : Natural, supportedFeatures : List +Text, user : Optional Text } xs Text (λ(x : { cores : Natural, host : Text, +key : Text, mandatoryFeatures : List Text, platforms : List < AArch64_Linux : +{} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : +{} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | +X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : +{} >, speedFactor : Natural, supportedFeatures : List Text, user : Optional +Text }) → λ(y : Text) → (Optional/fold Text x.user Text (λ(user : Text) +→ user ++ "@" ++ x.host ++ "") x.host ++ " " ++ (merge { Empty = λ(_ : {}) +→ "", NonEmpty = λ(result : Text) → result } (List/fold < AArch64_Linux : +{} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : +{} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | +X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : +{} > x.platforms < Empty : {} | NonEmpty : Text > (λ(element : < AArch64_Linux +: {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux +: {} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | +X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : +{} >) → λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = +λ(_ : {}) → < NonEmpty = merge { AArch64_Linux = λ(_ : {}) → +"aarch64-linux", ARMv5tel_Linux = λ(_ : {}) → "armv5tel-linux", ARMv7l_Linux += λ(_ : {}) → "armv7l-linux", I686_Cygwin = λ(_ : {}) → "i686-cygwin", +I686_Linux = λ(_ : {}) → "i686-linux", MIPS64el_Linux = λ(_ : {}) → +"mips64el-linux", PowerPC_Linux = λ(_ : {}) → "powerpc-linux", X86_64_Cygwin += λ(_ : {}) → "x86_64-cygwin", X86_64_Darwin = λ(_ : {}) → +"x86_64-darwin", X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd", X86_64_Linux += λ(_ : {}) → "x86_64-linux", X86_64_Solaris = λ(_ : {}) → +"x86_64-solaris" } element | Empty : {} >, NonEmpty = λ(result : Text) → < +NonEmpty = (merge { AArch64_Linux = λ(_ : {}) → "aarch64-linux", +ARMv5tel_Linux = λ(_ : {}) → "armv5tel-linux", ARMv7l_Linux = λ(_ : {}) → +"armv7l-linux", I686_Cygwin = λ(_ : {}) → "i686-cygwin", I686_Linux = λ(_ : +{}) → "i686-linux", MIPS64el_Linux = λ(_ : {}) → "mips64el-linux", +PowerPC_Linux = λ(_ : {}) → "powerpc-linux", X86_64_Cygwin = λ(_ : {}) → +"x86_64-cygwin", X86_64_Darwin = λ(_ : {}) → "x86_64-darwin", X86_64_FreeBSD += λ(_ : {}) → "x86_64-freebsd", X86_64_Linux = λ(_ : {}) → +"x86_64-linux", X86_64_Solaris = λ(_ : {}) → "x86_64-solaris" } element) ++ +"," ++ result | Empty : {} > } status : < Empty : {} | NonEmpty : Text >) < +Empty = {=} | NonEmpty : Text >) : Text) ++ " " ++ x.key ++ " " ++ Integer/show +(Natural/toInteger x.cores) ++ " " ++ Integer/show (Natural/toInteger +x.speedFactor) ++ " " ++ (merge { Empty = λ(_ : {}) → "", NonEmpty = +λ(result : Text) → result } (List/fold Text x.supportedFeatures < Empty : {} +| NonEmpty : Text > (λ(element : Text) → λ(status : < Empty : {} | NonEmpty +: Text >) → merge { Empty = λ(_ : {}) → < NonEmpty = element | Empty : {} +>, NonEmpty = λ(result : Text) → < NonEmpty = element ++ "," ++ result | +Empty : {} > } status : < Empty : {} | NonEmpty : Text >) < Empty = {=} | +NonEmpty : Text >) : Text) ++ " " ++ (merge { Empty = λ(_ : {}) → "", +NonEmpty = λ(result : Text) → result } (List/fold Text x.mandatoryFeatures < +Empty : {} | NonEmpty : Text > (λ(element : Text) → λ(status : < Empty : {} +| NonEmpty : Text >) → merge { Empty = λ(_ : {}) → < NonEmpty = element | +Empty : {} >, NonEmpty = λ(result : Text) → < NonEmpty = element ++ "," ++ +result | Empty : {} > } status : < Empty : {} | NonEmpty : Text >) < Empty = +{=} | NonEmpty : Text >) : Text) ++ "\n") ++ y) ""

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (forM)+import Criterion.Main (defaultMain, bgroup, bench, whnf, nfIO)+import Data.Map (Map, foldrWithKey, singleton, unions)++import System.Directory++import qualified Criterion.Main as Criterion+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified Dhall.Parser as Dhall++type PreludeFiles = Map FilePath T.Text++loadPreludeFiles :: IO PreludeFiles+loadPreludeFiles = loadDirectory "Prelude"+    where+        loadDirectory :: FilePath -> IO PreludeFiles+        loadDirectory dir =+            withCurrentDirectory dir $ do+                files <- getCurrentDirectory >>= listDirectory+                results <- forM files $ \file -> do+                    file' <- makeAbsolute file+                    doesExist <- doesFileExist file'+                    if doesExist+                       then loadFile file'+                       else loadDirectory file'+                pure $ unions results++        loadFile :: FilePath -> IO PreludeFiles+        loadFile path = singleton path <$> TIO.readFile path++benchParser :: PreludeFiles -> Criterion.Benchmark+benchParser =+      bgroup "exprFromText"+    . foldrWithKey (\name expr -> (benchExprFromText name expr :)) []++benchExprFromText :: String -> T.Text -> Criterion.Benchmark+benchExprFromText name expr =+    bench name $ whnf (Dhall.exprFromText "(input)") expr++main :: IO ()+main = do+    prelude <- loadPreludeFiles+    issue108 <- TIO.readFile "benchmark/examples/issue108.dhall"+    defaultMain+        [ benchParser prelude+        , bgroup "Issue #108" $+            [ benchExprFromText "108" issue108 ]+        ]

@@ -1,130 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}--{-| Utility executable for pretty-printing Dhall code--    You typically want to use this to either:--    * improve the readability of Dhall code (either written or generated)-    * automatically format your Dhall code to avoid stylistic debates--    Note that this does not yet support:--    * Preserving all comments-        * Currently, this only preserves all leading comments and whitespace-          up until the last newline preceding the code-        * This lets you preserve a comment header but if you want to document-          subexpressions then you will need to split them into a separate-          file for now-    * Preserving multi-line strings (this reduces them to ordinary strings)--    See the @Dhall.Tutorial@ module for example usage--}-module Main where--import Control.Applicative (optional)-import Control.Exception (SomeException)-import Control.Monad (when)-import Data.Monoid ((<>))-import Data.Version (showVersion)-import Dhall.Parser (exprAndHeaderFromText)-import Dhall.Pretty (annToAnsiStyle, prettyExpr)-import Options.Applicative (Parser, ParserInfo)-import System.IO (stderr)-import System.Exit (exitFailure, exitSuccess)--import qualified Paths_dhall as Meta--import qualified Control.Exception-import qualified Data.Text.IO-import qualified Data.Text.Lazy-import qualified Data.Text.Lazy.IO-import qualified Data.Text.Prettyprint.Doc                 as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty-import qualified Options.Applicative-import qualified System.Console.ANSI-import qualified System.IO--data Options = Options-    { version :: Bool-    , inplace :: Maybe FilePath-    }--parseOptions :: Parser Options-parseOptions = Options <$> parseVersion <*> optional parseInplace-  where-    parseVersion =-        Options.Applicative.switch-        (   Options.Applicative.long "version"-        <>  Options.Applicative.help "Display version and exit"-        )--    parseInplace =-        Options.Applicative.strOption-        (   Options.Applicative.long "inplace"-        <>  Options.Applicative.help "Modify the specified file in-place"-        <>  Options.Applicative.metavar "FILE"-        )--opts :: Pretty.LayoutOptions-opts =-    Pretty.defaultLayoutOptions-        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }--parserInfo :: ParserInfo Options-parserInfo =-    Options.Applicative.info-        (Options.Applicative.helper <*> parseOptions)-        (   Options.Applicative.progDesc "Formatter for the Dhall language"-        <>  Options.Applicative.fullDesc-        )--main :: IO ()-main = do-    Options {..} <- Options.Applicative.execParser parserInfo--    when version $ do-      putStrLn (showVersion Meta.version)-      exitSuccess--    let handler e = do-            let _ = e :: SomeException-            System.IO.hSetEncoding System.IO.stderr System.IO.utf8-            System.IO.hPrint stderr e-            System.Exit.exitFailure--    Control.Exception.handle handler (do-        case inplace of-            Just file -> do-                strictText <- Data.Text.IO.readFile file-                let lazyText = Data.Text.Lazy.fromStrict strictText-                (header, expr) <- case exprAndHeaderFromText "(stdin)" lazyText of-                    Left  err -> Control.Exception.throwIO err-                    Right x   -> return x--                let doc = Pretty.pretty header <> Pretty.pretty expr-                System.IO.withFile file System.IO.WriteMode (\handle -> do-                    Pretty.renderIO handle (Pretty.layoutSmart opts doc)-                    Data.Text.IO.hPutStrLn handle "" )-            Nothing -> do-                System.IO.hSetEncoding System.IO.stdin System.IO.utf8-                inText <- Data.Text.Lazy.IO.getContents--                (header, expr) <- case exprAndHeaderFromText "(stdin)" inText of-                    Left  err -> Control.Exception.throwIO err-                    Right x   -> return x--                let doc = Pretty.pretty header <> prettyExpr expr--                supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout--                if supportsANSI-                  then-                    Pretty.renderIO-                      System.IO.stdout-                      (fmap annToAnsiStyle (Pretty.layoutSmart opts doc))-                  else-                    Pretty.renderIO-                      System.IO.stdout-                      (Pretty.layoutSmart opts (Pretty.unAnnotate doc))-                Data.Text.IO.putStrLn "")

@@ -1,104 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}--module Main where--import Control.Exception (SomeException)-import Control.Monad (when)-import Data.Monoid ((<>))-import Data.Version (showVersion)-import Dhall.Core (normalize)-import Dhall.Import (Imported(..), hashExpressionToCode, load)-import Dhall.Parser (Src, exprFromText)-import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X)-import Options.Applicative (Parser, ParserInfo)-import System.IO (stderr)-import System.Exit (exitFailure, exitSuccess)--import qualified Paths_dhall as Meta--import qualified Control.Exception-import qualified Data.Text.Lazy.IO-import qualified Dhall.TypeCheck-import qualified Options.Applicative-import qualified System.IO--data Options = Options-    { explain :: Bool-    , version :: Bool-    }--parseOptions :: Parser Options-parseOptions = Options <$> parseExplain <*> parseVersion-  where-    parseExplain =-        Options.Applicative.switch-            (   Options.Applicative.long "explain"-            <>  Options.Applicative.help "Explain error messages in more detail"-            )--    parseVersion =-        Options.Applicative.switch-            (   Options.Applicative.long "version"-            <>  Options.Applicative.help "Display version and exit"-            )--parserInfo :: ParserInfo Options-parserInfo =-    Options.Applicative.info-        (Options.Applicative.helper <*> parseOptions)-        (   Options.Applicative.progDesc "Compute semantic hashes for Dhall expressions"-        <>  Options.Applicative.fullDesc-        )--main :: IO ()-main = do-    Options {..} <- Options.Applicative.execParser parserInfo--    when version $ do-      putStrLn (showVersion Meta.version)-      exitSuccess-    let handle =-                Control.Exception.handle handler2-            .   Control.Exception.handle handler1-            .   Control.Exception.handle handler0-          where-            handler0 e = do-                let _ = e :: TypeError Src X-                System.IO.hPutStrLn stderr ""-                if explain-                    then Control.Exception.throwIO (DetailedTypeError e)-                    else do-                        Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"-                        Control.Exception.throwIO e--            handler1 (Imported ps e) = do-                let _ = e :: TypeError Src X-                System.IO.hPutStrLn stderr ""-                if explain-                    then Control.Exception.throwIO (Imported ps (DetailedTypeError e))-                    else do-                        Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"-                        Control.Exception.throwIO (Imported ps e)--            handler2 e = do-                let _ = e :: SomeException-                System.IO.hSetEncoding System.IO.stderr System.IO.utf8-                System.IO.hPrint stderr e-                System.Exit.exitFailure--    handle (do-        System.IO.hSetEncoding System.IO.stdin System.IO.utf8-        inText <- Data.Text.Lazy.IO.getContents--        expr <- case exprFromText "(stdin)" inText of-            Left  err  -> Control.Exception.throwIO err-            Right expr -> return expr--        expr' <- load expr--        _ <- case Dhall.TypeCheck.typeOf expr' of-            Left  err -> Control.Exception.throwIO err-            Right _   -> return ()--        Data.Text.Lazy.IO.putStrLn (hashExpressionToCode (normalize expr')) )

@@ -1,251 +0,0 @@-{-# language FlexibleContexts #-}-{-# language NamedFieldPuns #-}-{-# language OverloadedStrings #-}--module Main ( main ) where--import Control.Exception ( SomeException(SomeException), displayException, throwIO )-import Control.Monad.IO.Class ( MonadIO, liftIO )-import Control.Monad.State.Class ( MonadState, get, modify )-import Control.Monad.State.Strict ( evalStateT )-import Data.List ( foldl' )--import qualified Data.Text.Lazy as LazyText-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty ( renderIO )-import qualified Dhall.Context-import qualified Dhall.Core as Dhall ( Var(V), Expr, normalize )-import qualified Dhall.Pretty-import qualified Dhall.Core as Expr ( Expr(..) )-import qualified Dhall.Import as Dhall-import qualified Dhall.Parser as Dhall-import qualified Dhall.TypeCheck as Dhall-import qualified System.Console.ANSI-import qualified System.Console.Haskeline.MonadException as Haskeline-import qualified System.Console.Repline as Repline-import qualified System.IO---main :: IO ()-main =-  evalStateT-    ( Repline.evalRepl-        "⊢ "-        ( dontCrash . eval )-        options-        ( Repline.Word completer )-        greeter-    )-    emptyEnv---data Env = Env-  { envBindings :: Dhall.Context.Context Binding-  , envIt :: Maybe Binding-  }---emptyEnv :: Env-emptyEnv =-  Env-    { envBindings = Dhall.Context.empty-    , envIt = Nothing-    }---data Binding = Binding-  { bindingExpr :: Dhall.Expr Dhall.Src Dhall.X-  , bindingType :: Dhall.Expr Dhall.Src Dhall.X-  }---envToContext :: Env -> Dhall.Context.Context Binding-envToContext Env{ envBindings, envIt } =-  case envIt of-    Nothing ->-      envBindings--    Just it ->-      Dhall.Context.insert "it" it envBindings---parseAndLoad-  :: ( MonadIO m, MonadState Env m )-  => String -> m ( Dhall.Expr Dhall.Src Dhall.X )-parseAndLoad src = do-  parsed <--    case Dhall.exprFromText "(stdin)" ( LazyText.pack src ) of-      Left e ->-        liftIO ( throwIO e )--      Right a ->-        return a--  liftIO ( Dhall.load parsed )---eval :: ( MonadIO m, MonadState Env m ) => String -> m ()-eval src = do-  loaded <--    parseAndLoad src--  exprType <--    typeCheck loaded--  expr <--    normalize loaded--  modify ( \e -> e { envIt = Just ( Binding expr exprType ) } )--  output System.IO.stdout expr----typeOf :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-typeOf [] =-  liftIO ( putStrLn ":type requires an argument to check the type of" )---typeOf srcs = do-  loaded <--    parseAndLoad ( unwords srcs )--  exprType <--    typeCheck loaded--  exprType' <--    normalize exprType--  output System.IO.stdout exprType'----normalize-  :: MonadState Env m-  => Dhall.Expr Dhall.Src Dhall.X -> m ( Dhall.Expr t Dhall.X )-normalize e = do-  env <--    get--  return-    ( Dhall.normalize-        ( foldl'-            ( \a (k, Binding { bindingType, bindingExpr }) ->-                Expr.Let k ( Just bindingType ) bindingExpr a-            )-            e-            ( Dhall.Context.toList ( envToContext env ) )-        )-    )---typeCheck-  :: ( MonadIO m, MonadState Env m )-  => Dhall.Expr Dhall.Src Dhall.X -> m ( Dhall.Expr Dhall.Src Dhall.X )-typeCheck expr = do-  env <--    get--  case Dhall.typeWith ( bindingType <$> envToContext env ) expr of-    Left e ->-      liftIO ( throwIO e )--    Right a ->-      return a---addBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-addBinding (k : "=" : srcs) = do-  let-    varName =-      LazyText.pack k--  loaded <--    parseAndLoad ( unwords srcs )--  t <--    typeCheck loaded--  expr <--    normalize loaded--  modify-    ( \e ->-        e-          { envBindings =-              Dhall.Context.insert-                varName-                Binding { bindingType = t, bindingExpr = expr }-                ( envBindings e )-          }-    )--  output-    System.IO.stdout-    ( Expr.Annot ( Expr.Var ( Dhall.V varName 0 ) ) t )--addBinding _ =-  liftIO ( fail ":let should be of the form `:let x = y`" )--saveBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-saveBinding (file : "=" : tokens) = do-  loadedExpression <- parseAndLoad (unwords tokens)--  _ <- typeCheck loadedExpression--  normalizedExpression <- normalize loadedExpression--  let handler handle = output handle normalizedExpression--  liftIO (System.IO.withFile file System.IO.WriteMode handler)-saveBinding _ = fail ":save should be of the form `:save x = y`"---options-  :: ( Haskeline.MonadException m, MonadIO m, MonadState Env m )-  => Repline.Options m-options =-  [ ( "type", dontCrash . typeOf )-  , ( "let", dontCrash . addBinding )-  , ( "save", dontCrash . saveBinding )-  ]---completer :: Monad m => Repline.WordCompleter m-completer _ =-  return []---greeter :: MonadIO m => m ()-greeter =-  return ()---dontCrash :: ( MonadIO m, Haskeline.MonadException m ) => m () -> m ()-dontCrash m =-  Haskeline.catch-    m-    ( \ e@SomeException{} -> liftIO ( putStrLn ( displayException e ) ) )---output-    :: (Pretty.Pretty a, MonadIO m)-    => System.IO.Handle -> Dhall.Expr s a -> m ()-output handle expr = do-  liftIO (System.IO.hPutStrLn handle "")  -- Visual spacing--  let opts =-          Pretty.defaultLayoutOptions-              { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }--  let stream = Pretty.layoutSmart opts (Dhall.Pretty.prettyExpr expr)-  supportsANSI <- liftIO (System.Console.ANSI.hSupportsANSI handle)-  let ansiStream =-          if supportsANSI-          then fmap Dhall.Pretty.annToAnsiStyle stream-          else Pretty.unAnnotateS stream--  liftIO (Pretty.renderIO handle ansiStream)-  liftIO (System.IO.hPutStrLn handle "") -- Pretty printing doesn't end with a new line--  liftIO (System.IO.hPutStrLn handle "")  -- Visual spacing

@@ -1,6 +1,6 @@ Name: dhall-Version: 1.14.0-Cabal-Version: >=1.8.0.2+Version: 1.15.0+Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 8.0.1 License: BSD3@@ -34,6 +34,7 @@     Prelude/Bool/show     Prelude/Double/show     Prelude/Integer/show+    Prelude/Integer/toDouble     Prelude/List/all     Prelude/List/any     Prelude/List/build@@ -63,6 +64,7 @@     Prelude/Natural/product     Prelude/Natural/show     Prelude/Natural/sum+    Prelude/Natural/toDouble     Prelude/Natural/toInteger     Prelude/Optional/all     Prelude/Optional/any@@ -95,6 +97,7 @@     tests/normalization/examples/Bool/show/*.dhall     tests/normalization/examples/Double/show/*.dhall     tests/normalization/examples/Integer/show/*.dhall+    tests/normalization/examples/Integer/toDouble/*.dhall     tests/normalization/examples/List/all/*.dhall     tests/normalization/examples/List/any/*.dhall     tests/normalization/examples/List/build/*.dhall@@ -123,6 +126,7 @@     tests/normalization/examples/Natural/product/*.dhall     tests/normalization/examples/Natural/show/*.dhall     tests/normalization/examples/Natural/sum/*.dhall+    tests/normalization/examples/Natural/toDouble/*.dhall     tests/normalization/examples/Natural/toInteger/*.dhall     tests/normalization/examples/Optional/all/*.dhall     tests/normalization/examples/Optional/any/*.dhall@@ -143,15 +147,24 @@     tests/normalization/examples/Text/concatSep/*.dhall     tests/normalization/simplifications/*.dhall     tests/parser/*.dhall+    tests/parser/failure/*.dhall     tests/regression/*.dhall     tests/tutorial/*.dhall     tests/typecheck/*.dhall     tests/typecheck/examples/Monoid/*.dhall+    tests/import/*.dhall+    benchmark/examples/*.dhall+    benchmark/deep-nested-large-record/*.dhall  Source-Repository head     Type: git     Location: https://github.com/dhall-lang/dhall-haskell +Flag with-http+  Description: Include support for importing dhall modules from HTTP URLs+  Default:     True+  Manual:      True+ Library     Hs-Source-Dirs: src     Build-Depends:@@ -162,101 +175,72 @@         containers                  >= 0.5.0.0  && < 0.6 ,         contravariant                              < 1.5 ,         cryptonite                  >= 0.23     && < 1.0 ,-        exceptions                  >= 0.8.3    && < 0.11,+        Diff                        >= 0.2      && < 0.4 ,         directory                   >= 1.3      && < 1.4 ,+        exceptions                  >= 0.8.3    && < 0.11,         filepath                    >= 1.4      && < 1.5 ,-        formatting                  >= 6.3      && < 6.4 ,-        http-client                 >= 0.4.30   && < 0.6 ,-        http-client-tls             >= 0.2.0    && < 0.4 ,+        haskeline                   >= 0.7.3.0  && < 0.8 ,         insert-ordered-containers   >= 0.2.1.0  && < 0.3 ,         lens-family-core            >= 1.0.0    && < 1.3 ,         megaparsec                  >= 6.1.1    && < 6.6 ,         memory                      >= 0.14     && < 0.15,+        mtl                         >= 2.2.1    && < 2.3 ,+        optparse-applicative                       < 0.15,         parsers                     >= 0.12.4   && < 0.13,         prettyprinter               >= 1.2.0.1  && < 1.3 ,         prettyprinter-ansi-terminal >= 1.1.1    && < 1.2 ,+        repline                     >= 0.1.6.0  && < 0.2 ,         scientific                  >= 0.3.0.0  && < 0.4 ,+        template-haskell                           < 2.14,         text                        >= 0.11.1.0 && < 1.3 ,         transformers                >= 0.2.0.0  && < 0.6 ,         unordered-containers        >= 0.1.3.0  && < 0.3 ,         vector                      >= 0.11.0.0 && < 0.13+    if flag(with-http)+      Build-Depends:+        http-client                 >= 0.4.30   && < 0.6 ,+        http-client-tls             >= 0.2.0    && < 0.4     if !impl(ghc >= 8.0)       Build-Depends: semigroups == 0.18.*+      Build-Depends: transformers == 0.4.2.*      Exposed-Modules:         Dhall,         Dhall.Context,         Dhall.Core,-        Dhall.Diff+        Dhall.Diff,+        Dhall.Format,+        Dhall.Freeze,+        Dhall.Hash,         Dhall.Import,+        Dhall.Lint,+        Dhall.Main         Dhall.Parser,         Dhall.Pretty,+        Dhall.Repl+        Dhall.TH,         Dhall.Tutorial,         Dhall.TypeCheck     Other-Modules:-        Dhall.Pretty.Internal-    GHC-Options: -Wall--Executable dhall-    Hs-Source-Dirs: dhall-    Main-Is: Main.hs-    Build-Depends:-        ansi-terminal                                    ,-        base                        >= 4        && < 5   ,-        dhall                                            ,-        optparse-applicative                       < 0.15,-        prettyprinter                                    ,-        prettyprinter-ansi-terminal >= 1.1.1    && < 1.2 ,-        megaparsec                                       ,-        text                        >= 0.11.1.0 && < 1.3-    GHC-Options: -Wall-    Other-Modules:+        Dhall.Pretty.Internal,+        Dhall.Parser.Expression,+        Dhall.Parser.Combinators,+        Dhall.Parser.Token,+        Dhall.Import.Types,         Paths_dhall+    if flag(with-http)+      Other-Modules:+        Dhall.Import.HTTP -Executable dhall-repl-    Hs-Source-Dirs: dhall-repl-    Main-Is: Main.hs-    Build-Depends:-        base             >= 4        && < 5   ,-        ansi-terminal                         ,-        dhall                                 ,-        haskeline        >= 0.7.3.0  && < 0.8 ,-        mtl              >= 2.2.1    && < 2.3 ,-        repline          >= 0.1.6.0  && < 0.2 ,-        prettyprinter                         ,-        prettyprinter-ansi-terminal           ,-        text-    if !impl(ghc >= 8.0)-      Build-Depends: transformers == 0.4.2.*     GHC-Options: -Wall+    Default-Language: Haskell2010 -Executable dhall-format-    Hs-Source-Dirs: dhall-format+Executable dhall+    Hs-Source-Dirs: dhall     Main-Is: Main.hs-    Build-Depends:-        base                        >= 4        && < 5   ,-        ansi-terminal                                    ,-        dhall                                            ,-        megaparsec                                       ,-        optparse-applicative                       < 0.15,-        prettyprinter               >= 1.2.0.1  && < 1.3 ,-        prettyprinter-ansi-terminal >= 1.1.1    && < 1.2 ,-        text                        >= 0.11.1.0 && < 1.3+    Build-Depends: base, dhall     GHC-Options: -Wall-    Other-Modules:-        Paths_dhall--Executable dhall-hash-    Hs-Source-Dirs: dhall-hash-    Main-Is: Main.hs-    Build-Depends:-        base                 >= 4        && < 5   ,-        dhall                                     ,-        optparse-applicative                < 0.15,-        megaparsec                                ,-        text                 >= 0.11.1.0 && < 1.3-    Other-Modules:-        Paths_dhall+    Default-Language: Haskell2010  Test-Suite tasty     Type: exitcode-stdio-1.0@@ -265,6 +249,7 @@     GHC-Options: -Wall     Other-Modules:         Format+        Import         Normalization         Parser         Regression@@ -281,6 +266,7 @@         tasty-hunit               >= 0.9.2    && < 0.11,         text                      >= 0.11.1.0 && < 1.3 ,         vector                    >= 0.11.0.0 && < 0.13+    Default-Language: Haskell2010  Test-Suite doctest     Type: exitcode-stdio-1.0@@ -289,4 +275,28 @@     GHC-Options: -Wall     Build-Depends:         base                      ,+        Diff    >= 0.2   && < 0.4 ,         doctest >= 0.7.0 && < 0.16+    Default-Language: Haskell2010++Benchmark dhall-parser+    Type: exitcode-stdio-1.0+    Main-Is: benchmark/parser/Main.hs+    Build-Depends:+        base                      >= 4        && < 5  ,+        containers                >= 0.5.0.0  && < 0.6,+        criterion                 >= 1.1      && < 1.5,+        dhall                                         ,+        directory                 >= 1.3      && < 1.4,+        text                      >= 0.11.1.0 && < 1.3+    Default-Language: Haskell2010++Benchmark deep-nested-large-record+    Type: exitcode-stdio-1.0+    Main-Is: benchmark/deep-nested-large-record/Main.hs+    Build-Depends:+        base                      >= 4        && < 5  ,+        containers                >= 0.5.0.0  && < 0.6,+        criterion                 >= 1.1      && < 1.5,+        dhall+    Default-Language: Haskell2010

@@ -1,206 +1,6 @@-{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RecordWildCards    #-}- module Main where -import Control.Applicative ((<|>))-import Control.Exception (Exception, SomeException)-import Data.Monoid (mempty, (<>))-import Data.Text.Prettyprint.Doc (Pretty)-import Data.Typeable (Typeable)-import Data.Version (showVersion)-import Dhall.Core (Expr, Import)-import Dhall.Import (Imported(..), load)-import Dhall.Parser (Src)-import Dhall.Pretty (annToAnsiStyle, prettyExpr)-import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X)-import Options.Applicative (Parser)-import System.Exit (exitFailure)-import System.IO (Handle)--import qualified Paths_dhall as Meta--import qualified Control.Exception-import qualified Data.Text.Lazy.IO-import qualified Data.Text.Prettyprint.Doc                 as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty-import qualified Dhall.Core-import qualified Dhall.Parser-import qualified Dhall.TypeCheck-import qualified Options.Applicative-import qualified System.Console.ANSI-import qualified System.IO--data Options = Options-    { mode    :: Mode-    , explain :: Bool-    , plain   :: Bool-    }--data Mode = Default | Version | Resolve | Type | Normalize--parseOptions :: Parser Options-parseOptions = Options <$> parseMode <*> parseExplain <*> parsePlain-  where-    parseExplain =-        Options.Applicative.switch-            (   Options.Applicative.long "explain"-            <>  Options.Applicative.help "Explain error messages in more detail"-            )--    parsePlain =-        Options.Applicative.switch-            (   Options.Applicative.long "plain"-            <>  Options.Applicative.help "Disable syntax highlighting"-            )--parseMode :: Parser Mode-parseMode =-        subcommand "version"   "Display version"                 Version-    <|> subcommand "resolve"   "Resolve an expression's imports" Resolve-    <|> subcommand "type"      "Infer an expression's type"      Type-    <|> subcommand "normalize" "Normalize an expression"         Normalize-    <|> pure Default-  where-    subcommand name description mode =-        Options.Applicative.subparser-            (   Options.Applicative.command name parserInfo-            <>  Options.Applicative.metavar name-            )-      where-        parserInfo =-            Options.Applicative.info parser-                (   Options.Applicative.fullDesc-                <>  Options.Applicative.progDesc description-                )--        parser =-            Options.Applicative.helper <*> pure mode--opts :: Pretty.LayoutOptions-opts =-    Pretty.defaultLayoutOptions-        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }--data ImportResolutionDisabled =-    ImportResolutionDisabled deriving (Exception, Typeable)--instance Show ImportResolutionDisabled where-    show _ = "\nImport resolution is disabled"--throws :: Exception e => Either e a -> IO a-throws (Left  e) = Control.Exception.throwIO e-throws (Right a) = return a--getExpression :: IO (Expr Src Import)-getExpression = do-    inText <- Data.Text.Lazy.IO.getContents--    throws (Dhall.Parser.exprFromText "(stdin)" inText)--assertNoImports :: Expr Src Import -> IO (Expr Src X)-assertNoImports expression =-    throws (traverse (\_ -> Left ImportResolutionDisabled) expression)+import qualified Dhall.Main  main :: IO ()-main = do-    let parserInfo =-            Options.Applicative.info-                (Options.Applicative.helper <*> parseOptions)-                (   Options.Applicative.progDesc "Interpreter for the Dhall language"-                <>  Options.Applicative.fullDesc-                )--    Options {..} <- Options.Applicative.execParser parserInfo--    System.IO.hSetEncoding System.IO.stdin System.IO.utf8--    let handle =-                Control.Exception.handle handler2-            .   Control.Exception.handle handler1-            .   Control.Exception.handle handler0-          where-            handler0 e = do-                let _ = e :: TypeError Src X-                System.IO.hPutStrLn System.IO.stderr ""-                if explain-                    then Control.Exception.throwIO (DetailedTypeError e)-                    else do-                        Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"-                        Control.Exception.throwIO e--            handler1 (Imported ps e) = do-                let _ = e :: TypeError Src X-                System.IO.hPutStrLn System.IO.stderr ""-                if explain-                    then Control.Exception.throwIO (Imported ps (DetailedTypeError e))-                    else do-                        Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"-                        Control.Exception.throwIO (Imported ps e)--            handler2 e = do-                let _ = e :: SomeException-                System.IO.hSetEncoding System.IO.stderr System.IO.utf8-                System.IO.hPrint System.IO.stderr e-                System.Exit.exitFailure--    let render :: Pretty a => Handle -> Expr s a -> IO ()-        render h e = do-            let doc = prettyExpr e--            let layoutOptions = opts--            let stream = Pretty.layoutSmart layoutOptions doc--            supportsANSI <- System.Console.ANSI.hSupportsANSI h-            let ansiStream =-                    if supportsANSI && not plain-                    then fmap annToAnsiStyle stream-                    else Pretty.unAnnotateS stream--            Pretty.renderIO h ansiStream-            Data.Text.Lazy.IO.hPutStrLn h ""--    handle $ case mode of-        Version -> do-            putStrLn (showVersion Meta.version)--        Default -> do-            expression <- getExpression--            resolvedExpression <- load expression--            inferredType <- throws (Dhall.TypeCheck.typeOf resolvedExpression)--            render System.IO.stderr (Dhall.Core.normalize inferredType)--            Data.Text.Lazy.IO.hPutStrLn System.IO.stderr mempty--            render System.IO.stdout (Dhall.Core.normalize resolvedExpression)--        Resolve -> do-            expression <- getExpression--            resolvedExpression <- load expression--            render System.IO.stdout resolvedExpression--        Normalize -> do-            expression <- getExpression--            resolvedExpression <- assertNoImports expression--            _ <- throws (Dhall.TypeCheck.typeOf resolvedExpression)--            render System.IO.stdout (Dhall.Core.normalize resolvedExpression)--        Type -> do-            expression <- getExpression--            resolvedExpression <- assertNoImports expression--            inferredType <- throws (Dhall.TypeCheck.typeOf resolvedExpression)--            render System.IO.stdout (Dhall.Core.normalize inferredType)+main = Dhall.Main.main

@@ -3,4 +3,4 @@ import qualified Test.DocTest  main :: IO ()-main = Test.DocTest.doctest [ "-isrc", "src/Dhall.hs" ]+main = Test.DocTest.doctest [ "-isrc", "src/Dhall.hs", "src/Dhall/Import.hs" ]

@@ -19,7 +19,11 @@     (     -- * Input       input+    , inputFrom     , inputWith+    , inputFromWith+    , inputExpr+    , inputExprWith     , detailed      -- * Types@@ -72,7 +76,7 @@ import Data.Monoid ((<>)) import Data.Scientific (Scientific) import Data.Sequence (Seq)-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Typeable (Typeable) import Data.Vector (Vector) import Data.Word (Word8, Word16, Word32, Word64)@@ -80,7 +84,6 @@ import Dhall.Import (Imported(..)) import Dhall.Parser (Src(..)) import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X)-import Formatting.Buildable (Buildable(..)) import GHC.Generics import Numeric.Natural (Natural) import Prelude hiding (maybe, sequence)@@ -96,12 +99,12 @@ import qualified Data.Set import qualified Data.Text import qualified Data.Text.Lazy-import qualified Data.Text.Lazy.Builder import qualified Data.Vector import qualified Dhall.Context import qualified Dhall.Core import qualified Dhall.Import import qualified Dhall.Parser+import qualified Dhall.Pretty.Internal import qualified Dhall.TypeCheck  -- $setup@@ -154,9 +157,21 @@     -- ^ The Dhall program     -> IO a     -- ^ The decoded value in Haskell-input ty txt =-  inputWith ty Dhall.Context.empty (const Nothing) txt+input =+  inputFrom "(input)" +inputFrom+    :: FilePath+    -- ^ The source file to report locations from; only used in error messages+    -> Type a+    -- ^ The type of value to decode from Dhall to Haskell+    -> Text+    -- ^ The Dhall program+    -> IO a+    -- ^ The decoded value in Haskell+inputFrom filename ty txt =+  inputFromWith filename ty Dhall.Context.empty (const Nothing) txt+ {-| Extend 'input' with a custom typing context and normalization process.  -}@@ -170,13 +185,28 @@     -- ^ The Dhall program     -> IO a     -- ^ The decoded value in Haskell-inputWith (Type {..}) ctx n txt = do-    expr  <- throws (Dhall.Parser.exprFromText "(input)" txt)+inputWith =+  inputFromWith "(input)"++{-| Extend 'inputFrom' with a custom typing context and normalization process.++-}+inputFromWith+    :: FilePath+    -- ^ The source file to report locations from; only used in error messages+    -> Type a+    -- ^ The type of value to decode from Dhall to Haskell+    -> Dhall.Context.Context (Expr Src X)+    -- ^ The starting context for type-checking+    -> Dhall.Core.Normalizer X+    -> Text+    -- ^ The Dhall program+    -> IO a+    -- ^ The decoded value in Haskell+inputFromWith filename (Type {..}) ctx n txt = do+    expr  <- throws (Dhall.Parser.exprFromText filename txt)     expr' <- Dhall.Import.loadWithContext ctx n expr-    let suffix =-            ( Data.Text.Lazy.Builder.toLazyText-            . build-            ) expected+    let suffix = Dhall.Pretty.Internal.prettyToStrictText expected     let annot = case expr' of             Note (Src begin end bytes) _ ->                 Note (Src begin end bytes') (Annot expr' expected)@@ -189,6 +219,32 @@         Just x  -> return x         Nothing -> Control.Exception.throwIO InvalidType +{-| Similar to `input`, but without interpreting the Dhall `Expr` into a Haskell+    type.+-}+inputExpr+    :: Text+    -- ^ The Dhall program+    -> IO (Expr Src X)+    -- ^ The fully normalized AST+inputExpr = inputExprWith Dhall.Context.empty (const Nothing)++{-| Extend `inputExpr` with a custom typing context and normalization process.+-}+inputExprWith+    :: Dhall.Context.Context (Expr Src X)+    -- ^ The starting context for type-checking+    -> Dhall.Core.Normalizer X+    -> Text+    -- ^ The Dhall program+    -> IO (Expr Src X)+    -- ^ The fully normalized AST+inputExprWith ctx n txt = do+    expr  <- throws (Dhall.Parser.exprFromText "(input)" txt)+    expr' <- Dhall.Import.loadWithContext ctx n expr+    _ <- throws (Dhall.TypeCheck.typeWith ctx expr')+    pure (Dhall.Core.normalizeWith n expr')+ -- | Use this function to extract Haskell values directly from Dhall AST. --   The intended use case is to allow easy extraction of Dhall values for --   making the function `Dhall.Core.normalizeWith` easier to use.@@ -415,10 +471,10 @@ >>> input lazyText "\"Test\"" "Test" -}-lazyText :: Type Text+lazyText :: Type Data.Text.Lazy.Text lazyText = Type {..}   where-    extract (TextLit (Chunks [] t)) = pure (Data.Text.Lazy.Builder.toLazyText t)+    extract (TextLit (Chunks [] t)) = pure (Data.Text.Lazy.fromStrict t)     extract  _                      = empty      expected = Text@@ -428,7 +484,7 @@ >>> input strictText "\"Test\"" "Test" -}-strictText :: Type Data.Text.Text+strictText :: Type Text strictText = fmap Data.Text.Lazy.toStrict lazyText  {-| Decode a `Maybe`@@ -551,10 +607,10 @@ instance {-# OVERLAPS #-} Interpret [Char] where     autoWith _ = string -instance Interpret Text where+instance Interpret Data.Text.Lazy.Text where     autoWith _ = lazyText -instance Interpret Data.Text.Text where+instance Interpret Text where     autoWith _ = strictText  instance Interpret a => Interpret (Maybe a) where@@ -649,8 +705,8 @@         nR :: M1 i c2 f2 a         nR = undefined -        nameL = constructorModifier (Data.Text.Lazy.pack (conName nL))-        nameR = constructorModifier (Data.Text.Lazy.pack (conName nR))+        nameL = constructorModifier (Data.Text.pack (conName nL))+        nameR = constructorModifier (Data.Text.pack (conName nR))          extract (UnionLit name e _)             | name == nameL = fmap (L1 . M1) (extractL e)@@ -670,7 +726,7 @@         n :: M1 i c h a         n = undefined -        name = constructorModifier (Data.Text.Lazy.pack (conName n))+        name = constructorModifier (Data.Text.pack (conName n))          extract u@(UnionLit name' e _)             | name == name' = fmap (R1 . M1) (extractR e)@@ -689,7 +745,7 @@         n :: M1 i c f a         n = undefined -        name = constructorModifier (Data.Text.Lazy.pack (conName n))+        name = constructorModifier (Data.Text.pack (conName n))          extract u@(UnionLit name' e _)             | name == name' = fmap (L1 . M1) (extractL e)@@ -748,14 +804,14 @@     genericAutoWith opts@(InterpretOptions {..}) = do         name <- getSelName n         let extract (RecordLit m) = do-                    let name' = fieldModifier (Data.Text.Lazy.pack name)+                    let name' = fieldModifier (Data.Text.pack name)                     e <- Data.HashMap.Strict.InsOrd.lookup name' m                     fmap (M1 . K1) (extract' e)             extract _            = Nothing         let expected =                 Record (Data.HashMap.Strict.InsOrd.fromList [(key, expected')])               where-                key = fieldModifier (Data.Text.Lazy.pack name)+                key = fieldModifier (Data.Text.pack name)         pure (Type {..})       where         n :: M1 i s f a@@ -813,18 +869,18 @@          declared = Bool -instance Inject Text where+instance Inject Data.Text.Lazy.Text where     injectWith _ = InputType {..}       where         embed text =-            TextLit (Chunks [] (Data.Text.Lazy.Builder.fromLazyText text))+            TextLit (Chunks [] (Data.Text.Lazy.toStrict text))          declared = Text -instance Inject Data.Text.Text where+instance Inject Text where     injectWith _ = InputType {..}       where-        embed text = TextLit (Chunks [] (Data.Text.Lazy.Builder.fromText text))+        embed text = TextLit (Chunks [] text)          declared = Text @@ -961,8 +1017,8 @@         nR :: M1 i c2 f2 a         nR = undefined -        keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))-        keyR = constructorModifier (Data.Text.Lazy.pack (conName nR))+        keyL = constructorModifier (Data.Text.pack (conName nL))+        keyR = constructorModifier (Data.Text.pack (conName nR))          InputType embedL declaredL = evalState (genericInjectWith options) 1         InputType embedR declaredR = evalState (genericInjectWith options) 1@@ -979,7 +1035,7 @@         nR :: M1 i c h a         nR = undefined -        keyR = constructorModifier (Data.Text.Lazy.pack (conName nR))+        keyR = constructorModifier (Data.Text.pack (conName nR))          declared = Union (Data.HashMap.Strict.InsOrd.insert keyR declaredR ktsL) @@ -998,7 +1054,7 @@         nL :: M1 i c f a         nL = undefined -        keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))+        keyL = constructorModifier (Data.Text.pack (conName nL))          declared = Union (Data.HashMap.Strict.InsOrd.insert keyL declaredL ktsR) @@ -1049,7 +1105,7 @@  instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where     genericInjectWith opts@(InterpretOptions {..}) = do-        name <- fieldModifier . Data.Text.Lazy.pack <$> getSelName n+        name <- fieldModifier . Data.Text.pack <$> getSelName n         let embed (M1 (K1 x)) =                 RecordLit (Data.HashMap.Strict.InsOrd.singleton name (embedIn x))         let declared =@@ -1102,7 +1158,7 @@     ( Data.Functor.Product.Product         ( Control.Applicative.Const             ( Data.HashMap.Strict.InsOrd.InsOrdHashMap-                Data.Text.Lazy.Text+                Text                 ( Expr Src X )             )         )@@ -1127,7 +1183,7 @@   -- | Parse a single field of a record.-field :: Data.Text.Lazy.Text -> Type a -> RecordType a+field :: Text -> Type a -> RecordType a field key valueType =   let     extractBody expr = do

@@ -12,7 +12,7 @@     , toList     ) where -import Data.Text.Lazy (Text)+import Data.Text (Text) import Prelude hiding (lookup)  {-| A @(Context a)@ associates `Text` labels with values of type @a@.  Each

@@ -1,12 +1,13 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE CPP               #-}-{-# LANGUAGE DeriveFoldable    #-}-{-# LANGUAGE DeriveFunctor     #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE UnicodeSyntax     #-}+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE UnicodeSyntax      #-} {-# OPTIONS_GHC -Wall #-}  {-| This module contains the core calculus for the Dhall language.@@ -41,6 +42,7 @@     , isNormalized     , isNormalizedWith     , denote+    , freeIn      -- * Pretty-printing     , pretty@@ -58,6 +60,7 @@ import Control.Applicative (empty) import Crypto.Hash (SHA256) import Data.Bifunctor (Bifunctor(..))+import Data.Data (Data) import Data.Foldable import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import Data.HashSet (HashSet)@@ -66,12 +69,10 @@ import Data.Semigroup (Semigroup(..)) import Data.Sequence (Seq, ViewL(..), ViewR(..)) import Data.Set (Set)-import Data.Text.Lazy (Text)-import Data.Text.Lazy.Builder (Builder)+import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty) import Data.Traversable import {-# SOURCE #-} Dhall.Pretty.Internal-import Formatting.Buildable (Buildable(..)) import Numeric.Natural (Natural) import Prelude hiding (succ) @@ -82,7 +83,6 @@ import qualified Data.Sequence import qualified Data.Set import qualified Data.Text-import qualified Data.Text.Lazy.Builder     as Builder import qualified Data.Text.Prettyprint.Doc  as Pretty  {-| Constants for a pure type system@@ -102,15 +102,15 @@     Note that Dhall does not support functions from terms to types and therefore     Dhall is not a dependently typed language -}-data Const = Type | Kind deriving (Show, Eq, Bounded, Enum)+data Const = Type | Kind deriving (Show, Eq, Data, Bounded, Enum) -instance Buildable Const where-    build = buildConst+instance Pretty Const where+    pretty = Pretty.unAnnotate . prettyConst  {-| Internal representation of a directory that stores the path components in     reverse order -    In other words, the directory @/foo/bar/baz@ is encoded as+    In other words, the directory @\/foo\/bar\/baz@ is encoded as     @Directory { components = [ "baz", "bar", "foo" ] }@ -} newtype Directory = Directory { components :: [Text] }@@ -120,11 +120,11 @@     Directory components₀ <> Directory components₁ =         Directory (components₁ <> components₀) -instance Buildable Directory where-    build (Directory {..}) =-        foldMap buildComponent (reverse components)+instance Pretty Directory where+    pretty (Directory {..}) =+        foldMap prettyComponent (reverse components)       where-        buildComponent text = "/" <> build text+        prettyComponent text = "/" <> Pretty.pretty text  {-| A `File` is a `directory` followed by one additional path component     representing the `file` name@@ -134,8 +134,8 @@     , file      :: Text     } deriving (Eq, Ord, Show) -instance Buildable File where-    build (File {..}) = build directory <> "/" <> build file+instance Pretty File where+    pretty (File {..}) = Pretty.pretty directory <> "/" <> Pretty.pretty file  instance Semigroup File where     File directory₀ _ <> File directory₁ file =@@ -146,17 +146,14 @@     -- ^ Absolute path     | Here     -- ^ Path relative to @.@-    | Parent-    -- ^ Path relative to @..@     | Home     -- ^ Path relative to @~@     deriving (Eq, Ord, Show) -instance Buildable FilePrefix where-    build Absolute = ""-    build Here     = "."-    build Parent   = ".."-    build Home     = "~"+instance Pretty FilePrefix where+    pretty Absolute = ""+    pretty Here     = "."+    pretty Home     = "~"  -- | The type of import (i.e. local vs. remote vs. environment) data ImportType@@ -166,42 +163,34 @@     -- ^ URL of remote resource and optional headers stored in an import     | Env  Text     -- ^ Environment variable+    | Missing     deriving (Eq, Ord, Show) -parent :: File-parent = File { directory = Directory { components = [ ".." ] }, file = "" }- instance Semigroup ImportType where     Local prefix file₀ <> Local Here file₁ = Local prefix (file₀ <> file₁)      URL prefix file₀ suffix headers <> Local Here file₁ =         URL prefix (file₀ <> file₁) suffix headers -    Local prefix file₀ <> Local Parent file₁ =-        Local prefix (file₀ <> parent <> file₁)--    URL prefix file₀ suffix headers <> Local Parent file₁ =-        URL prefix (file₀ <> parent <> file₁) suffix headers-     _ <> import₁ =         import₁ -instance Buildable ImportType where-    build (Local prefix file) =-        build prefix <> build file <> " "+instance Pretty ImportType where+    pretty (Local prefix file) =+        Pretty.pretty prefix <> Pretty.pretty file -    build (URL prefix file suffix headers) =-            build prefix-        <>  build file-        <>  build suffix-        <>  foldMap buildHeaders headers-        <>  " "+    pretty (URL prefix file suffix headers) =+            Pretty.pretty prefix+        <>  Pretty.pretty file+        <>  Pretty.pretty suffix+        <>  foldMap prettyHeaders headers       where-        buildHeaders h = " using " <> build h+        prettyHeaders h = " using " <> Pretty.pretty h -    build (Env env) =-        "env:" <> build env <> " "+    pretty (Env env) = "env:" <> Pretty.pretty env +    pretty Missing = "missing"+ -- | How to interpret the import's contents (i.e. as Dhall code or raw text) data ImportMode = Code | RawText deriving (Eq, Ord, Show) @@ -215,11 +204,11 @@     ImportHashed _ importType₀ <> ImportHashed hash importType₁ =         ImportHashed hash (importType₀ <> importType₁) -instance Buildable ImportHashed where-    build (ImportHashed  Nothing p) =-      build p-    build (ImportHashed (Just h) p) =-      build p <> "sha256:" <> build (show h) <> " "+instance Pretty ImportHashed where+    pretty (ImportHashed  Nothing p) =+      Pretty.pretty p+    pretty (ImportHashed (Just h) p) =+      Pretty.pretty p <> " sha256:" <> Pretty.pretty (show h)  -- | Reference to an external resource data Import = Import@@ -231,16 +220,14 @@     Import importHashed₀ _ <> Import importHashed₁ code =         Import (importHashed₀ <> importHashed₁) code -instance Buildable Import where-    build (Import {..}) = build importHashed <> suffix+instance Pretty Import where+    pretty (Import {..}) = Pretty.pretty importHashed <> Pretty.pretty suffix       where+        suffix :: Text         suffix = case importMode of-            RawText -> "as Text"+            RawText -> " as Text"             Code    -> "" -instance Pretty Import where-    pretty import_ = Pretty.pretty (Builder.toLazyText (build import_))- -- | Type synonym for `Import`, provided for backwards compatibility type Path = Import @@ -279,13 +266,13 @@     appear as a numeric suffix. -} data Var = V Text !Integer-    deriving (Eq, Show)+    deriving (Data, Eq, Show)  instance IsString Var where     fromString str = V (fromString str) 0 -instance Buildable Var where-    build = buildVar+instance Pretty Var where+    pretty = Pretty.unAnnotate . prettyVar  -- | Syntax tree for expressions data Expr s a@@ -348,6 +335,8 @@     | IntegerLit Integer     -- | > IntegerShow                              ~  Integer/show     | IntegerShow+    -- | > IntegerToDouble                          ~  Integer/toDouble+    | IntegerToDouble     -- | > Double                                   ~  Double     | Double     -- | > DoubleLit n                              ~  n@@ -415,9 +404,11 @@     | Project (Expr s a) (Set Text)     -- | > Note s x                                 ~  e     | Note s (Expr s a)+    -- | > ImportAlt                                ~  e1 ? e2+    | ImportAlt (Expr s a) (Expr s a)     -- | > Embed import                             ~  import     | Embed a-    deriving (Functor, Foldable, Traversable, Show, Eq)+    deriving (Functor, Foldable, Traversable, Show, Eq, Data)  instance Applicative (Expr s) where     pure = Embed@@ -455,6 +446,7 @@     Integer              >>= _ = Integer     IntegerLit a         >>= _ = IntegerLit a     IntegerShow          >>= _ = IntegerShow+    IntegerToDouble      >>= _ = IntegerToDouble     Double               >>= _ = Double     DoubleLit a          >>= _ = DoubleLit a     DoubleShow           >>= _ = DoubleShow@@ -487,6 +479,7 @@     Field a b            >>= k = Field (a >>= k) b     Project a b          >>= k = Project (a >>= k) b     Note a b             >>= k = Note a (b >>= k)+    ImportAlt a b        >>= k = ImportAlt (a >>= k) (b >>= k)     Embed a              >>= k = k a  instance Bifunctor Expr where@@ -518,6 +511,7 @@     first _  Integer               = Integer     first _ (IntegerLit a        ) = IntegerLit a     first _  IntegerShow           = IntegerShow+    first _  IntegerToDouble       = IntegerToDouble     first _  Double                = Double     first _ (DoubleLit a         ) = DoubleLit a     first _  DoubleShow            = DoubleShow@@ -550,6 +544,7 @@     first k (Field a b           ) = Field (first k a) b     first k (Project a b         ) = Project (first k a) b     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      second = fmap@@ -558,8 +553,8 @@     fromString str = Var (fromString str)  -- | The body of an interpolated @Text@ literal-data Chunks s a = Chunks [(Builder, Expr s a)] Builder-    deriving (Functor, Foldable, Traversable, Show, Eq)+data Chunks s a = Chunks [(Text, Expr s a)] Text+    deriving (Functor, Foldable, Traversable, Show, Eq, Data)  instance Data.Semigroup.Semigroup (Chunks s a) where     Chunks xysL zL <> Chunks         []    zR =@@ -589,9 +584,6 @@ -}  -- | Generates a syntactically valid Dhall program-instance Buildable a => Buildable (Expr s a) where-    build = buildExpr- instance Pretty a => Pretty (Expr s a) where     pretty = Pretty.unAnnotate . prettyExpr @@ -732,6 +724,7 @@ shift _ _ Integer = Integer shift _ _ (IntegerLit a) = IntegerLit a shift _ _ IntegerShow = IntegerShow+shift _ _ IntegerToDouble = IntegerToDouble shift _ _ Double = Double shift _ _ (DoubleLit a) = DoubleLit a shift _ _ DoubleShow = DoubleShow@@ -808,6 +801,10 @@ shift d v (Note a b) = Note a b'   where     b' = shift d v b+shift d v (ImportAlt a b) = ImportAlt a' b'+  where+    a' = shift d v a+    b' = shift d v b -- The Dhall compiler enforces that all embedded values are closed expressions -- and `shift` does nothing to a closed expression shift _ _ (Embed p) = Embed p@@ -888,6 +885,7 @@ subst _ _ Integer = Integer subst _ _ (IntegerLit a) = IntegerLit a subst _ _ IntegerShow = IntegerShow+subst _ _ IntegerToDouble = IntegerToDouble subst _ _ Double = Double subst _ _ (DoubleLit a) = DoubleLit a subst _ _ DoubleShow = DoubleShow@@ -955,6 +953,10 @@ subst x e (Note a b) = Note a b'   where     b' = subst x e b+subst x e (ImportAlt a b) = ImportAlt a' b'+  where+    a' = subst x e a+    b' = subst x e b -- The Dhall compiler enforces that all embedded values are closed expressions -- and `subst` does nothing to a closed expression subst _ _ (Embed p) = Embed p@@ -1093,6 +1095,8 @@     IntegerLit n alphaNormalize IntegerShow =     IntegerShow+alphaNormalize IntegerToDouble =+    IntegerToDouble alphaNormalize Double =     Double alphaNormalize (DoubleLit n) =@@ -1218,6 +1222,11 @@     Note s e₁   where     e₁ = alphaNormalize e₀+alphaNormalize (ImportAlt l₀ r₀) =+    ImportAlt l₁ r₁+  where+    l₁ = alphaNormalize l₀+    r₁ = alphaNormalize r₀ alphaNormalize (Embed a) =     Embed a @@ -1286,6 +1295,7 @@ denote  Integer               = Integer denote (IntegerLit a        ) = IntegerLit a denote  IntegerShow           = IntegerShow+denote  IntegerToDouble       = IntegerToDouble denote  Double                = Double denote (DoubleLit a         ) = DoubleLit a denote  DoubleShow            = DoubleShow@@ -1317,6 +1327,7 @@ denote (Constructors a      ) = Constructors (denote a) denote (Field a b           ) = Field (denote a) b denote (Project a b         ) = Project (denote a) b+denote (ImportAlt a b       ) = ImportAlt (denote a) (denote b) denote (Embed a             ) = Embed a  {-| Reduce an expression to its normal form, performing beta reduction and applying@@ -1385,12 +1396,13 @@             App NaturalOdd (NaturalLit n) -> BoolLit (odd n)             App NaturalToInteger (NaturalLit n) -> IntegerLit (toInteger n)             App NaturalShow (NaturalLit n) ->-                TextLit (Chunks [] (buildNatural n))+                TextLit (Chunks [] (Data.Text.pack (show n)))             App IntegerShow (IntegerLit n)-                | 0 <= n    -> TextLit (Chunks [] ("+" <> buildNumber n))-                | otherwise -> TextLit (Chunks [] (buildNumber n))+                | 0 <= n    -> TextLit (Chunks [] ("+" <> Data.Text.pack (show n)))+                | otherwise -> TextLit (Chunks [] (Data.Text.pack (show n)))+            App IntegerToDouble (IntegerLit n) -> DoubleLit (fromInteger n)             App DoubleShow (DoubleLit n) ->-                TextLit (Chunks [] (buildScientific n))+                TextLit (Chunks [] (Data.Text.pack (show n)))             App (App OptionalBuild _A₀) g ->                 loop (App (App (App g optional) just) nothing)               where@@ -1438,8 +1450,7 @@                 m = case Data.Sequence.viewr ys of                         _ :> y -> Just y                         _      -> Nothing-            App (App ListIndexed _A₀) (ListLit _A₁ as₀) ->-                loop (ListLit (Just _A₂) as₁)+            App (App ListIndexed _A₀) (ListLit _A₁ as₀) -> loop (ListLit t as₁)               where                 as₁ = Data.Sequence.mapWithIndex adapt as₀ @@ -1449,6 +1460,9 @@                           , ("value", _A₀)                           ] +                t | null as₀  = Just _A₂+                  | otherwise = Nothing+                 adapt n a_ =                     RecordLit (Data.HashMap.Strict.InsOrd.fromList kvs)                   where@@ -1542,6 +1556,7 @@     Integer -> Integer     IntegerLit n -> IntegerLit n     IntegerShow -> IntegerShow+    IntegerToDouble -> IntegerToDouble     Double -> Double     DoubleLit n -> DoubleLit n     DoubleShow -> DoubleShow@@ -1683,6 +1698,7 @@                     return (x, v)             r' -> Project r' xs     Note _ e' -> loop e'+    ImportAlt l _r -> loop l     Embed a -> Embed a  {-| Returns `True` if two expressions are α-equivalent and β-equivalent and@@ -1733,6 +1749,7 @@         App NaturalShow (NaturalLit _) -> False         App NaturalToInteger (NaturalLit _) -> False         App IntegerShow (IntegerLit _) -> False+        App IntegerToDouble (IntegerLit _) -> False         App DoubleShow (DoubleLit _) -> False         App (App OptionalBuild _) _ -> False         App (App ListBuild _) _ -> False@@ -1807,6 +1824,7 @@     Integer -> True     IntegerLit _ -> True     IntegerShow -> True+    IntegerToDouble -> True     Double -> True     DoubleLit _ -> True     DoubleShow -> True@@ -1894,8 +1912,27 @@                     else True             _ -> True     Note _ e' -> isNormalized e'+    ImportAlt l _r -> isNormalized l     Embed _ -> True +{-| Detect if the given variable is free within the given expression++>>> "x" `freeIn` "x"+True+>>> "x" `freeIn` "y"+False+>>> "x" `freeIn` Lam "x" (Const Type) "x"+False+-}+freeIn :: Eq a => Var -> Expr s a -> Bool+variable `freeIn` expression =+    Dhall.Core.shift 1 variable strippedExpression /= strippedExpression+  where+    denote' :: Expr t b -> Expr () b+    denote' = denote++    strippedExpression = denote' expression+ _ERROR :: String _ERROR = "\ESC[1;31mError\ESC[0m" @@ -1948,6 +1985,7 @@         , "Natural/show"         , "Integer"         , "Integer/show"+        , "Integer/toDouble"         , "Double"         , "Double/show"         , "Text"

@@ -15,23 +15,27 @@     , Dhall.Diff.diff     ) where -import Data.Foldable (fold)+import Data.Foldable (fold, toList)+import Data.Function (on) import Data.HashMap.Strict.InsOrd (InsOrdHashMap)+import Data.List.NonEmpty (NonEmpty(..)) import Data.Monoid (Any(..)) import Data.Scientific (Scientific) import Data.Semigroup+import Data.Sequence (Seq) import Data.Set (Set) import Data.String (IsString(..))-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, Pretty)-import Data.List.NonEmpty (NonEmpty(..))-import Dhall.Core (Const(..), Expr(..), Var(..))+import Dhall.Core (Chunks (..), Const(..), Expr(..), Var(..)) import Dhall.Pretty.Internal (Ann) import Numeric.Natural (Natural) +import qualified Data.Algorithm.Diff        as Algo.Diff import qualified Data.HashMap.Strict.InsOrd as HashMap import qualified Data.List.NonEmpty import qualified Data.Set+import qualified Data.Text import qualified Data.Text.Prettyprint.Doc  as Pretty import qualified Dhall.Core import qualified Dhall.Pretty.Internal      as Internal@@ -157,7 +161,7 @@ diff :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Doc Ann diff l0 r0 = doc   where-    Diff {..} = diffExprA l0 r0+    Diff {..} = diffExpression l0 r0 <> hardline  diffPrimitive :: Eq a => (a -> Diff) -> a -> a -> Diff diffPrimitive f l r@@ -205,6 +209,9 @@      natural = diffInteger nL nR +diffPretty :: (Eq a, Pretty a) => a -> a -> Diff+diffPretty = diffPrimitive (token . Pretty.pretty)+ diffMaybe :: Diff -> (a -> a -> Diff) -> (Maybe a -> Maybe a -> Diff) diffMaybe _ _ Nothing Nothing =     mempty@@ -239,7 +246,7 @@     prefixes = l :| repeat (hardline <> m)  diffKeyVals-    :: Pretty a+    :: (Eq a, Pretty a)     => Diff     -> InsOrdHashMap Text (Expr s a)     -> InsOrdHashMap Text (Expr s a)@@ -263,7 +270,7 @@             <>  ignore             ] -    shared = HashMap.intersectionWith diffExprA kvsL kvsR+    shared = HashMap.intersectionWith diffExpression kvsL kvsR      diffFieldValues =         filter (not . same) (HashMap.foldMapWithKey adapt shared)@@ -285,23 +292,120 @@ angled :: [Diff] -> Diff angled = enclosed (langle <> " ") (pipe <> " ") rangle +bracketed :: [Diff] -> Diff+bracketed = enclosed (lbracket <> " ") (comma <> " ") rbracket++diffText :: Text -> Text -> Diff+diffText l r+  | null parts         = "\"\""+  | allDifferent parts = difference textSkeleton textSkeleton+  | allSame parts      = textSkeleton+  | otherwise          = "\"" <> foldMap prettyPart parts <> "\""+  where+    allDifferent = not . any isBoth+    allSame      = all isBoth++    -- TODO: check for color support from the TTY+    colorDiff colorCode chars =+            "\ESC["+        <>  colorCode+        <>  "m"+        <>  fromString chars+        <>  "\ESC[0m"++    prettyPart part =+      case part of+        -- Only present in left+        Algo.Diff.First  chars ->+            -- Red background+            (colorDiff "41" chars) { same = False }++        -- Only present in right+        Algo.Diff.Second chars ->+            -- Green background+            (colorDiff "42" chars) { same = False }++        -- Present in both+        Algo.Diff.Both _ chars ->+            -- Dim foreground+            colorDiff "2" chars++    parts = Algo.Diff.getGroupedDiff (Data.Text.unpack l) (Data.Text.unpack r)++diffChunks+    :: (Eq a, Pretty a)+    => Chunks s a -> Chunks s a -> Diff+diffChunks cL cR+  | null chunks             = "\"\""+  | [c] <- chunks           = c+  | otherwise               = align (enclosed "   " "++ " "" chunks)+  where+    toEitherList (Chunks te t) =+        concatMap (\(a, b) -> [Left a, Right b]) te ++ [Left t]++    diffTextSkeleton = difference textSkeleton textSkeleton++    chunks = zipWith chunkDiff (toEitherList cL) (toEitherList cR) ++    chunkDiff a b =+      case (a, b) of+        (Left  x, Left y ) -> diffText x y+        (Right x, Right y) -> diffExpression x y+        _                  -> diffTextSkeleton++diffList+    :: (Eq a, Pretty a)+    => Seq (Expr s a) -> Seq (Expr s a) -> Diff+diffList l r+  | allDifferent parts = difference listSkeleton listSkeleton+  | otherwise          = bracketed (foldMap diffPart parts)+  where+    allDifferent = not . any isBoth++    -- Sections of the list that are only in left, only in right, or in both+    parts =+        Algo.Diff.getGroupedDiffBy ((same .) . diffExpression) (toList l) (toList r)++    -- Render each element of a list using an extra rendering function f+    prettyElems f = map (f . token . Internal.prettyExpr)++    diffPart part =+      case part of+        -- Only present in left+        Algo.Diff.First  elements ->+            prettyElems minus elements++        -- Only present in right+        Algo.Diff.Second elements ->+            prettyElems plus  elements++        -- Present in both+        Algo.Diff.Both _ _        ->+            pure ignore++-- Helper function to check when a diff part is present on both sides+isBoth :: Algo.Diff.Diff a -> Bool+isBoth p+  | Algo.Diff.Both _ _ <- p = True+  | otherwise               = False+ diffRecord-    :: Pretty a+    :: (Eq a, Pretty a)     => InsOrdHashMap Text (Expr s a) -> InsOrdHashMap Text (Expr s a) -> Diff diffRecord kvsL kvsR = braced (diffKeyVals colon kvsL kvsR)  diffRecordLit-    :: Pretty a+    :: (Eq a, Pretty a)     => InsOrdHashMap Text (Expr s a) -> InsOrdHashMap Text (Expr s a) -> Diff diffRecordLit kvsL kvsR = braced (diffKeyVals equals kvsL kvsR)  diffUnion-    :: Pretty a+    :: (Eq a, Pretty a)     => InsOrdHashMap Text (Expr s a) -> InsOrdHashMap Text (Expr s a) -> Diff diffUnion kvsL kvsR = angled (diffKeyVals colon kvsL kvsR)  diffUnionLit-    :: Pretty a+    :: (Eq a, Pretty a)     => Text     -> Text     -> Expr s a@@ -315,11 +419,25 @@     <>  format " " (diffLabel kL kR)     <>  equals     <>  " "-    <>  format " " (diffExprA vL vR)+    <>  format " " (diffExpression vL vR)     <>  halfAngled (diffKeyVals equals kvsL kvsR)   where     halfAngled = enclosed (pipe <> " ") (pipe <> " ") rangle +listSkeleton :: Diff+listSkeleton =+        lbracket+    <>  " "+    <>  ignore+    <>  " "+    <>  rbracket++textSkeleton :: Diff+textSkeleton =+        "\""+    <>  ignore+    <>  "\""+ skeleton :: Pretty a => Expr s a -> Diff skeleton (Lam {}) =         lambda@@ -347,6 +465,12 @@     <>  rarrow     <>  " "     <>  ignore+skeleton (App Optional _) =+        "Optional "+    <>  ignore+skeleton (App List _) =+        "List "+    <>  ignore skeleton (App {}) =         ignore     <>  " "@@ -418,9 +542,7 @@     <>  " "     <>  ignore skeleton (TextLit {}) =-        "\""-    <>  ignore-    <>  "\""+        textSkeleton skeleton (TextAppend {}) =         ignore     <>  " "@@ -428,11 +550,7 @@     <>  " "     <>  ignore skeleton (ListLit {}) =-        lbracket-    <>  " "-    <>  ignore-    <>  " "-    <>  rbracket+        listSkeleton     <>  " "     <>  colon     <>  " "@@ -542,25 +660,8 @@ mismatch :: Pretty a => Expr s a -> Expr s a -> Diff mismatch l r = difference (skeleton l) (skeleton r) -diffExprA :: Pretty a => Expr s a -> Expr s a -> Diff-diffExprA l@(Annot {}) r@(Annot {}) =-    enclosed' "  " (colon <> " ") (docs l r)-  where-    docs (Annot aL bL) (Annot aR bR) =-        Data.List.NonEmpty.cons (align doc) (docs bL bR)-      where-        doc = diffExprB aL aR-    docs aL aR =-        diffExprB aL aR :| []-diffExprA l@(Annot {}) r =-    mismatch l r-diffExprA l r@(Annot {}) =-    mismatch l r-diffExprA l r =-    diffExprB l r--diffExprB :: Pretty a => Expr s a -> Expr s a -> Diff-diffExprB l@(Lam {}) r@(Lam {}) =+diffExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffExpression l@(Lam {}) r@(Lam {}) =     enclosed' "  " (rarrow <> " ") (docs l r)   where     docs (Lam aL bL cL) (Lam aR bR cR) =@@ -571,16 +672,16 @@             <>  format " " (diffLabel aL aR)             <>  colon             <>  " "-            <>  format mempty (diffExprA bL bR)+            <>  format mempty (diffExpression bL bR)             <>  rparen      docs aL aR =-        pure (diffExprC aL aR)-diffExprB l@(Lam {}) r =+        pure (diffExpression aL aR)+diffExpression l@(Lam {}) r =     mismatch l r-diffExprB l r@(Lam {}) =+diffExpression l r@(Lam {}) =     mismatch l r-diffExprB l@(BoolIf {}) r@(BoolIf {}) =+diffExpression l@(BoolIf {}) r@(BoolIf {}) =     enclosed' "      " (keyword "else" <> "  ") (docs l r)   where     docs (BoolIf aL bL cL) (BoolIf aR bR cR) =@@ -588,17 +689,35 @@       where         doc =   keyword "if"             <>  " "-            <>  format " " (diffExprA aL aR)+            <>  format " " (diffExpression aL aR)             <>  keyword "then"             <>  " "-            <>  diffExprA bL bR+            <>  diffExpression bL bR     docs aL aR =-        pure (diffExprB aL aR)-diffExprB l@(BoolIf {}) r =+        pure (diffExpression aL aR)+diffExpression l@(BoolIf {}) r =     mismatch l r-diffExprB l r@(BoolIf {}) =+diffExpression l r@(BoolIf {}) =     mismatch l r-diffExprB l@(Pi {}) r@(Pi {}) =+diffExpression l@(Let {}) r@(Let {}) =+    enclosed' "    " (keyword "in" <> "  ") (docs l r)+  where+    docs (Let aL bL cL dL) (Let aR bR cR dR) =+        Data.List.NonEmpty.cons (align doc) (docs dL dR)+      where+        doc =   keyword "let"+            <>  " "+            <>  format " " (diffLabel aL aR)+            <>  format " " (diffMaybe (colon <> " ") diffExpression bL bR)+            <>  equals+            <>  " "+            <>  diffExpression cL cR+    docs aL aR = pure (diffExpression aL aR)+diffExpression l@(Let {}) r =+    mismatch l r+diffExpression l r@(Let {}) =+    mismatch l r+diffExpression l@(Pi {}) r@(Pi {}) =     enclosed' "  " (rarrow <> " ") (docs l r)   where     docs (Pi aL bL cL) (Pi aR bR cR) =@@ -609,263 +728,274 @@             <>  format " " (diffLabel aL aR)             <>  colon             <>  " "-            <>  format mempty (diffExprA bL bR)+            <>  format mempty (diffExpression bL bR)             <>  rparen-    docs aL aR = pure (diffExprB aL aR)-diffExprB l@(Pi {}) r =+    docs aL aR = pure (diffExpression aL aR)+diffExpression l@(Pi {}) r =     mismatch l r-diffExprB l r@(Pi {}) =+diffExpression l r@(Pi {}) =     mismatch l r-diffExprB l@(Let {}) r@(Let {}) =-    enclosed' "    " (keyword "in" <> "  ") (docs l r)+diffExpression l r =+    diffAnnotatedExpression l r++diffAnnotatedExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffAnnotatedExpression (Merge aL bL cL) (Merge aR bR cR) = align doc   where-    docs (Let aL bL cL dL) (Let aR bR cR dR) =-        Data.List.NonEmpty.cons (align doc) (docs dL dR)-      where-        doc =   keyword "let"-            <>  " "-            <>  format " " (diffLabel aL aR)-            <>  format " " (diffMaybe (colon <> " ") diffExprA bL bR)-            <>  equals-            <>  " "-            <>  diffExprA cL cR-    docs aL aR = pure (diffExprB aL aR)-diffExprB l@(Let {}) r =-    mismatch l r-diffExprB l r@(Let {}) =-    mismatch l r--- TODO: Implement proper list diff-diffExprB l@(ListLit {}) r@(ListLit {}) =-    mismatch l r-diffExprB l@(ListLit {}) r =+    doc =   keyword "merge"+        <>  " "+        <>  format " " (diffImportExpression aL aR)+        <>  format " " (diffImportExpression bL bR)+        <>  diffMaybe (colon <> " ") diffApplicationExpression cL cR+diffAnnotatedExpression l@(Merge {}) r =     mismatch l r-diffExprB l r@(ListLit {}) =+diffAnnotatedExpression l r@(Merge {}) =     mismatch l r-diffExprB (OptionalLit aL bL) (OptionalLit aR bR) = align doc+diffAnnotatedExpression (ListLit aL@(Just _) bL) (ListLit aR bR) = align doc   where+    doc =   format " " (diffList bL bR)+        <>  format " " (diffMaybe (colon <> " ") (diffApplicationExpression `on` App List) aL aR)+diffAnnotatedExpression (ListLit aL bL) (ListLit aR@(Just _) bR) = align doc+  where+    doc =   format " " (diffList bL bR)+        <>  format " " (diffMaybe (colon <> " ") (diffApplicationExpression `on` App List) aL aR)+diffAnnotatedExpression (OptionalLit aL bL) (OptionalLit aR bR) =+    align doc+  where     doc =   lbracket         <>  " "-        <>  format " " (diffMaybe mempty diffExprA bL bR)+        <>  format " " (diffMaybe mempty diffExpression bL bR)         <>  rbracket         <>  " "         <>  colon         <>  " "-        <>  diffExprD (App Optional aL) (App Optional aR)-diffExprB l@(OptionalLit {}) r =+        <>  diffApplicationExpression (App Optional aL) (App Optional aR)+diffAnnotatedExpression l@(OptionalLit {}) r =     mismatch l r-diffExprB l r@(OptionalLit {}) =+diffAnnotatedExpression l r@(OptionalLit {}) =     mismatch l r-diffExprB (Merge aL bL cL) (Merge aR bR cR) = align doc+diffAnnotatedExpression l@(Annot {}) r@(Annot {}) =+    enclosed' "  " (colon <> " ") (docs l r)   where-    doc =   keyword "merge"-        <>  " "-        <>  format " " (diffExprE aL aR)-        <>  format " " (diffExprE bL bR)-        <>  diffMaybe (colon <> " ") diffExprE cL cR-diffExprB l@(Merge {}) r =+    docs (Annot aL bL) (Annot aR bR) =+        Data.List.NonEmpty.cons (align doc) (docs bL bR)+      where+        doc = diffOperatorExpression aL aR+    docs aL aR =+        diffExpression aL aR :| []+diffAnnotatedExpression l@(Annot {}) r =     mismatch l r-diffExprB l r@(Merge {}) =+diffAnnotatedExpression l r@(Annot {}) =     mismatch l r-diffExprB l r =-    diffExprC l r+diffAnnotatedExpression l r =+    diffOperatorExpression l r -diffExprC :: Pretty a => Expr s a -> Expr s a -> Diff-diffExprC = diffBoolOr+diffOperatorExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffOperatorExpression = diffOrExpression -diffBoolOr :: Pretty a => Expr s a -> Expr s a -> Diff-diffBoolOr l@(BoolOr {}) r@(BoolOr {}) =+diffOrExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffOrExpression l@(BoolOr {}) r@(BoolOr {}) =     enclosed' "    " (operator "||" <> "  ") (docs l r)   where     docs (BoolOr aL bL) (BoolOr aR bR) =-        Data.List.NonEmpty.cons (diffTextAppend aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffTextAppendExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffTextAppend aL aR)-diffBoolOr l@(BoolOr {}) r =+        pure (diffTextAppendExpression aL aR)+diffOrExpression l@(BoolOr {}) r =     mismatch l r-diffBoolOr l r@(BoolOr {}) =+diffOrExpression l r@(BoolOr {}) =     mismatch l r-diffBoolOr l r =-    diffTextAppend l r+diffOrExpression l r =+    diffPlusExpression l r -diffTextAppend :: Pretty a => Expr s a -> Expr s a -> Diff-diffTextAppend l@(TextAppend {}) r@(TextAppend {}) =-    enclosed' "    " (operator "++" <> "  ") (docs l r)+diffPlusExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffPlusExpression l@(NaturalPlus {}) r@(NaturalPlus {}) =+    enclosed' "  " (operator "+" <> " ") (docs l r)   where-    docs (TextAppend aL bL) (TextAppend aR bR) =-        Data.List.NonEmpty.cons (diffNaturalPlus aL aR) (docs bL bR)+    docs (NaturalPlus aL bL) (NaturalPlus aR bR) =+        Data.List.NonEmpty.cons (diffListAppendExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffNaturalPlus aL aR)-diffTextAppend l@(TextAppend {}) r =+        pure (diffListAppendExpression aL aR)+diffPlusExpression l@(NaturalPlus {}) r =     mismatch l r-diffTextAppend l r@(TextAppend {}) =+diffPlusExpression l r@(NaturalPlus {}) =     mismatch l r-diffTextAppend l r =-    diffNaturalPlus l r+diffPlusExpression l r =+    diffTextAppendExpression l r -diffNaturalPlus :: Pretty a => Expr s a -> Expr s a -> Diff-diffNaturalPlus l@(NaturalPlus {}) r@(NaturalPlus {}) =-    enclosed' "  " (operator "+" <> " ") (docs l r)+diffTextAppendExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffTextAppendExpression l@(TextAppend {}) r@(TextAppend {}) =+    enclosed' "    " (operator "++" <> "  ") (docs l r)   where-    docs (NaturalPlus aL bL) (NaturalPlus aR bR) =-        Data.List.NonEmpty.cons (diffListAppend aL aR) (docs bL bR)+    docs (TextAppend aL bL) (TextAppend aR bR) =+        Data.List.NonEmpty.cons (diffPlusExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffListAppend aL aR)-diffNaturalPlus l@(NaturalPlus {}) r =+        pure (diffPlusExpression aL aR)+diffTextAppendExpression l@(TextAppend {}) r =     mismatch l r-diffNaturalPlus l r@(NaturalPlus {}) =+diffTextAppendExpression l r@(TextAppend {}) =     mismatch l r-diffNaturalPlus l r =-    diffListAppend l r+diffTextAppendExpression l r =+    diffListAppendExpression l r -diffListAppend :: Pretty a => Expr s a -> Expr s a -> Diff-diffListAppend l@(ListAppend {}) r@(ListAppend {}) =+diffListAppendExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffListAppendExpression l@(ListAppend {}) r@(ListAppend {}) =     enclosed' "  " (operator "#" <> " ") (docs l r)   where     docs (ListAppend aL bL) (ListAppend aR bR) =-        Data.List.NonEmpty.cons (diffBoolAnd aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffAndExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffBoolAnd aL aR)-diffListAppend l@(ListAppend {}) r =+        pure (diffAndExpression aL aR)+diffListAppendExpression l@(ListAppend {}) r =     mismatch l r-diffListAppend l r@(ListAppend {}) =+diffListAppendExpression l r@(ListAppend {}) =     mismatch l r-diffListAppend l r =-    diffBoolAnd l r+diffListAppendExpression l r =+    diffAndExpression l r -diffBoolAnd :: Pretty a => Expr s a -> Expr s a -> Diff-diffBoolAnd l@(BoolAnd {}) r@(BoolAnd {}) =+diffAndExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffAndExpression l@(BoolAnd {}) r@(BoolAnd {}) =     enclosed' "    " (operator "&&" <> "  ") (docs l r)   where     docs (BoolAnd aL bL) (BoolAnd aR bR) =-        Data.List.NonEmpty.cons (diffCombine aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffCombineExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffCombine aL aR)-diffBoolAnd l@(BoolAnd {}) r =+        pure (diffCombineExpression aL aR)+diffAndExpression l@(BoolAnd {}) r =     mismatch l r-diffBoolAnd l r@(BoolAnd {}) =+diffAndExpression l r@(BoolAnd {}) =     mismatch l r-diffBoolAnd l r =-    diffCombine l r+diffAndExpression l r =+    diffCombineExpression l r -diffCombine :: Pretty a => Expr s a -> Expr s a -> Diff-diffCombine l@(Combine {}) r@(Combine {}) =+diffCombineExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffCombineExpression l@(Combine {}) r@(Combine {}) =     enclosed' "  " (operator "∧" <> " ") (docs l r)   where     docs (Combine aL bL) (Combine aR bR) =-        Data.List.NonEmpty.cons (diffPrefer aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffPreferExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffPrefer aL aR)-diffCombine l@(Combine {}) r =+        pure (diffPreferExpression aL aR)+diffCombineExpression l@(Combine {}) r =     mismatch l r-diffCombine l r@(Combine {}) =+diffCombineExpression l r@(Combine {}) =     mismatch l r-diffCombine l r =-    diffPrefer l r+diffCombineExpression l r =+    diffPreferExpression l r -diffPrefer :: Pretty a => Expr s a -> Expr s a -> Diff-diffPrefer l@(Prefer {}) r@(Prefer {}) =+diffPreferExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffPreferExpression l@(Prefer {}) r@(Prefer {}) =     enclosed' "  " (operator "⫽" <> " ") (docs l r)   where     docs (Prefer aL bL) (Prefer aR bR) =-        Data.List.NonEmpty.cons (diffCombineTypes aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffCombineTypesExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffCombineTypes aL aR)-diffPrefer l@(Prefer {}) r =+        pure (diffCombineTypesExpression aL aR)+diffPreferExpression l@(Prefer {}) r =     mismatch l r-diffPrefer l r@(Prefer {}) =+diffPreferExpression l r@(Prefer {}) =     mismatch l r-diffPrefer l r =-    diffCombineTypes l r+diffPreferExpression l r =+    diffCombineTypesExpression l r -diffCombineTypes :: Pretty a => Expr s a -> Expr s a -> Diff-diffCombineTypes l@(CombineTypes {}) r@(CombineTypes {}) =+diffCombineTypesExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffCombineTypesExpression l@(CombineTypes {}) r@(CombineTypes {}) =     enclosed' "  " (operator "*" <> " ") (docs l r)   where     docs (CombineTypes aL bL) (CombineTypes aR bR) =-        Data.List.NonEmpty.cons (diffNaturalTimes aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffTimesExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffNaturalTimes aL aR)-diffCombineTypes l@(CombineTypes {}) r =+        pure (diffTimesExpression aL aR)+diffCombineTypesExpression l@(CombineTypes {}) r =     mismatch l r-diffCombineTypes l r@(CombineTypes {}) =+diffCombineTypesExpression l r@(CombineTypes {}) =     mismatch l r-diffCombineTypes l r =-    diffNaturalTimes l r+diffCombineTypesExpression l r =+    diffTimesExpression l r -diffNaturalTimes :: Pretty a => Expr s a -> Expr s a -> Diff-diffNaturalTimes l@(NaturalTimes {}) r@(NaturalTimes {}) =+diffTimesExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffTimesExpression l@(NaturalTimes {}) r@(NaturalTimes {}) =     enclosed' "  " (operator "*" <> " ") (docs l r)   where     docs (NaturalTimes aL bL) (NaturalTimes aR bR) =-        Data.List.NonEmpty.cons (diffBoolEQ aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffEqualExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffBoolEQ aL aR)-diffNaturalTimes l@(NaturalTimes {}) r =+        pure (diffEqualExpression aL aR)+diffTimesExpression l@(NaturalTimes {}) r =     mismatch l r-diffNaturalTimes l r@(NaturalTimes {}) =+diffTimesExpression l r@(NaturalTimes {}) =     mismatch l r-diffNaturalTimes l r =-    diffBoolEQ l r+diffTimesExpression l r =+    diffEqualExpression l r -diffBoolEQ :: Pretty a => Expr s a -> Expr s a -> Diff-diffBoolEQ l@(BoolEQ {}) r@(BoolEQ {}) =+diffEqualExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffEqualExpression l@(BoolEQ {}) r@(BoolEQ {}) =     enclosed' "    " (operator "==" <> "  ") (docs l r)   where     docs (BoolEQ aL bL) (BoolEQ aR bR) =-        Data.List.NonEmpty.cons (diffBoolNE aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffNotEqualExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffBoolNE aL aR)-diffBoolEQ l@(BoolEQ {}) r =+        pure (diffNotEqualExpression aL aR)+diffEqualExpression l@(BoolEQ {}) r =     mismatch l r-diffBoolEQ l r@(BoolEQ {}) =+diffEqualExpression l r@(BoolEQ {}) =     mismatch l r-diffBoolEQ l r =-    diffBoolNE l r+diffEqualExpression l r =+    diffNotEqualExpression l r -diffBoolNE :: Pretty a => Expr s a -> Expr s a -> Diff-diffBoolNE l@(BoolNE {}) r@(BoolNE {}) =+diffNotEqualExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffNotEqualExpression l@(BoolNE {}) r@(BoolNE {}) =     enclosed' "    " (operator "!=" <> "  ") (docs l r)   where     docs (BoolNE aL bL) (BoolNE aR bR) =-        Data.List.NonEmpty.cons (diffExprD aL aR) (docs bL bR)+        Data.List.NonEmpty.cons (diffApplicationExpression aL aR) (docs bL bR)     docs aL aR =-        pure (diffExprD aL aR)-diffBoolNE l@(BoolNE {}) r =+        pure (diffApplicationExpression aL aR)+diffNotEqualExpression l@(BoolNE {}) r =     mismatch l r-diffBoolNE l r@(BoolNE {}) =+diffNotEqualExpression l r@(BoolNE {}) =     mismatch l r-diffBoolNE l r =-    diffExprD l r+diffNotEqualExpression l r =+    diffApplicationExpression l r -diffExprD :: Pretty a => Expr s a -> Expr s a -> Diff-diffExprD l@(App {}) r@(App {}) =+diffApplicationExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffApplicationExpression l@(App {}) r@(App {}) =     enclosed' mempty mempty (Data.List.NonEmpty.reverse (docs l r))   where     docs (App aL bL) (App aR bR) =-        Data.List.NonEmpty.cons (diffExprE bL bR) (docs aL aR)+        Data.List.NonEmpty.cons (diffImportExpression bL bR) (docs aL aR)     docs (Constructors aL) (Constructors aR) =-        diffExprE aL aR :| [ keyword "constructors" ]+        diffImportExpression aL aR :| [ keyword "constructors" ]     docs aL@(App {}) aR@(Constructors {}) =         pure (mismatch aL aR)     docs aL@(Constructors {}) aR@(App {}) =         pure (mismatch aL aR)     docs aL aR =-        pure (diffExprE aL aR)-diffExprD l@(App {}) r =+        pure (diffImportExpression aL aR)+diffApplicationExpression l@(App {}) r =     mismatch l r-diffExprD l r@(App {}) =+diffApplicationExpression l r@(App {}) =     mismatch l r-diffExprD l@(Constructors {}) r@(Constructors {}) =-    enclosed' mempty mempty (keyword "constructors" :| [ diffExprE l r ])-diffExprD l@(Constructors {}) r =+diffApplicationExpression l@(Constructors {}) r@(Constructors {}) =+    enclosed' mempty mempty (keyword "constructors" :| [ diffImportExpression l r ])+diffApplicationExpression l@(Constructors {}) r =     mismatch l r-diffExprD l r@(Constructors {}) =+diffApplicationExpression l r@(Constructors {}) =     mismatch l r-diffExprD l r =-    diffExprE l r+diffApplicationExpression l r =+    diffImportExpression l r -diffExprE :: Pretty a => Expr s a -> Expr s a -> Diff-diffExprE l@(Field {}) r@(Field {}) =+diffImportExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffImportExpression (Embed l) (Embed r) =+    diffPretty l r+diffImportExpression l@(Embed {}) r =+    mismatch l r+diffImportExpression l r@(Embed {}) =+    mismatch l r+diffImportExpression l r =+    diffSelectorExpression l r++diffSelectorExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffSelectorExpression l@(Field {}) r@(Field {}) =     enclosed' "  " (dot <> " ") (Data.List.NonEmpty.reverse (docs l r))   where     docs (Field aL bL) (Field aR bR) =@@ -873,12 +1003,12 @@     docs (Project aL bL) (Project aR bR) =         Data.List.NonEmpty.cons (diffLabels bL bR) (docs aL aR)     docs aL aR =-        pure (diffExprF aL aR)-diffExprE l@(Field {}) r =+        pure (diffPrimitiveExpression aL aR)+diffSelectorExpression l@(Field {}) r =     mismatch l r-diffExprE l r@(Field {}) =+diffSelectorExpression l r@(Field {}) =     mismatch l r-diffExprE l@(Project {}) r@(Project {}) =+diffSelectorExpression l@(Project {}) r@(Project {}) =     enclosed' "  " (dot <> " ") (Data.List.NonEmpty.reverse (docs l r))   where     docs (Field aL bL) (Field aR bR) =@@ -886,235 +1016,247 @@     docs (Project aL bL) (Project aR bR) =         Data.List.NonEmpty.cons (diffLabels bL bR) (docs aL aR)     docs aL aR =-        pure (diffExprF aL aR)-diffExprE l@(Project {}) r =+        pure (diffPrimitiveExpression aL aR)+diffSelectorExpression l@(Project {}) r =     mismatch l r-diffExprE l r@(Project {}) =+diffSelectorExpression l r@(Project {}) =     mismatch l r-diffExprE l r =-    diffExprF l r+diffSelectorExpression l r =+    diffPrimitiveExpression l r -diffExprF :: Pretty a => Expr s a -> Expr s a -> Diff-diffExprF (Var aL) (Var aR) =+diffPrimitiveExpression :: (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff+diffPrimitiveExpression (Var aL) (Var aR) =     diffVar aL aR-diffExprF l@(Var {}) r =+diffPrimitiveExpression l@(Var {}) r =     mismatch l r-diffExprF l r@(Var {}) =+diffPrimitiveExpression l r@(Var {}) =     mismatch l r-diffExprF (Const aL) (Const aR) =+diffPrimitiveExpression (Const aL) (Const aR) =     diffConst aL aR-diffExprF l@(Const {}) r =+diffPrimitiveExpression l@(Const {}) r =     mismatch l r-diffExprF l r@(Const {}) =+diffPrimitiveExpression l r@(Const {}) =     mismatch l r-diffExprF Bool Bool =+diffPrimitiveExpression Bool Bool =     "…"-diffExprF l@Bool r =+diffPrimitiveExpression l@Bool r =     mismatch l r-diffExprF l r@Bool =+diffPrimitiveExpression l r@Bool =     mismatch l r-diffExprF Natural Natural =+diffPrimitiveExpression Natural Natural =     "…"-diffExprF l@Natural r =+diffPrimitiveExpression l@Natural r =     mismatch l r-diffExprF l r@Natural =+diffPrimitiveExpression l r@Natural =     mismatch l r-diffExprF NaturalFold NaturalFold =+diffPrimitiveExpression NaturalFold NaturalFold =     "…"-diffExprF l@NaturalFold r =+diffPrimitiveExpression l@NaturalFold r =     mismatch l r-diffExprF l r@NaturalFold =+diffPrimitiveExpression l r@NaturalFold =     mismatch l r-diffExprF NaturalBuild NaturalBuild =+diffPrimitiveExpression NaturalBuild NaturalBuild =     "…"-diffExprF l@NaturalBuild r =+diffPrimitiveExpression l@NaturalBuild r =     mismatch l r-diffExprF l r@NaturalBuild =+diffPrimitiveExpression l r@NaturalBuild =     mismatch l r-diffExprF NaturalIsZero NaturalIsZero =+diffPrimitiveExpression NaturalIsZero NaturalIsZero =     "…"-diffExprF l@NaturalIsZero r =+diffPrimitiveExpression l@NaturalIsZero r =     mismatch l r-diffExprF l r@NaturalIsZero =+diffPrimitiveExpression l r@NaturalIsZero =     mismatch l r-diffExprF NaturalEven NaturalEven =+diffPrimitiveExpression NaturalEven NaturalEven =     "…"-diffExprF l@NaturalEven r =+diffPrimitiveExpression l@NaturalEven r =     mismatch l r-diffExprF l r@NaturalEven =+diffPrimitiveExpression l r@NaturalEven =     mismatch l r-diffExprF NaturalOdd NaturalOdd =+diffPrimitiveExpression NaturalOdd NaturalOdd =     "…"-diffExprF l@NaturalOdd r =+diffPrimitiveExpression l@NaturalOdd r =     mismatch l r-diffExprF l r@NaturalOdd =+diffPrimitiveExpression l r@NaturalOdd =     mismatch l r-diffExprF NaturalToInteger NaturalToInteger =+diffPrimitiveExpression NaturalToInteger NaturalToInteger =     "…"-diffExprF l@NaturalToInteger r =+diffPrimitiveExpression l@NaturalToInteger r =     mismatch l r-diffExprF l r@NaturalToInteger =+diffPrimitiveExpression l r@NaturalToInteger =     mismatch l r-diffExprF NaturalShow NaturalShow =+diffPrimitiveExpression NaturalShow NaturalShow =     "…"-diffExprF l@NaturalShow r =+diffPrimitiveExpression l@NaturalShow r =     mismatch l r-diffExprF l r@NaturalShow =+diffPrimitiveExpression l r@NaturalShow =     mismatch l r-diffExprF Integer Integer =+diffPrimitiveExpression Integer Integer =     "…"-diffExprF l@Integer r =+diffPrimitiveExpression l@Integer r =     mismatch l r-diffExprF l r@Integer =+diffPrimitiveExpression l r@Integer =     mismatch l r-diffExprF IntegerShow IntegerShow =+diffPrimitiveExpression IntegerShow IntegerShow =     "…"-diffExprF l@IntegerShow r =+diffPrimitiveExpression l@IntegerShow r =     mismatch l r-diffExprF l r@IntegerShow =+diffPrimitiveExpression l r@IntegerShow =     mismatch l r-diffExprF Double Double =+diffPrimitiveExpression IntegerToDouble IntegerToDouble =     "…"-diffExprF l@Double r =+diffPrimitiveExpression l@IntegerToDouble r =     mismatch l r-diffExprF l r@Double =+diffPrimitiveExpression l r@IntegerToDouble =     mismatch l r-diffExprF DoubleShow DoubleShow =+diffPrimitiveExpression Double Double =     "…"-diffExprF l@DoubleShow r =+diffPrimitiveExpression l@Double r =     mismatch l r-diffExprF l r@DoubleShow =+diffPrimitiveExpression l r@Double =     mismatch l r-diffExprF Text Text =+diffPrimitiveExpression DoubleShow DoubleShow =     "…"-diffExprF l@Text r =+diffPrimitiveExpression l@DoubleShow r =     mismatch l r-diffExprF l r@Text =+diffPrimitiveExpression l r@DoubleShow =     mismatch l r-diffExprF List List =+diffPrimitiveExpression Text Text =     "…"-diffExprF l@List r =+diffPrimitiveExpression l@Text r =     mismatch l r-diffExprF l r@List =+diffPrimitiveExpression l r@Text =     mismatch l r-diffExprF ListBuild ListBuild =+diffPrimitiveExpression List List =     "…"-diffExprF l@ListBuild r =+diffPrimitiveExpression l@List r =     mismatch l r-diffExprF l r@ListBuild =+diffPrimitiveExpression l r@List =     mismatch l r-diffExprF ListFold ListFold =+diffPrimitiveExpression (ListLit Nothing bL) (ListLit Nothing bR) = align doc+  where+    doc = format " " (diffList bL bR)+diffPrimitiveExpression l@(ListLit {}) r =+    mismatch l r+diffPrimitiveExpression l r@(ListLit {}) =+    mismatch l r+diffPrimitiveExpression ListBuild ListBuild =     "…"-diffExprF l@ListFold r =+diffPrimitiveExpression l@ListBuild r =     mismatch l r-diffExprF l r@ListFold =+diffPrimitiveExpression l r@ListBuild =     mismatch l r-diffExprF ListLength ListLength =+diffPrimitiveExpression ListFold ListFold =     "…"-diffExprF l@ListLength r =+diffPrimitiveExpression l@ListFold r =     mismatch l r-diffExprF l r@ListLength =+diffPrimitiveExpression l r@ListFold =     mismatch l r-diffExprF ListHead ListHead =+diffPrimitiveExpression ListLength ListLength =     "…"-diffExprF l@ListHead r =+diffPrimitiveExpression l@ListLength r =     mismatch l r-diffExprF l r@ListHead =+diffPrimitiveExpression l r@ListLength =     mismatch l r-diffExprF ListLast ListLast =+diffPrimitiveExpression ListHead ListHead =     "…"-diffExprF l@ListLast r =+diffPrimitiveExpression l@ListHead r =     mismatch l r-diffExprF l r@ListLast =+diffPrimitiveExpression l r@ListHead =     mismatch l r-diffExprF ListIndexed ListIndexed =+diffPrimitiveExpression ListLast ListLast =     "…"-diffExprF l@ListIndexed r =+diffPrimitiveExpression l@ListLast r =     mismatch l r-diffExprF l r@ListIndexed =+diffPrimitiveExpression l r@ListLast =     mismatch l r-diffExprF ListReverse ListReverse =+diffPrimitiveExpression ListIndexed ListIndexed =     "…"-diffExprF l@ListReverse r =+diffPrimitiveExpression l@ListIndexed r =     mismatch l r-diffExprF l r@ListReverse =+diffPrimitiveExpression l r@ListIndexed =     mismatch l r-diffExprF Optional Optional =+diffPrimitiveExpression ListReverse ListReverse =     "…"-diffExprF l@Optional r =+diffPrimitiveExpression l@ListReverse r =     mismatch l r-diffExprF l r@Optional =+diffPrimitiveExpression l r@ListReverse =     mismatch l r-diffExprF OptionalFold OptionalFold =+diffPrimitiveExpression Optional Optional =     "…"-diffExprF l@OptionalFold r =+diffPrimitiveExpression l@Optional r =     mismatch l r-diffExprF l r@OptionalFold =+diffPrimitiveExpression l r@Optional =     mismatch l r-diffExprF OptionalBuild OptionalBuild =+diffPrimitiveExpression OptionalFold OptionalFold =     "…"-diffExprF l@OptionalBuild r =+diffPrimitiveExpression l@OptionalFold r =     mismatch l r-diffExprF l r@OptionalBuild =+diffPrimitiveExpression l r@OptionalFold =     mismatch l r-diffExprF (BoolLit aL) (BoolLit aR) =+diffPrimitiveExpression OptionalBuild OptionalBuild =+    "…"+diffPrimitiveExpression l@OptionalBuild r =+    mismatch l r+diffPrimitiveExpression l r@OptionalBuild =+    mismatch l r+diffPrimitiveExpression (BoolLit aL) (BoolLit aR) =     diffBool aL aR-diffExprF l@(BoolLit {}) r =+diffPrimitiveExpression l@(BoolLit {}) r =     mismatch l r-diffExprF l r@(BoolLit {}) =+diffPrimitiveExpression l r@(BoolLit {}) =     mismatch l r-diffExprF (IntegerLit aL) (IntegerLit aR) =+diffPrimitiveExpression (IntegerLit aL) (IntegerLit aR) =     diffInteger aL aR-diffExprF l@(IntegerLit {}) r =+diffPrimitiveExpression l@(IntegerLit {}) r =     mismatch l r-diffExprF l r@(IntegerLit {}) =+diffPrimitiveExpression l r@(IntegerLit {}) =     mismatch l r-diffExprF (NaturalLit aL) (NaturalLit aR) =-    token (Internal.literal "+") <> diffNatural aL aR-diffExprF l@(NaturalLit {}) r =+diffPrimitiveExpression (NaturalLit aL) (NaturalLit aR) =+    diffNatural aL aR+diffPrimitiveExpression l@(NaturalLit {}) r =     mismatch l r-diffExprF l r@(NaturalLit {}) =+diffPrimitiveExpression l r@(NaturalLit {}) =     mismatch l r-diffExprF (DoubleLit aL) (DoubleLit aR) =+diffPrimitiveExpression (DoubleLit aL) (DoubleLit aR) =     diffScientific aL aR-diffExprF l@(DoubleLit {}) r =-    mismatch l r-diffExprF l r@(DoubleLit {}) =+diffPrimitiveExpression l@(DoubleLit {}) r =     mismatch l r--- TODO: Implement proper textual diff-diffExprF l@(TextLit {}) r@(TextLit {}) =+diffPrimitiveExpression l r@(DoubleLit {}) =     mismatch l r-diffExprF l@(TextLit {}) r =+diffPrimitiveExpression (TextLit l) (TextLit r) =+    diffChunks l r+diffPrimitiveExpression l@(TextLit {}) r =     mismatch l r-diffExprF l r@(TextLit {}) =+diffPrimitiveExpression l r@(TextLit {}) =     mismatch l r-diffExprF (Record aL) (Record aR) =+diffPrimitiveExpression (Record aL) (Record aR) =     diffRecord aL aR-diffExprF l@(Record {}) r =+diffPrimitiveExpression l@(Record {}) r =     mismatch l r-diffExprF l r@(Record {}) =+diffPrimitiveExpression l r@(Record {}) =     mismatch l r-diffExprF (RecordLit aL) (RecordLit aR) =+diffPrimitiveExpression (RecordLit aL) (RecordLit aR) =     diffRecordLit aL aR-diffExprF l@(RecordLit {}) r =+diffPrimitiveExpression l@(RecordLit {}) r =     mismatch l r-diffExprF l r@(RecordLit {}) =+diffPrimitiveExpression l r@(RecordLit {}) =     mismatch l r-diffExprF (Union aL) (Union aR) =+diffPrimitiveExpression (Union aL) (Union aR) =     diffUnion aL aR-diffExprF l@(Union {}) r =+diffPrimitiveExpression l@(Union {}) r =     mismatch l r-diffExprF l r@(Union {}) =+diffPrimitiveExpression l r@(Union {}) =     mismatch l r-diffExprF (UnionLit aL bL cL) (UnionLit aR bR cR) =+diffPrimitiveExpression (UnionLit aL bL cL) (UnionLit aR bR cR) =     diffUnionLit aL aR bL bR cL cR-diffExprF l@(UnionLit {}) r =+diffPrimitiveExpression l@(UnionLit {}) r =     mismatch l r-diffExprF l r@(UnionLit {}) =+diffPrimitiveExpression l r@(UnionLit {}) =     mismatch l r-diffExprF aL aR =+diffPrimitiveExpression aL aR =     if same doc     then ignore     else align ("( " <> doc <> hardline <> ")")   where-    doc = diffExprA aL aR+    doc = diffExpression aL aR

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++module Dhall.Format ( format ) where++import Dhall.Parser (exprAndHeaderFromText)+import Dhall.Pretty (annToAnsiStyle, prettyExpr)++import Data.Monoid ((<>))++import qualified Data.Text.Prettyprint.Doc                 as Pretty+import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty+import qualified Control.Exception+import qualified Data.Text.IO+import qualified System.Console.ANSI+import qualified System.IO++opts :: Pretty.LayoutOptions+opts =+    Pretty.defaultLayoutOptions+        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }++format :: Maybe FilePath -> IO ()+format inplace = do+        case inplace of+            Just file -> do+                text <- Data.Text.IO.readFile file+                (header, expr) <- case exprAndHeaderFromText "(stdin)" text of+                    Left  err -> Control.Exception.throwIO err+                    Right x   -> return x++                let doc = Pretty.pretty header <> Pretty.pretty expr+                System.IO.withFile file System.IO.WriteMode (\handle -> do+                    Pretty.renderIO handle (Pretty.layoutSmart opts doc)+                    Data.Text.IO.hPutStrLn handle "" )+            Nothing -> do+                System.IO.hSetEncoding System.IO.stdin System.IO.utf8+                inText <- Data.Text.IO.getContents++                (header, expr) <- case exprAndHeaderFromText "(stdin)" inText of+                    Left  err -> Control.Exception.throwIO err+                    Right x   -> return x++                let doc = Pretty.pretty header <> prettyExpr expr++                supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout++                if supportsANSI+                  then+                    Pretty.renderIO+                      System.IO.stdout+                      (fmap annToAnsiStyle (Pretty.layoutSmart opts doc))+                  else+                    Pretty.renderIO+                      System.IO.stdout+                      (Pretty.layoutSmart opts (Pretty.unAnnotate doc))

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}++module Dhall.Freeze (+      freeze+    , hashImport+    ) where++import Dhall.Core+import Dhall.Import (load, hashExpression)+import Dhall.Parser (exprAndHeaderFromText, Src)+import Dhall.Pretty (annToAnsiStyle)++import System.Console.ANSI (hSupportsANSI)+import Data.Monoid ((<>))+import Data.Maybe (fromMaybe)+import Data.Text++import qualified Data.Text.Prettyprint.Doc                 as Pretty+import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty+import qualified Control.Exception+import qualified Data.Text.IO+import qualified System.IO++opts :: Pretty.LayoutOptions+opts =+    Pretty.defaultLayoutOptions+        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }++readInput :: Maybe FilePath -> IO Text+readInput = maybe fromStdin Data.Text.IO.readFile+    where +        fromStdin = System.IO.hSetEncoding System.IO.stdin System.IO.utf8 >> Data.Text.IO.getContents++hashImport :: Import -> IO Import+hashImport import_ = do+    expression <- Dhall.Import.load (Embed import_)+    let expressionHash = Just (Dhall.Import.hashExpression expression)+    let newImportHashed = (importHashed import_) { hash = expressionHash }+    return $ import_ { importHashed = newImportHashed }++parseExpr :: String -> Text -> IO (Text, Expr Src Import)+parseExpr src txt =+    case exprAndHeaderFromText src txt of+        Left err -> Control.Exception.throwIO err+        Right x  -> return x++freezeExpr :: (Text, Expr s Import) -> IO (Text, Expr s Import)+freezeExpr (t, e) = do+    e' <- traverse hashImport e+    return (t, e')++writeExpr :: Maybe FilePath -> (Text, Expr s Import) -> IO ()+writeExpr inplace (header, expr) = do+    let doc = Pretty.pretty header <> Pretty.pretty expr+    let layoutOptions = opts+    let stream = Pretty.layoutSmart layoutOptions doc++    case inplace of+        Just f ->+            System.IO.withFile f System.IO.WriteMode (\h ->+                Pretty.renderIO h (annToAnsiStyle <$> stream))++        Nothing -> do+            supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout+            if supportsANSI +               then +                 Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Pretty.layoutSmart opts doc)+               else+                 Pretty.renderIO System.IO.stdout (Pretty.layoutSmart opts (Pretty.unAnnotate doc)) ++freeze :: Maybe FilePath -> IO ()+freeze inplace = do+    expr <- readInput inplace+    parseExpr srcInfo expr >>= freezeExpr >>= writeExpr inplace+        where+            srcInfo = fromMaybe "(stdin)" inplace

@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Dhall.Hash ( hash ) where++import Dhall.Parser (exprFromText)+import Dhall.Import (hashExpressionToCode, load)++import qualified Control.Exception+import qualified Dhall.TypeCheck+import qualified Data.Text.IO+import qualified System.IO++hash :: IO ()+hash = do+        System.IO.hSetEncoding System.IO.stdin System.IO.utf8+        inText <- Data.Text.IO.getContents++        expr <- case exprFromText "(stdin)" inText of+            Left  err  -> Control.Exception.throwIO err+            Right expr -> return expr++        expr' <- load expr++        _ <- case Dhall.TypeCheck.typeOf expr' of+            Left  err -> Control.Exception.throwIO err+            Right _   -> return ()++        Data.Text.IO.putStrLn (hashExpressionToCode expr')

@@ -113,27 +113,24 @@     , PrettyHttpException(..)     , MissingFile(..)     , MissingEnvironmentVariable(..)+    , MissingImports(..)     ) where  import Control.Applicative (empty)-import Control.Exception (Exception, SomeException, throwIO)-import Control.Monad (join)-import Control.Monad.Catch (throwM, MonadCatch(catch))+import Control.Exception (Exception, SomeException, throwIO, toException)+import Control.Monad.Catch (throwM, MonadCatch(catch), catches, Handler(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.State.Strict (StateT) import Crypto.Hash (SHA256) import Data.CaseInsensitive (CI) import Data.List.NonEmpty (NonEmpty(..))-import Data.Map (Map) import Data.Semigroup (sconcat, (<>))-import Data.Text.Lazy (Text)-import Data.Text.Lazy.Builder (Builder)+import Data.Text (Text) #if MIN_VERSION_base(4,8,0) #else import Data.Traversable (traverse) #endif import Data.Typeable (Typeable)-import Formatting.Buildable (build) import System.FilePath ((</>)) import Dhall.Core     ( Expr(..)@@ -146,46 +143,38 @@     , ImportMode(..)     , Import(..)     )+#ifdef MIN_VERSION_http_client+import Dhall.Import.HTTP+#endif+import Dhall.Import.Types+ import Dhall.Parser (Parser(..), ParseError(..), Src(..)) import Dhall.TypeCheck (X(..))-import Lens.Family (LensLike') import Lens.Family.State.Strict (zoom)-#if MIN_VERSION_http_client(0,5,0)-import Network.HTTP.Client-    (HttpException(..), HttpExceptionContent(..), Manager)-#else-import Network.HTTP.Client (HttpException(..), Manager)-#endif -import qualified Control.Monad.Trans.State.Strict as State+import qualified Control.Monad.Trans.State.Strict        as State import qualified Crypto.Hash import qualified Data.ByteString import qualified Data.CaseInsensitive import qualified Data.Foldable-import qualified Data.List                        as List++import qualified Data.List                               as List import qualified Data.HashMap.Strict.InsOrd-import qualified Data.Map.Strict                  as Map+import qualified Data.Map.Strict                         as Map import qualified Data.Text.Encoding-import qualified Data.Text.Lazy                   as Text-import qualified Data.Text.Lazy.Builder           as Builder-import qualified Data.Text.Lazy.Encoding-import qualified Data.Text.Lazy.IO+import qualified Data.Text                               as Text+import qualified Data.Text.IO import qualified Dhall.Core import qualified Dhall.Parser import qualified Dhall.Context+import qualified Dhall.Pretty.Internal import qualified Dhall.TypeCheck-import qualified Network.HTTP.Client              as HTTP-import qualified Network.HTTP.Client.TLS          as HTTP import qualified System.Environment import qualified System.Directory-import qualified System.FilePath                  as FilePath import qualified Text.Megaparsec import qualified Text.Parser.Combinators import qualified Text.Parser.Token -builderToString :: Builder -> String-builderToString = Text.unpack . Builder.toLazyText- -- | An import failed because of a cycle in the import graph newtype Cycle = Cycle     { cyclicImport :: Import  -- ^ The offending cyclic import@@ -196,7 +185,7 @@  instance Show Cycle where     show (Cycle import_) =-        "\nCyclic import: " ++ builderToString (build import_)+        "\nCyclic import: " ++ Dhall.Pretty.Internal.prettyToString import_  {-| Dhall tries to ensure that all expressions hosted on network endpoints are     weakly referentially transparent, meaning roughly that any two clients will@@ -232,7 +221,7 @@  instance Show ReferentiallyOpaque where     show (ReferentiallyOpaque import_) =-        "\nReferentially opaque import: " ++ builderToString (build import_)+        "\nReferentially opaque import: " ++ Dhall.Pretty.Internal.prettyToString import_  -- | Extend another exception with the current import stack data Imported e = Imported@@ -249,56 +238,11 @@         ++  show e       where         indent (n, import_) =-            take (2 * n) (repeat ' ') ++ "↳ " ++ builderToString (build import_)+            take (2 * n) (repeat ' ') ++ "↳ " ++ Dhall.Pretty.Internal.prettyToString import_         -- Canonicalize all imports         imports' = zip [0..] (drop 1 (reverse (canonicalizeAll imports))) --- | Newtype used to wrap `HttpException`s with a prettier `Show` instance-newtype PrettyHttpException = PrettyHttpException HttpException-    deriving (Typeable) -instance Exception PrettyHttpException--#if MIN_VERSION_http_client(0,5,0)-instance Show PrettyHttpException where-  show (PrettyHttpException (InvalidUrlException _ r)) =-    "\n"-    <>  "\ESC[1;31mError\ESC[0m: Invalid URL\n"-    <>  "\n"-    <>  "↳ " <> show r-  show (PrettyHttpException (HttpExceptionRequest _ e)) = case e of-    ConnectionFailure e' ->-      "\n"-      <>  "\ESC[1;31mError\ESC[0m: Wrong host\n"-      <>  "\n"-      <>  "↳ " <> show e'-    InvalidDestinationHost host ->-      "\n"-      <>  "\ESC[1;31mError\ESC[0m: Invalid host name\n"-      <>  "\n"-      <>  "↳ " <> show host-    ResponseTimeout ->-      "\ESC[1;31mError\ESC[0m: The host took too long to respond\n"-    e' -> "\n" <> show e'-#else-instance Show PrettyHttpException where-    show (PrettyHttpException e) = case e of-        FailedConnectionException2 _ _ _ e' ->-                "\n"-            <>  "\ESC[1;31mError\ESC[0m: Wrong host\n"-            <>  "\n"-            <>  "↳ " <> show e'-        InvalidDestinationHost host ->-                "\n"-            <>  "\ESC[1;31mError\ESC[0m: Invalid host name\n"-            <>  "\n"-            <>  "↳ " <> show host-        ResponseTimeout ->-                "\ESC[1;31mError\ESC[0m: The host took too long to respond\n"-        e' ->   "\n"-            <> show e'-#endif- -- | Exception thrown when an imported file is missing data MissingFile = MissingFile FilePath     deriving (Typeable)@@ -325,56 +269,61 @@         <>  "\n"         <>  "↳ " <> Text.unpack name --- | State threaded throughout the import process-data Status = Status-    { _stack   :: [Import]-    -- ^ Stack of `Import`s that we've imported along the way to get to the-    -- current point-    , _cache   :: Map Import (Expr Src X)-    -- ^ Cache of imported expressions in order to avoid importing the same-    --   expression twice with different values-    , _manager :: Maybe Manager-    -- ^ Cache for the `Manager` so that we only acquire it once-    }+-- | List of Exceptions we encounter while resolving Import Alternatives+newtype MissingImports = MissingImports [SomeException] --- | Default starting `Status`-emptyStatus :: Status-emptyStatus = Status [] Map.empty Nothing+instance Exception MissingImports -canonicalizeAll :: [Import] -> [Import]-canonicalizeAll = map canonicalizeImport . List.tails+instance Show MissingImports where+    show (MissingImports []) =+            "\n"+        <>  "\ESC[1;31mError\ESC[0m: No valid imports"+        <>  "\n"+    show (MissingImports [e]) = show e+    show (MissingImports es) =+            "\n"+        <>  "\ESC[1;31mError\ESC[0m: Failed to resolve imports. Error list:"+        <>  "\n"+        <>  concatMap (\e -> "\n" <> show e <> "\n") es+        <>  "\n" -stack :: Functor f => LensLike' f Status [Import]-stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))+throwMissingImport :: (MonadCatch m, Exception e) => e -> m a+throwMissingImport e = throwM (MissingImports [(toException e)]) -cache :: Functor f => LensLike' f Status (Map Import (Expr Src X))-cache k s = fmap (\x -> s { _cache = x }) (k (_cache s)) -manager :: Functor f => LensLike' f Status (Maybe Manager)-manager k s = fmap (\x -> s { _manager = x }) (k (_manager s))+-- | Exception thrown when a HTTP url is imported but dhall was built without+-- the @with-http@ Cabal flag.+data CannotImportHTTPURL =+    CannotImportHTTPURL+        String+        (Maybe [(CI Data.ByteString.ByteString, Data.ByteString.ByteString)])+    deriving (Typeable) -needManager :: StateT Status IO Manager-needManager = do-    x <- zoom manager State.get-    case x of-        Just m  -> return m-        Nothing -> do-            let settings = HTTP.tlsManagerSettings-#if MIN_VERSION_http_client(0,5,0)-                    { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (30 * 1000 * 1000) }  -- 30 seconds-#else-                    { HTTP.managerResponseTimeout = Just (30 * 1000 * 1000) }  -- 30 seconds-#endif-            m <- liftIO (HTTP.newManager settings)-            zoom manager (State.put (Just m))-            return m+instance Exception CannotImportHTTPURL +instance Show CannotImportHTTPURL where+    show (CannotImportHTTPURL url _mheaders) =+            "\n"+        <>  "\ESC[1;31mError\ESC[0m: Cannot import HTTP URL.\n"+        <>  "\n"+        <>  "Dhall was compiled without the 'with-http' flag.\n"+        <>  "\n"+        <>  "The requested URL was: "+        <>  url+        <>  "\n"++canonicalizeAll :: [Import] -> [Import]+canonicalizeAll = map canonicalizeImport . List.tails+ {-| > canonicalize (canonicalize x) = canonicalize x -} class Canonicalize path where     canonicalize :: path -> path +-- |+-- >>> canonicalize (Directory {components = ["..",".."]})+-- Directory {components = ["..",".."]} instance Canonicalize Directory where     canonicalize (Directory []) = Directory [] @@ -383,8 +332,12 @@      canonicalize (Directory (".." : components₀)) =         case canonicalize (Directory components₀) of-            Directory      []           -> Directory [ ".." ]-            Directory (_ : components₁) -> Directory components₁+            Directory [] ->+                Directory [ ".." ]+            Directory (".." : components₁) ->+                Directory (".." : ".." : components₁)+            Directory (_    : components₁) ->+                Directory components₁      canonicalize (Directory (component : components₀)) =         Directory (component : components₁)@@ -405,6 +358,9 @@     canonicalize (Env name) =         Env name +    canonicalize Missing =+        Missing+ instance Canonicalize ImportHashed where     canonicalize (ImportHashed hash importType) =         ImportHashed hash (canonicalize importType)@@ -439,10 +395,8 @@   :: Expr s a   -> Maybe (CI Data.ByteString.ByteString, Data.ByteString.ByteString) toHeader (RecordLit m) = do-    TextLit (Chunks [] keyBuilder  ) <- Data.HashMap.Strict.InsOrd.lookup "header" m-    TextLit (Chunks [] valueBuilder) <- Data.HashMap.Strict.InsOrd.lookup "value"  m-    let keyText   = Text.toStrict (Builder.toLazyText keyBuilder  )-    let valueText = Text.toStrict (Builder.toLazyText valueBuilder)+    TextLit (Chunks [] keyText  ) <- Data.HashMap.Strict.InsOrd.lookup "header" m+    TextLit (Chunks [] valueText) <- Data.HashMap.Strict.InsOrd.lookup "value"  m     let keyBytes   = Data.Text.Encoding.encodeUtf8 keyText     let valueBytes = Data.Text.Encoding.encodeUtf8 valueText     return (Data.CaseInsensitive.mk keyBytes, valueBytes)@@ -450,38 +404,6 @@     empty  -{-| This exception indicates that there was an internal error in Dhall's-    import-related logic-    the `expected` type then the `extract` function must succeed.  If not, then-    this exception is thrown--    This exception indicates that an invalid `Type` was provided to the `input`-    function--}-data InternalError = InternalError deriving (Typeable)--_ERROR :: String-_ERROR = "\ESC[1;31mError\ESC[0m"--instance Show InternalError where-    show InternalError = unlines-        [ _ERROR <> ": Compiler bug                                                        "-        , "                                                                                "-        , "Explanation: This error message means that there is a bug in the Dhall compiler."-        , "You didn't do anything wrong, but if you would like to see this problem fixed   "-        , "then you should report the bug at:                                              "-        , "                                                                                "-        , "https://github.com/dhall-lang/dhall-haskell/issues                              "-        , "                                                                                "-        , "Please include the following text in your bug report:                           "-        , "                                                                                "-        , "```                                                                             "-        , "Header extraction failed even though the header type-checked                    "-        , "```                                                                             "-        ]--instance Exception InternalError- -- | Exception thrown when an integrity check fails data HashMismatch = HashMismatch     { expectedHash :: Crypto.Hash.Digest SHA256@@ -519,10 +441,6 @@                 Absolute -> do                     return "/" -                Parent -> do-                    pwd <- System.Directory.getCurrentDirectory-                    return (FilePath.takeDirectory pwd)-                 Here -> do                     System.Directory.getCurrentDirectory @@ -536,26 +454,25 @@              if exists                 then return ()-                else throwIO (MissingFile path)+                else throwMissingImport (MissingFile path) -            text <- Data.Text.Lazy.IO.readFile path+            text <- Data.Text.IO.readFile path              return (path, text)          URL prefix file suffix maybeHeaders -> do-            m <- needManager--            let fileText = Builder.toLazyText (build file)+            let fileText = Dhall.Pretty.Internal.prettyToStrictText file             let url      = Text.unpack (prefix <> fileText <> suffix) -            request <- liftIO (HTTP.parseUrlThrow url)--            requestWithHeaders <- case maybeHeaders of-                Nothing           -> return request+            mheaders <- case maybeHeaders of+                Nothing            -> return Nothing                 Just importHashed_ -> do-                    expr <- loadStaticIO Dhall.Context.empty-                                         (const Nothing)-                                         (Import importHashed_ Code)+                    expr <- loadStaticWith+                        exprFromImport+                        Dhall.Context.empty+                        (const Nothing)+                        (Embed (Import importHashed_ Code))+                     let expected :: Expr Src X                         expected =                             App List@@ -564,10 +481,7 @@                                         [("header", Text), ("value", Text)]                                     )                                 )-                    let suffix_ =-                            ( Builder.toLazyText-                            . build-                            ) expected+                    let suffix_ = Dhall.Pretty.Internal.prettyToStrictText expected                     let annot = case expr of                             Note (Src begin end bytes) _ ->                                 Note (Src begin end bytes') (Annot expr expected)@@ -582,32 +496,27 @@                      let expr' = Dhall.Core.normalize expr -                    headers <- case toHeaders expr' of+                    case toHeaders expr' of                         Just headers -> do-                            return headers+                            return (Just headers)                         Nothing      -> do                             liftIO (throwIO InternalError) -                    let requestWithHeaders = request-                            { HTTP.requestHeaders = headers-                            }--                    return requestWithHeaders--            response <- liftIO (HTTP.httpLbs requestWithHeaders m)--            let bytes = HTTP.responseBody response--            case Data.Text.Lazy.Encoding.decodeUtf8' bytes of-                Left  err  -> liftIO (throwIO err)-                Right text -> return (url, text)+#ifdef MIN_VERSION_http_client+            fetchFromHttpUrl url mheaders+#else+            liftIO (throwIO (CannotImportHTTPURL url mheaders))+#endif          Env env -> liftIO $ do             x <- System.Environment.lookupEnv (Text.unpack env)             case x of                 Just string -> return (Text.unpack env, Text.pack string)-                Nothing     -> throwIO (MissingEnvironmentVariable env)+                Nothing     -> throwMissingImport (MissingEnvironmentVariable env) +        Missing -> liftIO $ do+            throwM (MissingImports [])+     case importMode of         Code -> do             let parser = unParser $ do@@ -623,29 +532,7 @@                     return expr          RawText -> do-            return (TextLit (Chunks [] (build text)))--{-| Load an `Import` as a \"dynamic\" expression (without resolving any imports)--}-loadDynamic-    :: forall m . MonadCatch m-    => (Import -> StateT Status m (Expr Src Import))-    -> Import-    -> StateT Status m (Expr Src Import)-loadDynamic from_import import_ = do-    imports <- zoom stack State.get--    let handler :: SomeException -> StateT Status m (Expr Src Import)-        handler e = throwM (Imported (import_:imports) e)--    from_import (canonicalizeImport (import_:imports)) `catch` handler--loadStaticIO-    :: Dhall.Context.Context (Expr Src X)-    -> Dhall.Core.Normalizer X-    -> Import-    -> StateT Status IO (Expr Src X)-loadStaticIO = loadStaticWith exprFromImport+            return (TextLit (Chunks [] text))  -- | Resolve all imports within an expression using a custom typing context and -- `Import`-resolving callback in arbitrary `MonadCatch` monad.@@ -656,7 +543,8 @@     -> Dhall.Core.Normalizer X     -> Expr Src Import     -> m (Expr Src X)-loadWith from_import ctx n = evalStatus (loadStaticWith from_import ctx n)+loadWith from_import ctx n expr =+    State.evalStateT (loadStaticWith from_import ctx n expr) emptyStatus  -- | Resolve all imports within an expression using a custom typing context. --@@ -666,48 +554,78 @@     -> Dhall.Core.Normalizer X     -> Expr Src Import     -> IO (Expr Src X)-loadWithContext ctx n = evalStatus (loadStaticIO ctx n)+loadWithContext ctx n expr =+    State.evalStateT (loadStaticWith exprFromImport ctx n expr) emptyStatus +-- | This loads a \"static\" expression (i.e. an expression free of imports) loadStaticWith     :: MonadCatch m     => (Import -> StateT Status m (Expr Src Import))     -> Dhall.Context.Context (Expr Src X)     -> Dhall.Core.Normalizer X-    -> Import+    -> Expr Src Import     -> StateT Status m (Expr Src X)-loadStaticWith from_import ctx n import_ = do+loadStaticWith from_import ctx n expr₀ = case expr₀ of+  Embed import_ -> do     imports <- zoom stack State.get -    let local (Import (ImportHashed _ (URL   {})) _) = False-        local (Import (ImportHashed _ (Local {})) _) = True-        local (Import (ImportHashed _ (Env   {})) _) = True+    let local (Import (ImportHashed _ (URL     {})) _) = False+        local (Import (ImportHashed _ (Local   {})) _) = True+        local (Import (ImportHashed _ (Env     {})) _) = True+        local (Import (ImportHashed _ (Missing {})) _) = True      let parent = canonicalizeImport imports     let here   = canonicalizeImport (import_:imports)      if local here && not (local parent)-        then throwM (Imported imports (ReferentiallyOpaque import_))+        then throwMissingImport (Imported imports (ReferentiallyOpaque import_))         else return ()      expr <- if here `elem` canonicalizeAll imports-        then throwM (Imported imports (Cycle import_))+        then throwMissingImport (Imported imports (Cycle import_))         else do             m <- zoom cache State.get             case Map.lookup here m of                 Just expr -> return expr                 Nothing   -> do-                    expr'  <- loadDynamic from_import import_-                    expr'' <- case traverse (\_ -> Nothing) expr' of-                        -- No imports left-                        Just expr -> return expr-                        -- Some imports left, so recurse-                        Nothing   -> do-                            let imports' = import_:imports-                            zoom stack (State.put imports')-                            expr'' <- fmap join (traverse (loadStaticWith from_import ctx n)-                                                           expr')-                            zoom stack (State.put imports)-                            return expr''+                    -- Here we have to match and unwrap the @MissingImports@+                    -- in a separate handler, otherwise we'd have it wrapped+                    -- in another @Imported@ when parsing a @missing@, because+                    -- we are representing it with an empty exception list+                    -- (which would not be empty if this would happen).+                    -- TODO: restructure the Exception hierarchy to prevent+                    -- this nesting from happening in the first place.+                    let handler₀+                            :: (MonadCatch m)+                            => MissingImports+                            -> StateT Status m (Expr Src Import)+                        handler₀ e@(MissingImports []) = throwM e+                        handler₀ (MissingImports [e]) =+                          throwMissingImport (Imported (import_:imports) e)+                        handler₀ (MissingImports es) = throwM+                          (MissingImports+                           (fmap+                             (\e -> (toException (Imported (import_:imports) e)))+                             es))+                        handler₁+                            :: (MonadCatch m)+                            => SomeException+                            -> StateT Status m (Expr Src Import)+                        handler₁ e =+                          throwMissingImport (Imported (import_:imports) e)++                    -- This loads a \"dynamic\" expression (i.e. an expression+                    -- that might still contain imports)+                    let loadDynamic =+                            from_import (canonicalizeImport (import_:imports))++                    expr' <- loadDynamic `catches` [ Handler handler₀, Handler handler₁ ]++                    let imports' = import_:imports+                    zoom stack (State.put imports')+                    expr'' <- loadStaticWith from_import ctx n expr'+                    zoom stack (State.put imports)+                     -- Type-check expressions here for three separate reasons:                     --                     --  * to verify that they are closed@@ -731,14 +649,80 @@             let actualHash = hashExpression expr             if expectedHash == actualHash                 then return ()-                else throwM (Imported (import_:imports) (HashMismatch {..}))+                else throwMissingImport (Imported (import_:imports) (HashMismatch {..}))      return expr+  ImportAlt a b -> loop a `catch` handler₀+    where+      handler₀ (MissingImports es₀) =+        loop b `catch` handler₁+        where+          handler₁ (MissingImports es₁) =+            throwM (MissingImports (es₀ ++ es₁))+  Const a              -> pure (Const a)+  Var a                -> pure (Var a)+  Lam a b c            -> Lam <$> pure a <*> loop b <*> loop c+  Pi a b c             -> Pi <$> pure a <*> loop b <*> loop c+  App a b              -> App <$> loop a <*> loop b+  Let a b c d          -> Let <$> pure a <*> mapM loop b <*> loop c <*> loop d+  Annot a b            -> Annot <$> loop a <*> loop b+  Bool                 -> pure Bool+  BoolLit a            -> pure (BoolLit a)+  BoolAnd a b          -> BoolAnd <$> loop a <*> loop b+  BoolOr a b           -> BoolOr <$> loop a <*> loop b+  BoolEQ a b           -> BoolEQ <$> loop a <*> loop b+  BoolNE a b           -> BoolNE <$> loop a <*> loop b+  BoolIf a b c         -> BoolIf <$> loop a <*> loop b <*> loop c+  Natural              -> pure Natural+  NaturalLit a         -> pure (NaturalLit a)+  NaturalFold          -> pure NaturalFold+  NaturalBuild         -> pure NaturalBuild+  NaturalIsZero        -> pure NaturalIsZero+  NaturalEven          -> pure NaturalEven+  NaturalOdd           -> pure NaturalOdd+  NaturalToInteger     -> pure NaturalToInteger+  NaturalShow          -> pure NaturalShow+  NaturalPlus a b      -> NaturalPlus <$> loop a <*> loop b+  NaturalTimes a b     -> NaturalTimes <$> loop a <*> loop b+  Integer              -> pure Integer+  IntegerLit a         -> pure (IntegerLit a)+  IntegerShow          -> pure IntegerShow+  IntegerToDouble      -> pure IntegerToDouble+  Double               -> pure Double+  DoubleLit a          -> pure (DoubleLit a)+  DoubleShow           -> pure DoubleShow+  Text                 -> pure Text+  TextLit (Chunks a b) -> fmap TextLit (Chunks <$> mapM (mapM loop) a <*> pure b)+  TextAppend a b       -> TextAppend <$> loop a <*> loop b+  List                 -> pure List+  ListLit a b          -> ListLit <$> mapM loop a <*> mapM loop b+  ListAppend a b       -> ListAppend <$> loop a <*> loop b+  ListBuild            -> pure ListBuild+  ListFold             -> pure ListFold+  ListLength           -> pure ListLength+  ListHead             -> pure ListHead+  ListLast             -> pure ListLast+  ListIndexed          -> pure ListIndexed+  ListReverse          -> pure ListReverse+  Optional             -> pure Optional+  OptionalLit a b      -> OptionalLit <$> loop a <*> mapM loop b+  OptionalFold         -> pure OptionalFold+  OptionalBuild        -> pure OptionalBuild+  Record a             -> Record <$> mapM loop a+  RecordLit a          -> RecordLit <$> mapM loop a+  Union a              -> Union <$> mapM loop a+  UnionLit a b c       -> UnionLit <$> pure a <*> loop b <*> mapM loop c+  Combine a b          -> Combine <$> loop a <*> loop b+  CombineTypes a b     -> CombineTypes <$> loop a <*> loop b+  Prefer a b           -> Prefer <$> loop a <*> loop b+  Merge a b c          -> Merge <$> loop a <*> loop b <*> mapM loop c+  Constructors a       -> Constructors <$> loop a+  Field a b            -> Field <$> loop a <*> pure b+  Project a b          -> Project <$> loop a <*> pure b+  Note a b             -> Note <$> pure a <*> loop b+  where+    loop = loadStaticWith from_import ctx n -evalStatus-    :: (Traversable f, Monad m, Monad f)-    => (a -> StateT Status m (f b)) -> f a -> m (f b)-evalStatus cb expr = State.evalStateT (fmap join (traverse cb expr)) emptyStatus  -- | Resolve all imports within an expression load :: Expr Src Import -> IO (Expr Src X)@@ -746,10 +730,10 @@  -- | Hash a fully resolved expression hashExpression :: Expr s X -> (Crypto.Hash.Digest SHA256)-hashExpression expr = Crypto.Hash.hashlazy actualBytes+hashExpression expr = Crypto.Hash.hash actualBytes   where     text = Dhall.Core.pretty (Dhall.Core.normalize expr)-    actualBytes = Data.Text.Lazy.Encoding.encodeUtf8 text+    actualBytes = Data.Text.Encoding.encodeUtf8 text  {-| Convenience utility to hash a fully resolved expression and return the     base-16 encoded hash with the @sha256:@ prefix

@@ -0,0 +1,117 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}++module Dhall.Import.HTTP where++import Control.Exception (throwIO)+import Control.Monad (join)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.State.Strict (StateT)+import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI)+import Data.Dynamic (fromDynamic, toDyn)+import Data.Semigroup ((<>))+import Lens.Family.State.Strict (zoom)++import qualified Control.Monad.Trans.State.Strict        as State+import qualified Data.Text                               as Text+import qualified Data.Text.Lazy+import qualified Data.Text.Lazy.Encoding++import Dhall.Import.Types++#if MIN_VERSION_http_client(0,5,0)+import Network.HTTP.Client+    (HttpException(..), HttpExceptionContent(..), Manager)+#else+import Network.HTTP.Client (HttpException(..), Manager)+#endif++import qualified Network.HTTP.Client                     as HTTP+import qualified Network.HTTP.Client.TLS                 as HTTP++mkPrettyHttpException :: HttpException -> PrettyHttpException+mkPrettyHttpException ex =+    PrettyHttpException (renderPrettyHttpException ex) (toDyn ex)++renderPrettyHttpException :: HttpException -> String+#if MIN_VERSION_http_client(0,5,0)+renderPrettyHttpException (InvalidUrlException _ r) =+  "\n"+  <>  "\ESC[1;31mError\ESC[0m: Invalid URL\n"+  <>  "\n"+  <>  "↳ " <> show r+renderPrettyHttpException (HttpExceptionRequest _ e) =+  case e of+    ConnectionFailure e' ->+      "\n"+      <>  "\ESC[1;31mError\ESC[0m: Wrong host\n"+      <>  "\n"+      <>  "↳ " <> show e'+    InvalidDestinationHost host ->+      "\n"+      <>  "\ESC[1;31mError\ESC[0m: Invalid host name\n"+      <>  "\n"+      <>  "↳ " <> show host+    ResponseTimeout ->+      "\ESC[1;31mError\ESC[0m: The host took too long to respond\n"+    e' -> "\n" <> show e'+#else+renderPrettyHttpException e = case e of+    FailedConnectionException2 _ _ _ e' ->+            "\n"+        <>  "\ESC[1;31mError\ESC[0m: Wrong host\n"+        <>  "\n"+        <>  "↳ " <> show e'+    InvalidDestinationHost host ->+            "\n"+        <>  "\ESC[1;31mError\ESC[0m: Invalid host name\n"+        <>  "\n"+        <>  "↳ " <> show host+    ResponseTimeout ->+            "\ESC[1;31mError\ESC[0m: The host took too long to respond\n"+    e' ->   "\n"+        <> show e'+#endif++needManager :: StateT Status IO Manager+needManager = do+    x <- zoom manager State.get+    case join (fmap fromDynamic x) of+        Just m  -> return m+        Nothing -> do+            let settings = HTTP.tlsManagerSettings++#ifdef MIN_VERSION_http_client+#if MIN_VERSION_http_client(0,5,0)+                    { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (30 * 1000 * 1000) }  -- 30 seconds+#else+                    { HTTP.managerResponseTimeout = Just (30 * 1000 * 1000) }  -- 30 seconds+#endif+#endif+            m <- liftIO (HTTP.newManager settings)+            zoom manager (State.put (Just (toDyn m)))+            return m++fetchFromHttpUrl+    :: String+    -> Maybe [(CI ByteString, ByteString)]+    -> StateT Status IO (String, Text.Text)+fetchFromHttpUrl url mheaders = do+    m <- needManager++    request <- liftIO (HTTP.parseUrlThrow url)++    let requestWithHeaders =+            case mheaders of+              Nothing      -> request+              Just headers -> request { HTTP.requestHeaders = headers }++    response <- liftIO (HTTP.httpLbs requestWithHeaders m)++    let bytes = HTTP.responseBody response++    case Data.Text.Lazy.Encoding.decodeUtf8' bytes of+        Left  err  -> liftIO (throwIO err)+        Right text -> return (url, Data.Text.Lazy.toStrict text)

@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -Wall #-}++module Dhall.Import.Types where++import Control.Exception (Exception)+import Data.Dynamic+import Data.Map (Map)+import Data.Semigroup ((<>))+import Lens.Family (LensLike')++import qualified Data.Map as Map++import Dhall.Core (Import, Expr)+import Dhall.Parser (Src)+import Dhall.TypeCheck (X)+++-- | State threaded throughout the import process+data Status = Status+    { _stack   :: [Import]+    -- ^ Stack of `Import`s that we've imported along the way to get to the+    -- current point+    , _cache   :: Map Import (Expr Src X)+    -- ^ Cache of imported expressions in order to avoid importing the same+    --   expression twice with different values+    , _manager :: Maybe Dynamic+    -- ^ Cache for the HTTP `Manager` so that we only acquire it once+    }++-- | Default starting `Status`+emptyStatus :: Status+emptyStatus = Status [] Map.empty Nothing++stack :: Functor f => LensLike' f Status [Import]+stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))++cache :: Functor f => LensLike' f Status (Map Import (Expr Src X))+cache k s = fmap (\x -> s { _cache = x }) (k (_cache s))++manager :: Functor f => LensLike' f Status (Maybe Dynamic)+manager k s = fmap (\x -> s { _manager = x }) (k (_manager s))++++{-| This exception indicates that there was an internal error in Dhall's+    import-related logic+    the `expected` type then the `extract` function must succeed.  If not, then+    this exception is thrown++    This exception indicates that an invalid `Type` was provided to the `input`+    function+-}+data InternalError = InternalError deriving (Typeable)+++instance Show InternalError where+    show InternalError = unlines+        [ _ERROR <> ": Compiler bug                                                        "+        , "                                                                                "+        , "Explanation: This error message means that there is a bug in the Dhall compiler."+        , "You didn't do anything wrong, but if you would like to see this problem fixed   "+        , "then you should report the bug at:                                              "+        , "                                                                                "+        , "https://github.com/dhall-lang/dhall-haskell/issues                              "+        , "                                                                                "+        , "Please include the following text in your bug report:                           "+        , "                                                                                "+        , "```                                                                             "+        , "Header extraction failed even though the header type-checked                    "+        , "```                                                                             "+        ]+      where+        _ERROR :: String+        _ERROR = "\ESC[1;31mError\ESC[0m"++instance Exception InternalError++-- | Wrapper around `HttpException`s with a prettier `Show` instance.+--+-- In order to keep the library API constant even when the @with-http@ Cabal+-- flag is disabled the pretty error message is pre-rendered and the real+-- 'HttpExcepion' is stored in a 'Dynamic'+data PrettyHttpException = PrettyHttpException String Dynamic+    deriving (Typeable)++instance Exception PrettyHttpException++instance Show PrettyHttpException where+  show (PrettyHttpException msg _) = msg

@@ -0,0 +1,222 @@+module Dhall.Lint+    ( -- * Lint+      lint+    ) where++import Dhall.Core (Chunks(..), Expr(..), Import, Var(..))+import Dhall.TypeCheck (X(..))++import qualified Dhall.Core++lint :: Expr s Import -> Expr t Import+lint expression = loop (Dhall.Core.denote expression)+  where+    loop (Const a) =+        Const a+    loop (Var a) =+        Var a+    loop (Lam a b c) = Lam a b' c'+      where+        b' = loop b+        c' = loop c+    loop (Pi a b c) = Pi a b' c'+      where+        b' = loop b+        c' = loop c+    loop (App a b) = App a' b'+      where+        a' = loop a+        b' = loop b+    loop (Let a b c d)+        | not (V a 0 `Dhall.Core.freeIn` d) =+            loop d+        | otherwise =+            Let a b' c' d'+      where+        b' = fmap loop b+        c' =      loop c+        d' =      loop d+    loop (Annot a b) =+        Annot a' b'+      where+        a' = loop a+        b' = loop b+    loop Bool =+        Bool+    loop (BoolLit a) =+        BoolLit a+    loop (BoolAnd a b) =+        BoolAnd a' b'+      where+        a' = loop a+        b' = loop b+    loop (BoolOr a b) =+        BoolOr a' b'+      where+        a' = loop a+        b' = loop b+    loop (BoolEQ a b) =+        BoolEQ a' b'+      where+        a' = loop a+        b' = loop b+    loop (BoolNE a b) =+        BoolNE a' b'+      where+        a' = loop a+        b' = loop b+    loop (BoolIf a b c) =+        BoolIf a' b' c'+      where+        a' = loop a+        b' = loop b+        c' = loop c+    loop Natural =+        Natural+    loop (NaturalLit a) =+        NaturalLit a+    loop NaturalFold =+        NaturalFold+    loop NaturalBuild =+        NaturalBuild+    loop NaturalIsZero =+        NaturalIsZero+    loop NaturalEven =+        NaturalEven+    loop NaturalOdd =+        NaturalOdd+    loop NaturalToInteger =+        NaturalToInteger+    loop NaturalShow =+        NaturalShow+    loop (NaturalPlus a b) =+        NaturalPlus a' b'+      where+        a' = loop a+        b' = loop b+    loop (NaturalTimes a b) =+        NaturalTimes a' b'+      where+        a' = loop a+        b' = loop b+    loop Integer =+        Integer+    loop (IntegerLit a) =+        IntegerLit a+    loop IntegerShow =+        IntegerShow+    loop IntegerToDouble =+        IntegerToDouble+    loop Double =+        Double+    loop (DoubleLit a) =+        DoubleLit a+    loop DoubleShow =+        DoubleShow+    loop Text =+        Text+    loop (TextLit (Chunks a b)) =+        TextLit (Chunks a' b)+      where+        a' = fmap (fmap loop) a+    loop (TextAppend a b) =+        TextAppend a' b'+      where+        a' = loop a+        b' = loop b+    loop List =+        List+    loop (ListLit a b) =+        ListLit a' b'+      where+        a' = fmap loop a+        b' = fmap loop b+    loop (ListAppend a b) =+        ListAppend a' b'+      where+        a' = loop a+        b' = loop b+    loop ListBuild =+        ListBuild+    loop ListFold =+        ListFold+    loop ListLength =+        ListLength+    loop ListHead =+        ListHead+    loop ListLast =+        ListLast+    loop ListIndexed =+        ListIndexed+    loop ListReverse =+        ListReverse+    loop Optional =+        Optional+    loop (OptionalLit a b) =+        OptionalLit a' b'+      where+        a' =      loop a+        b' = fmap loop b+    loop OptionalFold =+        OptionalFold+    loop OptionalBuild =+        OptionalBuild+    loop (Record a) =+        Record a'+      where+        a' = fmap loop a+    loop (RecordLit a) =+        RecordLit a'+      where+        a' = fmap loop a+    loop (Union a) =+        Union a'+      where+        a' = fmap loop a+    loop (UnionLit a b c) =+        UnionLit a b' c'+      where+        b' =      loop b+        c' = fmap loop c+    loop (Combine a b) =+        Combine a' b'+      where+        a' = loop a+        b' = loop b+    loop (CombineTypes a b) =+        CombineTypes a' b'+      where+        a' = loop a+        b' = loop b+    loop (Prefer a b) =+        Prefer a' b'+      where+        a' = loop a+        b' = loop b+    loop (Merge a b c) =+        Merge a' b' c'+      where+        a' =      loop a+        b' =      loop b+        c' = fmap loop c+    loop (Constructors a) =+        Constructors a'+      where+        a' = loop a+    loop (Field a b) =+        Field a' b+      where+        a' = loop a+    loop (Project a b) =+        Project a' b+      where+        a' = loop a+    loop (Note a _) =+        absurd a+    loop (ImportAlt a b) =+        ImportAlt a' b'+      where+        a' = loop a+        b' = loop b+    loop (Embed a) =+        Embed a

@@ -0,0 +1,334 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}++module Dhall.Main+    ( -- Commands+      parseOptions+    , parserInfoOptions+    , command+    , main+    ) where++import Control.Applicative (optional, (<|>))+import Control.Exception (Exception, SomeException)+import Data.Monoid (mempty, (<>))+import Data.Text (Text)+import Data.Text.Prettyprint.Doc (Pretty)+import Data.Version (showVersion)+import Dhall.Core (Expr, Import)+import Dhall.Import (Imported(..), load)+import Dhall.Parser (Src)+import Dhall.Pretty (annToAnsiStyle, prettyExpr)+import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X)+import Options.Applicative (Parser, ParserInfo)+import System.Exit (exitFailure)+import System.IO (Handle)++import qualified Paths_dhall as Meta++import qualified Control.Exception+import qualified Data.Text+import qualified Data.Text.IO+import qualified Data.Text.Prettyprint.Doc                 as Pretty+import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty+import qualified Dhall+import qualified Dhall.Core+import qualified Dhall.Diff+import qualified Dhall.Format+import qualified Dhall.Freeze+import qualified Dhall.Hash+import qualified Dhall.Lint+import qualified Dhall.Parser+import qualified Dhall.Repl+import qualified Dhall.TypeCheck+import qualified Options.Applicative+import qualified System.Console.ANSI+import qualified System.IO++data Options = Options+    { mode    :: Mode+    , explain :: Bool+    , plain   :: Bool+    }++data Mode+    = Default+    | Version+    | Resolve+    | Type+    | Normalize+    | Repl+    | Format (Maybe FilePath)+    | Freeze (Maybe FilePath)+    | Hash+    | Diff Text Text+    | Lint (Maybe FilePath)++parseInplace :: Parser String+parseInplace =+        Options.Applicative.strOption+        (   Options.Applicative.long "inplace"+        <>  Options.Applicative.help "Modify the specified file in-place"+        <>  Options.Applicative.metavar "FILE"+        )++parseOptions :: Parser Options+parseOptions = Options <$> parseMode <*> parseExplain <*> parsePlain+  where+    parseExplain =+        Options.Applicative.switch+            (   Options.Applicative.long "explain"+            <>  Options.Applicative.help "Explain error messages in more detail"+            )++    parsePlain =+        Options.Applicative.switch+            (   Options.Applicative.long "plain"+            <>  Options.Applicative.help "Disable syntax highlighting"+            )+++parseMode :: Parser Mode+parseMode =+        subcommand "version"   "Display version"                 (pure Version)+    <|> subcommand "resolve"   "Resolve an expression's imports" (pure Resolve)+    <|> subcommand "type"      "Infer an expression's type"      (pure Type)+    <|> subcommand "normalize" "Normalize an expression"         (pure Normalize)+    <|> subcommand "repl"      "Interpret expressions in a REPL" (pure Repl)+    <|> subcommand "diff"      "Render the difference between the normal form of two expressions" diffParser+    <|> subcommand "hash"      "Compute semantic hashes for Dhall expressions" (pure Hash)+    <|> subcommand "lint"      "Improve Dhall code"              parseLint+    <|> formatSubcommand+    <|> freezeSubcommand+    <|> pure Default+  where+    subcommand name description modeParser =+        Options.Applicative.subparser+            (   Options.Applicative.command name parserInfo+            <>  Options.Applicative.metavar name+            )+      where+        parserInfo =+            Options.Applicative.info parser+                (   Options.Applicative.fullDesc+                <>  Options.Applicative.progDesc description+                )++        parser =+            Options.Applicative.helper <*> modeParser++    diffParser =+        Diff <$> argument "expr1" <*> argument "expr2"+      where+        argument =+                fmap Data.Text.pack+            .   Options.Applicative.strArgument+            .   Options.Applicative.metavar++    parseLint =+        Lint <$> optional parseInplace++    formatSubcommand =+        Options.Applicative.hsubparser+            (   Options.Applicative.command "format" parserInfo+            <>  Options.Applicative.metavar "format"+            )+      where parserInfo =+                Options.Applicative.info parserWithHelper+                    (   Options.Applicative.fullDesc+                    <>  Options.Applicative.progDesc "Formatter for the Dhall language"+                    )+            parserWithHelper = Options.Applicative.helper <*> parser+            parser = Format <$> optional parseInplace++    freezeSubcommand = subcommand "freeze" "Add hashes to all import statements of an expression" parseFreeze+        where+            parseFreeze = Freeze <$> optional parseInplace++opts :: Pretty.LayoutOptions+opts =+    Pretty.defaultLayoutOptions+        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }++data ImportResolutionDisabled = ImportResolutionDisabled deriving (Exception)++instance Show ImportResolutionDisabled where+    show _ = "\nImport resolution is disabled"++throws :: Exception e => Either e a -> IO a+throws (Left  e) = Control.Exception.throwIO e+throws (Right a) = return a++getExpression :: IO (Expr Src Import)+getExpression = do+    inText <- Data.Text.IO.getContents++    throws (Dhall.Parser.exprFromText "(stdin)" inText)++assertNoImports :: Expr Src Import -> IO (Expr Src X)+assertNoImports expression =+    throws (traverse (\_ -> Left ImportResolutionDisabled) expression)++parserInfoOptions :: ParserInfo Options+parserInfoOptions =+    Options.Applicative.info+        (Options.Applicative.helper <*> parseOptions)+        (   Options.Applicative.progDesc "Interpreter for the Dhall language"+        <>  Options.Applicative.fullDesc+        )++command :: Options -> IO ()+command (Options {..}) = do+    System.IO.hSetEncoding System.IO.stdin System.IO.utf8++    let handle =+                Control.Exception.handle handler2+            .   Control.Exception.handle handler1+            .   Control.Exception.handle handler0+          where+            handler0 e = do+                let _ = e :: TypeError Src X+                System.IO.hPutStrLn System.IO.stderr ""+                if explain+                    then Control.Exception.throwIO (DetailedTypeError e)+                    else do+                        Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"+                        Control.Exception.throwIO e++            handler1 (Imported ps e) = do+                let _ = e :: TypeError Src X+                System.IO.hPutStrLn System.IO.stderr ""+                if explain+                    then Control.Exception.throwIO (Imported ps (DetailedTypeError e))+                    else do+                        Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"+                        Control.Exception.throwIO (Imported ps e)++            handler2 e = do+                let _ = e :: SomeException+                System.IO.hSetEncoding System.IO.stderr System.IO.utf8+                System.IO.hPrint System.IO.stderr e+                System.Exit.exitFailure++    let render :: Pretty a => Handle -> Expr s a -> IO ()+        render h e = do+            let doc = prettyExpr e++            let layoutOptions = opts++            let stream = Pretty.layoutSmart layoutOptions doc++            supportsANSI <- System.Console.ANSI.hSupportsANSI h+            let ansiStream =+                    if supportsANSI && not plain+                    then fmap annToAnsiStyle stream+                    else Pretty.unAnnotateS stream++            Pretty.renderIO h ansiStream+            Data.Text.IO.hPutStrLn h ""++    handle $ case mode of+        Version -> do+            putStrLn (showVersion Meta.version)++        Default -> do+            expression <- getExpression++            resolvedExpression <- load expression++            inferredType <- throws (Dhall.TypeCheck.typeOf resolvedExpression)++            render System.IO.stderr (Dhall.Core.normalize inferredType)++            Data.Text.IO.hPutStrLn System.IO.stderr mempty++            render System.IO.stdout (Dhall.Core.normalize resolvedExpression)++        Resolve -> do+            expression <- getExpression++            resolvedExpression <- load expression++            render System.IO.stdout resolvedExpression++        Normalize -> do+            expression <- getExpression++            resolvedExpression <- assertNoImports expression++            _ <- throws (Dhall.TypeCheck.typeOf resolvedExpression)++            render System.IO.stdout (Dhall.Core.normalize resolvedExpression)++        Type -> do+            expression <- getExpression++            resolvedExpression <- assertNoImports expression++            inferredType <- throws (Dhall.TypeCheck.typeOf resolvedExpression)++            render System.IO.stdout (Dhall.Core.normalize inferredType)++        Repl -> do+            Dhall.Repl.repl explain++        Diff expr1 expr2 -> do+            expression1 <- Dhall.inputExpr expr1++            expression2 <- Dhall.inputExpr expr2++            let diff = Dhall.Diff.diffNormalized expression1 expression2+                prettyDiff = fmap annToAnsiStyle diff++            Pretty.hPutDoc System.IO.stdout prettyDiff++        Format inplace -> do+            Dhall.Format.format inplace++        Freeze inplace -> do+            Dhall.Freeze.freeze inplace++        Hash -> do+            Dhall.Hash.hash ++        Lint inplace -> do+            case inplace of+                Just file -> do+                    text <- Data.Text.IO.readFile file++                    (header, expression) <- throws (Dhall.Parser.exprAndHeaderFromText file text)++                    let lintedExpression = Dhall.Lint.lint expression++                    let doc = Pretty.pretty header <> Pretty.pretty lintedExpression++                    System.IO.withFile file System.IO.WriteMode (\h -> do+                        Pretty.renderIO h (Pretty.layoutSmart opts doc)+                        Data.Text.IO.hPutStrLn h "" )+                Nothing -> do+                    System.IO.hSetEncoding System.IO.stdin System.IO.utf8+                    text <- Data.Text.IO.getContents++                    (header, expression) <- throws (Dhall.Parser.exprAndHeaderFromText "(stdin)" text)++                    let lintedExpression = Dhall.Lint.lint expression++                    let doc = Pretty.pretty header <> prettyExpr lintedExpression++                    supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout++                    if supportsANSI+                      then+                        Pretty.renderIO+                          System.IO.stdout+                          (fmap annToAnsiStyle (Pretty.layoutSmart opts doc))+                      else+                        Pretty.renderIO+                          System.IO.stdout+                          (Pretty.layoutSmart opts (Pretty.unAnnotate doc))++main :: IO ()+main = do+    options <- Options.Applicative.execParser parserInfoOptions+    command options

@@ -1,1639 +1,83 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-}---- | This module contains Dhall's parsing logic--module Dhall.Parser (-    -- * Utilities-      exprFromText-    , exprAndHeaderFromText--    -- * Parsers-    , expr, exprA--    -- * Types-    , Src(..)-    , ParseError(..)-    , Parser(..)-    ) where--import Control.Applicative (Alternative(..), liftA2, optional)-import Control.Exception (Exception)-import Control.Monad (MonadPlus)-import Data.ByteArray.Encoding (Base(..))-import Data.Functor (void)-import Data.HashMap.Strict.InsOrd (InsOrdHashMap)-import Data.Scientific (Scientific)-import Data.Semigroup (Semigroup(..))-import Data.Sequence (ViewL(..))-import Data.Set (Set)-import Data.String (IsString(..))-import Data.Text.Lazy (Text)-import Data.Text.Lazy.Builder (Builder)-import Data.Void (Void)-import Dhall.Core-import Formatting.Buildable (Buildable(..))-import Numeric.Natural (Natural)-import Prelude hiding (const, pi)-import Text.Parser.Combinators (choice, try, (<?>))-import Text.Parser.Token (TokenParsing(..))--import qualified Control.Monad-import qualified Crypto.Hash-import qualified Data.ByteArray.Encoding-import qualified Data.ByteString-import qualified Data.ByteString.Lazy-import qualified Data.Char-import qualified Data.HashMap.Strict.InsOrd-import qualified Data.HashSet-import qualified Data.List-import qualified Data.List.NonEmpty-import qualified Data.Sequence-import qualified Data.Set-import qualified Data.Text-import qualified Data.Text.Lazy-import qualified Data.Text.Lazy.Builder-import qualified Data.Text.Lazy.Encoding-import qualified Text.Megaparsec-import qualified Text.Megaparsec.Char-import qualified Text.Parser.Char-import qualified Text.Parser.Combinators-import qualified Text.Parser.Token-import qualified Text.Parser.Token.Style---- | Source code extract-data Src = Src Text.Megaparsec.SourcePos Text.Megaparsec.SourcePos Text-  deriving (Eq, Show)--instance Buildable Src where-    build (Src begin _ text) =-            build text <> "\n"-        <>  "\n"-        <>  build (Text.Megaparsec.sourcePosPretty begin)-        <>  "\n"--{-| A `Parser` that is almost identical to-    @"Text.Megaparsec".`Text.Megaparsec.Parsec`@ except treating Haskell-style-    comments as whitespace--}-newtype Parser a = Parser { unParser :: Text.Megaparsec.Parsec Void Text a }-    deriving-    (   Functor-    ,   Applicative-    ,   Monad-    ,   Alternative-    ,   MonadPlus-    ,   Text.Megaparsec.MonadParsec Void Text-    )--instance Data.Semigroup.Semigroup a => Data.Semigroup.Semigroup (Parser a) where-    (<>) = liftA2 (<>)--instance (Data.Semigroup.Semigroup a, Monoid a) => Monoid (Parser a) where-    mempty = pure mempty--#if !(MIN_VERSION_base(4,11,0))-    mappend = (<>)-#endif--instance IsString a => IsString (Parser a) where-    fromString x = fromString x <$ Text.Megaparsec.Char.string (fromString x)--instance Text.Parser.Combinators.Parsing Parser where-  try = Text.Megaparsec.try--  (<?>) = (Text.Megaparsec.<?>)--  skipMany = Text.Megaparsec.skipMany--  skipSome = Text.Megaparsec.skipSome--  unexpected = fail--  eof = Parser Text.Megaparsec.eof--  notFollowedBy = Text.Megaparsec.notFollowedBy--instance Text.Parser.Char.CharParsing Parser where-  satisfy = Parser . Text.Megaparsec.Char.satisfy--  char = Text.Megaparsec.Char.char--  notChar = Text.Megaparsec.Char.char--  anyChar = Text.Megaparsec.Char.anyChar--  string = fmap Data.Text.Lazy.unpack . Text.Megaparsec.Char.string . fromString--  text = fmap Data.Text.Lazy.toStrict . Text.Megaparsec.Char.string . Data.Text.Lazy.fromStrict--instance TokenParsing Parser where-    someSpace =-        Text.Parser.Token.Style.buildSomeSpaceParser-            (Parser (Text.Megaparsec.skipSome (Text.Megaparsec.Char.satisfy Data.Char.isSpace)))-            Text.Parser.Token.Style.haskellCommentStyle--    highlight _ = id--    semi = token (Text.Megaparsec.Char.char ';' <?> ";")--noted :: Parser (Expr Src a) -> Parser (Expr Src a)-noted parser = do-    before      <- Text.Megaparsec.getPosition-    (tokens, e) <- Text.Megaparsec.match parser-    after       <- Text.Megaparsec.getPosition-    return (Note (Src before after tokens) e)--count :: (Semigroup a, Monoid a) => Int -> Parser a -> Parser a-count n parser = mconcat (replicate n parser)--range :: (Semigroup a, Monoid a) => Int -> Int -> Parser a -> Parser a-range minimumBound maximumMatches parser =-    count minimumBound parser <> loop maximumMatches-  where-    loop 0 = mempty-    loop n = (parser <> loop (n - 1)) <|> mempty--option :: (Alternative f, Monoid a) => f a -> f a-option p = p <|> pure mempty--star :: (Alternative f, Monoid a) => f a -> f a-star p = plus p <|> pure mempty--plus :: (Alternative f, Monoid a) => f a -> f a-plus p = mappend <$> p <*> star p--satisfy :: (Char -> Bool) -> Parser Builder-satisfy predicate =-    fmap Data.Text.Lazy.Builder.singleton (Text.Parser.Char.satisfy predicate)--blockComment :: Parser ()-blockComment = do-    _ <- Text.Parser.Char.text "{-"-    blockCommentContinue--blockCommentChunk :: Parser ()-blockCommentChunk =-    choice-        [ blockComment  -- Nested block comment-        , character-        , endOfLine-        ]-  where-    character = void (Text.Parser.Char.satisfy predicate)-      where-        predicate c = '\x20' <= c && c <= '\x10FFFF' || c == '\n' || c == '\t'--    endOfLine = void (Text.Parser.Char.text "\r\n")--blockCommentContinue :: Parser ()-blockCommentContinue = endOfComment <|> continue-  where-    endOfComment = void (Text.Parser.Char.text "-}")--    continue = do-        blockCommentChunk-        blockCommentContinue--lineComment :: Parser ()-lineComment = do-    _ <- Text.Parser.Char.text "--"-    Text.Parser.Combinators.skipMany notEndOfLine-    endOfLine-    return ()-  where-    endOfLine =-            void (Text.Parser.Char.char '\n'  )-        <|> void (Text.Parser.Char.text "\r\n")--    notEndOfLine = void (Text.Parser.Char.satisfy predicate)-      where-        predicate c = ('\x20' <= c && c <= '\x10FFFF') || c == '\t'---whitespaceChunk :: Parser ()-whitespaceChunk =-    choice-        [ void (Text.Parser.Char.satisfy predicate)-        , void (Text.Parser.Char.text "\r\n")-        , lineComment-        , blockComment-        ] <?> "whitespace"-  where-    predicate c = c == ' ' || c == '\t' || c == '\n'--whitespace :: Parser ()-whitespace = Text.Parser.Combinators.skipMany whitespaceChunk--alpha :: Char -> Bool-alpha c = ('\x41' <= c && c <= '\x5A') || ('\x61' <= c && c <= '\x7A')--digit :: Char -> Bool-digit c = '\x30' <= c && c <= '\x39'--hexdig :: Char -> Bool-hexdig c =-        ('0' <= c && c <= '9')-    ||  ('A' <= c && c <= 'F')-    ||  ('a' <= c && c <= 'f')--hexNumber :: Parser Int-hexNumber = choice [ hexDigit, hexUpper, hexLower ]-  where-    hexDigit = do-        c <- Text.Parser.Char.satisfy predicate-        return (Data.Char.ord c - Data.Char.ord '0')-      where-        predicate c = '0' <= c && c <= '9'--    hexUpper = do-        c <- Text.Parser.Char.satisfy predicate-        return (10 + Data.Char.ord c - Data.Char.ord 'A')-      where-        predicate c = 'A' <= c && c <= 'F'--    hexLower = do-        c <- Text.Parser.Char.satisfy predicate-        return (10 + Data.Char.ord c - Data.Char.ord 'a')-      where-        predicate c = 'a' <= c && c <= 'f'--simpleLabel :: Parser Text-simpleLabel = try (do-    c  <- Text.Parser.Char.satisfy headCharacter-    cs <- many (Text.Parser.Char.satisfy tailCharacter)-    let string = c:cs-    let text = Data.Text.Lazy.pack string-    Control.Monad.guard (not (Data.HashSet.member text reservedIdentifiers))-    return text )-  where-    headCharacter c = alpha c || c == '_'--    tailCharacter c = alpha c || digit c || c == '_' || c == '-' || c == '/'--backtickLabel :: Parser Text-backtickLabel = do-    _ <- Text.Parser.Char.char '`'-    t <- some (Text.Parser.Char.satisfy predicate)-    _ <- Text.Parser.Char.char '`'-    return (Data.Text.Lazy.pack t)-  where-    predicate c = alpha c || digit c || elem c ("-/_:." :: String)--label :: Parser Text-label = (do-    t <- backtickLabel <|> simpleLabel-    whitespace-    return t ) <?> "label"--noDuplicates :: Ord a => [a] -> Parser (Set a)-noDuplicates = go Data.Set.empty-  where-    go found    []  = return found-    go found (x:xs) =-        if Data.Set.member x found-        then fail "Duplicate key"-        else go (Data.Set.insert x found) xs--labels :: Parser (Set Text)-labels = do-    _openBrace-    xs <- nonEmptyLabels <|> emptyLabels-    _closeBrace-    return xs-  where-    emptyLabels = pure Data.Set.empty--    nonEmptyLabels = do-        x  <- label-        xs <- many (do _ <- _comma; label)-        noDuplicates (x : xs)--doubleQuotedChunk :: Parser a -> Parser (Chunks Src a)-doubleQuotedChunk embedded =-    choice-        [ interpolation-        , unescapedCharacter-        , escapedCharacter-        ]-  where-    interpolation = do-        _ <- Text.Parser.Char.text "${"-        e <- completeExpression embedded-        _ <- Text.Parser.Char.char '}'-        return (Chunks [(mempty, e)] mempty)--    unescapedCharacter = do-        c <- Text.Parser.Char.satisfy predicate-        return (Chunks [] (Data.Text.Lazy.Builder.singleton c))-      where-        predicate c =-                ('\x20' <= c && c <= '\x21'    )-            ||  ('\x23' <= c && c <= '\x5B'    )-            ||  ('\x5D' <= c && c <= '\x10FFFF')--    escapedCharacter = do-        _ <- Text.Parser.Char.char '\\'-        c <- choice-            [ quotationMark-            , dollarSign-            , backSlash-            , forwardSlash-            , backSpace-            , formFeed-            , lineFeed-            , carriageReturn-            , tab-            , unicode-            ]-        return (Chunks [] (Data.Text.Lazy.Builder.singleton c))-      where-        quotationMark = Text.Parser.Char.char '"'--        dollarSign = Text.Parser.Char.char '$'--        backSlash = Text.Parser.Char.char '\\'--        forwardSlash = Text.Parser.Char.char '/'--        backSpace = do _ <- Text.Parser.Char.char 'b'; return '\b'--        formFeed = do _ <- Text.Parser.Char.char 'f'; return '\f'--        lineFeed = do _ <- Text.Parser.Char.char 'n'; return '\n'--        carriageReturn = do _ <- Text.Parser.Char.char 'r'; return '\r'--        tab = do _ <- Text.Parser.Char.char 't'; return '\t'--        unicode = do-            _  <- Text.Parser.Char.char 'u';-            n0 <- hexNumber-            n1 <- hexNumber-            n2 <- hexNumber-            n3 <- hexNumber-            let n = ((n0 * 16 + n1) * 16 + n2) * 16 + n3-            return (Data.Char.chr n)--doubleQuotedLiteral :: Parser a -> Parser (Chunks Src a)-doubleQuotedLiteral embedded = do-    _      <- Text.Parser.Char.char '"'-    chunks <- many (doubleQuotedChunk embedded)-    _      <- Text.Parser.Char.char '"'-    return (mconcat chunks)---- | Similar to `Dhall.Core.buildChunks` except that this doesn't bother to--- render interpolated expressions to avoid a `Buildable a` constraint.  The--- interpolated contents are not necessary for computing how much to dedent a--- multi-line string------ This also doesn't include the surrounding quotes since they would interfere--- with the whitespace detection-buildChunks :: Chunks s a -> Builder-buildChunks (Chunks a b) = foldMap buildChunk a <> escapeText b-  where-    buildChunk (c, _) = escapeText c <> "${x}"--dedent :: Chunks Src a -> Chunks Src a-dedent chunks0 = process chunks0-  where-    builder0 = buildChunks chunks0--    text0 = Data.Text.Lazy.Builder.toLazyText builder0--    lines0 = Data.Text.Lazy.lines text0--    isEmpty = Data.Text.Lazy.all Data.Char.isSpace--    nonEmptyLines = filter (not . isEmpty) lines0--    indentLength line =-        Data.Text.Lazy.length (Data.Text.Lazy.takeWhile Data.Char.isSpace line)--    shortestIndent = case nonEmptyLines of-        [] -> 0-        _  -> minimum (map indentLength nonEmptyLines)--    -- The purpose of this complicated `trimBegin`/`trimContinue` is to ensure-    -- that we strip leading whitespace without stripping whitespace after-    -- variable interpolation--    -- This is the trim function we use up until the first variable-    -- interpolation, dedenting all lines-    trimBegin =-          build-        . Data.Text.Lazy.intercalate "\n"-        . map (Data.Text.Lazy.drop shortestIndent)-        . Data.Text.Lazy.splitOn "\n"-        . Data.Text.Lazy.Builder.toLazyText--    -- This is the trim function we use after each variable interpolation-    -- where we indent each line except the first line (since it's not a true-    -- beginning of a line)-    trimContinue builder = build (Data.Text.Lazy.intercalate "\n" lines_)-      where-        text = Data.Text.Lazy.Builder.toLazyText builder--        lines_ = case Data.Text.Lazy.splitOn "\n" text of-            []   -> []-            l:ls -> l:map (Data.Text.Lazy.drop shortestIndent) ls--    -- This is the loop that drives whether or not to use `trimBegin` or-    -- `trimContinue`.  We call this function with `trimBegin`, but after the-    -- first interpolation we switch permanently to `trimContinue`-    process (Chunks ((x0, y0):xys) z) =-        Chunks ((trimBegin x0, y0):xys') (trimContinue z)-      where-        xys' = [ (trimContinue x, y) | (x, y) <- xys ]-    process (Chunks [] z) =-        Chunks [] (trimBegin z)--singleQuoteContinue :: Parser a -> Parser (Chunks Src a)-singleQuoteContinue embedded =-    choice-        [ escapeSingleQuotes-        , interpolation-        , escapeInterpolation-        , endLiteral-        , unescapedCharacter-        , tab-        , endOfLine-        ]-  where-        escapeSingleQuotes = do-            _ <- "'''" :: Parser Builder-            b <- singleQuoteContinue embedded-            return ("''" <> b)--        interpolation = do-            _ <- Text.Parser.Char.text "${"-            a <- completeExpression embedded-            _ <- Text.Parser.Char.char '}'-            b <- singleQuoteContinue embedded-            return (Chunks [(mempty, a)] mempty <> b)--        escapeInterpolation = do-            _ <- Text.Parser.Char.text "''${"-            b <- singleQuoteContinue embedded-            return ("${" <> b)--        endLiteral = do-            _ <- Text.Parser.Char.text "''"-            return mempty--        unescapedCharacter = do-            a <- satisfy predicate-            b <- singleQuoteContinue embedded-            return (Chunks [] a <> b)-          where-            predicate c = '\x20' <= c && c <= '\x10FFFF'--        endOfLine = do-            a <- "\n" <|> "\r\n"-            b <- singleQuoteContinue embedded-            return (Chunks [] a <> b)--        tab = do-            _ <- Text.Parser.Char.char '\t'-            b <- singleQuoteContinue embedded-            return ("\t" <> b)--singleQuoteLiteral :: Parser a -> Parser (Chunks Src a)-singleQuoteLiteral embedded = do-    _ <- Text.Parser.Char.text "''"--    -- This is technically not in the grammar, but it's still equivalent to the-    -- original grammar and an easy way to discard the first character if it's-    -- a newline-    _ <- optional endOfLine--    a <- singleQuoteContinue embedded--    return (dedent a)-  where-    endOfLine =-            void (Text.Parser.Char.char '\n'  )-        <|> void (Text.Parser.Char.text "\r\n")--textLiteral :: Parser a -> Parser (Expr Src a)-textLiteral embedded = (do-    literal <- doubleQuotedLiteral embedded <|> singleQuoteLiteral embedded-    whitespace-    return (TextLit literal) ) <?> "text literal"--reserved :: Data.Text.Text -> Parser ()-reserved x = do _ <- Text.Parser.Char.text x; whitespace--_if :: Parser ()-_if = reserved "if"--_then :: Parser ()-_then = reserved "then"--_else :: Parser ()-_else = reserved "else"--_let :: Parser ()-_let = reserved "let"--_in :: Parser ()-_in = reserved "in"--_as :: Parser ()-_as = reserved "as"--_using :: Parser ()-_using = reserved "using"--_merge :: Parser ()-_merge = reserved "merge"--_constructors :: Parser ()-_constructors = reserved "constructors"--_NaturalFold :: Parser ()-_NaturalFold = reserved "Natural/fold"--_NaturalBuild :: Parser ()-_NaturalBuild = reserved "Natural/build"--_NaturalIsZero :: Parser ()-_NaturalIsZero = reserved "Natural/isZero"--_NaturalEven :: Parser ()-_NaturalEven = reserved "Natural/even"--_NaturalOdd :: Parser ()-_NaturalOdd = reserved "Natural/odd"--_NaturalToInteger :: Parser ()-_NaturalToInteger = reserved "Natural/toInteger"--_NaturalShow :: Parser ()-_NaturalShow = reserved "Natural/show"--_IntegerShow :: Parser ()-_IntegerShow = reserved "Integer/show"--_DoubleShow :: Parser ()-_DoubleShow = reserved "Double/show"--_ListBuild :: Parser ()-_ListBuild = reserved "List/build"--_ListFold :: Parser ()-_ListFold = reserved "List/fold"--_ListLength :: Parser ()-_ListLength = reserved "List/length"--_ListHead :: Parser ()-_ListHead = reserved "List/head"--_ListLast :: Parser ()-_ListLast = reserved "List/last"--_ListIndexed :: Parser ()-_ListIndexed = reserved "List/indexed"--_ListReverse :: Parser ()-_ListReverse = reserved "List/reverse"--_OptionalFold :: Parser ()-_OptionalFold = reserved "Optional/fold"--_OptionalBuild :: Parser ()-_OptionalBuild = reserved "Optional/build"--_Bool :: Parser ()-_Bool = reserved "Bool"--_Optional :: Parser ()-_Optional = reserved "Optional"--_Natural :: Parser ()-_Natural = reserved "Natural"--_Integer :: Parser ()-_Integer = reserved "Integer"--_Double :: Parser ()-_Double = reserved "Double"--_Text :: Parser ()-_Text = reserved "Text"--_List :: Parser ()-_List = reserved "List"--_True :: Parser ()-_True = reserved "True"--_False :: Parser ()-_False = reserved "False"--_Type :: Parser ()-_Type = reserved "Type"--_Kind :: Parser ()-_Kind = reserved "Kind"--_equal :: Parser ()-_equal = reserved "="--_or :: Parser ()-_or = reserved "||"--_plus :: Parser ()-_plus = reserved "+"--_textAppend :: Parser ()-_textAppend = reserved "++"--_listAppend :: Parser ()-_listAppend = reserved "#"--_and :: Parser ()-_and = reserved "&&"--_times :: Parser ()-_times = reserved "*"--_doubleEqual :: Parser ()-_doubleEqual = reserved "=="--_notEqual :: Parser ()-_notEqual = reserved "!="--_dot :: Parser ()-_dot = reserved "."--_openBrace :: Parser ()-_openBrace = reserved "{"--_closeBrace :: Parser ()-_closeBrace = reserved "}"--_openBracket :: Parser ()-_openBracket = reserved "["--_closeBracket :: Parser ()-_closeBracket = reserved "]"--_openAngle :: Parser ()-_openAngle = reserved "<"--_closeAngle :: Parser ()-_closeAngle = reserved ">"--_bar :: Parser ()-_bar = reserved "|"--_comma :: Parser ()-_comma = reserved ","--_openParens :: Parser ()-_openParens = reserved "("--_closeParens :: Parser ()-_closeParens = reserved ")"--_colon :: Parser ()-_colon = reserved ":"--_at :: Parser ()-_at = reserved "@"--_combine :: Parser ()-_combine = do-    void (Text.Parser.Char.char '∧' <?> "\"∧\"") <|> void (Text.Parser.Char.text "/\\")-    whitespace--_combineTypes :: Parser ()-_combineTypes = do-    void (Text.Parser.Char.char '⩓' <?> "\"⩓\"") <|> void (Text.Parser.Char.text "//\\\\")-    whitespace--_prefer :: Parser ()-_prefer = do-    void (Text.Parser.Char.char '⫽' <?> "\"⫽\"") <|> void (Text.Parser.Char.text "//")-    whitespace--_lambda :: Parser ()-_lambda = do-    _ <- Text.Parser.Char.satisfy predicate-    whitespace-  where-    predicate 'λ'  = True-    predicate '\\' = True-    predicate _    = False--_forall :: Parser ()-_forall = do-    void (Text.Parser.Char.char '∀' <?> "\"∀\"") <|> void (Text.Parser.Char.text "forall")-    whitespace--_arrow :: Parser ()-_arrow = do-    void (Text.Parser.Char.char '→' <?> "\"→\"") <|> void (Text.Parser.Char.text "->")-    whitespace--doubleLiteral :: Parser Scientific-doubleLiteral = (do-    sign <-  fmap (\_ -> negate) (Text.Parser.Char.char '-')-         <|> pure id-    a    <-  Text.Parser.Token.scientific-    return (sign a) ) <?> "double literal"--integerLiteral :: Parser Integer-integerLiteral = (do-    let positive = fmap (\_ -> id    ) (Text.Parser.Char.char '+')-    let negative = fmap (\_ -> negate) (Text.Parser.Char.char '-')-    sign <- positive <|> negative-    a <- Text.Parser.Token.natural-    return (sign a) ) <?> "integer literal"--naturalLiteral :: Parser Natural-naturalLiteral = (do-    a <- Text.Parser.Token.natural-    return (fromIntegral a) ) <?> "natural literal"--identifier :: Parser Var-identifier = do-    x <- label--    let indexed = do-            _ <- Text.Parser.Char.char '@'-            Text.Parser.Token.natural--    n <- indexed <|> pure 0-    return (V x n)--pathCharacter :: Char -> Bool-pathCharacter c =-        ('\x21' <= c && c <= '\x22')-    ||  ('\x24' <= c && c <= '\x27')-    ||  ('\x2A' <= c && c <= '\x2B')-    ||  ('\x2D' <= c && c <= '\x2E')-    ||  ('\x30' <= c && c <= '\x3B')-    ||  c == '\x3D'-    ||  ('\x40' <= c && c <= '\x5A')-    ||  ('\x5E' <= c && c <= '\x7A')-    ||  c == '\x7C'-    ||  c == '\x7E'--pathComponent :: Parser Text-pathComponent = do-    _      <- "/" :: Parser Builder-    string <- some (Text.Parser.Char.satisfy pathCharacter)--    return (Data.Text.Lazy.pack string)--file_ :: Parser File-file_ = do-    path <- Data.List.NonEmpty.some1 pathComponent--    let directory = Directory (reverse (Data.List.NonEmpty.init path))-    let file      = Data.List.NonEmpty.last path--    return (File {..})--localRaw :: Parser ImportType-localRaw =-    choice-        [ parentPath-        , herePath-        , homePath-        , try absolutePath-        ]-  where-    parentPath = do-        _    <- ".." :: Parser Builder-        file <- file_--        return (Local Parent file)--    herePath = do-        _    <- "." :: Parser Builder-        file <- file_--        return (Local Here file)--    homePath = do-        _    <- "~" :: Parser Builder-        file <- file_--        return (Local Home file)--    absolutePath = do-        file <- file_--        return (Local Absolute file)--local :: Parser ImportType-local = do-    a <- localRaw-    whitespace-    return a--scheme :: Parser Builder-scheme = "http" <> option "s"--httpRaw :: Parser (Text, File, Text)-httpRaw = do-    prefix <- scheme <> "://" <> authority-    file   <- file_-    suffix <- option ("?" <> query) <> option ("#" <> fragment)--    let prefixText = Data.Text.Lazy.Builder.toLazyText prefix-    let suffixText = Data.Text.Lazy.Builder.toLazyText suffix--    return (prefixText, file, suffixText)--authority :: Parser Builder-authority = option (try (userinfo <> "@")) <> host <> option (":" <> port)--userinfo :: Parser Builder-userinfo = star (satisfy predicate <|> pctEncoded)-  where-    predicate c = unreserved c || subDelims c || c == ':'--host :: Parser Builder-host = choice [ ipLiteral, ipV4Address, regName ]--port :: Parser Builder-port = star (satisfy digit)--ipLiteral :: Parser Builder-ipLiteral = "[" <> (ipV6Address <|> ipVFuture) <> "]"--ipVFuture :: Parser Builder-ipVFuture = "v" <> plus (satisfy hexdig) <> "." <> plus (satisfy predicate)-  where-    predicate c = unreserved c || subDelims c || c == ':'--ipV6Address :: Parser Builder-ipV6Address =-    choice-        [ try alternative0-        , try alternative1-        , try alternative2-        , try alternative3-        , try alternative4-        , try alternative5-        , try alternative6-        , try alternative7-        ,     alternative8-        ]-  where-    alternative0 = count 6 (h16 <> ":") <> ls32--    alternative1 = "::" <> count 5 (h16 <> ":") <> ls32--    alternative2 = option h16 <> "::" <> count 4 (h16 <> ":") <> ls32--    alternative3 =-            option (range 0 1 (h16 <> ":") <> h16)-        <>  "::"-        <>  count 3 (h16 <> ":")-        <>  ls32--    alternative4 =-            option (range 0 2 (h16 <> ":") <> h16)-        <>  "::"-        <>  count 2 (h16 <> ":")-        <>  ls32--    alternative5 =-        option (range 0 3 (h16 <> ":") <> h16) <> "::" <> h16 <> ":" <> ls32--    alternative6 =-        option (range 0 4 (h16 <> ":") <> h16) <> "::" <> ls32--    alternative7 =-        option (range 0 5 (h16 <> ":") <> h16) <> "::" <> h16--    alternative8 =-        option (range 0 6 (h16 <> ":") <> h16) <> "::"--h16 :: Parser Builder-h16 = range 1 3 (satisfy hexdig)--ls32 :: Parser Builder-ls32 = (h16 <> ":" <> h16) <|> ipV4Address--ipV4Address :: Parser Builder-ipV4Address = decOctet <> "." <> decOctet <> "." <> decOctet <> "." <> decOctet--decOctet :: Parser Builder-decOctet =-    choice-        [ try alternative4-        , try alternative3-        , try alternative2-        , try alternative1-        ,     alternative0-        ]-  where-    alternative0 = satisfy digit--    alternative1 = satisfy predicate <> satisfy digit-      where-        predicate c = '\x31' <= c && c <= '\x39'--    alternative2 = "1" <> count 2 (satisfy digit)--    alternative3 = "2" <> satisfy predicate <> satisfy digit-      where-        predicate c = '\x30' <= c && c <= '\x34'--    alternative4 = "25" <> satisfy predicate-      where-        predicate c = '\x30' <= c && c <= '\x35'--regName :: Parser Builder-regName = star (satisfy predicate <|> pctEncoded)-  where-    predicate c = unreserved c || subDelims c--pchar :: Parser Builder-pchar = satisfy predicate <|> pctEncoded-  where-    predicate c = unreserved c || subDelims c || c == ':' || c == '@'--query :: Parser Builder-query = star (pchar <|> satisfy predicate)-  where-    predicate c = c == '/' || c == '?'--fragment :: Parser Builder-fragment = star (pchar <|> satisfy predicate)-  where-    predicate c = c == '/' || c == '?'--pctEncoded :: Parser Builder-pctEncoded = "%" <> count 2 (satisfy hexdig)--unreserved :: Char -> Bool-unreserved c =-    alpha c || digit c || c == '-' || c == '.' || c == '_' || c == '~'--subDelims :: Char -> Bool-subDelims c = c `elem` ("!$&'()*+,;=" :: String)--http :: Parser ImportType-http = do-    (prefix, path, suffix) <- httpRaw-    whitespace-    headers <- optional (do-        _using-        importHashed_ )-    return (URL prefix path suffix headers)--env :: Parser ImportType-env = do-    _ <- Text.Parser.Char.text "env:"-    a <- (alternative0 <|> alternative1)-    whitespace-    return (Env a)-  where-    alternative0 = do-        a <- bashEnvironmentVariable-        return (Data.Text.Lazy.Builder.toLazyText a)--    alternative1 = do-        _ <- Text.Parser.Char.char '"'-        a <- posixEnvironmentVariable-        _ <- Text.Parser.Char.char '"'-        return (Data.Text.Lazy.Builder.toLazyText a)--bashEnvironmentVariable :: Parser Builder-bashEnvironmentVariable = satisfy predicate0 <> star (satisfy predicate1)-  where-    predicate0 c = alpha c || c == '_'--    predicate1 c = alpha c || digit c || c == '_'--posixEnvironmentVariable :: Parser Builder-posixEnvironmentVariable = plus posixEnvironmentVariableCharacter--posixEnvironmentVariableCharacter :: Parser Builder-posixEnvironmentVariableCharacter =-    ("\\" <> satisfy predicate0) <|> satisfy predicate1-  where-    predicate0 c = c `elem` ("\"\\abfnrtv" :: String)--    predicate1 c =-            ('\x20' <= c && c <= '\x21')-        ||  ('\x23' <= c && c <= '\x3C')-        ||  ('\x3E' <= c && c <= '\x5B')-        ||  ('\x5D' <= c && c <= '\x7E')--expression :: Parser a -> Parser (Expr Src a)-expression embedded =-    (   noted-        ( choice-            [ alternative0-            , alternative1-            , alternative2-            , alternative3-            , alternative4-            ]-        )-    <|> alternative5-    ) <?> "expression"-  where-    alternative0 = do-        _lambda-        _openParens-        a <- label-        _colon-        b <- expression embedded-        _closeParens-        _arrow-        c <- expression embedded-        return (Lam a b c)--    alternative1 = do-        _if-        a <- expression embedded-        _then-        b <- expression embedded-        _else-        c <- expression embedded-        return (BoolIf a b c)--    alternative2 = do-        _let-        a <- label-        b <- optional (do-            _colon-            expression embedded )-        _equal-        c <- expression embedded-        _in-        d <- expression embedded-        return (Let a b c d)--    alternative3 = do-        _forall-        _openParens-        a <- label-        _colon-        b <- expression embedded-        _closeParens-        _arrow-        c <- expression embedded-        return (Pi a b c)--    alternative4 = do-        a <- try (do a <- operatorExpression embedded; _arrow; return a)-        b <- expression embedded-        return (Pi "_" a b)--    alternative5 = annotatedExpression embedded--annotatedExpression :: Parser a -> Parser (Expr Src a)-annotatedExpression embedded =-    noted-        ( choice-            [ alternative0-            , try alternative1-            , alternative2-            ]-        )-  where-    alternative0 = do-        _merge-        a <- selectorExpression embedded-        b <- selectorExpression embedded-        c <- optional (do-            _colon-            applicationExpression embedded )-        return (Merge a b c)--    alternative1 = (do-        _openBracket-        (emptyCollection embedded <|> nonEmptyOptional embedded) )-        <?> "list literal"--    alternative2 = do-        a <- operatorExpression embedded-        b <- optional (do _colon; expression embedded)-        case b of-            Nothing -> return a-            Just c  -> return (Annot a c)--emptyCollection :: Parser a -> Parser (Expr Src a)-emptyCollection embedded = do-    _closeBracket-    _colon-    a <- alternative0 <|> alternative1-    b <- selectorExpression embedded-    return (a b)-  where-    alternative0 = do-        _List-        return (\a -> ListLit (Just a) empty)--    alternative1 = do-        _Optional-        return (\a -> OptionalLit a empty)--nonEmptyOptional :: Parser a -> Parser (Expr Src a)-nonEmptyOptional embedded = do-    a <- expression embedded-    _closeBracket-    _colon-    _Optional-    b <- selectorExpression embedded-    return (OptionalLit b (pure a))--operatorExpression :: Parser a -> Parser (Expr Src a)-operatorExpression = orExpression--makeOperatorExpression-    :: (Parser a -> Parser (Expr Src a))-    -> Parser ()-    -> (Expr Src a -> Expr Src a -> Expr Src a)-    -> Parser a-    -> Parser (Expr Src a)-makeOperatorExpression subExpression operatorParser operator embedded =-    noted (do-        a <- subExpression embedded-        b <- many (do operatorParser; subExpression embedded)-        return (foldr1 operator (a:b)) )--orExpression :: Parser a -> Parser (Expr Src a)-orExpression =-    makeOperatorExpression plusExpression _or BoolOr--plusExpression :: Parser a -> Parser (Expr Src a)-plusExpression =-    makeOperatorExpression textAppendExpression _plus NaturalPlus--textAppendExpression :: Parser a -> Parser (Expr Src a)-textAppendExpression =-    makeOperatorExpression listAppendExpression _textAppend TextAppend--listAppendExpression :: Parser a -> Parser (Expr Src a)-listAppendExpression =-    makeOperatorExpression andExpression _listAppend ListAppend--andExpression :: Parser a -> Parser (Expr Src a)-andExpression =-    makeOperatorExpression combineExpression _and BoolAnd--combineExpression :: Parser a -> Parser (Expr Src a)-combineExpression =-    makeOperatorExpression preferExpression _combine Combine--preferExpression :: Parser a -> Parser (Expr Src a)-preferExpression =-    makeOperatorExpression combineTypesExpression _prefer Prefer--combineTypesExpression :: Parser a -> Parser (Expr Src a)-combineTypesExpression =-    makeOperatorExpression timesExpression _combineTypes CombineTypes--timesExpression :: Parser a -> Parser (Expr Src a)-timesExpression =-    makeOperatorExpression equalExpression _times NaturalTimes--equalExpression :: Parser a -> Parser (Expr Src a)-equalExpression =-    makeOperatorExpression notEqualExpression _doubleEqual BoolEQ--notEqualExpression :: Parser a -> Parser (Expr Src a)-notEqualExpression =-    makeOperatorExpression applicationExpression _notEqual BoolNE--applicationExpression :: Parser a -> Parser (Expr Src a)-applicationExpression embedded = do-    f <- (do _constructors; return Constructors) <|> return id-    a <- noted (selectorExpression embedded)-    b <- many (noted (selectorExpression embedded))-    return (foldl app (f a) b)-  where-    app nL@(Note (Src before _ bytesL) _) nR@(Note (Src _ after bytesR) _) =-        Note (Src before after (bytesL <> bytesR)) (App nL nR)-    app nL nR =-        App nL nR--selectorExpression :: Parser a -> Parser (Expr Src a)-selectorExpression embedded = noted (do-    a <- primitiveExpression embedded--    let left  x  e = Field   e x-    let right xs e = Project e xs-    b <- many (try (do _dot; fmap left label <|> fmap right labels))-    return (foldl (\e k -> k e) a b) )--primitiveExpression :: Parser a -> Parser (Expr Src a)-primitiveExpression embedded =-    noted-        ( choice-            [ alternative00-            , alternative01-            , alternative02-            , alternative03-            , alternative04-            , alternative05-            , alternative06-            , alternative07-            , alternative37--            , choice-                [ alternative08-                , alternative09-                , alternative10-                , alternative11-                , alternative12-                , alternative13-                , alternative14-                , alternative15-                , alternative16-                , alternative17-                , alternative18-                , alternative19-                , alternative20-                , alternative21-                , alternative22-                , alternative23-                , alternative24-                , alternative25-                , alternative26-                , alternative27-                , alternative28-                , alternative29-                , alternative30-                , alternative31-                , alternative32-                , alternative33-                , alternative34-                , alternative35-                , alternative36-                ] <?> "built-in expression"-            ]-        )-    <|> alternative38-  where-    alternative00 = do-        a <- try doubleLiteral-        return (DoubleLit a)--    alternative01 = do-        a <- try naturalLiteral-        return (NaturalLit a)--    alternative02 = do-        a <- try integerLiteral-        return (IntegerLit a)--    alternative03 = textLiteral embedded--    alternative04 = (do-        _openBrace-        a <- recordTypeOrLiteral embedded-        _closeBrace-        return a ) <?> "record type or literal"--    alternative05 = (do-        _openAngle-        a <- unionTypeOrLiteral embedded-        _closeAngle-        return a ) <?> "union type or literal"--    alternative06 = nonEmptyListLiteral embedded--    alternative07 = do-        a <- embedded-        return (Embed a)--    alternative08 = do-        _NaturalFold-        return NaturalFold--    alternative09 = do-        _NaturalBuild-        return NaturalBuild--    alternative10 = do-        _NaturalIsZero-        return NaturalIsZero--    alternative11 = do-        _NaturalEven-        return NaturalEven--    alternative12 = do-        _NaturalOdd-        return NaturalOdd--    alternative13 = do-        _NaturalToInteger-        return NaturalToInteger--    alternative14 = do-        _NaturalShow-        return NaturalShow--    alternative15 = do-        _IntegerShow-        return IntegerShow--    alternative16 = do-        _DoubleShow-        return DoubleShow--    alternative17 = do-        _ListBuild-        return ListBuild--    alternative18 = do-        _ListFold-        return ListFold--    alternative19 = do-        _ListLength-        return ListLength--    alternative20 = do-        _ListHead-        return ListHead--    alternative21 = do-        _ListLast-        return ListLast--    alternative22 = do-        _ListIndexed-        return ListIndexed--    alternative23 = do-        _ListReverse-        return ListReverse--    alternative24 = do-        _OptionalFold-        return OptionalFold--    alternative25 = do-        _OptionalBuild-        return OptionalBuild--    alternative26 = do-        _Bool-        return Bool--    alternative27 = do-        _Optional-        return Optional--    alternative28 = do-        _Natural-        return Natural--    alternative29 = do-        _Integer-        return Integer--    alternative30 = do-        _Double-        return Double--    alternative31 = do-        _Text-        return Text--    alternative32 = do-        _List-        return List--    alternative33 = do-        _True-        return (BoolLit True)--    alternative34 = do-        _False-        return (BoolLit False)--    alternative35 = do-        _Type-        return (Const Type)--    alternative36 = do-        _Kind-        return (Const Kind)--    alternative37 = do-        a <- identifier-        return (Var a)--    alternative38 = do-        _openParens-        a <- expression embedded-        _closeParens-        return a--recordTypeOrLiteral :: Parser a -> Parser (Expr Src a)-recordTypeOrLiteral embedded =-    choice-        [ alternative0-        , alternative1-        , alternative2-        ]-  where-    alternative0 = do-        _equal-        return (RecordLit Data.HashMap.Strict.InsOrd.empty)--    alternative1 = nonEmptyRecordTypeOrLiteral embedded--    alternative2 = return (Record Data.HashMap.Strict.InsOrd.empty)--nonEmptyRecordTypeOrLiteral :: Parser a -> Parser (Expr Src a)-nonEmptyRecordTypeOrLiteral embedded = do-    a <- label--    let nonEmptyRecordType = do-            _colon-            b <- expression embedded-            e <- many (do-                _comma-                c <- label-                _colon-                d <- expression embedded-                return (c, d) )-            return (Record (Data.HashMap.Strict.InsOrd.fromList ((a, b):e)))--    let nonEmptyRecordLiteral = do-            _equal-            b <- expression embedded-            e <- many (do-                _comma-                c <- label-                _equal-                d <- expression embedded-                return (c, d) )-            return (RecordLit (Data.HashMap.Strict.InsOrd.fromList ((a, b):e)))--    nonEmptyRecordType <|> nonEmptyRecordLiteral--unionTypeOrLiteral :: Parser a -> Parser (Expr Src a)-unionTypeOrLiteral embedded =-        nonEmptyUnionTypeOrLiteral embedded-    <|> return (Union Data.HashMap.Strict.InsOrd.empty)--nonEmptyUnionTypeOrLiteral :: Parser a -> Parser (Expr Src a)-nonEmptyUnionTypeOrLiteral embedded = do-    (f, kvs) <- loop-    m <- toMap kvs-    return (f m)-  where-    loop = do-        a <- label--        let alternative0 = do-                _equal-                b <- expression embedded-                kvs <- many (do-                    _bar-                    c <- label-                    _colon-                    d <- expression embedded-                    return (c, d) )-                return (UnionLit a b, kvs)--        let alternative1 = do-                _colon-                b <- expression embedded--                let alternative2 = do-                        _bar-                        (f, kvs) <- loop-                        return (f, (a, b):kvs)--                let alternative3 = return (Union, [(a, b)])--                alternative2 <|> alternative3--        alternative0 <|> alternative1--nonEmptyListLiteral :: Parser a -> Parser (Expr Src a)-nonEmptyListLiteral embedded = (do-    _openBracket-    a <- expression embedded-    b <- many (do _comma; expression embedded)-    _closeBracket-    return (ListLit Nothing (Data.Sequence.fromList (a:b))) ) <?> "list literal"--completeExpression :: Parser a -> Parser (Expr Src a)-completeExpression embedded = do-    whitespace-    expression embedded--toMap :: [(Text, a)] -> Parser (InsOrdHashMap Text a)-toMap kvs = do-    let adapt (k, v) = (k, pure v)-    let m = fromListWith (<|>) (fmap adapt kvs)-    let action k vs = case Data.Sequence.viewl vs of-            EmptyL  -> empty-            v :< vs' ->-                if null vs'-                then pure v-                else-                    Text.Parser.Combinators.unexpected-                        ("duplicate field: " ++ Data.Text.Lazy.unpack k)-    Data.HashMap.Strict.InsOrd.traverseWithKey action m-  where-    fromListWith combine = Data.List.foldl' snoc nil-      where-        nil = Data.HashMap.Strict.InsOrd.empty--        snoc m (k, v) = Data.HashMap.Strict.InsOrd.insertWith combine k v m---- | Parser for a top-level Dhall expression-expr :: Parser (Expr Src Import)-expr = exprA import_---- | Parser for a top-level Dhall expression. The expression is parameterized--- over any parseable type, allowing the language to be extended as needed.-exprA :: Parser a -> Parser (Expr Src a)-exprA = completeExpression--importType_ :: Parser ImportType-importType_ = choice [ local, http, env ]--importHashed_ :: Parser ImportHashed-importHashed_ = do-    importType <- importType_-    hash       <- optional importHash_-    return (ImportHashed {..})-  where-    importHash_ = do-        _ <- Text.Parser.Char.text "sha256:"-        builder <- count 64 (satisfy hexdig <?> "hex digit")-        whitespace-        let lazyText    = Data.Text.Lazy.Builder.toLazyText builder-        let lazyBytes16 = Data.Text.Lazy.Encoding.encodeUtf8 lazyText-        let strictBytes16 = Data.ByteString.Lazy.toStrict lazyBytes16-        strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of-            Left  string      -> fail string-            Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString)-        case Crypto.Hash.digestFromByteString strictBytes of-          Nothing -> fail "Invalid sha256 hash"-          Just h -> pure h--import_ :: Parser Import-import_ = (do-    importHashed <- importHashed_-    importMode   <- alternative <|> pure Code-    return (Import {..}) ) <?> "import"-  where-    alternative = do-        _as-        _Text-        return RawText---- | A parsing error-data ParseError = ParseError-    { unwrap :: Text.Megaparsec.ParseError Char Void-    , input  :: Text-    }--instance Show ParseError where-    show (ParseError {..}) =-      "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.parseErrorPretty' input unwrap--instance Exception ParseError---- | Parse an expression from `Text` containing a Dhall program-exprFromText :: String -> Text -> Either ParseError (Expr Src Import)-exprFromText delta text = fmap snd (exprAndHeaderFromText delta text)--{-| 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-    -> Text-    -> Either ParseError (Text, Expr Src Import)-exprAndHeaderFromText delta text = case result of-    Left errInfo   -> Left (ParseError { unwrap = errInfo, input = text })-    Right (txt, r) -> Right (Data.Text.Lazy.dropWhileEnd (/= '\n') txt, r)+{-# LANGUAGE RecordWildCards            #-}+-- | This module contains Dhall's parsing logic++module Dhall.Parser (+    -- * Utilities+      exprFromText+    , exprAndHeaderFromText++    -- * Parsers+    , expr, exprA++    -- * Types+    , Src(..)+    , ParseError(..)+    , Parser(..)+    ) where++import Control.Exception (Exception)+import Data.Semigroup (Semigroup(..))+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Core+import Prelude hiding (const, pi)++import qualified Data.Text+import qualified Text.Megaparsec++import Dhall.Parser.Combinators+import Dhall.Parser.Token+import Dhall.Parser.Expression++-- | Parser for a top-level Dhall expression+expr :: Parser (Expr Src Import)+expr = exprA import_++-- | Parser for a top-level Dhall expression. The expression is parameterized+-- over any parseable type, allowing the language to be extended as needed.+exprA :: Parser a -> Parser (Expr Src a)+exprA = completeExpression++-- | A parsing error+data ParseError = ParseError+    { unwrap :: Text.Megaparsec.ParseError Char Void+    , input  :: Text+    }++instance Show ParseError where+    show (ParseError {..}) =+      "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.parseErrorPretty' input unwrap++instance Exception ParseError++-- | Parse an expression from `Text` containing a Dhall program+exprFromText+  :: String -- ^ User-friendly name describing the input expression,+            --   used in parsing error messages+  -> Text   -- ^ Input expression to parse+  -> Either ParseError (Expr Src Import)+exprFromText delta text = fmap snd (exprAndHeaderFromText delta text)++{-| 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+    -> Text   -- ^ Input expression to parse+    -> Either ParseError (Text, Expr Src Import)+exprAndHeaderFromText delta text = case result of+    Left errInfo   -> Left (ParseError { unwrap = errInfo, input = text })+    Right (txt, r) -> Right (Data.Text.dropWhileEnd (/= '\n') txt, r)   where     parser = do         (bytes, _) <- Text.Megaparsec.match whitespace

@@ -0,0 +1,161 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+module Dhall.Parser.Combinators where+++import           Control.Applicative        (Alternative (..), liftA2)+import           Control.Monad              (MonadPlus)+import           Data.Data                  (Data)+import           Data.HashMap.Strict.InsOrd (InsOrdHashMap)+import           Data.Semigroup             (Semigroup (..))+import           Data.Sequence              (ViewL (..))+import           Data.Set                   (Set)+import           Data.String                (IsString (..))+import           Data.Text                  (Text)+import           Data.Text.Prettyprint.Doc  (Pretty (..))+import           Data.Void                  (Void)+import           Prelude                    hiding (const, pi)+import           Text.Parser.Combinators    (try, (<?>))+import           Text.Parser.Token          (TokenParsing (..))++import qualified Data.Char+import qualified Data.HashMap.Strict.InsOrd+import qualified Data.List+import qualified Data.Sequence+import qualified Data.Set+import qualified Data.Text+import qualified Text.Megaparsec+import qualified Text.Megaparsec.Char+import qualified Text.Parser.Char+import qualified Text.Parser.Combinators+import qualified Text.Parser.Token.Style++-- | Source code extract+data Src = Src Text.Megaparsec.SourcePos Text.Megaparsec.SourcePos Text+  deriving (Data, Eq, Show)++instance Pretty Src where+    pretty (Src begin _ text) =+            pretty text <> "\n"+        <>  "\n"+        <>  pretty (Text.Megaparsec.sourcePosPretty begin)+        <>  "\n"++{-| A `Parser` that is almost identical to+    @"Text.Megaparsec".`Text.Megaparsec.Parsec`@ except treating Haskell-style+    comments as whitespace+-}+newtype Parser a = Parser { unParser :: Text.Megaparsec.Parsec Void Text a }+    deriving+    (   Functor+    ,   Applicative+    ,   Monad+    ,   Alternative+    ,   MonadPlus+    ,   Text.Megaparsec.MonadParsec Void Text+    )++instance Data.Semigroup.Semigroup a => Data.Semigroup.Semigroup (Parser a) where+    (<>) = liftA2 (<>)++instance (Data.Semigroup.Semigroup a, Monoid a) => Monoid (Parser a) where+    mempty = pure mempty++#if !(MIN_VERSION_base(4,11,0))+    mappend = (<>)+#endif++instance IsString a => IsString (Parser a) where+    fromString x = fromString x <$ Text.Megaparsec.Char.string (fromString x)++instance Text.Parser.Combinators.Parsing Parser where+  try = Text.Megaparsec.try++  (<?>) = (Text.Megaparsec.<?>)++  skipMany = Text.Megaparsec.skipMany++  skipSome = Text.Megaparsec.skipSome++  unexpected = fail++  eof = Parser Text.Megaparsec.eof++  notFollowedBy = Text.Megaparsec.notFollowedBy++instance Text.Parser.Char.CharParsing Parser where+  satisfy = Parser . Text.Megaparsec.Char.satisfy++  char = Text.Megaparsec.Char.char++  notChar = Text.Megaparsec.Char.char++  anyChar = Text.Megaparsec.Char.anyChar++  string = fmap Data.Text.unpack . Text.Megaparsec.Char.string . fromString++  text = Text.Megaparsec.Char.string++instance TokenParsing Parser where+    someSpace =+        Text.Parser.Token.Style.buildSomeSpaceParser+            (Parser (Text.Megaparsec.skipSome (Text.Megaparsec.Char.satisfy Data.Char.isSpace)))+            Text.Parser.Token.Style.haskellCommentStyle++    highlight _ = id++    semi = token (Text.Megaparsec.Char.char ';' <?> ";")++count :: (Semigroup a, Monoid a) => Int -> Parser a -> Parser a+count n parser = mconcat (replicate n parser)++range :: (Semigroup a, Monoid a) => Int -> Int -> Parser a -> Parser a+range minimumBound maximumMatches parser =+    count minimumBound parser <> loop maximumMatches+  where+    loop 0 = mempty+    loop n = (parser <> loop (n - 1)) <|> mempty++option :: (Alternative f, Monoid a) => f a -> f a+option p = p <|> pure mempty++star :: (Alternative f, Monoid a) => f a -> f a+star p = plus p <|> pure mempty++plus :: (Alternative f, Monoid a) => f a -> f a+plus p = mappend <$> p <*> star p++satisfy :: (Char -> Bool) -> Parser Text+satisfy = fmap Data.Text.singleton . Text.Parser.Char.satisfy++noDuplicates :: Ord a => [a] -> Parser (Set a)+noDuplicates = go Data.Set.empty+  where+    go found    []  = return found+    go found (x:xs) =+        if Data.Set.member x found+        then fail "Duplicate key"+        else go (Data.Set.insert x found) xs++toMap :: [(Text, a)] -> Parser (InsOrdHashMap Text a)+toMap kvs = do+    let adapt (k, v) = (k, pure v)+    let m = fromListWith (<|>) (fmap adapt kvs)+    let action k vs = case Data.Sequence.viewl vs of+            EmptyL  -> empty+            v :< vs' ->+                if null vs'+                then pure v+                else+                    Text.Parser.Combinators.unexpected+                        ("duplicate field: " ++ Data.Text.unpack k)+    Data.HashMap.Strict.InsOrd.traverseWithKey action m+  where+    fromListWith combine = Data.List.foldl' snoc nil+      where+        nil = Data.HashMap.Strict.InsOrd.empty++        snoc m (k, v) = Data.HashMap.Strict.InsOrd.insertWith combine k v m

@@ -0,0 +1,863 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Parsing Dhall expressions.+module Dhall.Parser.Expression where++import Control.Applicative (Alternative(..), optional)+import Data.ByteArray.Encoding (Base(..))+import Data.Functor (void)+import Data.Semigroup (Semigroup(..))+import Data.Text (Text)+import Dhall.Core+import Prelude hiding (const, pi)+import Text.Parser.Combinators (choice, try, (<?>))++import qualified Crypto.Hash+import qualified Data.ByteArray.Encoding+import qualified Data.ByteString+import qualified Data.Char+import qualified Data.HashMap.Strict.InsOrd+import qualified Data.Sequence+import qualified Data.Text+import qualified Data.Text.Encoding+import qualified Text.Megaparsec+import qualified Text.Parser.Char++import Dhall.Parser.Combinators+import Dhall.Parser.Token++noted :: Parser (Expr Src a) -> Parser (Expr Src a)+noted parser = do+    before      <- Text.Megaparsec.getPosition+    (tokens, e) <- Text.Megaparsec.match parser+    after       <- Text.Megaparsec.getPosition+    let src₀ = Src before after tokens+    case e of+        Note src₁ _ | src₀ == src₁ -> return e+        _                          -> return (Note src₀ e)++expression :: Parser a -> Parser (Expr Src a)+expression embedded =+    (   noted+        ( choice+            [ alternative0+            , alternative1+            , alternative2+            , alternative3+            , alternative4+            ]+        )+    <|> alternative5+    ) <?> "expression"+  where+    alternative0 = do+        _lambda+        _openParens+        a <- label+        _colon+        b <- expression embedded+        _closeParens+        _arrow+        c <- expression embedded+        return (Lam a b c)++    alternative1 = do+        _if+        a <- expression embedded+        _then+        b <- expression embedded+        _else+        c <- expression embedded+        return (BoolIf a b c)++    alternative2 = do+        _let+        a <- label+        b <- optional (do+            _colon+            expression embedded )+        _equal+        c <- expression embedded+        _in+        d <- expression embedded+        return (Let a b c d)++    alternative3 = do+        _forall+        _openParens+        a <- label+        _colon+        b <- expression embedded+        _closeParens+        _arrow+        c <- expression embedded+        return (Pi a b c)++    alternative4 = do+        a <- try (do a <- operatorExpression embedded; _arrow; return a)+        b <- expression embedded+        return (Pi "_" a b)++    alternative5 = annotatedExpression embedded++annotatedExpression :: Parser a -> Parser (Expr Src a)+annotatedExpression embedded =+    noted+        ( choice+            [ alternative0+            , try alternative1+            , alternative2+            ]+        )+  where+    alternative0 = do+        _merge+        a <- importExpression embedded+        b <- importExpression embedded+        c <- optional (do+            _colon+            applicationExpression embedded )+        return (Merge a b c)++    alternative1 = (do+        _openBracket+        (emptyCollection embedded <|> nonEmptyOptional embedded) )+        <?> "list literal"++    alternative2 = do+        a <- operatorExpression embedded+        b <- optional (do _colon; expression embedded)+        case b of+            Nothing -> return a+            Just c  -> return (Annot a c)++emptyCollection :: Parser a -> Parser (Expr Src a)+emptyCollection embedded = do+    _closeBracket+    _colon+    a <- alternative0 <|> alternative1+    b <- importExpression embedded+    return (a b)+  where+    alternative0 = do+        _List+        return (\a -> ListLit (Just a) empty)++    alternative1 = do+        _Optional+        return (\a -> OptionalLit a empty)++nonEmptyOptional :: Parser a -> Parser (Expr Src a)+nonEmptyOptional embedded = do+    a <- expression embedded+    _closeBracket+    _colon+    _Optional+    b <- importExpression embedded+    return (OptionalLit b (pure a))++operatorExpression :: Parser a -> Parser (Expr Src a)+operatorExpression = importAltExpression++makeOperatorExpression+    :: (Parser a -> Parser (Expr Src a))+    -> Parser ()+    -> (Expr Src a -> Expr Src a -> Expr Src a)+    -> Parser a+    -> Parser (Expr Src a)+makeOperatorExpression subExpression operatorParser operator embedded =+    noted (do+        a <- subExpression embedded+        b <- many (do operatorParser; subExpression embedded)+        return (foldr1 operator (a:b)) )++importAltExpression :: Parser a -> Parser (Expr Src a)+importAltExpression =+    makeOperatorExpression orExpression _importAlt ImportAlt++orExpression :: Parser a -> Parser (Expr Src a)+orExpression =+    makeOperatorExpression plusExpression _or BoolOr++plusExpression :: Parser a -> Parser (Expr Src a)+plusExpression =+    makeOperatorExpression textAppendExpression _plus NaturalPlus++textAppendExpression :: Parser a -> Parser (Expr Src a)+textAppendExpression =+    makeOperatorExpression listAppendExpression _textAppend TextAppend++listAppendExpression :: Parser a -> Parser (Expr Src a)+listAppendExpression =+    makeOperatorExpression andExpression _listAppend ListAppend++andExpression :: Parser a -> Parser (Expr Src a)+andExpression =+    makeOperatorExpression combineExpression _and BoolAnd++combineExpression :: Parser a -> Parser (Expr Src a)+combineExpression =+    makeOperatorExpression preferExpression _combine Combine++preferExpression :: Parser a -> Parser (Expr Src a)+preferExpression =+    makeOperatorExpression combineTypesExpression _prefer Prefer++combineTypesExpression :: Parser a -> Parser (Expr Src a)+combineTypesExpression =+    makeOperatorExpression timesExpression _combineTypes CombineTypes++timesExpression :: Parser a -> Parser (Expr Src a)+timesExpression =+    makeOperatorExpression equalExpression _times NaturalTimes++equalExpression :: Parser a -> Parser (Expr Src a)+equalExpression =+    makeOperatorExpression notEqualExpression _doubleEqual BoolEQ++notEqualExpression :: Parser a -> Parser (Expr Src a)+notEqualExpression =+    makeOperatorExpression applicationExpression _notEqual BoolNE++applicationExpression :: Parser a -> Parser (Expr Src a)+applicationExpression embedded = do+    f <- (do _constructors; return Constructors) <|> return id+    a <- noted (importExpression embedded)+    b <- many (noted (importExpression embedded))+    return (foldl app (f a) b)+  where+    app nL@(Note (Src before _ bytesL) _) nR@(Note (Src _ after bytesR) _) =+        Note (Src before after (bytesL <> bytesR)) (App nL nR)+    app nL nR =+        App nL nR++importExpression :: Parser a -> Parser (Expr Src a)+importExpression embedded = noted (choice [ alternative0, alternative1 ])+  where+    alternative0 = do+        a <- embedded+        return (Embed a)++    alternative1 = selectorExpression embedded++selectorExpression :: Parser a -> Parser (Expr Src a)+selectorExpression embedded = noted (do+    a <- primitiveExpression embedded++    let left  x  e = Field   e x+    let right xs e = Project e xs+    b <- many (try (do _dot; fmap left label <|> fmap right labels))+    return (foldl (\e k -> k e) a b) )++primitiveExpression :: Parser a -> Parser (Expr Src a)+primitiveExpression embedded =+    noted+        ( choice+            [ alternative00+            , alternative01+            , alternative02+            , alternative03+            , alternative04+            , alternative05+            , alternative06+            , alternative37++            , choice+                [ alternative08+                , alternative09+                , alternative10+                , alternative11+                , alternative12+                , alternative13+                , alternative14+                , alternative15+                , alternativeIntegerToDouble+                , alternative16+                , alternative17+                , alternative18+                , alternative19+                , alternative20+                , alternative21+                , alternative22+                , alternative23+                , alternative24+                , alternative25+                , alternative26+                , alternative27+                , alternative28+                , alternative29+                , alternative30+                , alternative31+                , alternative32+                , alternative33+                , alternative34+                , alternative35+                , alternative36+                ] <?> "built-in expression"+            ]+        )+    <|> alternative38+  where+    alternative00 = do+        a <- try doubleLiteral+        return (DoubleLit a)++    alternative01 = do+        a <- try naturalLiteral+        return (NaturalLit a)++    alternative02 = do+        a <- try integerLiteral+        return (IntegerLit a)++    alternative03 = textLiteral embedded++    alternative04 = (do+        _openBrace+        a <- recordTypeOrLiteral embedded+        _closeBrace+        return a ) <?> "record type or literal"++    alternative05 = (do+        _openAngle+        a <- unionTypeOrLiteral embedded+        _closeAngle+        return a ) <?> "union type or literal"++    alternative06 = nonEmptyListLiteral embedded++    alternative08 = do+        _NaturalFold+        return NaturalFold++    alternative09 = do+        _NaturalBuild+        return NaturalBuild++    alternative10 = do+        _NaturalIsZero+        return NaturalIsZero++    alternative11 = do+        _NaturalEven+        return NaturalEven++    alternative12 = do+        _NaturalOdd+        return NaturalOdd++    alternative13 = do+        _NaturalToInteger+        return NaturalToInteger++    alternative14 = do+        _NaturalShow+        return NaturalShow++    alternative15 = do+        _IntegerShow+        return IntegerShow++    alternativeIntegerToDouble = do+        _IntegerToDouble+        return IntegerToDouble++    alternative16 = do+        _DoubleShow+        return DoubleShow++    alternative17 = do+        _ListBuild+        return ListBuild++    alternative18 = do+        _ListFold+        return ListFold++    alternative19 = do+        _ListLength+        return ListLength++    alternative20 = do+        _ListHead+        return ListHead++    alternative21 = do+        _ListLast+        return ListLast++    alternative22 = do+        _ListIndexed+        return ListIndexed++    alternative23 = do+        _ListReverse+        return ListReverse++    alternative24 = do+        _OptionalFold+        return OptionalFold++    alternative25 = do+        _OptionalBuild+        return OptionalBuild++    alternative26 = do+        _Bool+        return Bool++    alternative27 = do+        _Optional+        return Optional++    alternative28 = do+        _Natural+        return Natural++    alternative29 = do+        _Integer+        return Integer++    alternative30 = do+        _Double+        return Double++    alternative31 = do+        _Text+        return Text++    alternative32 = do+        _List+        return List++    alternative33 = do+        _True+        return (BoolLit True)++    alternative34 = do+        _False+        return (BoolLit False)++    alternative35 = do+        _Type+        return (Const Type)++    alternative36 = do+        _Kind+        return (Const Kind)++    alternative37 = do+        a <- identifier+        return (Var a)++    alternative38 = do+        _openParens+        a <- expression embedded+        _closeParens+        return a+++doubleQuotedChunk :: Parser a -> Parser (Chunks Src a)+doubleQuotedChunk embedded =+    choice+        [ interpolation+        , unescapedCharacter+        , escapedCharacter+        ]+  where+    interpolation = do+        _ <- Text.Parser.Char.text "${"+        e <- completeExpression embedded+        _ <- Text.Parser.Char.char '}'+        return (Chunks [(mempty, e)] mempty)++    unescapedCharacter = do+        c <- Text.Parser.Char.satisfy predicate+        return (Chunks [] (Data.Text.singleton c))+      where+        predicate c =+                ('\x20' <= c && c <= '\x21'    )+            ||  ('\x23' <= c && c <= '\x5B'    )+            ||  ('\x5D' <= c && c <= '\x10FFFF')++    escapedCharacter = do+        _ <- Text.Parser.Char.char '\\'+        c <- choice+            [ quotationMark+            , dollarSign+            , backSlash+            , forwardSlash+            , backSpace+            , formFeed+            , lineFeed+            , carriageReturn+            , tab+            , unicode+            ]+        return (Chunks [] (Data.Text.singleton c))+      where+        quotationMark = Text.Parser.Char.char '"'++        dollarSign = Text.Parser.Char.char '$'++        backSlash = Text.Parser.Char.char '\\'++        forwardSlash = Text.Parser.Char.char '/'++        backSpace = do _ <- Text.Parser.Char.char 'b'; return '\b'++        formFeed = do _ <- Text.Parser.Char.char 'f'; return '\f'++        lineFeed = do _ <- Text.Parser.Char.char 'n'; return '\n'++        carriageReturn = do _ <- Text.Parser.Char.char 'r'; return '\r'++        tab = do _ <- Text.Parser.Char.char 't'; return '\t'++        unicode = do+            _  <- Text.Parser.Char.char 'u';+            n0 <- hexNumber+            n1 <- hexNumber+            n2 <- hexNumber+            n3 <- hexNumber+            let n = ((n0 * 16 + n1) * 16 + n2) * 16 + n3+            return (Data.Char.chr n)++doubleQuotedLiteral :: Parser a -> Parser (Chunks Src a)+doubleQuotedLiteral embedded = do+    _      <- Text.Parser.Char.char '"'+    chunks <- many (doubleQuotedChunk embedded)+    _      <- Text.Parser.Char.char '"'+    return (mconcat chunks)++singleQuoteContinue :: Parser a -> Parser (Chunks Src a)+singleQuoteContinue embedded =+    choice+        [ escapeSingleQuotes+        , interpolation+        , escapeInterpolation+        , endLiteral+        , unescapedCharacter+        , tab+        , endOfLine+        ]+  where+        escapeSingleQuotes = do+            _ <- "'''" :: Parser Text+            b <- singleQuoteContinue embedded+            return ("''" <> b)++        interpolation = do+            _ <- Text.Parser.Char.text "${"+            a <- completeExpression embedded+            _ <- Text.Parser.Char.char '}'+            b <- singleQuoteContinue embedded+            return (Chunks [(mempty, a)] mempty <> b)++        escapeInterpolation = do+            _ <- Text.Parser.Char.text "''${"+            b <- singleQuoteContinue embedded+            return ("${" <> b)++        endLiteral = do+            _ <- Text.Parser.Char.text "''"+            return mempty++        unescapedCharacter = do+            a <- satisfy predicate+            b <- singleQuoteContinue embedded+            return (Chunks [] a <> b)+          where+            predicate c = '\x20' <= c && c <= '\x10FFFF'++        endOfLine = do+            a <- "\n" <|> "\r\n"+            b <- singleQuoteContinue embedded+            return (Chunks [] a <> b)++        tab = do+            _ <- Text.Parser.Char.char '\t'+            b <- singleQuoteContinue embedded+            return ("\t" <> b)++singleQuoteLiteral :: Parser a -> Parser (Chunks Src a)+singleQuoteLiteral embedded = do+    _ <- Text.Parser.Char.text "''"++    -- This is technically not in the grammar, but it's still equivalent to the+    -- original grammar and an easy way to discard the first character if it's+    -- a newline+    _ <- optional endOfLine++    a <- singleQuoteContinue embedded++    return (dedent a)+  where+    endOfLine =+            void (Text.Parser.Char.char '\n'  )+        <|> void (Text.Parser.Char.text "\r\n")++textLiteral :: Parser a -> Parser (Expr Src a)+textLiteral embedded = (do+    literal <- doubleQuotedLiteral embedded <|> singleQuoteLiteral embedded+    whitespace+    return (TextLit literal) ) <?> "text literal"++recordTypeOrLiteral :: Parser a -> Parser (Expr Src a)+recordTypeOrLiteral embedded =+    choice+        [ alternative0+        , alternative1+        , alternative2+        ]+  where+    alternative0 = do+        _equal+        return (RecordLit Data.HashMap.Strict.InsOrd.empty)++    alternative1 = nonEmptyRecordTypeOrLiteral embedded++    alternative2 = return (Record Data.HashMap.Strict.InsOrd.empty)++nonEmptyRecordTypeOrLiteral :: Parser a -> Parser (Expr Src a)+nonEmptyRecordTypeOrLiteral embedded = do+    a <- label++    let nonEmptyRecordType = do+            _colon+            b <- expression embedded+            e <- many (do+                _comma+                c <- label+                _colon+                d <- expression embedded+                return (c, d) )+            m <- toMap ((a, b) : e)+            return (Record m)++    let nonEmptyRecordLiteral = do+            _equal+            b <- expression embedded+            e <- many (do+                _comma+                c <- label+                _equal+                d <- expression embedded+                return (c, d) )+            m <- toMap ((a, b) : e)+            return (RecordLit m)++    nonEmptyRecordType <|> nonEmptyRecordLiteral++unionTypeOrLiteral :: Parser a -> Parser (Expr Src a)+unionTypeOrLiteral embedded =+        nonEmptyUnionTypeOrLiteral embedded+    <|> return (Union Data.HashMap.Strict.InsOrd.empty)++nonEmptyUnionTypeOrLiteral :: Parser a -> Parser (Expr Src a)+nonEmptyUnionTypeOrLiteral embedded = do+    (f, kvs) <- loop+    m <- toMap kvs+    return (f m)+  where+    loop = do+        a <- label++        let alternative0 = do+                _equal+                b <- expression embedded+                kvs <- many (do+                    _bar+                    c <- label+                    _colon+                    d <- expression embedded+                    return (c, d) )+                return (UnionLit a b, kvs)++        let alternative1 = do+                _colon+                b <- expression embedded++                let alternative2 = do+                        _bar+                        (f, kvs) <- loop+                        return (f, (a, b):kvs)++                let alternative3 = return (Union, [(a, b)])++                alternative2 <|> alternative3++        alternative0 <|> alternative1++nonEmptyListLiteral :: Parser a -> Parser (Expr Src a)+nonEmptyListLiteral embedded = (do+    _openBracket+    a <- expression embedded+    b <- many (do _comma; expression embedded)+    _closeBracket+    return (ListLit Nothing (Data.Sequence.fromList (a:b))) ) <?> "list literal"++completeExpression :: Parser a -> Parser (Expr Src a)+completeExpression embedded = do+    whitespace+    expression embedded++env :: Parser ImportType+env = do+    _ <- Text.Parser.Char.text "env:"+    a <- (alternative0 <|> alternative1)+    whitespace+    return (Env a)+  where+    alternative0 = bashEnvironmentVariable++    alternative1 = do+        _ <- Text.Parser.Char.char '"'+        a <- posixEnvironmentVariable+        _ <- Text.Parser.Char.char '"'+        return a++localRaw :: Parser ImportType+localRaw =+    choice+        [ parentPath+        , herePath+        , homePath+        , try absolutePath+        ]+  where+    parentPath = do+        _    <- ".." :: Parser Text+        File (Directory segments) final <- file_++        return (Local Here (File (Directory (segments ++ [".."])) final))++    herePath = do+        _    <- "." :: Parser Text+        file <- file_++        return (Local Here file)++    homePath = do+        _    <- "~" :: Parser Text+        file <- file_++        return (Local Home file)++    absolutePath = do+        file <- file_++        return (Local Absolute file)++local :: Parser ImportType+local = do+    a <- localRaw+    whitespace+    return a++http :: Parser ImportType+http = do+    (prefix, path, suffix) <- httpRaw+    whitespace+    headers <- optional (do+        _using+        (importHashed_ <|> (_openParens *> importHashed_ <* _closeParens)) )+    return (URL prefix path suffix headers)++missing :: Parser ImportType+missing = do+  _missing+  return Missing++importType_ :: Parser ImportType+importType_ = choice [ local, http, env, missing ]++importHashed_ :: Parser ImportHashed+importHashed_ = do+    importType <- importType_+    hash       <- optional importHash_+    return (ImportHashed {..})+  where+    importHash_ = do+        _ <- Text.Parser.Char.text "sha256:"+        text <- count 64 (satisfy hexdig <?> "hex digit")+        whitespace+        let strictBytes16 = Data.Text.Encoding.encodeUtf8 text+        strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of+            Left  string      -> fail string+            Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString)+        case Crypto.Hash.digestFromByteString strictBytes of+          Nothing -> fail "Invalid sha256 hash"+          Just h  -> pure h++import_ :: Parser Import+import_ = (do+    importHashed <- importHashed_+    importMode   <- alternative <|> pure Code+    return (Import {..}) ) <?> "import"+  where+    alternative = do+        _as+        _Text+        return RawText++-- | Similar to `Dhall.Core.renderChunks` except that this doesn't bother to+-- render interpolated expressions to avoid a `Buildable a` constraint.  The+-- interpolated contents are not necessary for computing how much to dedent a+-- multi-line string+--+-- This also doesn't include the surrounding quotes since they would interfere+-- with the whitespace detection+renderChunks :: Chunks s a -> Text+renderChunks (Chunks a b) = foldMap renderChunk a <> b+  where+    renderChunk :: (Text, Expr s a) -> Text+    renderChunk (c, _) = c <> "${x}"++dedent :: Chunks Src a -> Chunks Src a+dedent chunks0 = process chunks0+  where+    text0 = renderChunks chunks0++    lines0 = Data.Text.lines text0++    isEmpty = Data.Text.all Data.Char.isSpace++    nonEmptyLines = filter (not . isEmpty) lines0++    indentLength line =+        Data.Text.length (Data.Text.takeWhile Data.Char.isSpace line)++    shortestIndent = case nonEmptyLines of+        [] -> 0+        _  -> minimum (map indentLength nonEmptyLines)++    -- The purpose of this complicated `trimBegin`/`trimContinue` is to ensure+    -- that we strip leading whitespace without stripping whitespace after+    -- variable interpolation++    -- This is the trim function we use up until the first variable+    -- interpolation, dedenting all lines+    trimBegin =+          Data.Text.intercalate "\n"+        . map (Data.Text.drop shortestIndent)+        . Data.Text.splitOn "\n"++    -- This is the trim function we use after each variable interpolation+    -- where we indent each line except the first line (since it's not a true+    -- beginning of a line)+    trimContinue text = Data.Text.intercalate "\n" lines_+      where+        lines_ = case Data.Text.splitOn "\n" text of+            []   -> []+            l:ls -> l:map (Data.Text.drop shortestIndent) ls++    -- This is the loop that drives whether or not to use `trimBegin` or+    -- `trimContinue`.  We call this function with `trimBegin`, but after the+    -- first interpolation we switch permanently to `trimContinue`+    process (Chunks ((x0, y0):xys) z) =+        Chunks ((trimBegin x0, y0):xys') (trimContinue z)+      where+        xys' = [ (trimContinue x, y) | (x, y) <- xys ]+    process (Chunks [] z) =+        Chunks [] (trimBegin z)