dhall 1.40.1 → 1.40.2
raw patch · 96 files changed
+1438/−650 lines, 96 filesdep +base16-bytestringdep +cryptohash-sha256dep +system-filepathdep −cryptonitedep −memorydep ~QuickCheckdep ~doctestdep ~megaparsecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: base16-bytestring, cryptohash-sha256, system-filepath
Dependencies removed: cryptonite, memory
Dependency ranges changed: QuickCheck, doctest, megaparsec, optparse-applicative, prettyprinter, prettyprinter-ansi-terminal, text
API changes (from Hackage documentation)
- Dhall.Crypto: instance Data.ByteArray.Types.ByteArrayAccess Dhall.Crypto.SHA256Digest
- Dhall.Import: loadRelativeToWithManager :: IO Manager -> FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void)
+ Dhall.Core: subExpressionsWith :: Applicative f => (a -> f (Expr s b)) -> (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b)
+ Dhall.Import: [_loadOriginHeaders] :: Status -> StateT Status IO OriginHeaders
+ Dhall.Import: envOriginHeaders :: Expr Src Import
+ Dhall.Import: fetchRemote :: URL -> StateT Status IO Text
+ Dhall.Import: loadWithStatus :: Status -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void)
+ Dhall.Import: makeEmptyStatus :: IO Manager -> IO (Expr Src Import) -> FilePath -> Status
+ Dhall.Marshal.Decode: day :: Decoder Day
+ Dhall.Marshal.Decode: genericAutoWithInputNormalizer :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> InputNormalizer -> Decoder a
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Time.Calendar.Days.Day
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Time.Clock.Internal.UTCTime.UTCTime
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Time.LocalTime.Internal.LocalTime.LocalTime
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Time.LocalTime.Internal.TimeOfDay.TimeOfDay
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Time.LocalTime.Internal.TimeZone.TimeZone
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Time.LocalTime.Internal.ZonedTime.ZonedTime
+ Dhall.Marshal.Decode: localTime :: Decoder LocalTime
+ Dhall.Marshal.Decode: timeOfDay :: Decoder TimeOfDay
+ Dhall.Marshal.Decode: timeZone :: Decoder TimeZone
+ Dhall.Marshal.Decode: utcTime :: Decoder UTCTime
+ Dhall.Marshal.Decode: zonedTime :: Decoder ZonedTime
+ Dhall.Marshal.Encode: genericToDhallWithInputNormalizer :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> InputNormalizer -> Encoder a
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Time.Calendar.Days.Day
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Time.Clock.Internal.UTCTime.UTCTime
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Time.LocalTime.Internal.LocalTime.LocalTime
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Time.LocalTime.Internal.TimeOfDay.TimeOfDay
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Time.LocalTime.Internal.TimeZone.TimeZone
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Time.LocalTime.Internal.ZonedTime.ZonedTime
+ Dhall.Parser.Expression: [letBinding] :: Parsers a -> Parser (Binding Src a)
+ Dhall.Parser.Token: lineCommentPrefix :: Parser Text
+ Dhall.TH: GenerateOptions :: (Text -> Text) -> (Text -> Text) -> Bool -> Bool -> GenerateOptions
+ Dhall.TH: [constructorModifier] :: GenerateOptions -> Text -> Text
+ Dhall.TH: [fieldModifier] :: GenerateOptions -> Text -> Text
+ Dhall.TH: [generateFromDhallInstance] :: GenerateOptions -> Bool
+ Dhall.TH: [generateToDhallInstance] :: GenerateOptions -> Bool
+ Dhall.TH: data GenerateOptions
+ Dhall.TH: defaultGenerateOptions :: GenerateOptions
+ Dhall.TH: makeHaskellTypesWith :: GenerateOptions -> [HaskellType Text] -> Q [Dec]
- Dhall.Import: Status :: NonEmpty Chained -> [Depends] -> Map Chained ImportSemantics -> IO Manager -> Maybe Manager -> (URL -> StateT Status IO Text) -> Substitutions Src Void -> Maybe (ReifiedNormalizer Void) -> Context (Expr Src Void) -> SemanticCacheMode -> CacheWarning -> Status
+ Dhall.Import: Status :: NonEmpty Chained -> [Depends] -> Map Chained ImportSemantics -> IO Manager -> Maybe Manager -> StateT Status IO OriginHeaders -> (URL -> StateT Status IO Text) -> Substitutions Src Void -> Maybe (ReifiedNormalizer Void) -> Context (Expr Src Void) -> SemanticCacheMode -> CacheWarning -> Status
- Dhall.Parser.Expression: Parsers :: Parser (Expr Src a) -> Parser (Expr Src a) -> Parsers a
+ Dhall.Parser.Expression: Parsers :: Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Binding Src a) -> Parsers a
Files
- CHANGELOG.md +30/−0
- benchmark/deep-nested-large-record/Main.hs +1/−1
- dhall-lang/Prelude/Text/package.dhall +4/−0
- dhall-lang/Prelude/Text/shell-escape.dhall +16/−0
- dhall-lang/Prelude/XML/Type +1/−1
- dhall-lang/Prelude/XML/Type.dhall +3/−0
- dhall-lang/Prelude/XML/element +1/−1
- dhall-lang/Prelude/XML/element.dhall +2/−1
- dhall-lang/Prelude/XML/leaf +1/−1
- dhall-lang/Prelude/XML/leaf.dhall +2/−2
- dhall-lang/Prelude/XML/package.dhall +9/−5
- dhall-lang/Prelude/XML/rawText.dhall +40/−0
- dhall-lang/Prelude/XML/render +1/−1
- dhall-lang/Prelude/XML/render.dhall +5/−4
- dhall-lang/Prelude/XML/text +1/−1
- dhall-lang/Prelude/XML/text.dhall +3/−2
- dhall-lang/Prelude/package.dhall +2/−2
- dhall-lang/tests/import/data/userAgent.dhall +1/−0
- dhall-lang/tests/import/failure/originHeadersFromRemote.dhall +1/−0
- dhall-lang/tests/import/failure/originHeadersFromRemoteENV.dhall +11/−0
- dhall-lang/tests/import/success/originHeadersA.dhall +1/−0
- dhall-lang/tests/import/success/originHeadersB.dhall +5/−0
- dhall-lang/tests/import/success/originHeadersENV.dhall +10/−0
- dhall-lang/tests/import/success/originHeadersImportA.dhall +1/−0
- dhall-lang/tests/import/success/originHeadersImportB.dhall +5/−0
- dhall-lang/tests/import/success/originHeadersImportENV.dhall +10/−0
- dhall-lang/tests/import/success/originHeadersImportFromEnvA.dhall +1/−0
- dhall-lang/tests/import/success/originHeadersImportFromEnvB.dhall +5/−0
- dhall-lang/tests/import/success/originHeadersImportFromEnvENV.dhall +11/−0
- dhall-lang/tests/import/success/originHeadersOverrideA.dhall +3/−0
- dhall-lang/tests/import/success/originHeadersOverrideB.dhall +5/−0
- dhall-lang/tests/import/success/originHeadersOverrideENV.dhall +10/−0
- dhall-lang/tests/import/success/userHeadersA.dhall +0/−1
- dhall-lang/tests/import/success/userHeadersB.dhall +0/−5
- dhall-lang/tests/import/success/userHeadersENV.dhall +0/−10
- dhall-lang/tests/import/success/userHeadersOverrideA.dhall +0/−3
- dhall-lang/tests/import/success/userHeadersOverrideB.dhall +0/−5
- dhall-lang/tests/import/success/userHeadersOverrideENV.dhall +0/−10
- dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineA.dhall +2/−0
- dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineB.dhallb +1/−0
- dhall-lang/tests/type-inference/success/preludeB.dhall +21/−0
- dhall-lang/tests/type-inference/success/unit/ConstructorShiftA.dhall +1/−0
- dhall-lang/tests/type-inference/success/unit/ConstructorShiftB.dhall +1/−0
- dhall.cabal +14/−11
- ghc-src/Dhall/Crypto.hs +10/−13
- ghc-src/Dhall/Import/HTTP.hs +44/−12
- ghc-src/Dhall/Import/Manager.hs +1/−1
- ghcjs-src/Dhall/Crypto.hs +11/−12
- ghcjs-src/Dhall/Import/HTTP.hs +7/−2
- src/Dhall/Binary.hs +2/−3
- src/Dhall/Core.hs +8/−7
- src/Dhall/Diff.hs +18/−18
- src/Dhall/DirectoryTree.hs +9/−9
- src/Dhall/Eval.hs +1/−1
- src/Dhall/Format.hs +5/−9
- src/Dhall/Freeze.hs +9/−9
- src/Dhall/Import.hs +118/−94
- src/Dhall/Import/Headers.hs +131/−0
- src/Dhall/Import/Types.hs +19/−4
- src/Dhall/Lint.hs +1/−1
- src/Dhall/Main.hs +30/−29
- src/Dhall/Marshal/Decode.hs +114/−5
- src/Dhall/Marshal/Encode.hs +55/−4
- src/Dhall/Normalize.hs +1/−1
- src/Dhall/Optics.hs +1/−1
- src/Dhall/Parser.hs +1/−1
- src/Dhall/Parser/Combinators.hs +13/−19
- src/Dhall/Parser/Expression.hs +42/−41
- src/Dhall/Parser/Token.hs +10/−6
- src/Dhall/Pretty/Internal.hs +16/−16
- src/Dhall/Pretty/Internal.hs-boot +1/−1
- src/Dhall/Repl.hs +54/−33
- src/Dhall/Schemas.hs +21/−21
- src/Dhall/Src.hs +1/−1
- src/Dhall/Syntax.hs +57/−48
- src/Dhall/TH.hs +159/−31
- src/Dhall/TypeCheck.hs +8/−8
- src/Dhall/URL.hs +1/−1
- src/Dhall/Util.hs +18/−18
- tests/Dhall/Test/Dhall.hs +1/−1
- tests/Dhall/Test/Diff.hs +13/−13
- tests/Dhall/Test/Format.hs +11/−11
- tests/Dhall/Test/Import.hs +29/−17
- tests/Dhall/Test/Lint.hs +11/−11
- tests/Dhall/Test/Main.hs +1/−1
- tests/Dhall/Test/Normalization.hs +6/−6
- tests/Dhall/Test/Parser.hs +6/−6
- tests/Dhall/Test/QuickCheck.hs +2/−7
- tests/Dhall/Test/Regression.hs +5/−5
- tests/Dhall/Test/Schemas.hs +11/−11
- tests/Dhall/Test/SemanticHash.hs +4/−4
- tests/Dhall/Test/TH.hs +83/−0
- tests/Dhall/Test/Tags.hs +5/−5
- tests/Dhall/Test/Util.hs +5/−5
- tests/format/letAnnotatedShortA.dhall +1/−0
- tests/format/letAnnotatedShortB.dhall +5/−0
CHANGELOG.md view
@@ -1,3 +1,33 @@+1.40.2++* [Supports standard version 21.1.0](https://github.com/dhall-lang/dhall-haskell/pull/2236)+ * [The interpreter now supports customizing headers using a `headers.dhall`+ configuration file](https://github.com/dhall-lang/dhall-haskell/pull/2236)+ * [Generalize grammar for certain annotations](https://github.com/dhall-lang/dhall-haskell/pull/2320)+ * [Add support for a trailing line comment without a newline](https://github.com/dhall-lang/dhall-haskell/pull/2309)+* [BUG FIX: `dhall repl` no longer ignores type annotations on `:let` commands](https://github.com/dhall-lang/dhall-haskell/pull/2297)+ * Before this fix, `:let x : T = 3` would ignore the `: T` type annotation+* [BUG FIX: Don't accept a bar after an empty union](https://github.com/dhall-lang/dhall-haskell/pull/2338)+ * Before this fix, the interpreter would accept something like `<>|`, which+ is not valid according to the standard grammar+* New `FromDhall`/`ToDhall` instances for `Day`/`TimeOfDay`/`TimeZone` [#2294](https://github.com/dhall-lang/dhall-haskell/pull/2294) [#2300](https://github.com/dhall-lang/dhall-haskell/pull/2300)+ * These types correspond to the recent temporal literals added to the+ language+* [New `subExpressionsWith` `Traversal`](https://github.com/dhall-lang/dhall-haskell/pull/2302)+* [Add Template Haskell support for modifying field names in generated Haskell+ types](https://github.com/dhall-lang/dhall-haskell/pull/2285)+ * This adds a new `makeHaskellTypesWith` utility with takes a+ `GenerateOptions` function argument for customizing the code-generation+ logic+ * This comes in handy when Dhall fields have names are reserved keywords in+ Haskell code. You can now transform the Haskell field names to avoid+ collisions+* [Support GHC 9.2](https://github.com/dhall-lang/dhall-haskell/pull/2328)+* Fixes and improvements to documentation+ * [#2290](https://github.com/dhall-lang/dhall-haskell/pull/2290)+* Fixes and improvements to error messages+ * [#2303](https://github.com/dhall-lang/dhall-haskell/pull/2303)+ 1.40.1 * [BUG FIX: Fix equivalence check for `Date` / `Time` / `TimeZone`](https://github.com/dhall-lang/dhall-haskell/pull/2291)
benchmark/deep-nested-large-record/Main.hs view
@@ -2,7 +2,7 @@ module Main (main) where import Data.Void (Void)-import Gauge (defaultMain)+import Gauge (defaultMain) import qualified Data.Sequence as Seq import qualified Dhall.Core as Core
dhall-lang/Prelude/Text/package.dhall view
@@ -34,6 +34,10 @@ ./replicate.dhall sha256:1b398b1d464b3a6c7264a690ac3cacb443b5683b43348c859d68e7c2cb925c4f ? ./replicate.dhall+, shell-escape =+ ./shell-escape.dhall+ sha256:d53521b3f478cb18a7d63730bc0e3153c2124b70d6ac9a1f610ce7db67cfc7a2+ ? ./shell-escape.dhall , show = ./show.dhall sha256:c9dc5de3e5f32872dbda57166804865e5e80785abe358ff61f1d8ac45f1f4784
+ dhall-lang/Prelude/Text/shell-escape.dhall view
@@ -0,0 +1,16 @@+{-|+Escape a Text value such that it can be used safely in shells.+The escaping is done by replacing all `'` with `'"'"'` and wraps that string in+single quotes.++This works for all POSIX-compliant shells and some other shells like csh.+-}+let shell-escape+ : Text -> Text+ = \(xs : Text) -> "'${Text/replace "'" "'\"'\"'" xs}'"++let example0 = assert : shell-escape "foo" === "'foo'"++let example1 = assert : shell-escape "foo'bar" === "'foo'\"'\"'bar'"++in shell-escape
dhall-lang/Prelude/XML/Type view
@@ -1,3 +1,3 @@ ./Type.dhall- sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall
dhall-lang/Prelude/XML/Type.dhall view
@@ -15,6 +15,8 @@ → λ ( xml : { text : Text → XML+ , rawText :+ Text → XML , element : { attributes : List { mapKey : Text, mapValue : Text }@@ -49,6 +51,7 @@ = ∀(XML : Type) → ∀ ( xml : { text : Text → XML+ , rawText : Text → XML , element : { attributes : List { mapKey : Text, mapValue : Text } , content : List XML
dhall-lang/Prelude/XML/element view
@@ -1,3 +1,3 @@ ./element.dhall- sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall
dhall-lang/Prelude/XML/element.dhall view
@@ -20,7 +20,7 @@ -} let XML = ./Type.dhall- sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let List/map =@@ -41,6 +41,7 @@ λ(XML : Type) → λ ( xml : { text : Text → XML+ , rawText : Text → XML , element : { attributes : List { mapKey : Text, mapValue : Text } , content : List XML
dhall-lang/Prelude/XML/leaf view
@@ -1,3 +1,3 @@ ./leaf.dhall- sha256:4383e4fc4bf6a29ac2052776972eb59d5355a1cd067cded80d4ff32840969261+ sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506 ? ./leaf.dhall
dhall-lang/Prelude/XML/leaf.dhall view
@@ -11,12 +11,12 @@ -} let XML = ./Type.dhall- sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let element = ./element.dhall- sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall let leaf
dhall-lang/Prelude/XML/package.dhall view
@@ -1,6 +1,6 @@ { Type = ./Type.dhall- sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall , attribute = ./attribute.dhall@@ -8,20 +8,24 @@ ? ./attribute.dhall , render = ./render.dhall- sha256:550c8900fe199b83d629181d53c646f2f9425d9c64670dabb30d28e95bfa4c75+ sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66 ? ./render.dhall , element = ./element.dhall- sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall , leaf = ./leaf.dhall- sha256:4383e4fc4bf6a29ac2052776972eb59d5355a1cd067cded80d4ff32840969261+ sha256:5dcedf79a3664a362479f470220bb2f4932facde657c285fd8a3c24ab137c506 ? ./leaf.dhall , text = ./text.dhall- sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f+ sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab ? ./text.dhall+, rawText =+ ./rawText.dhall+ sha256:2af9d72c151677d4110039e361b7e9faaf2947e6c9d29aa72aea351ad797e05d+ ? ./rawText.dhall , emptyAttributes = ./emptyAttributes.dhall sha256:11b86e2d3f3c75d47a1d580213d2a03fd2c36d64f3e9b6381de0ba23472f64d5
+ dhall-lang/Prelude/XML/rawText.dhall view
@@ -0,0 +1,40 @@+{-|+Create a Text value to be inserted into an XML element as content with no+character escaping.++```+let XML = ./package.dhall++in XML.render+ ( XML.element+ { name = "location"+ , attributes = XML.emptyAttributes+ , content = [ XML.rawText "<bar n=\"1\"/>" ]+ }+ )+= "<foo><bar n=\"1\"/></foo>"+```+-}+let XML =+ ./Type.dhall+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9+ ? ./Type.dhall++let rawText+ : Text → XML+ = λ(d : Text) →+ λ(XML : Type) →+ λ ( xml+ : { text : Text → XML+ , rawText : Text → XML+ , element :+ { attributes : List { mapKey : Text, mapValue : Text }+ , content : List XML+ , name : Text+ } →+ XML+ }+ ) →+ xml.rawText d++in rawText
dhall-lang/Prelude/XML/render view
@@ -1,3 +1,3 @@ ./render.dhall- sha256:550c8900fe199b83d629181d53c646f2f9425d9c64670dabb30d28e95bfa4c75+ sha256:395c293702c85d99f6f2b461f3eee320f9fe5749c320c2e8b9ea799a7d210b66 ? ./render.dhall
dhall-lang/Prelude/XML/render.dhall view
@@ -8,7 +8,7 @@ let XML = ./package.dhall in XML.render- ( XML.node+ ( XML.element { name = "foo" , attributes = [ XML.attribute "a" "x", XML.attribute "b" (Natural/show 2) ] , content = [ XML.leaf { name = "bar", attributes = XML.emptyAttributes } ]@@ -20,7 +20,7 @@ -} let XML = ./Type.dhall- sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let Text/concatMap =@@ -35,12 +35,12 @@ let element = ./element.dhall- sha256:e0b948053c8cd8ccca9c39244d89e3f42db43d222531c18151551dfc75208b4b+ sha256:79266d604e147caf37e985581523b684f7bac66de0c93dd828841df3dfc445f9 ? ./element.dhall let text = ./text.dhall- sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f+ sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab ? ./text.dhall let emptyAttributes =@@ -76,6 +76,7 @@ x Text { text = escapeText+ , rawText = λ(t : Text) → t , element = λ ( elem : { attributes : List { mapKey : Text, mapValue : Text }
dhall-lang/Prelude/XML/text view
@@ -1,3 +1,3 @@ ./text.dhall- sha256:c83cd721d32d7dc28c04ce429c0cb22812639e572637ec348578a58ffb68844f+ sha256:a59670560a08bfc815893dee1f3eae21a5252400f8a619d1cd7bdd9f48eea2ab ? ./text.dhall
dhall-lang/Prelude/XML/text.dhall view
@@ -5,7 +5,7 @@ let XML = ./package.dhall in XML.render- ( XML.node+ ( XML.element { name = "location" , attributes = XML.emptyAttributes , content = [ XML.text "/foo/bar" ]@@ -16,7 +16,7 @@ -} let XML = ./Type.dhall- sha256:461930f3aab769ba537d1a4fd71f411504b0c8d1c1a78d65177be8ded0df8a5c+ sha256:ab91a0edaf0513e0083b1dfae5efa160adc99b0e589775a4a699ab77cce528a9 ? ./Type.dhall let text@@ -25,6 +25,7 @@ λ(XML : Type) → λ ( xml : { text : Text → XML+ , rawText : Text → XML , element : { attributes : List { mapKey : Text, mapValue : Text } , content : List XML
dhall-lang/Prelude/package.dhall view
@@ -52,10 +52,10 @@ ? ./JSON/package.dhall , Text = ./Text/package.dhall- sha256:17a0e0e881b05436d7e3ae94a658af9da5ba2a921fafa0d1d545890978853434+ sha256:79b671a70ac459b799a53bbb8a383cc8b81b40421745c54bf0fb1143168cbd6f ? ./Text/package.dhall , XML = ./XML/package.dhall- sha256:6a15ea2ab1918f97374ec2fe3b90c056fb807fb3a90c1c44ce9fb9233f59c0e5+ sha256:2e111f0952087d42072b059f0bf4c95861a46bffa67ad4c8c39086edf405f32e ? ./XML/package.dhall }
+ dhall-lang/tests/import/data/userAgent.dhall view
@@ -0,0 +1,1 @@+"Dhall (from import)"
+ dhall-lang/tests/import/failure/originHeadersFromRemote.dhall view
@@ -0,0 +1,1 @@+https://httpbin.org/user-agent as Text
+ dhall-lang/tests/import/failure/originHeadersFromRemoteENV.dhall view
@@ -0,0 +1,11 @@+-- Use of a remote import causes Cyclic Import on env:DHALL_HEADERS+toMap+ { DHALL_HEADERS =+ ''+ toMap {+ `httpbin.org:443` = toMap {+ `User-Agent` = http://example.com as Text+ }+ }+ ''+ }
+ dhall-lang/tests/import/success/originHeadersA.dhall view
@@ -0,0 +1,1 @@+https://httpbin.org/user-agent as Text
+ dhall-lang/tests/import/success/originHeadersB.dhall view
@@ -0,0 +1,5 @@+''+{+ "user-agent": "Dhall"+}+''
+ dhall-lang/tests/import/success/originHeadersENV.dhall view
@@ -0,0 +1,10 @@+toMap+ { DHALL_HEADERS =+ ''+ toMap {+ `httpbin.org:443` = toMap {+ `User-Agent` = "Dhall"+ }+ }+ ''+ }
+ dhall-lang/tests/import/success/originHeadersImportA.dhall view
@@ -0,0 +1,1 @@+https://httpbin.org/user-agent as Text
+ dhall-lang/tests/import/success/originHeadersImportB.dhall view
@@ -0,0 +1,5 @@+''+{+ "user-agent": "Dhall (from import)"+}+''
+ dhall-lang/tests/import/success/originHeadersImportENV.dhall view
@@ -0,0 +1,10 @@+toMap+ { DHALL_HEADERS =+ ''+ toMap {+ `httpbin.org:443` = toMap {+ `User-Agent` = ./dhall-lang/tests/import/data/userAgent.dhall+ }+ }+ ''+ }
+ dhall-lang/tests/import/success/originHeadersImportFromEnvA.dhall view
@@ -0,0 +1,1 @@+https://httpbin.org/user-agent as Text
+ dhall-lang/tests/import/success/originHeadersImportFromEnvB.dhall view
@@ -0,0 +1,5 @@+''+{+ "user-agent": "Dhall (from env)"+}+''
+ dhall-lang/tests/import/success/originHeadersImportFromEnvENV.dhall view
@@ -0,0 +1,11 @@+toMap+ { DHALL_HEADERS =+ ''+ toMap {+ `httpbin.org:443` = toMap {+ `User-Agent` = env:USER_AGENT as Text+ }+ }+ ''+ , USER_AGENT = "Dhall (from env)"+ }
+ dhall-lang/tests/import/success/originHeadersOverrideA.dhall view
@@ -0,0 +1,3 @@+https://httpbin.org/user-agent+ using [ { mapKey = "User-Agent", mapValue = "inline-header" } ]+ as Text
+ dhall-lang/tests/import/success/originHeadersOverrideB.dhall view
@@ -0,0 +1,5 @@+''+{+ "user-agent": "user-header"+}+''
+ dhall-lang/tests/import/success/originHeadersOverrideENV.dhall view
@@ -0,0 +1,10 @@+toMap+ { DHALL_HEADERS =+ ''+ toMap {+ `httpbin.org:443` = toMap {+ `User-Agent` = "user-header"+ }+ }+ ''+ }
− dhall-lang/tests/import/success/userHeadersA.dhall
@@ -1,1 +0,0 @@-https://httpbin.org/user-agent as Text
− dhall-lang/tests/import/success/userHeadersB.dhall
@@ -1,5 +0,0 @@-''-{- "user-agent": "Dhall"-}-''
− dhall-lang/tests/import/success/userHeadersENV.dhall
@@ -1,10 +0,0 @@-toMap- { DHALL_HEADERS =- ''- toMap {- `httpbin.org:443` = toMap {- `User-Agent` = "Dhall"- }- }- ''- }
− dhall-lang/tests/import/success/userHeadersOverrideA.dhall
@@ -1,3 +0,0 @@-https://httpbin.org/user-agent- using [ { mapKey = "User-Agent", mapValue = "inline-header" } ]- as Text
− dhall-lang/tests/import/success/userHeadersOverrideB.dhall
@@ -1,5 +0,0 @@-''-{- "user-agent": "user-header"-}-''
− dhall-lang/tests/import/success/userHeadersOverrideENV.dhall
@@ -1,10 +0,0 @@-toMap- { DHALL_HEADERS =- ''- toMap {- `httpbin.org:443` = toMap {- `User-Agent` = "user-header"- }- }- ''- }
+ dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineA.dhall view
@@ -0,0 +1,2 @@+-- This test verifies that a trailing line comment does not require a newline+1--
+ dhall-lang/tests/parser/success/unit/TrailingLineCommentWithoutNewlineB.dhallb view
@@ -0,0 +1,1 @@+
dhall-lang/tests/type-inference/success/preludeB.dhall view
@@ -588,6 +588,7 @@ , replace : ∀(needle : Text) → ∀(replacement : Text) → ∀(haystack : Text) → Text , replicate : ∀(num : Natural) → ∀(text : Text) → Text+ , shell-escape : ∀(xs : Text) → Text , show : Text → Text , spaces : ∀(a : Natural) → Text , upperASCII : ∀(nil : Text) → Text@@ -610,6 +611,7 @@ , name : Text } → XML+ , rawText : Text → XML , text : Text → XML } ) →@@ -626,6 +628,7 @@ , name : Text } → XML+ , rawText : Text → XML , text : Text → XML } ) →@@ -645,10 +648,26 @@ , name : Text } → XML+ , rawText : Text → XML , text : Text → XML } ) → XML+ , rawText :+ ∀(d : Text) →+ ∀(XML : Type) →+ ∀ ( xml+ : { element :+ { attributes : List { mapKey : Text, mapValue : Text }+ , content : List XML+ , name : Text+ } →+ XML+ , rawText : Text → XML+ , text : Text → XML+ }+ ) →+ XML , render : ∀ ( x : ∀(XML : Type) →@@ -659,6 +678,7 @@ , name : Text } → XML+ , rawText : Text → XML , text : Text → XML } ) →@@ -675,6 +695,7 @@ , name : Text } → XML+ , rawText : Text → XML , text : Text → XML } ) →
+ dhall-lang/tests/type-inference/success/unit/ConstructorShiftA.dhall view
@@ -0,0 +1,1 @@+λ(t : Type) → < t : t >.t
+ dhall-lang/tests/type-inference/success/unit/ConstructorShiftB.dhall view
@@ -0,0 +1,1 @@+∀(t : Type) → ∀(t : t) → < t : t@1 >
dhall.cabal view
@@ -1,5 +1,5 @@ Name: dhall-Version: 1.40.1+Version: 1.40.2 Cabal-Version: 2.0 Build-Type: Simple License: BSD3@@ -473,10 +473,11 @@ Hs-Source-Dirs: src Build-Depends: base >= 4.11.0.0 && < 5 ,- aeson >= 1.0.0.0 && < 1.6 ,+ aeson >= 1.0.0.0 && < 2.1 , aeson-pretty < 0.9 , ansi-terminal >= 0.6.3.1 && < 0.12, atomic-write >= 0.2.0.7 && < 0.3 ,+ base16-bytestring >= 1.0.0.0 , bytestring < 0.12, case-insensitive < 1.3 , cborg >= 0.2.0.0 && < 0.3 ,@@ -493,24 +494,24 @@ filepath >= 1.4 && < 1.5 , half >= 0.2.2.3 && < 0.4 , haskeline >= 0.7.2.1 && < 0.9 ,- hashable >= 1.2 && < 1.4 ,+ hashable >= 1.2 && < 1.5 , lens-family-core >= 1.0.0 && < 2.2 ,- megaparsec >= 7 && < 9.2 ,- memory >= 0.14 && < 0.17,+ -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469+ megaparsec >= 8 && < 10 , mmorph < 1.3 , mtl >= 2.2.1 && < 2.3 , network-uri >= 2.6 && < 2.7 , optparse-applicative >= 0.14.0.0 && < 0.17, parsers >= 0.12.4 && < 0.13, parser-combinators ,- prettyprinter >= 1.5.1 && < 1.8 ,+ prettyprinter >= 1.7.0 && < 1.8 , prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , pretty-simple < 4.1 , profunctors >= 3.1.2 && < 5.7 , repline >= 0.4.0.0 && < 0.5 , serialise >= 0.2.0.0 && < 0.3 , scientific >= 0.3.0.0 && < 0.4 ,- template-haskell >= 2.13.0.0 && < 2.18,+ template-haskell >= 2.13.0.0 && < 2.19, text >= 0.11.1.0 && < 1.3 , text-manipulate >= 0.2.0.1 && < 0.4 , th-lift-instances >= 0.1.13 && < 0.2 ,@@ -533,7 +534,7 @@ else Hs-Source-Dirs: ghc-src Build-Depends:- cryptonite >= 0.23 && < 0.30+ cryptohash-sha256 if flag(with-http) Build-Depends: http-types >= 0.7.0 && < 0.13,@@ -610,6 +611,7 @@ Other-Modules: Dhall.Eval Dhall.Import.Types+ Dhall.Import.Headers Dhall.Marshal.Internal Dhall.Normalize Dhall.Parser.Combinators@@ -676,17 +678,18 @@ lens-family-core , megaparsec , prettyprinter ,- QuickCheck >= 2.10 && < 2.15,+ QuickCheck >= 2.14 && < 2.15, quickcheck-instances >= 0.3.12 && < 0.4 , scientific , serialise , special-values < 0.2 , spoon < 0.4 ,+ system-filepath , tasty >= 0.11.2 && < 1.5 , tasty-expected-failure < 0.13, tasty-hunit >= 0.10 && < 0.11, tasty-quickcheck >= 0.9.2 && < 0.11,- tasty-silver < 3.3 ,+ tasty-silver < 3.4 , template-haskell , temporary >= 1.2.1 && < 1.4 , text >= 0.11.1.0 && < 1.3 ,@@ -710,7 +713,7 @@ directory , filepath < 1.5 , mockery < 0.4 ,- doctest >= 0.7.0 && < 0.19+ doctest >= 0.7.0 if os(windows) -- https://github.com/dhall-lang/dhall-haskell/issues/2237 Buildable: False
ghc-src/Dhall/Crypto.hs view
@@ -13,18 +13,17 @@ ) where import Control.DeepSeq (NFData)-import Crypto.Hash (SHA256)-import Data.ByteArray (ByteArrayAccess, convert)-import Data.ByteArray.Encoding (Base (Base16), convertToBase) import Data.ByteString (ByteString) import GHC.Generics (Generic) -import qualified Crypto.Hash-import qualified Data.ByteString.Char8 as ByteString.Char8+import qualified Crypto.Hash.SHA256+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Char8 as ByteString.Char8 -- | A SHA256 digest newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString }- deriving (Eq, Generic, Ord, NFData, ByteArrayAccess)+ deriving (Eq, Generic, Ord, NFData) instance Show SHA256Digest where show = toString@@ -33,16 +32,14 @@ `Nothing` if the conversion fails -} sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest-sha256DigestFromByteString bytes = SHA256Digest . convert <$> mh- where- mh = Crypto.Hash.digestFromByteString bytes :: Maybe (Crypto.Hash.Digest SHA256)+sha256DigestFromByteString bytes+ | ByteString.length bytes == 32 = Just (SHA256Digest bytes)+ | otherwise = Nothing -- | Hash a `ByteString` and return the hash as a `SHA256Digest` sha256Hash :: ByteString -> SHA256Digest-sha256Hash bytes = SHA256Digest $ convert h- where- h = Crypto.Hash.hash bytes :: Crypto.Hash.Digest SHA256+sha256Hash = SHA256Digest . Crypto.Hash.SHA256.hash -- | 'String' representation of a 'SHA256Digest' toString :: SHA256Digest -> String-toString (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes+toString (SHA256Digest bytes) = ByteString.Char8.unpack $ Base16.encode bytes
ghc-src/Dhall/Import/HTTP.hs view
@@ -1,8 +1,10 @@+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Dhall.Import.HTTP ( fetchFromHttpUrl+ , originHeadersFileExpr ) where import Control.Exception (Exception)@@ -11,25 +13,32 @@ import Data.ByteString (ByteString) import Data.CaseInsensitive (CI) import Data.Dynamic (toDyn)-import Data.List.NonEmpty (NonEmpty(..))+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text.Encoding (decodeUtf8) import Dhall.Core- ( Import (..)+ ( Expr (..)+ , Directory (..)+ , File (..)+ , FilePrefix (..)+ , Import (..) , ImportHashed (..)+ , ImportMode (..) , ImportType (..) , Scheme (..) , URL (..) ) import Dhall.Import.Types+import Dhall.Parser (Src) import Dhall.URL (renderURL)+import System.Directory (getXdgDirectory, XdgDirectory(XdgConfig))+import System.FilePath (splitDirectories) -import Network.HTTP.Client- ( HttpException (..)- , HttpExceptionContent (..)- )+import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..)) import qualified Control.Exception import qualified Control.Monad.Trans.State.Strict as State+import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text import qualified Data.Text.Encoding import qualified Data.Text.Lazy@@ -241,20 +250,35 @@ Control.Exception.throwIO (NotCORSCompliant {..}) corsCompliant _ _ _ = return () -type HTTPHeader = Network.HTTP.Types.Header+addHeaders :: OriginHeaders -> Maybe [HTTPHeader] -> HTTP.Request -> HTTP.Request+addHeaders originHeaders urlHeaders request =+ request { HTTP.requestHeaders = (filterHeaders urlHeaders) <> perOriginHeaders }+ where+ origin = decodeUtf8 (HTTP.host request) <> ":" <> Text.pack (show (HTTP.port request))+ + perOriginHeaders = HashMap.lookupDefault [] origin originHeaders + filterHeaders = foldMap (filter (not . overridden))++ overridden :: HTTPHeader -> Bool+ overridden (key, _value) = any (matchesKey key) perOriginHeaders++ matchesKey :: CI ByteString -> HTTPHeader -> Bool+ matchesKey key (candidate, _value) = key == candidate+ fetchFromHttpUrl :: URL -> Maybe [HTTPHeader] -> StateT Status IO Text.Text fetchFromHttpUrl childURL mheaders = do+ Status { _loadOriginHeaders } <- State.get++ originHeaders <- _loadOriginHeaders+ manager <- newManager let childURLString = Text.unpack (renderURL childURL) - request <- liftIO (HTTP.parseUrlThrow childURLString)+ baseRequest <- liftIO (HTTP.parseUrlThrow childURLString) - let requestWithHeaders =- case mheaders of- Nothing -> request- Just headers -> request { HTTP.requestHeaders = headers }+ let requestWithHeaders = addHeaders originHeaders mheaders baseRequest let io = HTTP.httpLbs requestWithHeaders manager @@ -281,3 +305,11 @@ case Data.Text.Lazy.Encoding.decodeUtf8' bytes of Left err -> liftIO (Control.Exception.throwIO err) Right text -> return (Data.Text.Lazy.toStrict text)++originHeadersFileExpr :: IO (Expr Src Import)+originHeadersFileExpr = do+ directoryStr <- getXdgDirectory XdgConfig "dhall"+ let components = map Text.pack (splitDirectories directoryStr)+ let directory = Directory (reverse components)+ let file = (File directory "headers.dhall")+ return (Embed (Import (ImportHashed Nothing (Local Absolute file)) Code))
ghc-src/Dhall/Import/Manager.hs view
@@ -16,7 +16,7 @@ , defaultNewManager ) where -import Network.HTTP.Client (Manager, newManager)+import Network.HTTP.Client (Manager, newManager) import qualified Network.HTTP.Client as HTTP #ifdef USE_HTTP_CLIENT_TLS
ghcjs-src/Dhall/Crypto.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE JavaScriptFFI #-}+{-# LANGUAGE JavaScriptFFI #-} {-| This module provides implementations of cryptographic utilities that only work for GHCJS@@ -12,32 +12,31 @@ , sha256Hash ) where -import Control.DeepSeq (NFData)-import Data.ByteArray (ByteArrayAccess)-import Data.ByteArray.Encoding (Base(Base16), convertToBase)-import Data.ByteString (ByteString)-import GHC.Generics (Generic)+import Control.DeepSeq (NFData)+import Data.ByteString (ByteString)+import GHC.Generics (Generic) import JavaScript.TypedArray.ArrayBuffer (ArrayBuffer)-import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as ByteString.Char8 import qualified GHCJS.Buffer as Buffer -- | A SHA256 digest newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString }- deriving (Eq, Generic, Ord, NFData, ByteArrayAccess)+ deriving (Eq, Generic, Ord, NFData) instance Show SHA256Digest where- show (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes+ show (SHA256Digest bytes) = ByteString.Char8.unpack $ Base16.encode bytes {-| Attempt to interpret a `ByteString` as a `SHA256Digest`, returning `Nothing` if the conversion fails -} sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest sha256DigestFromByteString bytes- | ByteString.length bytes == 32 = Just $ SHA256Digest bytes- | otherwise = Nothing+ | ByteString.length bytes == 32 = Just (SHA256Digest bytes)+ | otherwise = Nothing -- Use NodeJS' crypto module if there's a 'process' module, e.g. we're running -- inside GHCJS' THRunner. If we're running in the browser, use the WebCrypto
ghcjs-src/Dhall/Import/HTTP.hs view
@@ -2,14 +2,16 @@ module Dhall.Import.HTTP ( fetchFromHttpUrl+ , originHeadersFileExpr ) where import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.State.Strict (StateT) import Data.ByteString (ByteString) import Data.CaseInsensitive (CI)-import Dhall.Core (URL (..))-import Dhall.Import.Types (Status)+import Dhall.Core (URL (..), Expr (..))+import Dhall.Import.Types (Import, Status)+import Dhall.Parser (Src) import Dhall.URL (renderURL) import qualified Data.Text as Text@@ -35,3 +37,6 @@ return body fetchFromHttpUrl _ _ = fail "Dhall does not yet support custom headers when built using GHCJS"++originHeadersFileExpr :: IO (Expr Src Import)+originHeadersFileExpr = return Missing
src/Dhall/Binary.hs view
@@ -54,14 +54,13 @@ import Data.Void (Void, absurd) import GHC.Float (double2Float, float2Double) import Numeric.Half (fromHalf, toHalf)-import Prelude hiding (exponent)+import Prelude hiding (exponent) import qualified Codec.CBOR.ByteArray import qualified Codec.CBOR.Decoding as Decoding import qualified Codec.CBOR.Encoding as Encoding import qualified Codec.CBOR.Read as Read import qualified Codec.Serialise as Serialise-import qualified Data.ByteArray import qualified Data.ByteString import qualified Data.ByteString.Lazy import qualified Data.ByteString.Short@@ -1271,7 +1270,7 @@ Encoding.encodeNull Just digest ->- Encoding.encodeBytes ("\x12\x20" <> Data.ByteArray.convert digest)+ Encoding.encodeBytes ("\x12\x20" <> Dhall.Crypto.unSHA256Digest digest) m = Encoding.encodeInt (case importMode of Code -> 0; RawText -> 1; Location -> 2;)
src/Dhall/Core.hs view
@@ -56,6 +56,7 @@ -- * Optics , subExpressions+ , subExpressionsWith , chunkExprs , bindingExprs , recordFieldExprs@@ -78,16 +79,16 @@ , Syntax.desugarWith ) where -import Control.Exception (Exception)-import Control.Monad.IO.Class (MonadIO (..))-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Pretty)+import Control.Exception (Exception)+import Control.Monad.IO.Class (MonadIO (..))+import Data.Text (Text) import Dhall.Normalize import Dhall.Pretty.Internal-import Dhall.Src (Src (..))+import Dhall.Src (Src (..)) import Dhall.Syntax-import Instances.TH.Lift ()-import Lens.Family (over)+import Instances.TH.Lift ()+import Lens.Family (over)+import Prettyprinter (Pretty) import qualified Control.Exception import qualified Data.Text
src/Dhall/Diff.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-} {-| This module provides functionality for concisely displaying the difference between two expressions@@ -17,16 +17,15 @@ , diff ) where -import Data.Foldable (fold, toList)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid (Any (..))-import Data.Sequence (Seq)-import Data.String (IsString (..))-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, Pretty)-import Data.Void (Void)-import Dhall.Map (Map)-import Dhall.Pretty.Internal (Ann)+import Data.Foldable (fold, toList)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid (Any (..))+import Data.Sequence (Seq)+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Map (Map)+import Dhall.Pretty.Internal (Ann) import Dhall.Syntax ( Binding (..) , Chunks (..)@@ -37,18 +36,19 @@ , RecordField (..) , Var (..) )-import Numeric.Natural (Natural)+import Numeric.Natural (Natural)+import Prettyprinter (Doc, Pretty) -import qualified Data.Algorithm.Diff as Algo.Diff+import qualified Data.Algorithm.Diff as Algo.Diff import qualified Data.List.NonEmpty import qualified Data.Set import qualified Data.Text-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Time as Time+import qualified Data.Time as Time import qualified Dhall.Map-import qualified Dhall.Normalize as Normalize-import qualified Dhall.Pretty.Internal as Internal-import qualified Dhall.Syntax as Syntax+import qualified Dhall.Normalize as Normalize+import qualified Dhall.Pretty.Internal as Internal+import qualified Dhall.Syntax as Syntax+import qualified Prettyprinter as Pretty {-| This type is a `Doc` enriched with a `same` flag to efficiently track if any difference was detected
src/Dhall/DirectoryTree.hs view
@@ -16,16 +16,16 @@ import Dhall.Syntax (Chunks (..), Expr (..), RecordField (..)) import System.FilePath ((</>)) -import qualified Control.Exception as Exception-import qualified Data.Foldable as Foldable-import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty-import qualified Dhall.Map as Map+import qualified Control.Exception as Exception+import qualified Data.Foldable as Foldable+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Map as Map import qualified Dhall.Pretty-import qualified Dhall.Util as Util-import qualified System.Directory as Directory-import qualified System.FilePath as FilePath+import qualified Dhall.Util as Util+import qualified Prettyprinter.Render.String as Pretty+import qualified System.Directory as Directory+import qualified System.FilePath as FilePath {-| Attempt to transform a Dhall record into a directory tree where:
src/Dhall/Eval.hs view
@@ -52,7 +52,7 @@ import Data.Bifunctor (first) import Data.Foldable (foldr', toList)-import Data.List.NonEmpty (NonEmpty(..))+import Data.List.NonEmpty (NonEmpty (..)) import Data.Sequence (Seq, ViewL (..), ViewR (..)) import Data.Text (Text) import Data.Void (Void)
src/Dhall/Format.hs view
@@ -14,11 +14,7 @@ import Data.Foldable (for_) import Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe)-import Dhall.Pretty- ( CharacterSet- , annToAnsiStyle- , detectCharacterSet- )+import Dhall.Pretty (CharacterSet, annToAnsiStyle, detectCharacterSet) import Dhall.Util ( Censor , CheckFailed (..)@@ -30,13 +26,13 @@ ) import qualified Data.Text.IO-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text import qualified Dhall.Import import qualified Dhall.Pretty import qualified Dhall.Util-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.Terminal as Pretty.Terminal+import qualified Prettyprinter.Render.Text as Pretty.Text+import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText import qualified System.Console.ANSI import qualified System.FilePath import qualified System.IO
src/Dhall/Freeze.hs view
@@ -42,19 +42,19 @@ ) import System.Console.ANSI (hSupportsANSI) -import qualified Control.Exception as Exception-import qualified Control.Monad.Trans.State.Strict as State-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text-import qualified Dhall.Core as Core+import qualified Control.Exception as Exception+import qualified Control.Monad.Trans.State.Strict as State+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Core as Core import qualified Dhall.Import import qualified Dhall.Optics import qualified Dhall.Pretty import qualified Dhall.TypeCheck-import qualified Dhall.Util as Util-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText+import qualified Dhall.Util as Util+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.Terminal as Pretty+import qualified Prettyprinter.Render.Text as Pretty.Text+import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText import qualified System.FilePath import qualified System.IO
src/Dhall/Import.hs view
@@ -108,7 +108,7 @@ load , loadWithManager , loadRelativeTo- , loadRelativeToWithManager+ , loadWithStatus , loadWith , localToPath , hashExpression@@ -126,8 +126,11 @@ , chainedChangeMode , emptyStatus , emptyStatusWithManager+ , envOriginHeaders+ , makeEmptyStatus , remoteStatus , remoteStatusWithManager+ , fetchRemote , stack , cache , Depends(..)@@ -152,24 +155,24 @@ , HashMismatch(..) ) where -import Control.Applicative (Alternative (..), liftA2)+import Control.Applicative (Alternative (..)) import Control.Exception ( Exception , IOException , SomeException , toException )-import Control.Monad.Catch (MonadCatch (catch), handle, throwM)-import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Morph (hoist)-import Control.Monad.State.Strict (MonadState, StateT)-import Data.ByteString (ByteString)-import Data.CaseInsensitive (CI)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Text (Text)-import Data.Typeable (Typeable)-import Data.Void (Void, absurd)-import Dhall.TypeCheck (TypeError)+import Control.Monad.Catch (MonadCatch (catch), handle, throwM)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Morph (hoist)+import Control.Monad.State.Strict (MonadState, StateT)+import Data.ByteString (ByteString)+import Data.List.NonEmpty (NonEmpty (..), nonEmpty)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Typeable (Typeable)+import Data.Void (Void, absurd)+import Dhall.TypeCheck (TypeError) import Dhall.Syntax ( Chunks (..)@@ -188,10 +191,17 @@ ) import System.FilePath ((</>))+import Text.Megaparsec (SourcePos (SourcePos), mkPos) #ifdef WITH_HTTP import Dhall.Import.HTTP #endif+import Dhall.Import.Headers+ ( normalizeHeaders+ , originHeadersTypeExpr+ , toHeaders+ , toOriginHeaders+ ) import Dhall.Import.Types import Dhall.Parser@@ -209,12 +219,9 @@ import qualified Control.Monad.Trans.Maybe as Maybe import qualified Data.ByteString import qualified Data.ByteString.Lazy-import qualified Data.CaseInsensitive-import qualified Data.Foldable import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe as Maybe import qualified Data.Text as Text-import qualified Data.Text.Encoding import qualified Data.Text.IO import qualified Dhall.Binary import qualified Dhall.Core as Core@@ -229,8 +236,8 @@ import qualified System.Directory as Directory import qualified System.Environment import qualified System.FilePath as FilePath-import qualified System.Info import qualified System.IO+import qualified System.Info import qualified Text.Megaparsec import qualified Text.Parser.Combinators import qualified Text.Parser.Token@@ -286,7 +293,7 @@ instance Show ReferentiallyOpaque where show (ReferentiallyOpaque import_) =- "\nReferentially opaque import: " ++ Dhall.Pretty.Internal.prettyToString import_+ "\nLocal imports are not permitted from remote imports: " ++ Dhall.Pretty.Internal.prettyToString import_ -- | Extend another exception with the current import stack data Imported e = Imported@@ -355,9 +362,6 @@ throwMissingImport :: (MonadCatch m, Exception e) => e -> m a throwMissingImport e = throwM (MissingImports [toException e]) --- | HTTP headers-type HTTPHeader = (CI ByteString, ByteString)- -- | Exception thrown when a HTTP url is imported but dhall was built without -- the @with-http@ Cabal flag. data CannotImportHTTPURL =@@ -501,7 +505,7 @@ -- | Chain imports, also typecheck and normalize headers if applicable. chainImport :: Chained -> Import -> StateT Status IO Chained chainImport (Chained parent) child@(Import importHashed@(ImportHashed _ (Remote url)) _) = do- url' <- normalizeHeaders url+ url' <- normalizeHeadersIn url let child' = child { importHashed = importHashed { importType = Remote url' } } return (Chained (canonicalize (parent <> child'))) @@ -786,7 +790,7 @@ fetchFresh Missing = throwM (MissingImports []) -+-- | Fetch the text contents of a URL fetchRemote :: URL -> StateT Status IO Data.Text.Text #ifndef WITH_HTTP fetchRemote (url@URL { headers = maybeHeadersExpression }) = do@@ -805,29 +809,6 @@ fetchFromHttpUrl url' maybeHeaders #endif --- | Given a well-typed (of type `List { header : Text, value Text }` or--- `List { mapKey : Text, mapValue Text }`) headers expressions in normal form--- construct the corresponding binary http headers; otherwise return the empty--- list.-toHeaders :: Expr s a -> [HTTPHeader]-toHeaders (ListLit _ hs) = Data.Foldable.toList (Data.Foldable.fold maybeHeaders)- where- maybeHeaders = mapM toHeader hs-toHeaders _ = []--toHeader :: Expr s a -> Maybe HTTPHeader-toHeader (RecordLit m) = do- (Core.recordFieldValue -> TextLit (Chunks [] keyText), Core.recordFieldValue -> TextLit (Chunks [] valueText))- <- lookupHeader <|> lookupMapKey- let keyBytes = Data.Text.Encoding.encodeUtf8 keyText- let valueBytes = Data.Text.Encoding.encodeUtf8 valueText- return (Data.CaseInsensitive.mk keyBytes, valueBytes)- where- lookupHeader = liftA2 (,) (Dhall.Map.lookup "header" m) (Dhall.Map.lookup "value" m)- lookupMapKey = liftA2 (,) (Dhall.Map.lookup "mapKey" m) (Dhall.Map.lookup "mapValue" m)-toHeader _ =- empty- getCacheFile :: (MonadCatch m, Alternative m, MonadState CacheWarning m, MonadIO m) => FilePath -> Dhall.Crypto.SHA256Digest -> m FilePath@@ -1019,62 +1000,102 @@ -- If the URL contains headers typecheck them and replace them with their normal -- forms.-normalizeHeaders :: URL -> StateT Status IO URL-normalizeHeaders url@URL { headers = Just headersExpression } = do+normalizeHeadersIn :: URL -> StateT Status IO URL+normalizeHeadersIn url@URL { headers = Just headersExpression } = do Status { _stack } <- State.get loadedExpr <- loadWith headersExpression+ let handler (e :: SomeException) = throwMissingImport (Imported _stack e)+ normalized <- liftIO $ handle handler (normalizeHeaders loadedExpr)+ return url { headers = Just (fmap absurd normalized) } - let go key₀ key₁ = do- let expected :: Expr Src Void- expected =- App List- ( Record $ Core.makeRecordField <$>- Dhall.Map.fromList- [ (key₀, Text)- , (key₁, Text)- ]- )+normalizeHeadersIn url = return url - let suffix_ = Dhall.Pretty.Internal.prettyToStrictText expected- let annot = case loadedExpr of- Note (Src begin end bytes) _ ->- Note (Src begin end bytes') (Annot loadedExpr expected)- where- bytes' = bytes <> " : " <> suffix_- _ ->- Annot loadedExpr expected+-- | Empty origin headers used for remote contexts+-- (and fallback when nothing is set in env or config file)+emptyOriginHeaders :: Expr Src Import+emptyOriginHeaders = ListLit (Just (fmap absurd originHeadersTypeExpr)) mempty - _ <- case (Dhall.TypeCheck.typeOf annot) of- Left err -> throwMissingImport (Imported _stack err)- Right _ -> return ()+-- | A fake Src to annotate headers expressions with.+-- We need to wrap headers expressions in a Note for nice error reporting,+-- and because ImportAlt handling only catches SourcedExceptions+headersSrc :: Src+headersSrc = Src {+ srcStart = SourcePos {+ sourceName = fakeSrcName,+ sourceLine = mkPos 1,+ sourceColumn = mkPos 1+ },+ srcEnd = SourcePos {+ sourceName = fakeSrcName,+ sourceLine = mkPos 1,+ sourceColumn = mkPos (Text.length fakeSrcText)+ },+ srcText = fakeSrcText+ }+ where+ fakeSrcText = "«Origin Header Configuration»"+ fakeSrcName = "[builtin]" - return (Core.normalize loadedExpr)+-- | Load headers only from the environment (used in tests)+envOriginHeaders :: Expr Src Import+envOriginHeaders = Note headersSrc (Embed (Import (ImportHashed Nothing (Env "DHALL_HEADERS")) Code)) - let handler₀ (e :: SomeException) = do- {- Try to typecheck using the preferred @mapKey@/@mapValue@ fields- and fall back to @header@/@value@ if that fails. However, if- @header@/@value@ still fails then re-throw the original exception- for @mapKey@ / @mapValue@. -}- let handler₁ (_ :: SomeException) =- throwMissingImport (Imported _stack e)+-- | Load headers in env, falling back to config file+defaultOriginHeaders :: IO (Expr Src Import)+#ifndef WITH_HTTP+defaultOriginHeaders = return emptyOriginHeaders+#else+defaultOriginHeaders = do+ fromFile <- originHeadersFileExpr+ return (Note headersSrc (ImportAlt envOriginHeaders (Note headersSrc fromFile)))+#endif - handle handler₁ (go "header" "value")+-- | Given a headers expression, return an origin headers loader+originHeadersLoader :: IO (Expr Src Import) -> StateT Status IO OriginHeaders+originHeadersLoader headersExpr = do - headersExpression' <-- handle handler₀ (go "mapKey" "mapValue")+ -- Load the headers using the parent stack, which should always be a local+ -- import (we only load headers for the first remote import) - return url { headers = Just (fmap absurd headersExpression') }+ status <- State.get -normalizeHeaders url = return url+ let parentStack = fromMaybe abortEmptyStack (nonEmpty (NonEmpty.tail (_stack status))) + let headerLoadStatus = status { _stack = parentStack }++ (headers, _) <- liftIO (State.runStateT doLoad headerLoadStatus)++ -- return cached headers next time+ _ <- State.modify (\state -> state { _loadOriginHeaders = return headers })++ return headers+ where+ abortEmptyStack = Core.internalError "Origin headers loaded with an empty stack"++ doLoad = do+ partialExpr <- liftIO headersExpr+ loaded <- loadWith (Note headersSrc (ImportAlt partialExpr emptyOriginHeaders))+ liftIO (toOriginHeaders loaded)+ -- | Default starting `Status`, importing relative to the given directory. emptyStatus :: FilePath -> Status-emptyStatus = emptyStatusWithManager defaultNewManager+emptyStatus = makeEmptyStatus defaultNewManager defaultOriginHeaders +-- | See 'emptyStatus'+emptyStatusWithManager+ :: IO Manager+ -> FilePath+ -> Status+emptyStatusWithManager newManager = makeEmptyStatus newManager defaultOriginHeaders+ -- | See 'emptyStatus'.-emptyStatusWithManager :: IO Manager -> FilePath -> Status-emptyStatusWithManager newManager rootDirectory =- emptyStatusWith newManager fetchRemote rootImport+makeEmptyStatus+ :: IO Manager+ -> IO (Expr Src Import)+ -> FilePath+ -> Status+makeEmptyStatus newManager headersExpr rootDirectory =+ emptyStatusWith newManager (originHeadersLoader headersExpr) fetchRemote rootImport where prefix = if FilePath.isRelative rootDirectory then Here@@ -1107,7 +1128,7 @@ -- | See `remoteStatus` remoteStatusWithManager :: IO Manager -> URL -> Status remoteStatusWithManager newManager url =- emptyStatusWith newManager fetchRemote rootImport+ emptyStatusWith newManager (originHeadersLoader (pure emptyOriginHeaders)) fetchRemote rootImport where rootImport = Import { importHashed = ImportHashed@@ -1205,7 +1226,10 @@ -- | See 'load'. loadWithManager :: IO Manager -> Expr Src Import -> IO (Expr Src Void)-loadWithManager newManager = loadRelativeToWithManager newManager "." UseSemanticCache+loadWithManager newManager =+ loadWithStatus+ (makeEmptyStatus newManager defaultOriginHeaders ".")+ UseSemanticCache printWarning :: (MonadIO m) => String -> m () printWarning message = do@@ -1219,19 +1243,19 @@ -- | Resolve all imports within an expression, importing relative to the given -- directory. loadRelativeTo :: FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void)-loadRelativeTo = loadRelativeToWithManager defaultNewManager+loadRelativeTo parentDirectory = loadWithStatus+ (makeEmptyStatus defaultNewManager defaultOriginHeaders parentDirectory) -- | See 'loadRelativeTo'.-loadRelativeToWithManager- :: IO Manager- -> FilePath+loadWithStatus+ :: Status -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void)-loadRelativeToWithManager newManager rootDirectory semanticCacheMode expression =+loadWithStatus status semanticCacheMode expression = State.evalStateT (loadWith expression)- (emptyStatusWithManager newManager rootDirectory) { _semanticCacheMode = semanticCacheMode }+ status { _semanticCacheMode = semanticCacheMode } encodeExpression :: Expr Void Void -> Data.ByteString.ByteString encodeExpression expression = bytesStrict
+ src/Dhall/Import/Headers.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Dhall.Import.Headers+ ( normalizeHeaders+ , originHeadersTypeExpr+ , toHeaders+ , toOriginHeaders+ ) where++import Control.Applicative (Alternative (..), liftA2)+import Control.Exception (SomeException)+import Control.Monad.Catch (handle, throwM)+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Core+ ( Chunks (..)+ , Expr (..)+ )+import Dhall.Import.Types (HTTPHeader , OriginHeaders)+import Dhall.Parser (Src (..))++import qualified Data.CaseInsensitive+import qualified Data.Foldable+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text.Encoding+import qualified Dhall.Core as Core+import qualified Dhall.Map+import qualified Dhall.TypeCheck+import qualified Dhall.Pretty.Internal++-- | Given a well-typed (of type `List { header : Text, value Text }` or+-- `List { mapKey : Text, mapValue Text }`) headers expressions in normal form+-- construct the corresponding binary http headers; otherwise return the empty+-- list.+toHeaders :: Expr s a -> [HTTPHeader]+toHeaders (ListLit _ hs) = Data.Foldable.toList (Data.Foldable.fold maybeHeaders)+ where+ maybeHeaders = mapM toHeader hs+toHeaders _ = []++toHeader :: Expr s a -> Maybe HTTPHeader+toHeader (RecordLit m) = do+ (Core.recordFieldValue -> TextLit (Chunks [] keyText), Core.recordFieldValue -> TextLit (Chunks [] valueText))+ <- lookupHeader <|> lookupMapKey+ let keyBytes = Data.Text.Encoding.encodeUtf8 keyText+ let valueBytes = Data.Text.Encoding.encodeUtf8 valueText+ return (Data.CaseInsensitive.mk keyBytes, valueBytes)+ where+ lookupHeader = liftA2 (,) (Dhall.Map.lookup "header" m) (Dhall.Map.lookup "value" m)+ lookupMapKey = liftA2 (,) (Dhall.Map.lookup "mapKey" m) (Dhall.Map.lookup "mapValue" m)+toHeader _ =+ empty++-- | Normalize, typecheck and return OriginHeaders from a given expression.+toOriginHeaders :: Expr Src Void -> IO OriginHeaders+toOriginHeaders expr = fmap convert (normalizeOriginHeaders expr)+ where+ convert :: Expr s a -> OriginHeaders+ convert (ListLit _ hs) = HashMap.fromList (originPairs hs)+ convert _ = mempty++ originPairs hs = Data.Foldable.toList (Data.Foldable.fold (mapM toOriginPair hs))++ toOriginPair :: Expr s a -> Maybe (Text, [HTTPHeader])+ toOriginPair (RecordLit m) = do+ (Core.recordFieldValue -> TextLit (Chunks [] keyText), Core.recordFieldValue -> value)+ <- lookupMapKey+ return (keyText, toHeaders value)+ where+ lookupMapKey = liftA2 (,) (Dhall.Map.lookup "mapKey" m) (Dhall.Map.lookup "mapValue" m)+ toOriginPair _ = Nothing++makeHeadersTypeExpr :: Text -> Text -> Expr Src Void+makeHeadersTypeExpr keyKey valueKey =+ App List+ ( Record $ Core.makeRecordField <$>+ Dhall.Map.fromList+ [ (keyKey, Text)+ , (valueKey, Text)+ ]+ )++headersTypeExpr :: Expr Src Void+headersTypeExpr = makeHeadersTypeExpr "mapKey" "mapValue"++leagacyHeadersTypeExpr :: Expr Src Void+leagacyHeadersTypeExpr = makeHeadersTypeExpr "header" "value"++originHeadersTypeExpr :: Expr Src Void+originHeadersTypeExpr =+ App List+ ( Record $ Core.makeRecordField <$>+ Dhall.Map.fromList+ [ ("mapKey", Text)+ , ("mapValue", headersTypeExpr)+ ]+ )++typecheck :: Expr Src Void -> Expr Src Void -> IO (Expr Src Void)+typecheck expected expr = do+ 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)+ where+ bytes' = bytes <> " : " <> suffix_+ _ ->+ Annot expr expected++ _ <- case (Dhall.TypeCheck.typeOf annot) of+ Left err -> throwM err+ Right _ -> return ()++ return (Core.normalize expr)++normalizeHeaders :: Expr Src Void -> IO (Expr Src Void)+normalizeHeaders headersExpr = do+ let handler₀ (e :: SomeException) = do+ {- Try to typecheck using the preferred @mapKey@/@mapValue@ fields+ and fall back to @header@/@value@ if that fails. However, if+ @header@/@value@ still fails then re-throw the original exception+ for @mapKey@ / @mapValue@. -}+ let handler₁ (_ :: SomeException) = throwM e+ handle handler₁ (typecheck leagacyHeadersTypeExpr headersExpr)++ handle handler₀ (typecheck headersTypeExpr headersExpr)++normalizeOriginHeaders :: Expr Src Void -> IO (Expr Src Void)+normalizeOriginHeaders = typecheck originHeadersTypeExpr
src/Dhall/Import/Types.hs view
@@ -8,9 +8,11 @@ import Control.Exception (Exception) import Control.Monad.Trans.State.Strict (StateT)+import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI) import Data.Dynamic+import Data.HashMap.Strict (HashMap) import Data.List.NonEmpty (NonEmpty)-import Data.Text.Prettyprint.Doc (Pretty (..)) import Data.Void (Void) import Dhall.Context (Context) import Dhall.Core@@ -22,6 +24,7 @@ import Dhall.Map (Map) import Dhall.Parser (Src) import Lens.Family (LensLike')+import Prettyprinter (Pretty (..)) #ifdef WITH_HTTP import qualified Dhall.Import.Manager@@ -77,6 +80,12 @@ pure () #endif +-- | HTTP headers+type HTTPHeader = (CI ByteString, ByteString)++-- | A map of site origin -> HTTP headers+type OriginHeaders = HashMap Data.Text.Text [HTTPHeader]+ {-| Used internally to track whether or not we've already warned the user about caching issues -}@@ -101,6 +110,10 @@ -- ^ Used to cache the `Dhall.Import.Manager.Manager` when making multiple -- requests + , _loadOriginHeaders :: StateT Status IO OriginHeaders+ -- ^ Load the origin headers from environment or configuration file.+ -- After loading once, further evaluations return the cached version.+ , _remote :: URL -> StateT Status IO Data.Text.Text -- ^ The remote resolver, fetches the content at the given URL. @@ -117,14 +130,16 @@ -- cache directory } --- | Initial `Status`, parameterised over the HTTP 'Manager' and the remote--- resolver, importing relative to the given root import.+-- | Initial `Status`, parameterised over the HTTP 'Manager',+-- the origin headers and the remote resolver,+-- importing relative to the given root import. emptyStatusWith :: IO Manager+ -> StateT Status IO OriginHeaders -> (URL -> StateT Status IO Data.Text.Text) -> Import -> Status-emptyStatusWith _newManager _remote rootImport = Status {..}+emptyStatusWith _newManager _loadOriginHeaders _remote rootImport = Status {..} where _stack = pure (Chained rootImport)
src/Dhall/Lint.hs view
@@ -19,7 +19,7 @@ ) where import Control.Applicative ((<|>))-import Data.List.NonEmpty (NonEmpty(..))+import Data.List.NonEmpty (NonEmpty (..)) import Dhall.Syntax ( Binding (..)
src/Dhall/Main.hs view
@@ -21,35 +21,36 @@ , main ) where -import Control.Applicative (optional, (<|>))-import Control.Exception (Handler (..), SomeException)-import Control.Monad (when)-import Data.Foldable (for_)-import Data.Maybe (fromMaybe)-import Data.List.NonEmpty (NonEmpty (..), nonEmpty)-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, Pretty)-import Data.Void (Void)-import Dhall.Freeze (Intent (..), Scope (..))+import Control.Applicative (optional, (<|>))+import Control.Exception (Handler (..), SomeException)+import Control.Monad (when)+import Data.Foldable (for_)+import Data.List.NonEmpty (NonEmpty (..), nonEmpty)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Freeze (Intent (..), Scope (..)) import Dhall.Import ( Depends (..) , Imported (..) , SemanticCacheMode (..) , _semanticCacheMode )-import Dhall.Parser (Src)-import Dhall.Pretty (Ann, CharacterSet (..), annToAnsiStyle, detectCharacterSet)-import Dhall.Schemas (Schemas (..))-import Dhall.TypeCheck- ( Censored (..)- , DetailedTypeError (..)- , TypeError+import Dhall.Parser (Src)+import Dhall.Pretty+ ( Ann+ , CharacterSet (..)+ , annToAnsiStyle+ , detectCharacterSet )-import Dhall.Version (dhallVersionString)-import Options.Applicative (Parser, ParserInfo)-import System.Exit (ExitCode, exitFailure)-import System.IO (Handle)-import Text.Dot ((.->.))+import Dhall.Schemas (Schemas (..))+import Dhall.TypeCheck (Censored (..), DetailedTypeError (..), TypeError)+import Dhall.Version (dhallVersionString)+import Options.Applicative (Parser, ParserInfo)+import Prettyprinter (Doc, Pretty)+import System.Exit (ExitCode, exitFailure)+import System.IO (Handle)+import Text.Dot ((.->.)) import Dhall.Core ( Expr (Annot)@@ -74,7 +75,7 @@ import qualified Codec.CBOR.Read import qualified Codec.CBOR.Write import qualified Control.Exception-import qualified Control.Monad.Trans.State.Strict as State+import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Aeson import qualified Data.Aeson.Encode.Pretty import qualified Data.ByteString.Lazy@@ -82,14 +83,11 @@ import qualified Data.Map 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 Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text import qualified Dhall import qualified Dhall.Binary import qualified Dhall.Core import qualified Dhall.Diff-import qualified Dhall.DirectoryTree as DirectoryTree+import qualified Dhall.DirectoryTree as DirectoryTree import qualified Dhall.Format import qualified Dhall.Freeze import qualified Dhall.Import@@ -104,9 +102,12 @@ import qualified Dhall.Util import qualified GHC.IO.Encoding import qualified Options.Applicative-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.Terminal as Pretty+import qualified Prettyprinter.Render.Text as Pretty.Text+import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText import qualified System.Console.ANSI-import qualified System.Exit as Exit+import qualified System.Exit as Exit import qualified System.FilePath import qualified System.IO import qualified Text.Dot
src/Dhall/Marshal/Decode.hs view
@@ -56,6 +56,13 @@ , string , lazyText , strictText+ -- ** Time+ , timeOfDay+ , day+ , timeZone+ , localTime+ , zonedTime+ , utcTime -- ** Containers , maybe , pair@@ -86,6 +93,7 @@ , GenericFromDhallUnion(..) , genericAuto , genericAutoWith+ , genericAutoWithInputNormalizer -- * Decoding errors , DhallErrors(..)@@ -132,11 +140,14 @@ , eitherToValidation , validationToEither )-import Data.Functor.Contravariant (Op(..), Predicate(..), Equivalence(..))+import Data.Functor.Contravariant+ ( Equivalence (..)+ , Op (..)+ , Predicate (..)+ ) import Data.Hashable (Hashable) import Data.Int (Int16, Int32, Int64, Int8) import Data.List.NonEmpty (NonEmpty (..))-import Data.Text.Prettyprint.Doc (Pretty) import Data.Typeable (Proxy (..), Typeable) import Dhall.Parser (Src (..)) import Dhall.Syntax@@ -148,6 +159,7 @@ ) import GHC.Generics import Prelude hiding (maybe, sequence)+import Prettyprinter (Pretty) import qualified Control.Applicative import qualified Data.Foldable@@ -164,6 +176,7 @@ import qualified Data.Set import qualified Data.Text import qualified Data.Text.Lazy+import qualified Data.Time as Time import qualified Data.Vector import qualified Dhall.Core as Core import qualified Dhall.Map@@ -212,8 +225,8 @@ implement `Generic`. This does not auto-generate an instance for recursive types. - The default instance can be tweaked using 'genericAutoWith' and custom- 'InterpretOptions', or using+ The default instance can be tweaked using 'genericAutoWith'/'genericAutoWithInputNormalizer'+ and custom 'InterpretOptions', or using [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) and 'Dhall.Deriving.Codec' from "Dhall.Deriving". -}@@ -308,6 +321,24 @@ instance FromDhall a => FromDhall (Vector a) where autoWith opts = vector (autoWith opts) +instance FromDhall Time.TimeOfDay where+ autoWith _ = timeOfDay++instance FromDhall Time.Day where+ autoWith _ = day++instance FromDhall Time.TimeZone where+ autoWith _ = timeZone++instance FromDhall Time.LocalTime where+ autoWith _ = localTime++instance FromDhall Time.ZonedTime where+ autoWith _ = zonedTime++instance FromDhall Time.UTCTime where+ autoWith _ = utcTime+ {-| Note that this instance will throw errors in the presence of duplicates in the list. To ignore duplicates, use `setIgnoringDuplicates`. -}@@ -669,7 +700,13 @@ {-| `genericAutoWith` is a configurable version of `genericAuto`. -} genericAutoWith :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> Decoder a-genericAutoWith options = withProxy (\p -> fmap to (evalState (genericAutoWithNormalizer p defaultInputNormalizer options) 1))+genericAutoWith options = genericAutoWithInputNormalizer options defaultInputNormalizer++{-| `genericAutoWithInputNormalizer` is like `genericAutoWith`, but instead of+ using the `defaultInputNormalizer` it expects an custom `InputNormalizer`.+-}+genericAutoWithInputNormalizer :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> InputNormalizer -> Decoder a+genericAutoWithInputNormalizer options inputNormalizer = withProxy (\p -> fmap to (evalState (genericAutoWithNormalizer p inputNormalizer options) 1)) where withProxy :: (Proxy a -> Decoder a) -> Decoder a withProxy f = f Proxy@@ -892,6 +929,78 @@ extract expr = typeError expected expr expected = pure Text++{-| Decode `Time.TimeOfDay`++>>> input timeOfDay "00:00:00"+00:00:00+-}+timeOfDay :: Decoder Time.TimeOfDay+timeOfDay = Decoder {..}+ where+ extract (TimeLiteral t _) = pure t+ extract expr = typeError expected expr++ expected = pure Time++{-| Decode `Time.Day`++>>> input day "2000-01-01"+2000-01-01+-}+day :: Decoder Time.Day+day = Decoder {..}+ where+ extract (DateLiteral d) = pure d+ extract expr = typeError expected expr++ expected = pure Date++{-| Decode `Time.TimeZone`++>>> input timeZone "+00:00"++0000+-}+timeZone :: Decoder Time.TimeZone+timeZone = Decoder {..}+ where+ extract (TimeZoneLiteral z) = pure z+ extract expr = typeError expected expr++ expected = pure TimeZone++{-| Decode `Time.LocalTime`++>>> input localTime "2020-01-01T12:34:56"+2020-01-01 12:34:56+-}+localTime :: Decoder Time.LocalTime+localTime = record $+ Time.LocalTime+ <$> field "date" day+ <*> field "time" timeOfDay++{-| Decode `Time.ZonedTime`++>>> input zonedTime "2020-01-01T12:34:56+02:00"+2020-01-01 12:34:56 +0200+-}+zonedTime :: Decoder Time.ZonedTime+zonedTime = record $+ adapt+ <$> field "date" day+ <*> field "time" timeOfDay+ <*> field "timeZone" timeZone+ where+ adapt date time = Time.ZonedTime (Time.LocalTime date time)++{-| Decode `Time.UTCTime`++>>> input utcTime "2020-01-01T12:34:56+02:00"+2020-01-01 10:34:56 UTC+-}+utcTime :: Decoder Time.UTCTime+utcTime = Time.zonedTimeToUTC <$> zonedTime {-| Decode a `Maybe`.
src/Dhall/Marshal/Encode.hs view
@@ -41,6 +41,7 @@ , GenericToDhall(..) , genericToDhall , genericToDhallWith+ , genericToDhallWithInputNormalizer , InterpretOptions(..) , SingletonConstructors(..) , defaultInterpretOptions@@ -82,6 +83,7 @@ import qualified Data.Set import qualified Data.Text import qualified Data.Text.Lazy+import qualified Data.Time as Time import qualified Data.Vector import qualified Data.Void import qualified Dhall.Core as Core@@ -126,8 +128,8 @@ implement `Generic`. This does not auto-generate an instance for recursive types. - The default instance can be tweaked using 'genericToDhallWith' and custom- 'InterpretOptions', or using+ The default instance can be tweaked using 'genericToDhallWith'/'genericToDhallWithInputNormalizer'+ and custom 'InterpretOptions', or using [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) and 'Dhall.Deriving.Codec' from "Dhall.Deriving". -}@@ -311,6 +313,47 @@ instance ToDhall a => ToDhall (Vector a) where injectWith = fmap (contramap Data.Vector.toList) injectWith +instance ToDhall Time.TimeOfDay where+ injectWith _ = Encoder {..}+ where+ embed timeOfDay = TimeLiteral timeOfDay 12++ declared = Time++instance ToDhall Time.Day where+ injectWith _ = Encoder {..}+ where+ embed = DateLiteral++ declared = Date++instance ToDhall Time.TimeZone where+ injectWith _ = Encoder {..}+ where+ embed = TimeZoneLiteral++ declared = TimeZone++instance ToDhall Time.LocalTime where+ injectWith _ = recordEncoder $+ adapt+ >$< encodeField "date"+ >*< encodeField "time"+ where+ adapt (Time.LocalTime date time) = (date, time)++instance ToDhall Time.ZonedTime where+ injectWith _ = recordEncoder $+ adapt+ >$< encodeField "date"+ >*< encodeField "time"+ >*< encodeField "timeZone"+ where+ adapt (Time.ZonedTime (Time.LocalTime date time) timeZone) = (date, (time, timeZone))++instance ToDhall Time.UTCTime where+ injectWith = contramap (Time.utcToZonedTime Time.utc) . injectWith+ {-| Note that the output list will be sorted. >>> let x = Data.Set.fromList ["mom", "hi" :: Text]@@ -703,8 +746,16 @@ -} genericToDhallWith :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a-genericToDhallWith options- = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer defaultInputNormalizer options) 1)+genericToDhallWith options = genericToDhallWithInputNormalizer options defaultInputNormalizer++{-| `genericToDhallWithInputNormalizer` is like `genericToDhallWith`, but+ instead of using the `defaultInputNormalizer` it expects an custom+ `InputNormalizer`.+-}+genericToDhallWithInputNormalizer+ :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> InputNormalizer -> Encoder a+genericToDhallWithInputNormalizer options inputNormalizer+ = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer inputNormalizer options) 1)
src/Dhall/Normalize.hs view
@@ -23,7 +23,7 @@ import Control.Applicative (empty) import Data.Foldable import Data.Functor.Identity (Identity (..))-import Data.List.NonEmpty (NonEmpty(..))+import Data.List.NonEmpty (NonEmpty (..)) import Data.Sequence (ViewL (..), ViewR (..)) import Data.Traversable import Instances.TH.Lift ()
src/Dhall/Optics.hs view
@@ -20,7 +20,7 @@ import Control.Applicative (Const (..), WrappedMonad (..)) import Data.Functor.Contravariant (Contravariant (contramap)) import Data.Profunctor (Profunctor (dimap))-import Data.Profunctor.Unsafe (( #. ))+import Data.Profunctor.Unsafe ((#.)) import Lens.Family (ASetter, LensLike, LensLike', over) -- | Identical to @"Control.Lens".`Control.Lens.rewriteOf`@
src/Dhall/Parser.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} -- | This module contains Dhall's parsing logic
src/Dhall/Parser/Combinators.hs view
@@ -23,24 +23,24 @@ ) where -import Control.Applicative (Alternative (..), liftA2)-import Control.Exception (Exception)-import Control.Monad (MonadPlus (..))-import Data.String (IsString (..))-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Pretty (..))-import Data.Void (Void)-import Dhall.Map (Map)-import Dhall.Src (Src (..))-import Text.Parser.Combinators (try, (<?>))-import Text.Parser.Token (TokenParsing (..))+import Control.Applicative (Alternative (..), liftA2)+import Control.Exception (Exception)+import Control.Monad (MonadPlus (..))+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Map (Map)+import Dhall.Src (Src (..))+import Prettyprinter (Pretty (..))+import Text.Parser.Combinators (try, (<?>))+import Text.Parser.Token (TokenParsing (..)) import qualified Control.Monad.Fail-import qualified Data.Char as Char+import qualified Data.Char as Char import qualified Data.Text-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty import qualified Dhall.Map import qualified Dhall.Pretty+import qualified Prettyprinter.Render.String as Pretty import qualified Text.Megaparsec import qualified Text.Megaparsec.Char import qualified Text.Parser.Char@@ -136,13 +136,7 @@ -- {-# INLINE mplus #-} instance Text.Megaparsec.MonadParsec Void Text Parser where-#if MIN_VERSION_megaparsec(8, 0, 0) parseError e = Parser (Text.Megaparsec.parseError e)-#else- failure u e = Parser (Text.Megaparsec.failure u e)-- fancyFailure e = Parser (Text.Megaparsec.fancyFailure e)-#endif label l (Parser p) = Parser (Text.Megaparsec.label l p)
src/Dhall/Parser/Expression.hs view
@@ -8,7 +8,6 @@ module Dhall.Parser.Expression where import Control.Applicative (Alternative (..), liftA2, optional)-import Data.ByteArray.Encoding (Base (..)) import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)@@ -19,8 +18,7 @@ import qualified Control.Monad import qualified Control.Monad.Combinators as Combinators import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty-import qualified Data.ByteArray.Encoding-import qualified Data.ByteString+import qualified Data.ByteString.Base16 as Base16 import qualified Data.Char as Char import qualified Data.List import qualified Data.List.NonEmpty as NonEmpty@@ -107,6 +105,7 @@ data Parsers a = Parsers { completeExpression_ :: Parser (Expr Src a) , importExpression_ :: Parser (Expr Src a)+ , letBinding :: Parser (Binding Src a) } {-| Parse a numeric `TimeZone`@@ -237,10 +236,14 @@ -- | Given a parser for imports, parsers :: forall a. Parser a -> Parsers a-parsers embedded = Parsers {..}+parsers embedded = Parsers{..} where completeExpression_ =- many shebang *> whitespace *> expression <* whitespace+ many shebang+ *> whitespace+ *> expression+ <* whitespace+ <* optional lineCommentPrefix shebang = do _ <- text "#!"@@ -251,6 +254,34 @@ endOfLine + letBinding = do+ src0 <- try (_let *> src nonemptyWhitespace)++ c <- label++ src1 <- src whitespace++ d <- optional (do+ _colon++ src2 <- src nonemptyWhitespace++ e <- expression++ whitespace++ return (Just src2, e) )++ _equal++ src3 <- src whitespace++ f <- expression++ whitespace++ return (Binding (Just src0) c (Just src1) d (Just src3) f)+ expression = noted ( choice@@ -293,35 +324,7 @@ return (BoolIf a b c) alternative2 = do- let binding = do- src0 <- try (_let *> src nonemptyWhitespace)-- c <- label-- src1 <- src whitespace-- d <- optional (do- _colon-- src2 <- src nonemptyWhitespace-- e <- expression-- whitespace-- return (Just src2, e) )-- _equal-- src3 <- src whitespace-- f <- expression-- whitespace-- return (Binding (Just src0) c (Just src1) d (Just src3) f)-- as <- NonEmpty.some1 binding+ as <- NonEmpty.some1 letBinding try (_in *> nonemptyWhitespace) @@ -413,15 +416,15 @@ nonemptyWhitespace case (shallowDenote a, a0Info) of (ListLit Nothing [], _) -> do- b <- applicationExpression+ b <- expression return (ListLit (Just b) []) (Merge c d Nothing, NakedMergeOrSomeOrToMap) -> do- b <- applicationExpression+ b <- expression return (Merge c d (Just b)) (ToMap c Nothing, NakedMergeOrSomeOrToMap) -> do- b <- applicationExpression+ b <- expression return (ToMap c (Just b)) _ -> do@@ -1063,8 +1066,6 @@ let emptyUnionType = do try (optional (_bar *> whitespace) *> _closeAngle) - _ <- optional (_bar *> whitespace)- return (Union mempty) nonEmptyUnionType <|> emptyUnionType ) <?> "literal"@@ -1197,9 +1198,9 @@ _ <- text "sha256:" t <- count 64 (satisfy hexdig <?> "hex digit") let strictBytes16 = Data.Text.Encoding.encodeUtf8 t- strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of+ strictBytes <- case Base16.decode strictBytes16 of Left string -> fail string- Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString)+ Right strictBytes -> return strictBytes case Dhall.Crypto.sha256DigestFromByteString strictBytes of Nothing -> fail "Invalid sha256 hash" Just h -> pure h
src/Dhall/Parser/Token.hs view
@@ -8,6 +8,7 @@ validCodepoint, whitespace, lineComment,+ lineCommentPrefix, blockComment, nonemptyWhitespace, bashEnvironmentVariable,@@ -464,19 +465,22 @@ where predicate c = 'a' <= c && c <= 'f' --- | Parse a Dhall's single-line comment, starting from `--` and until the--- last character of the line /before/ the end-of-line character-lineComment :: Parser Text-lineComment = do+-- | Same as `lineComment` except that this doesn't parse the end-of-line+-- character+lineCommentPrefix :: Parser Text+lineCommentPrefix = do _ <- text "--" let predicate c = ('\x20' <= c && c <= '\x10FFFF') || c == '\t' commentText <- Dhall.Parser.Combinators.takeWhile predicate - _ <- endOfLine- return ("--" <> commentText)++-- | Parse a Dhall's single-line comment, starting from `--` and until the+-- last character of the line /before/ the end-of-line character+lineComment :: Parser Text+lineComment = try (lineCommentPrefix <* endOfLine) -- | Parsed text doesn't include opening braces blockComment :: Parser Text
src/Dhall/Pretty/Internal.hs view
@@ -79,7 +79,6 @@ import Data.Foldable import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, Pretty, space) import Dhall.Map (Map) import Dhall.Optics (cosmosOf, foldOf, to) import Dhall.Src (Src (..))@@ -87,20 +86,21 @@ import GHC.Generics (Generic) import Language.Haskell.TH.Syntax (Lift) import Numeric.Natural (Natural)+import Prettyprinter (Doc, Pretty, space) import qualified Data.Char import qualified Data.HashSet-import qualified Data.List as List-import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.List as List+import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe-import qualified Data.Text as Text-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty-import qualified Data.Time as Time-import qualified Dhall.Map as Map-import qualified Text.Printf as Printf+import qualified Data.Text as Text+import qualified Data.Time as Time+import qualified Dhall.Map as Map+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.String as Pretty+import qualified Prettyprinter.Render.Terminal as Terminal+import qualified Prettyprinter.Render.Text as Pretty+import qualified Text.Printf as Printf {-| Annotation type used to tag elements in a pretty-printed document for syntax highlighting purposes@@ -861,7 +861,7 @@ <> Pretty.indent 2 (prettyImportExpression_ b) <> Pretty.hardline <> colon <> space- <> prettyApplicationExpression c+ <> prettyExpression c ) short = keyword "merge" <> space@@ -869,7 +869,7 @@ <> " " <> prettyImportExpression_ b <> space <> colon <> space- <> prettyApplicationExpression c+ <> prettyExpression c prettyAnnotatedExpression (ToMap a (Just b)) = Pretty.group (Pretty.flatAlt long short) where@@ -880,13 +880,13 @@ <> Pretty.indent 2 (prettyImportExpression_ a) <> Pretty.hardline <> colon <> space- <> prettyApplicationExpression b+ <> prettyExpression b ) short = keyword "toMap" <> space <> prettyImportExpression_ a <> space <> colon <> space- <> prettyApplicationExpression b+ <> prettyExpression b prettyAnnotatedExpression a0@(Annot _ _) = enclose' ""@@ -906,7 +906,7 @@ prettyAnnotatedExpression (ListLit (Just a) b) = list (map prettyExpression (Data.Foldable.toList b)) <> " : "- <> prettyApplicationExpression a+ <> prettyExpression a prettyAnnotatedExpression a | Just doc <- preserveSource a = doc
src/Dhall/Pretty/Internal.hs-boot view
@@ -3,7 +3,7 @@ import Control.DeepSeq (NFData) import Data.Data (Data) import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Pretty, Doc)+import Prettyprinter (Pretty, Doc) import Dhall.Src (Src) import Language.Haskell.TH.Syntax (Lift)
src/Dhall/Repl.hs view
@@ -18,9 +18,9 @@ , displayException , throwIO )-import Control.Monad (forM_)+import Control.Monad (forM_) #if !(MIN_VERSION_base(4,13,0))-import Control.Monad.Fail (MonadFail)+import Control.Monad.Fail (MonadFail) #endif import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State.Class (MonadState, get, modify)@@ -45,35 +45,36 @@ import System.Directory (getDirectoryContents) import System.Environment (getEnvironment) -import qualified Control.Monad.Fail as Fail-import qualified Control.Monad.Trans.State.Strict as State+import qualified Control.Monad.Fail as Fail+import qualified Control.Monad.Trans.State.Strict as State import qualified Data.HashSet-import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty (renderIO)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO import qualified Dhall import qualified Dhall.Context import qualified Dhall.Core-import qualified Dhall.Core as Dhall+import qualified Dhall.Core as Dhall ( Expr , Var (V) , normalize )-import qualified Dhall.Core as Expr (Expr (..))-import qualified Dhall.Import as Dhall-import qualified Dhall.Map as Map-import qualified Dhall.Parser as Dhall-import qualified Dhall.Parser.Token as Parser.Token+import qualified Dhall.Core as Expr (Expr (..))+import qualified Dhall.Import as Dhall+import qualified Dhall.Map as Map+import qualified Dhall.Parser as Dhall+import qualified Dhall.Parser.Expression as Parser.Expression import qualified Dhall.Pretty import qualified Dhall.Pretty.Internal-import qualified Dhall.TypeCheck as Dhall-import qualified Dhall.Version as Meta+import qualified Dhall.Syntax as Syntax+import qualified Dhall.TypeCheck as Dhall+import qualified Dhall.Version as Meta+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.Terminal as Pretty (renderIO) import qualified System.Console.ANSI-import qualified System.Console.Haskeline.Completion as Haskeline-import qualified System.Console.Repline as Repline+import qualified System.Console.Haskeline.Completion as Haskeline+import qualified System.Console.Repline as Repline import qualified System.IO-import qualified Text.Megaparsec as Megaparsec+import qualified Text.Megaparsec as Megaparsec #if MIN_VERSION_haskeline(0,8,0) import qualified Control.Monad.Catch@@ -234,31 +235,51 @@ | otherwise = Left (trim str) -addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => Either String (String, String) -> m ()-addBinding (Right (k, src)) = do- varName <- case Megaparsec.parse (unParser Parser.Token.label) "(input)" (Text.pack k) of- Left _ -> Fail.fail "Invalid variable name"- Right varName -> return varName+addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => String -> m ()+addBinding string = do+ let parseBinding =+ Parser.Expression.letBinding+ (Parser.Expression.parsers+ (Megaparsec.try Parser.Expression.import_)+ ) - loaded <- parseAndLoad src+ let input = "let " <> Text.pack string - t <- typeCheck loaded+ Syntax.Binding{ variable, annotation, value } <- case Megaparsec.parse (unParser parseBinding) "(input)" input of+ Left _ -> Fail.fail ":let should be of the form `:let x [: T] = y`"+ Right binding -> return binding - expr <- normalize loaded+ (resolved, bindingType) <- case annotation of+ Just (_, unresolvedType) -> do+ let annotated = Syntax.Annot value unresolvedType + resolved <- liftIO (Dhall.load annotated)++ _ <- typeCheck resolved++ bindingType <- liftIO (Dhall.load unresolvedType)++ return (resolved, bindingType)+ _ -> do+ resolved <- liftIO (Dhall.load value)++ bindingType <- typeCheck resolved++ return (resolved, bindingType)++ bindingExpr <- normalize resolved+ modify ( \e -> e { envBindings = Dhall.Context.insert- varName- Binding { bindingType = t, bindingExpr = expr }+ variable+ Binding{ bindingType, bindingExpr } ( envBindings e ) } ) - output ( Expr.Annot ( Expr.Var ( Dhall.V varName 0 ) ) t )--addBinding _ = Fail.fail ":let should be of the form `:let x = y`"+ output (Expr.Annot (Expr.Var (Dhall.V variable 0)) bindingType) clearBindings :: (MonadFail m, MonadState Env m) => String -> m () clearBindings _ = modify adapt@@ -476,7 +497,7 @@ "let" "IDENTIFIER = EXPRESSION" "Assign an expression to a variable"- (dontCrash . addBinding . parseAssignment)+ (dontCrash . addBinding) , HelpOption "clear" ""
src/Dhall/Schemas.hs view
@@ -27,34 +27,34 @@ import Dhall.Syntax (Expr (..), Import, Var (..)) import Dhall.Util ( Censor (..)- , MultipleCheckFailed (..) , Header (..) , Input (..)+ , MultipleCheckFailed (..) , OutputMode (..) ) -import qualified Control.Exception as Exception+import qualified Control.Exception as Exception import qualified Data.Map-import qualified Data.Maybe as Maybe-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text-import qualified Data.Void as Void-import qualified Dhall.Core as Core-import qualified Dhall.Import as Import-import qualified Dhall.Map as Map-import qualified Dhall.Normalize as Normalize-import qualified Dhall.Optics as Optics-import qualified Dhall.Parser as Parser+import qualified Data.Maybe as Maybe+import qualified Data.Text.IO as Text.IO+import qualified Data.Void as Void+import qualified Dhall.Core as Core+import qualified Dhall.Import as Import+import qualified Dhall.Map as Map+import qualified Dhall.Normalize as Normalize+import qualified Dhall.Optics as Optics+import qualified Dhall.Parser as Parser import qualified Dhall.Pretty-import qualified Dhall.Substitution as Substitution-import qualified Dhall.Syntax as Syntax-import qualified Dhall.TypeCheck as TypeCheck-import qualified Dhall.Util as Util-import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite-import qualified System.Console.ANSI as ANSI-import qualified System.IO as IO+import qualified Dhall.Substitution as Substitution+import qualified Dhall.Syntax as Syntax+import qualified Dhall.TypeCheck as TypeCheck+import qualified Dhall.Util as Util+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.Terminal as Pretty.Terminal+import qualified Prettyprinter.Render.Text as Pretty.Text+import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite+import qualified System.Console.ANSI as ANSI+import qualified System.IO as IO -- | Arguments to the @rewrite-with-schemas@ subcommand data Schemas = Schemas
src/Dhall/Src.hs view
@@ -15,10 +15,10 @@ import Control.DeepSeq (NFData) import Data.Data (Data) import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Pretty (..)) import GHC.Generics (Generic) import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift (..))+import Prettyprinter (Pretty (..)) import Text.Megaparsec (SourcePos (SourcePos), mkPos, unPos) import {-# SOURCE #-} qualified Dhall.Util
src/Dhall/Syntax.hs view
@@ -46,6 +46,7 @@ -- ** Optics , subExpressions+ , subExpressionsWith , unsafeSubExpressions , chunkExprs , bindingExprs@@ -89,39 +90,39 @@ , shift ) where -import Control.DeepSeq (NFData)-import Data.Bifunctor (Bifunctor (..))-import Data.Bits (xor)-import Data.Data (Data)-import Data.Foldable-import Data.HashSet (HashSet)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Sequence (Seq)-import Data.String (IsString (..))-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, Pretty)-import Data.Traversable ()-import Data.Void (Void)-import Dhall.Map (Map)+import Control.DeepSeq (NFData)+import Data.Bifunctor (Bifunctor (..))+import Data.Bits (xor)+import Data.Data (Data)+import Data.Foldable+import Data.HashSet (HashSet)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Sequence (Seq)+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Traversable ()+import Data.Void (Void)+import Dhall.Map (Map) import {-# SOURCE #-} Dhall.Pretty.Internal-import Dhall.Src (Src (..))-import GHC.Generics (Generic)-import Instances.TH.Lift ()-import Language.Haskell.TH.Syntax (Lift)-import Numeric.Natural (Natural)-import Unsafe.Coerce (unsafeCoerce)+import Dhall.Src (Src (..))+import GHC.Generics (Generic)+import Instances.TH.Lift ()+import Language.Haskell.TH.Syntax (Lift)+import Numeric.Natural (Natural)+import Prettyprinter (Doc, Pretty)+import Unsafe.Coerce (unsafeCoerce) import qualified Control.Monad-import qualified Data.Fixed as Fixed+import qualified Data.Fixed as Fixed import qualified Data.HashSet-import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Time as Time+import qualified Data.Time as Time import qualified Dhall.Crypto-import qualified Dhall.Optics as Optics-import qualified Lens.Family as Lens-import qualified Network.URI as URI+import qualified Dhall.Optics as Optics+import qualified Lens.Family as Lens+import qualified Network.URI as URI+import qualified Prettyprinter as Pretty deriving instance Lift Time.Day deriving instance Lift Time.TimeOfDay@@ -371,19 +372,19 @@ RecordField (k <$> s0) (first k value) (k <$> s1) (k <$> s2) second = fmap -{-| Record the label of a function or a function-type expression--For example,--> λ({- A -} a {- B -} : {- C -} T) -> e--will be instantiated as follows:-* @functionBindingSrc0@ corresponds to the @A@ comment-* @functionBindingVariable@ is @a@-* @functionBindingSrc1@ corresponds to the @B@ comment-* @functionBindingSrc2@ corresponds to the @C@ comment-* @functionBindingAnnotation@ is @T@--}+-- | Record the label of a function or a function-type expression+--+-- For example,+--+-- > λ({- A -} a {- B -} : {- C -} T) -> e+--+-- … will be instantiated as follows:+--+-- * @functionBindingSrc0@ corresponds to the @A@ comment+-- * @functionBindingVariable@ is @a@+-- * @functionBindingSrc1@ corresponds to the @B@ comment+-- * @functionBindingSrc2@ corresponds to the @C@ comment+-- * @functionBindingAnnotation@ is @T@ data FunctionBinding s a = FunctionBinding { functionBindingSrc0 :: Maybe s , functionBindingVariable :: Text@@ -782,15 +783,23 @@ -- | A traversal over the immediate sub-expressions of an expression. subExpressions :: Applicative f => (Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)-subExpressions _ (Embed a) = pure (Embed a)-subExpressions f (Note a b) = Note a <$> f b-subExpressions f (Let a b) = Let <$> bindingExprs f a <*> f b-subExpressions f (Record a) = Record <$> traverse (recordFieldExprs f) a-subExpressions f (RecordLit a) = RecordLit <$> traverse (recordFieldExprs f) a-subExpressions f (Lam cs fb e) = Lam cs <$> functionBindingExprs f fb <*> f e-subExpressions f (Field a b) = Field <$> f a <*> pure b-subExpressions f expression = unsafeSubExpressions f expression+subExpressions = subExpressionsWith (pure . Embed) {-# INLINABLE subExpressions #-}++{-| A traversal over the immediate sub-expressions of an expression which+ allows mapping embedded values+-}+subExpressionsWith+ :: Applicative f => (a -> f (Expr s b)) -> (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b)+subExpressionsWith h _ (Embed a) = h a+subExpressionsWith _ f (Note a b) = Note a <$> f b+subExpressionsWith _ f (Let a b) = Let <$> bindingExprs f a <*> f b+subExpressionsWith _ f (Record a) = Record <$> traverse (recordFieldExprs f) a+subExpressionsWith _ f (RecordLit a) = RecordLit <$> traverse (recordFieldExprs f) a+subExpressionsWith _ f (Lam cs fb e) = Lam cs <$> functionBindingExprs f fb <*> f e+subExpressionsWith _ f (Field a b) = Field <$> f a <*> pure b+subExpressionsWith _ f expression = unsafeSubExpressions f expression+{-# INLINABLE subExpressionsWith #-} {-| An internal utility used to implement transformations that require changing one of the type variables of the `Expr` type
src/Dhall/TH.hs view
@@ -6,26 +6,33 @@ -- | Template Haskell utilities module Dhall.TH- ( -- * Template Haskell+ ( -- * Embedding Dhall in Haskell staticDhallExpression , dhall+ -- * Generating Haskell from Dhall expressions , makeHaskellTypeFromUnion , makeHaskellTypes+ , makeHaskellTypesWith , HaskellType(..)+ , GenerateOptions(..)+ , defaultGenerateOptions ) where import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Pretty) import Dhall (FromDhall, ToDhall) import Dhall.Syntax (Expr (..)) import GHC.Generics (Generic) import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ)+import Prettyprinter (Pretty) import Language.Haskell.TH.Syntax ( Bang (..)+ , Body (..) , Con (..) , Dec (..) , Exp (..)+ , Match (..)+ , Pat (..) , Q , SourceStrictness (..) , SourceUnpackedness (..)@@ -34,18 +41,19 @@ import Language.Haskell.TH.Syntax (DerivClause (..), DerivStrategy (..)) -import qualified Data.List as List-import qualified Data.Text as Text-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty-import qualified Data.Typeable as Typeable+import qualified Data.List as List+import qualified Data.Set as Set+import qualified Data.Text as Text+import qualified Data.Typeable as Typeable import qualified Dhall-import qualified Dhall.Core as Core+import qualified Dhall.Core as Core import qualified Dhall.Map import qualified Dhall.Pretty import qualified Dhall.Util import qualified GHC.IO.Encoding-import qualified Language.Haskell.TH.Syntax as Syntax+import qualified Language.Haskell.TH.Syntax as Syntax import qualified Numeric.Natural+import qualified Prettyprinter.Render.String as Pretty import qualified System.IO {-| This fully resolves, type checks, and normalizes the expression, so the@@ -179,27 +187,54 @@ predicate haskellType = Core.judgmentallyEqual (code haskellType) dhallType -derivingClauses :: [DerivClause]-derivingClauses =- [ DerivClause (Just StockStrategy) [ ConT ''Generic ]- , DerivClause (Just AnyclassStrategy) [ ConT ''FromDhall, ConT ''ToDhall ]- ]+-- | A deriving clause for `Generic`.+derivingGenericClause :: DerivClause+derivingGenericClause = DerivClause (Just StockStrategy) [ ConT ''Generic ] +-- | Generates a `FromDhall` instances.+fromDhallInstance+ :: Syntax.Name -- ^ The name of the type the instances is for+ -> Q Exp -- ^ A TH splice generating some `Dhall.InterpretOptions`+ -> Q [Dec]+fromDhallInstance n interpretOptions = [d|+ instance FromDhall $(pure $ ConT n) where+ autoWith = Dhall.genericAutoWithInputNormalizer $(interpretOptions)+ |]++-- | Generates a `ToDhall` instances.+toDhallInstance+ :: Syntax.Name -- ^ The name of the type the instances is for+ -> Q Exp -- ^ A TH splice generating some `Dhall.InterpretOptions`+ -> Q [Dec]+toDhallInstance n interpretOptions = [d|+ instance ToDhall $(pure $ ConT n) where+ injectWith = Dhall.genericToDhallWithInputNormalizer $(interpretOptions)+ |]+ -- | Convert a Dhall type to the corresponding Haskell datatype declaration toDeclaration :: (Eq a, Pretty a)- => [HaskellType (Expr s a)]+ => GenerateOptions+ -> [HaskellType (Expr s a)] -> HaskellType (Expr s a)- -> Q Dec-toDeclaration haskellTypes MultipleConstructors{..} =+ -> Q [Dec]+toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ@MultipleConstructors{..} = case code of Union kts -> do let name = Syntax.mkName (Text.unpack typeName) - constructors <- traverse (toConstructor haskellTypes typeName) (Dhall.Map.toList kts )+ let derivingClauses =+ [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] - return (DataD [] name [] Nothing constructors derivingClauses)+ constructors <- traverse (toConstructor generateOptions haskellTypes typeName) (Dhall.Map.toList kts) + let interpretOptions = generateToInterpretOptions generateOptions typ++ fmap concat . sequence $+ [pure [DataD [] name [] Nothing constructors derivingClauses]] <>+ [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <>+ [ toDhallInstance name interpretOptions | generateToDhallInstance ]+ _ -> do let document = mconcat@@ -242,24 +277,33 @@ let message = Pretty.renderString (Dhall.Pretty.layout document) fail message-toDeclaration haskellTypes SingleConstructor{..} = do+toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ@SingleConstructor{..} = do let name = Syntax.mkName (Text.unpack typeName) - constructor <- toConstructor haskellTypes typeName (constructorName, Just code)+ let derivingClauses =+ [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] - return (DataD [] name [] Nothing [constructor] derivingClauses)+ let interpretOptions = generateToInterpretOptions generateOptions typ + constructor <- toConstructor generateOptions haskellTypes typeName (constructorName, Just code)++ fmap concat . sequence $+ [pure [DataD [] name [] Nothing [constructor] derivingClauses]] <>+ [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <>+ [ toDhallInstance name interpretOptions | generateToDhallInstance ]+ -- | Convert a Dhall type to the corresponding Haskell constructor toConstructor :: (Eq a, Pretty a)- => [HaskellType (Expr s a)]+ => GenerateOptions+ -> [HaskellType (Expr s a)] -> Text -- ^ typeName -> (Text, Maybe (Expr s a)) -- ^ @(constructorName, fieldType)@ -> Q Con-toConstructor haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do- let name = Syntax.mkName (Text.unpack constructorName)+toConstructor GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do+ let name = Syntax.mkName (Text.unpack $ constructorModifier constructorName) let bang = Bang NoSourceUnpackedness NoSourceStrictness @@ -278,7 +322,7 @@ let process (key, dhallFieldType) = do haskellFieldType <- toNestedHaskellType haskellTypes dhallFieldType - return (Syntax.mkName (Text.unpack key), bang, haskellFieldType)+ return (Syntax.mkName (Text.unpack $ fieldModifier key), bang, haskellFieldType) varBangTypes <- traverse process (Dhall.Map.toList $ Core.recordFieldValue <$> kts) @@ -316,17 +360,18 @@ makeHaskellTypeFromUnion typeName code = makeHaskellTypes [ MultipleConstructors{..} ] --- | Used by `makeHaskellTypes` to specify how to generate Haskell types+-- | Used by `makeHaskellTypes` and `makeHaskellTypesWith` to specify how to+-- generate Haskell types. data HaskellType code -- | Generate a Haskell type with more than one constructor from a Dhall- -- union type+ -- union type. = MultipleConstructors { typeName :: Text -- ^ Name of the generated Haskell type , code :: code -- ^ Dhall code that evaluates to a union type }- -- | Generate a Haskell type with one constructor from any Dhall type+ -- | Generate a Haskell type with one constructor from any Dhall type. -- -- To generate a constructor with multiple named fields, supply a Dhall -- record type. This does not support more than one anonymous field.@@ -340,8 +385,82 @@ } deriving (Functor, Foldable, Traversable) +-- | This data type holds various options that let you control several aspects+-- how Haskell code is generated. In particular you can+--+-- * disable the generation of `FromDhall`/`ToDhall` instances.+-- * modify how a Dhall union field translates to a Haskell data constructor.+data GenerateOptions = GenerateOptions+ { constructorModifier :: Text -> Text+ -- ^ How to map a Dhall union field name to a Haskell constructor.+ -- Note: The `constructorName` of `SingleConstructor` will be passed to this function, too.+ , fieldModifier :: Text -> Text+ -- ^ How to map a Dhall record field names to a Haskell record field names.+ , generateFromDhallInstance :: Bool+ -- ^ Generate a `FromDhall` instance for the Haskell type+ , generateToDhallInstance :: Bool+ -- ^ Generate a `ToDhall` instance for the Haskell type+ }++-- | A default set of options used by `makeHaskellTypes`. That means:+--+-- * Constructors and fields are passed unmodified.+-- * Both `FromDhall` and `ToDhall` instances are generated.+defaultGenerateOptions :: GenerateOptions+defaultGenerateOptions = GenerateOptions+ { constructorModifier = id+ , fieldModifier = id+ , generateFromDhallInstance = True+ , generateToDhallInstance = True+ }++-- | This function generates `Dhall.InterpretOptions` that can be used for the+-- marshalling of the Haskell type generated according to the `GenerateOptions`.+-- I.e. those `Dhall.InterpretOptions` reflect the mapping done by+-- `constructorModifier` and `fieldModifier` on the value level.+generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp+generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretOptions+ { Dhall.fieldModifier = \ $(pure nameP) ->+ $(toCases fieldModifier $ fields haskellType)+ , Dhall.constructorModifier = \ $(pure nameP) ->+ $(toCases constructorModifier $ constructors haskellType)+ , Dhall.singletonConstructors = Dhall.singletonConstructors Dhall.defaultInterpretOptions+ }|]+ where+ constructors :: HaskellType (Expr s a) -> [Text]+ constructors SingleConstructor{..} = [constructorName]+ constructors MultipleConstructors{..} | Union kts <- code = Dhall.Map.keys kts+ constructors _ = []++ fields :: HaskellType (Expr s a) -> [Text]+ fields SingleConstructor{..} | Record kts <- code = Dhall.Map.keys kts+ fields MultipleConstructors{..} | Union kts <- code = Set.toList $ mconcat+ [ Dhall.Map.keysSet kts'+ | (_, Just (Record kts')) <- Dhall.Map.toList kts+ ]+ fields _ = []++ toCases :: (Text -> Text) -> [Text] -> Q Exp+ toCases f xs = do+ err <- [| Core.internalError $ "Unmatched " <> Text.pack (show $(pure nameE)) |]+ pure $ CaseE nameE $ map mkMatch xs <> [Match WildP (NormalB err) []]+ where+ mkMatch n = Match (textToPat $ f n) (NormalB $ textToExp n) []++ nameE :: Exp+ nameE = Syntax.VarE $ Syntax.mkName "n"++ nameP :: Pat+ nameP = Syntax.VarP $ Syntax.mkName "n"++ textToExp :: Text -> Exp+ textToExp = Syntax.LitE . Syntax.StringL . Text.unpack++ textToPat :: Text -> Pat+ textToPat = Syntax.LitP . Syntax.StringL . Text.unpack+ -- | Generate a Haskell datatype declaration with one constructor from a Dhall--- type+-- type. -- -- This comes in handy if you need to keep Dhall types and Haskell types in -- sync. You make the Dhall types the source of truth and use Template Haskell@@ -416,9 +535,18 @@ -- > deriving instance Ord Employee -- > deriving instance Show Employee makeHaskellTypes :: [HaskellType Text] -> Q [Dec]-makeHaskellTypes haskellTypes = do+makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions++-- | Like `makeHaskellTypes`, but with the ability to customize the generated+-- Haskell code by passing `GenerateOptions`.+--+-- For instance, `makeHaskellTypes` is implemented using this function:+--+-- > makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions+makeHaskellTypesWith :: GenerateOptions -> [HaskellType Text] -> Q [Dec]+makeHaskellTypesWith generateOptions haskellTypes = do Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) haskellTypes' <- traverse (traverse (Syntax.runIO . Dhall.inputExpr)) haskellTypes - traverse (toDeclaration haskellTypes') haskellTypes'+ concat <$> traverse (toDeclaration generateOptions haskellTypes') haskellTypes'
src/Dhall/TypeCheck.hs view
@@ -38,7 +38,6 @@ import Data.Sequence (Seq, ViewL (..)) import Data.Set (Set) import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, Pretty (..), vsep) import Data.Typeable (Typeable) import Data.Void (Void, absurd) import Dhall.Context (Context)@@ -51,6 +50,7 @@ import Dhall.Pretty (Ann) import Dhall.Src (Src) import Lens.Family (over)+import Prettyprinter (Doc, Pretty (..), vsep) import Dhall.Syntax ( Binding (..)@@ -63,25 +63,25 @@ , Var (..) ) -import qualified Data.Foldable as Foldable-import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Foldable as Foldable+import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map import qualified Data.Sequence import qualified Data.Set-import qualified Data.Text as Text-import qualified Data.Text.Prettyprint.Doc as Pretty-import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty+import qualified Data.Text as Text import qualified Data.Traversable import qualified Dhall.Context import qualified Dhall.Core import qualified Dhall.Diff-import qualified Dhall.Eval as Eval+import qualified Dhall.Eval as Eval import qualified Dhall.Map import qualified Dhall.Pretty import qualified Dhall.Pretty.Internal-import qualified Dhall.Syntax as Syntax+import qualified Dhall.Syntax as Syntax import qualified Dhall.Util import qualified Lens.Family+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.String as Pretty {-| A type synonym for `Void`
src/Dhall/URL.hs view
@@ -3,7 +3,7 @@ module Dhall.URL where -import Data.Text (Text)+import Data.Text (Text) import Dhall.Syntax (Directory (..), File (..), Scheme (..), URL (..))
src/Dhall/Util.hs view
@@ -25,30 +25,30 @@ , renderExpression ) where -import Control.Exception (Exception (..))-import Control.Monad.IO.Class (MonadIO (..))-import Data.Bifunctor (first)-import Data.Either (lefts)-import Data.Foldable (toList)-import Data.List.NonEmpty (NonEmpty (..))-import Data.String (IsString)-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, Pretty)-import Dhall.Parser (Header (..), ParseError)-import Dhall.Pretty (Ann, CharacterSet)-import Dhall.Src (Src)-import Dhall.Syntax (Expr, Import)+import Control.Exception (Exception (..))+import Control.Monad.IO.Class (MonadIO (..))+import Data.Bifunctor (first)+import Data.Either (lefts)+import Data.Foldable (toList)+import Data.List.NonEmpty (NonEmpty (..))+import Data.String (IsString)+import Data.Text (Text)+import Dhall.Parser (Header (..), ParseError)+import Dhall.Pretty (Ann, CharacterSet)+import Dhall.Src (Src)+import Dhall.Syntax (Expr, Import)+import Prettyprinter (Doc, Pretty) 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.Terminal-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text import qualified Dhall.Parser import qualified Dhall.Pretty-import qualified System.Console.ANSI as ANSI-import qualified System.IO as IO+import qualified Prettyprinter as Pretty+import qualified Prettyprinter.Render.Terminal as Pretty.Terminal+import qualified Prettyprinter.Render.Text as Pretty.Text+import qualified System.Console.ANSI as ANSI+import qualified System.IO as IO -- | Utility function to cut out the interior of a large text block snip :: Text -> Text
tests/Dhall/Test/Dhall.hs view
@@ -16,7 +16,7 @@ import Control.Exception (SomeException, throwIO, try) import Data.Either.Validation (validationToEither) import Data.Fix (Fix (..))-import Data.Functor.Classes (Eq1(..), Show1(..))+import Data.Functor.Classes (Eq1 (..), Show1 (..)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isJust) import Data.Scientific (Scientific)
tests/Dhall/Test/Diff.hs view
@@ -2,21 +2,21 @@ module Dhall.Test.Diff where -import Data.Text (Text)-import Prelude hiding (FilePath)-import Test.Tasty (TestTree)-import Turtle (FilePath)+import Data.Text (Text)+import Prelude hiding (FilePath)+import Test.Tasty (TestTree)+import Turtle (FilePath) -import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text-import qualified Dhall.Core as Core-import qualified Dhall.Diff as Diff-import qualified Dhall.Parser as Parser+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Core as Core+import qualified Dhall.Diff as Diff+import qualified Dhall.Parser as Parser import qualified Dhall.Pretty-import qualified Dhall.Test.Util as Test.Util-import qualified Test.Tasty as Tasty-import qualified Test.Tasty.HUnit as Tasty.HUnit+import qualified Dhall.Test.Util as Test.Util+import qualified Prettyprinter.Render.Text as Pretty.Text+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty.HUnit import qualified Turtle diffDirectory :: FilePath
tests/Dhall/Test/Format.hs view
@@ -7,17 +7,17 @@ import Dhall.Pretty (CharacterSet (..)) import Test.Tasty (TestTree) -import qualified Control.Monad as Monad-import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc as Doc-import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text-import qualified Dhall.Core as Core-import qualified Dhall.Parser as Parser-import qualified Dhall.Pretty as Pretty-import qualified Dhall.Test.Util as Test.Util-import qualified Test.Tasty as Tasty-import qualified Test.Tasty.Silver as Tasty.Silver+import qualified Control.Monad as Monad+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Core as Core+import qualified Dhall.Parser as Parser+import qualified Dhall.Pretty as Pretty+import qualified Dhall.Test.Util as Test.Util+import qualified Prettyprinter as Doc+import qualified Prettyprinter.Render.Text as Doc.Render.Text+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Silver as Tasty.Silver import qualified Turtle getTests :: IO TestTree
tests/Dhall/Test/Import.hs view
@@ -3,12 +3,14 @@ module Dhall.Test.Import where -import Control.Exception (SomeException)-import Data.Text (Text)-import Data.Void (Void)-import Prelude hiding (FilePath)-import Test.Tasty (TestTree)-import Turtle (FilePath, (</>))+import Control.Exception (SomeException)+import Data.Foldable (fold)+import Data.Text (Text, isSuffixOf)+import Data.Void (Void)+import Filesystem.Path.CurrentOS (toText)+import Prelude hiding (FilePath)+import Test.Tasty (TestTree)+import Turtle (FilePath, (</>)) import qualified Control.Exception as Exception import qualified Control.Monad as Monad@@ -54,7 +56,7 @@ return path ) - failureTests <- Test.Util.discover (Turtle.chars <> ".dhall") failureTest (do+ failureTests <- Test.Util.discover (Turtle.chars <* ".dhall") failureTest (do path <- Turtle.lstree (importDirectory </> "failure") let expectedSuccesses =@@ -62,7 +64,8 @@ , importDirectory </> "failure/unit/DontRecoverTypeError.dhall" ] - Monad.guard (path `notElem` expectedSuccesses)+ _ <- Monad.guard (path `notElem` expectedSuccesses)+ _ <- Monad.guard (not ("ENV.dhall" `isSuffixOf` (fold (toText path)))) return path ) let testTree =@@ -87,8 +90,6 @@ , importDirectory </> "success/unit/cors/AllowedAll" , importDirectory </> "success/unit/cors/SelfImportRelative" , importDirectory </> "success/unit/cors/OnlyGithub"- , importDirectory </> "success/userHeaders"- , importDirectory </> "success/userHeadersOverride" ] Test.Util.testCase prefix expectedFailures (do@@ -107,10 +108,17 @@ HTTP.newManager HTTP.tlsManagerSettings { HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (120 * 1000 * 1000) }++ let status =+ Import.makeEmptyStatus+ httpManager+ (pure Import.envOriginHeaders)+ directoryString+ let load = State.evalStateT (Test.Util.loadWith actualExpr)- (Import.emptyStatusWithManager httpManager directoryString)+ status let usesCache = [ "hashFromCache" , "unit/asLocation/Hash"@@ -168,18 +176,22 @@ Tasty.HUnit.assertEqual message expected actual) failureTest :: Text -> TestTree-failureTest path = do+failureTest prefix = do+ let path = prefix <> ".dhall"+ let pathString = Text.unpack path Tasty.HUnit.testCase pathString (do actualExpr <- do Core.throws (Parser.exprFromText mempty (Test.Util.toDhallPath path)) - succeeded <- Exception.catch @SomeException- (do _ <- Test.Util.load actualExpr- return True- )- (\_ -> return False)+ let setup = Test.Util.managedTestEnvironment prefix++ let run = Exception.catch @SomeException+ (Test.Util.load actualExpr >> return True)+ (\_ -> return False)++ succeeded <- Turtle.with setup (const run) if succeeded then fail "Import should have failed, but it succeeds"
tests/Dhall/Test/Lint.hs view
@@ -8,17 +8,17 @@ import Test.Tasty (TestTree) import Turtle (FilePath) -import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc as Doc-import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text-import qualified Dhall.Core as Core-import qualified Dhall.Lint as Lint-import qualified Dhall.Parser as Parser-import qualified Dhall.Pretty as Pretty-import qualified Dhall.Test.Util as Test.Util-import qualified Test.Tasty as Tasty-import qualified Test.Tasty.HUnit as Tasty.HUnit+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Core as Core+import qualified Dhall.Lint as Lint+import qualified Dhall.Parser as Parser+import qualified Dhall.Pretty as Pretty+import qualified Dhall.Test.Util as Test.Util+import qualified Prettyprinter as Doc+import qualified Prettyprinter.Render.Text as Doc.Render.Text+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty.HUnit import qualified Turtle lintDirectory :: FilePath
tests/Dhall/Test/Main.hs view
@@ -15,8 +15,8 @@ import qualified Dhall.Test.Regression import qualified Dhall.Test.Schemas import qualified Dhall.Test.SemanticHash-import qualified Dhall.Test.Tags import qualified Dhall.Test.TH+import qualified Dhall.Test.Tags import qualified Dhall.Test.Tutorial import qualified Dhall.Test.TypeInference import qualified GHC.IO.Encoding
tests/Dhall/Test/Normalization.hs view
@@ -2,12 +2,12 @@ module Dhall.Test.Normalization where -import Data.Text (Text)-import Data.Void (Void)-import Dhall.Core (Expr (..), Var (..), throws)-import Prelude hiding (FilePath)-import Test.Tasty (TestTree)-import Turtle (FilePath, (</>))+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Core (Expr (..), Var (..), throws)+import Prelude hiding (FilePath)+import Test.Tasty (TestTree)+import Turtle (FilePath, (</>)) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO
tests/Dhall/Test/Parser.hs view
@@ -2,12 +2,12 @@ module Dhall.Test.Parser where -import Data.Text (Text)-import Data.Void (Void)-import Dhall.Core (Binding (..), Expr (..), Import, Var (..))-import Prelude hiding (FilePath)-import Test.Tasty (TestTree)-import Turtle (FilePath, (</>))+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Core (Binding (..), Expr (..), Import, Var (..))+import Prelude hiding (FilePath)+import Test.Tasty (TestTree)+import Turtle (FilePath, (</>)) import qualified Control.Monad as Monad import qualified Data.Bifunctor as Bifunctor
tests/Dhall/Test/QuickCheck.hs view
@@ -62,7 +62,7 @@ import Dhall.Src (Src (..)) import Dhall.Test.Format (format) import Dhall.TypeCheck (TypeError, Typer)-import Generic.Random ((:+) (..), ConstrGen (..), W, Weights, (%))+import Generic.Random (ConstrGen (..), W, Weights, (%), (:+) (..)) import Test.QuickCheck ( Arbitrary (..) , Gen@@ -453,12 +453,7 @@ True chooseCharacter :: (Char, Char) -> Gen Char-chooseCharacter =-#if MIN_VERSION_QuickCheck(2,14,0)- Test.QuickCheck.chooseEnum-#else- Test.QuickCheck.choose-#endif+chooseCharacter = Test.QuickCheck.chooseEnum instance Arbitrary File where arbitrary = lift2 File
tests/Dhall/Test/Regression.hs view
@@ -16,16 +16,16 @@ import qualified Control.Exception import qualified Data.Text.IO import qualified Data.Text.Lazy.IO-import qualified Data.Text.Prettyprint.Doc-import qualified Data.Text.Prettyprint.Doc.Render.Text import qualified Dhall import qualified Dhall.Context import qualified Dhall.Core import qualified Dhall.Map import qualified Dhall.Parser import qualified Dhall.Pretty-import qualified Dhall.Test.Util as Util+import qualified Dhall.Test.Util as Util import qualified Dhall.TypeCheck+import qualified Prettyprinter+import qualified Prettyprinter.Render.Text import qualified System.Timeout import qualified Test.Tasty import qualified Test.Tasty.HUnit@@ -162,9 +162,9 @@ -- Verify that pretty-printing preserves string interpolation source <- Data.Text.IO.readFile "./tests/regression/issue216b.dhall" e <- Util.code source- let doc = Data.Text.Prettyprint.Doc.pretty e+ let doc = Prettyprinter.pretty e let docStream = Dhall.Pretty.layout doc- let text0 = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream+ let text0 = Prettyprinter.Render.Text.renderLazy docStream text1 <- Data.Text.Lazy.IO.readFile "./tests/regression/issue216b.dhall"
tests/Dhall/Test/Schemas.hs view
@@ -8,17 +8,17 @@ import Test.Tasty (TestTree) import Turtle (FilePath) -import qualified Data.Text as Text-import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Prettyprint.Doc as Doc-import qualified Data.Text.Prettyprint.Doc.Render.Text as Doc.Render.Text-import qualified Dhall.Core as Core-import qualified Dhall.Parser as Parser-import qualified Dhall.Pretty as Pretty-import qualified Dhall.Schemas as Schemas-import qualified Dhall.Test.Util as Test.Util-import qualified Test.Tasty as Tasty-import qualified Test.Tasty.HUnit as Tasty.HUnit+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Core as Core+import qualified Dhall.Parser as Parser+import qualified Dhall.Pretty as Pretty+import qualified Dhall.Schemas as Schemas+import qualified Dhall.Test.Util as Test.Util+import qualified Prettyprinter as Doc+import qualified Prettyprinter.Render.Text as Doc.Render.Text+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty.HUnit import qualified Turtle schemasDirectory :: FilePath
tests/Dhall/Test/SemanticHash.hs view
@@ -2,10 +2,10 @@ module Dhall.Test.SemanticHash where -import Data.Text (Text)-import Prelude hiding (FilePath)-import Test.Tasty (TestTree)-import Turtle (FilePath)+import Data.Text (Text)+import Prelude hiding (FilePath)+import Test.Tasty (TestTree)+import Turtle (FilePath) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO
tests/Dhall/Test/TH.hs view
@@ -7,9 +7,12 @@ module Dhall.Test.TH where +import Control.Exception (throwIO)+import Data.Either.Validation (Validation(..)) import Dhall.TH (HaskellType (..)) import Test.Tasty (TestTree) +import qualified Data.Text import qualified Dhall import qualified Dhall.TH import qualified Test.Tasty as Tasty@@ -70,3 +73,83 @@ qux <- Dhall.input Dhall.auto "let T = ./tests/th/issue2066.dhall in T.Qux.Foo { foo = +2, bar = { baz = +3 } }" Tasty.HUnit.assertEqual "" qux (Foo MakeFoo{ foo = 2, bar = MakeBar{ baz = 3 } })++Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions+ { Dhall.TH.constructorModifier = ("My" <>)+ , Dhall.TH.fieldModifier = ("my" <>) . Data.Text.toTitle+ })+ [ MultipleConstructors "MyT" "./tests/th/example.dhall"+ , MultipleConstructors "MyDepartment" "./tests/th/Department.dhall"+ , SingleConstructor "MyEmployee" "Employee" "./tests/th/Employee.dhall"+ ]++deriving instance Eq MyT+deriving instance Eq MyDepartment+deriving instance Eq MyEmployee+deriving instance Show MyT+deriving instance Show MyDepartment+deriving instance Show MyEmployee++testMakeHaskellTypesWith :: TestTree+testMakeHaskellTypesWith = Tasty.HUnit.testCase "makeHaskellTypesWith" $ do+ let text0 = "let T = ./tests/th/example.dhall in T.A { x = True, y = [] : List Text }"+ ref0 = MyA{ myX = True, myY = [] }+ myTest text0 ref0++ let text1 = "let T = ./tests/th/example.dhall in T.B (None (List Natural))"+ ref1 = MyB Nothing+ myTest text1 ref1++ let text2 = "let T = ./tests/th/example.dhall in T.C"+ ref2 = MyC+ myTest text2 ref2++ let textDepartment = "let T = ./tests/th/Department.dhall in T.Sales"+ refDepartment = MySales+ myTest textDepartment refDepartment++ let textEmployee = "let T = ./tests/th/Department.dhall in T.Sales"+ refEmployee = MyEmployee{ myName = "", myDepartment = MySales }+ myTest textEmployee refEmployee+ where+ myTest text ref = do+ expr <- Dhall.inputExpr text+ t <- case Dhall.extract Dhall.auto expr of+ Failure e -> throwIO e+ Success t -> return t++ Tasty.HUnit.assertEqual "" t ref+ Tasty.HUnit.assertEqual "" expr $ Dhall.embed Dhall.inject ref++Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions+ { Dhall.TH.constructorModifier = ("NoFromDhall" <>)+ , Dhall.TH.fieldModifier = ("noFromDhall" <>) . Data.Text.toTitle+ , Dhall.TH.generateFromDhallInstance = False+ })+ [ MultipleConstructors "NoFromDhallT" "./tests/th/example.dhall"+ ]++instance Dhall.FromDhall NoFromDhallT++Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions+ { Dhall.TH.constructorModifier = ("NoToDhall" <>)+ , Dhall.TH.fieldModifier = ("noToDhall" <>) . Data.Text.toTitle+ , Dhall.TH.generateToDhallInstance = False+ })+ [ MultipleConstructors "NoToDhallT" "./tests/th/example.dhall"+ ]++instance Dhall.ToDhall NoToDhallT++Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions+ { Dhall.TH.constructorModifier = ("NoInstances" <>)+ , Dhall.TH.fieldModifier = ("noInstances" <>) . Data.Text.toTitle+ , Dhall.TH.generateFromDhallInstance = False+ , Dhall.TH.generateToDhallInstance = False+ })+ [ MultipleConstructors "NoInstancesT" "./tests/th/example.dhall"+ ]++deriving instance Dhall.Generic NoInstancesT+instance Dhall.FromDhall NoInstancesT+instance Dhall.ToDhall NoInstancesT
tests/Dhall/Test/Tags.hs view
@@ -2,11 +2,11 @@ module Dhall.Test.Tags where -import Data.Text (Text)-import Dhall.Util (Input (..))-import Prelude hiding (FilePath)-import Test.Tasty (TestTree)-import Turtle (FilePath)+import Data.Text (Text)+import Dhall.Util (Input (..))+import Prelude hiding (FilePath)+import Test.Tasty (TestTree)+import Turtle (FilePath) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO
tests/Dhall/Test/Util.hs view
@@ -23,17 +23,17 @@ , managedTestEnvironment ) where +import Control.Applicative (liftA2, (<|>))+import Control.Exception (tryJust)+import Control.Monad (guard) import Control.Monad.Trans.State.Strict (StateT)-import Control.Applicative ((<|>), liftA2)-import Control.Exception (tryJust)-import Control.Monad (guard) import Data.Bifunctor (first) import Data.Text (Text) import Data.Void (Void) import Dhall.Context (Context) import Dhall.Core- ( Chunks(..)- , Expr(..)+ ( Chunks (..)+ , Expr (..) , Import , Normalizer , ReifiedNormalizer (..)
+ tests/format/letAnnotatedShortA.dhall view
@@ -0,0 +1,1 @@+let empty : ∀(a : Type) → List a = λ(a : Type) → [] : List a in empty
+ tests/format/letAnnotatedShortB.dhall view
@@ -0,0 +1,5 @@+let empty+ : ∀(a : Type) → List a+ = λ(a : Type) → [] : List a++in empty