dhall 1.42.1 → 1.42.2
raw patch · 71 files changed
+825/−567 lines, 71 filesdep +tasty-benchdep −gaugedep ~Diffdep ~QuickCheckdep ~containersbinary-addedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: tasty-bench
Dependencies removed: gauge
Dependency ranges changed: Diff, QuickCheck, containers, optparse-applicative, turtle
API changes (from Hackage documentation)
- Dhall.Binary: instance Codec.Serialise.Class.Serialise (Dhall.Syntax.Expr.Expr Data.Void.Void Data.Void.Void)
- Dhall.Binary: instance Codec.Serialise.Class.Serialise (Dhall.Syntax.Expr.Expr Data.Void.Void Dhall.Syntax.Import.Import)
- Dhall.Map: instance GHC.Classes.Ord k => GHC.Exts.IsList (Dhall.Map.Map k v)
- Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.ByteString.Internal.ByteString
- Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.Void.Void
- Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.ByteString.Internal.ByteString
- Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.Void.Void
+ Dhall: resolveAndStatusWithSettings :: InputSettings -> Expr Src Import -> IO (Expr Src Void, Status)
+ Dhall.Binary: instance Codec.Serialise.Class.Serialise (Dhall.Syntax.Expr.Expr GHC.Base.Void Dhall.Syntax.Import.Import)
+ Dhall.Binary: instance Codec.Serialise.Class.Serialise (Dhall.Syntax.Expr.Expr GHC.Base.Void GHC.Base.Void)
+ Dhall.DirectoryTree: BinaryFileEntry :: Entry ByteString -> FilesystemEntry
+ Dhall.DirectoryTree: TextFileEntry :: Entry Text -> FilesystemEntry
+ Dhall.Map: instance GHC.Classes.Ord k => GHC.IsList.IsList (Dhall.Map.Map k v)
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall Data.ByteString.Internal.Type.ByteString
+ Dhall.Marshal.Decode: instance Dhall.Marshal.Decode.FromDhall GHC.Base.Void
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall Data.ByteString.Internal.Type.ByteString
+ Dhall.Marshal.Encode: instance Dhall.Marshal.Encode.ToDhall GHC.Base.Void
+ Dhall.Pretty: AnyLabel :: UnescapedLabel
+ Dhall.Pretty: AnyLabelOrSome :: UnescapedLabel
+ Dhall.Pretty: NonReservedLabel :: UnescapedLabel
+ Dhall.Pretty: data UnescapedLabel
+ Dhall.Util: _WARNING :: IsString string => string
+ Dhall.Util: printWarning :: MonadIO m => String -> m ()
- Dhall.Marshal.Decode: class Generic a
+ Dhall.Marshal.Decode: class () => Generic a
- Dhall.Marshal.Decode: data Natural
+ Dhall.Marshal.Decode: data () => Natural
- Dhall.Marshal.Decode: data Seq a
+ Dhall.Marshal.Decode: data () => Seq a
- Dhall.Marshal.Decode: data Text
+ Dhall.Marshal.Decode: data () => Text
- Dhall.Marshal.Decode: data Vector a
+ Dhall.Marshal.Decode: data () => Vector a
- Dhall.Marshal.Encode: class Generic a
+ Dhall.Marshal.Encode: class () => Generic a
- Dhall.Marshal.Encode: data Natural
+ Dhall.Marshal.Encode: data () => Natural
- Dhall.Marshal.Encode: data Seq a
+ Dhall.Marshal.Encode: data () => Seq a
- Dhall.Marshal.Encode: data Text
+ Dhall.Marshal.Encode: data () => Text
- Dhall.Marshal.Encode: data Vector a
+ Dhall.Marshal.Encode: data () => Vector a
- Dhall.Pretty: escapeLabel :: Bool -> Text -> Text
+ Dhall.Pretty: escapeLabel :: UnescapedLabel -> Text -> Text
Files
- CHANGELOG.md +26/−0
- benchmark/deep-nested-large-record/Main.hs +10/−11
- benchmark/examples/cpkg.dhall too large to diff
- benchmark/examples/issue108.dhall +0/−63
- benchmark/examples/normalize/ChurchEval.dhall +0/−22
- benchmark/examples/normalize/FunCompose.dhall +0/−18
- benchmark/examples/normalize/ListBench.dhall +0/−75
- benchmark/examples/normalize/ListBenchAlt.dhall +0/−45
- benchmark/parser/Main.hs +35/−34
- benchmark/parser/examples/cpkg.dhall too large to diff
- benchmark/parser/examples/issue108.dhall +63/−0
- benchmark/parser/examples/issue108.dhallb binary
- benchmark/parser/examples/kubernetes.dhallb too large to diff
- benchmark/parser/examples/normalize/ChurchEval.dhall +22/−0
- benchmark/parser/examples/normalize/FunCompose.dhall +18/−0
- benchmark/parser/examples/normalize/ListBench.dhall +75/−0
- benchmark/parser/examples/normalize/ListBenchAlt.dhall +45/−0
- dhall-lang/Prelude/Function/compose.dhall +6/−6
- dhall-lang/Prelude/Function/composeList.dhall +35/−0
- dhall-lang/Prelude/Function/package.dhall +4/−0
- dhall-lang/Prelude/Map/mapMaybe.dhall +1/−1
- dhall-lang/Prelude/package.dhall +1/−1
- dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall +1/−1
- dhall-lang/tests/parser/success/binaryA.dhall +8/−0
- dhall-lang/tests/parser/success/binaryB.dhallb binary
- dhall-lang/tests/parser/success/builtinsA.dhall +1/−0
- dhall-lang/tests/parser/success/builtinsB.dhallb +1/−1
- dhall-lang/tests/type-inference/success/preludeB.dhall +8/−7
- dhall.cabal +21/−16
- doctest/Main.hs +12/−10
- man/dhall.1 +1/−1
- src/Dhall.hs +16/−4
- src/Dhall/Diff.hs +6/−6
- src/Dhall/DirectoryTree.hs +25/−16
- src/Dhall/DirectoryTree/Types.hs +7/−0
- src/Dhall/Eval.hs +6/−3
- src/Dhall/Import.hs +1/−9
- src/Dhall/Import/Headers.hs +7/−1
- src/Dhall/Map.hs +58/−58
- src/Dhall/Marshal/Decode.hs +32/−27
- src/Dhall/Normalize.hs +10/−2
- src/Dhall/Parser/Combinators.hs +10/−1
- src/Dhall/Parser/Expression.hs +8/−1
- src/Dhall/Parser/Token.hs +4/−1
- src/Dhall/Pretty.hs +1/−0
- src/Dhall/Pretty/Internal.hs +35/−16
- src/Dhall/Syntax/Chunks.hs-boot +5/−0
- src/Dhall/Syntax/Expr.hs +3/−0
- src/Dhall/Syntax/Expr.hs-boot +5/−0
- src/Dhall/Syntax/Types.hs-boot +5/−0
- src/Dhall/TH.hs +53/−30
- src/Dhall/Tutorial.hs +9/−5
- src/Dhall/TypeCheck.hs +4/−4
- src/Dhall/Util.hs +17/−0
- tests/Dhall/Test/Diff.hs +0/−2
- tests/Dhall/Test/Format.hs +1/−2
- tests/Dhall/Test/Freeze.hs +1/−6
- tests/Dhall/Test/Import.hs +9/−14
- tests/Dhall/Test/Lint.hs +0/−2
- tests/Dhall/Test/Main.hs +5/−0
- tests/Dhall/Test/Normalization.hs +24/−15
- tests/Dhall/Test/Parser.hs +5/−6
- tests/Dhall/Test/Schemas.hs +0/−2
- tests/Dhall/Test/SemanticHash.hs +0/−2
- tests/Dhall/Test/Tags.hs +8/−7
- tests/Dhall/Test/TypeInference.hs +2/−4
- tests/Dhall/Test/Util.hs +25/−7
- tests/format/issue2601A.dhall +11/−0
- tests/format/issue2601B.dhall +11/−0
- tests/format/numericLiteralsA.dhall +1/−1
- tests/format/numericLiteralsB.dhall +1/−1
CHANGELOG.md view
@@ -1,3 +1,23 @@+1.42.2++* [Supports standard version 23.1.0](https://github.com/dhall-lang/dhall-lang/releases/tag/v23.1.0)+ * [Allow `Natural` and `Integer` literals in binary notation](https://github.com/dhall-lang/dhall-haskell/pull/2540)+* Fix macOS build [[#2561](https://github.com/dhall-lang/dhall-haskell/pull/2561)] / [[#2586](https://github.com/dhall-lang/dhall-haskell/pull/2586)]+* [`dhall to-directory-tree`: Fix support for empty `Map`s](https://github.com/dhall-lang/dhall-haskell/pull/2609)+* [`Dhall.TH`: Improve recompilation checking](https://github.com/dhall-lang/dhall-haskell/pull/2620)+ * `Dhall.TH` utilities now use `addDependentFile` internally so that GHC will recompile if any Dhall dependencies change+* Performance improvements+ * Optimize `Natural/fold`: [[#2585](https://github.com/dhall-lang/dhall-haskell/pull/2585)] / [[#2596](https://github.com/dhall-lang/dhall-haskell/pull/2596)]+ * [Improve `Dhall.Map.traverseWithKey` performance](https://github.com/dhall-lang/dhall-haskell/pull/2589)+ * The fold will now short-circuit if it reaches a fixed point+ * [#2611](https://github.com/dhall-lang/dhall-haskell/pull/2611)+* Fixes and improvements to test suite+ * [#2593](https://github.com/dhall-lang/dhall-haskell/pull/2593)+* Fixes and improvements to haddocks+ * [#2546](https://github.com/dhall-lang/dhall-haskell/pull/2546)+* Fixes and improvements to code formatting+ * [#2608](https://github.com/dhall-lang/dhall-haskell/pull/2608)+ 1.42.1 * Add several new entrypoints to `Dhall` module [[#2534](https://github.com/dhall-lang/dhall-haskell/pull/2534)] / [[#2544](https://github.com/dhall-lang/dhall-haskell/pull/2544)]@@ -361,6 +381,12 @@ * If you really don't want to handle the new error-related wrapper, you can get the old behavior using a partial pattern match (which will be partial, still an improvement over the previous behavior, which was hanging)+* BREAKING CHANGE: [Records can no longer contain attributes named after language keywords](https://github.com/dhall-lang/dhall-haskell/pull/1801)+ * This is a bugfix, because the language standard disallows using+ keywords as record labels. However, some users were relying on+ this bug.+ * If you need to use a keyword as a record label, enclose it in backticks:+ ``{ `assert` = 1 }``. * [Fix invalid cache entries](https://github.com/dhall-lang/dhall-haskell/pull/1793) * The interpreter will now correct cached expressions that are incorrect and warn you when this happens
benchmark/deep-nested-large-record/Main.hs view
@@ -1,14 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Data.Void (Void)-import Gauge (defaultMain)+import Data.Void (Void)+import Test.Tasty.Bench import qualified Data.Sequence as Seq import qualified Dhall.Core as Core import qualified Dhall.Import as Import import qualified Dhall.TypeCheck as TypeCheck-import qualified Gauge dhallPreludeImport :: Core.Import dhallPreludeImport = Core.Import@@ -22,8 +21,8 @@ } } -issue412 :: Core.Expr s Void -> Gauge.Benchmarkable-issue412 prelude = Gauge.whnf TypeCheck.typeOf expr+issue412 :: Core.Expr s Void -> Benchmarkable+issue412 prelude = whnf TypeCheck.typeOf expr where expr = Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude)@@ -34,8 +33,8 @@ little = Core.makeFieldSelection "little" foo = Core.makeFieldSelection "Foo" -unionPerformance :: Core.Expr s Void -> Gauge.Benchmarkable-unionPerformance prelude = Gauge.whnf TypeCheck.typeOf expr+unionPerformance :: Core.Expr s Void -> Benchmarkable+unionPerformance prelude = whnf TypeCheck.typeOf expr where expr = Core.Let@@ -64,10 +63,10 @@ main :: IO () main = defaultMain- [ Gauge.env prelude $ \p ->- Gauge.bgroup "Prelude"- [ Gauge.bench "issue 412" (issue412 p)- , Gauge.bench "union performance" (unionPerformance p)+ [ env prelude $ \p ->+ bgroup "Prelude"+ [ bench "issue 412" (issue412 p)+ , bench "union performance" (unionPerformance p) ] ] where prelude = Import.load (Core.Embed dhallPreludeImport)
− benchmark/examples/cpkg.dhall
file too large to diff
− benchmark/examples/issue108.dhall
@@ -1,63 +0,0 @@-λ ( xs : List { cores : Natural , host : Text , key : Text , mandatoryFeatures :-List Text , platforms : List < AArch64_Linux : {} | ARMv5tel_Linux : {} |-ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} |-PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD :-{} | X86_64_Linux : {} | X86_64_Solaris : {} > , speedFactor : Natural ,-supportedFeatures : List Text , user : Optional Text } )→ List/fold { cores :-Natural , host : Text , key : Text , mandatoryFeatures : List Text , platforms :-List < AArch64_Linux : {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} |-I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} | PowerPC_Linux : {} |-X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux :-{} | X86_64_Solaris : {} > , speedFactor : Natural , supportedFeatures : List-Text , user : Optional Text } xs Text ( λ ( x : { cores : Natural , host : Text-, key : Text , mandatoryFeatures : List Text , platforms : List < AArch64_Linux-: {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux :-{} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} |-X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris :-{} > , speedFactor : Natural , supportedFeatures : List Text , user : Optional-Text } ) → λ(y : Text) →-merge { None = x.host, Some = λ(user : Text) → "${user}@${x.host}" } x.user-++ " " ++ ( merge { Empty = λ(_ : {}) → "",-NonEmpty = λ(result : Text) → result } ( List/fold < AArch64_Linux : {} |-ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} |-MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin :-{} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : {} > x.platforms-< Empty : {} | NonEmpty : Text > ( λ ( element : < AArch64_Linux : {} |-ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} |-MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin :-{} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : {} > ) →-λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → <-NonEmpty : Text | Empty : {} >.NonEmpty ( merge { AArch64_Linux = λ(_ : {}) →-"aarch64-linux" , ARMv5tel_Linux = λ(_ : {}) → "armv5tel-linux" , ARMv7l_Linux =-λ(_ : {}) → "armv7l-linux" , I686_Cygwin = λ(_ : {}) → "i686-cygwin" ,-I686_Linux = λ(_ : {}) → "i686-linux" , MIPS64el_Linux = λ(_ : {}) →-"mips64el-linux" , PowerPC_Linux = λ(_ : {}) → "powerpc-linux" , X86_64_Cygwin =-λ(_ : {}) → "x86_64-cygwin" , X86_64_Darwin = λ(_ : {}) → "x86_64-darwin" ,-X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd" , X86_64_Linux = λ(_ : {}) →-"x86_64-linux" , X86_64_Solaris = λ(_ : {}) → "x86_64-solaris" } element ) ,-NonEmpty = λ(result : Text) → < NonEmpty : Text | Empty : {} >.NonEmpty ( (-merge { AArch64_Linux = λ(_ : {}) → "aarch64-linux" , ARMv5tel_Linux = λ(_ : {})-→ "armv5tel-linux" , ARMv7l_Linux = λ(_ : {}) → "armv7l-linux" , I686_Cygwin =-λ(_ : {}) → "i686-cygwin" , I686_Linux = λ(_ : {}) → "i686-linux" ,-MIPS64el_Linux = λ(_ : {}) → "mips64el-linux" , PowerPC_Linux = λ(_ : {}) →-"powerpc-linux" , X86_64_Cygwin = λ(_ : {}) → "x86_64-cygwin" , X86_64_Darwin =-λ(_ : {}) → "x86_64-darwin" , X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd" ,-X86_64_Linux = λ(_ : {}) → "x86_64-linux" , X86_64_Solaris = λ(_ : {}) →-"x86_64-solaris" } element ) ++ "," ++ result ) } status : < Empty : {} |-NonEmpty : Text > ) (< Empty : {} | NonEmpty : Text >.Empty {=}) ) : Text ) ++-" " ++ x.key ++ " " ++ Integer/show (Natural/toInteger x.cores) ++ " " ++-Integer/show (Natural/toInteger x.speedFactor) ++ " " ++ ( merge { Empty = λ(_ :-{}) → "", NonEmpty = λ(result : Text) → result } ( List/fold Text-x.supportedFeatures < Empty : {} | NonEmpty : Text > ( λ(element : Text) →-λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → <-NonEmpty : Text | Empty : {} >.NonEmpty element , NonEmpty = λ(result : Text) →-< NonEmpty : Text | Empty : {} >.NonEmpty (element ++ "," ++ result) } status :-< Empty : {} | NonEmpty : Text > ) (< Empty : {} | NonEmpty : Text >.Empty {=})-) : Text ) ++ " " ++ ( merge { Empty = λ(_ : {}) → "", NonEmpty = λ(result :-Text) → result } ( List/fold Text x.mandatoryFeatures < Empty : {} | NonEmpty :-Text > ( λ(element : Text) → λ(status : < Empty : {} | NonEmpty : Text >) →-merge { Empty = λ(_ : {}) → < NonEmpty : Text | Empty : {} >.NonEmpty element ,-NonEmpty = λ(result : Text) → < NonEmpty : Text | Empty : {} >.NonEmpty-(element ++ "," ++ result) } status : < Empty : {} | NonEmpty : Text > ) (<-Empty : {} | NonEmpty : Text->.Empty {=}) ) : Text ) ++ "\n" ++ y ) ""
− benchmark/examples/normalize/ChurchEval.dhall
@@ -1,22 +0,0 @@--let Nat = ∀(N : Type) → (N → N) → N → N-let n2 = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s z)-let n5 = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s (s (s (s z))))--let mul =- λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N (b N s) z--let add =- λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N s (b N s z)--let n10 = mul n2 n5-let n100 = mul n10 n10-let n1k = mul n10 n100-let n10k = mul n100 n100-let n100k = mul n10 n10k-let n1M = mul n10k n100-let n5M = mul n1M n5-let n10M = mul n1M n10-let n20M = mul n10M n2--in n1M Natural (λ (x:Natural) → x + 1) 0
− benchmark/examples/normalize/FunCompose.dhall
@@ -1,18 +0,0 @@--let compose- : ∀(a : Type) → ∀(b : Type) → ∀(c : Type) → (a → b) → (b → c) → a → c- = λ(A : Type)- → λ(B : Type)- → λ(C : Type)- → λ(f : A → B)- → λ(g : B → C)- → λ(x : A)- → g (f x)--let composeN : ∀ (a : Type) → Natural → (a → a) → a → a- = λ (a : Type)- → λ (n : Natural)- → λ (f : a → a)- → Natural/fold n (a → a) (compose a a a f) (λ (x : a) → x)--in composeN Natural 100000 (λ (x : Natural) → x + 1) 0
− benchmark/examples/normalize/ListBench.dhall
@@ -1,75 +0,0 @@--let iterate- = λ(n : Natural)- → λ(a : Type)- → λ(f : a → a)- → λ(x : a)- → List/build- a- ( λ(list : Type)- → λ(cons : a → list → list)- → List/fold- { index : Natural, value : {} }- ( List/indexed- {}- ( List/build- {}- ( λ(list : Type)- → λ(cons : {} → list → list)- → Natural/fold n list (cons {=})- )- )- )- list- ( λ(y : { index : Natural, value : {} })- → cons (Natural/fold y.index a f x)- )- )--let countTo =- λ (x : Natural)- → iterate x Natural (λ (x : Natural) → x + 1) 0--let sum =- λ (xs : List Natural)- → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0---let map- : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b- = λ(a : Type)- → λ(b : Type)- → λ(f : a → b)- → λ(xs : List a)- → List/build- b- ( λ(list : Type)- → λ(cons : b → list → list)- → List/fold a xs list (λ(x : a) → cons (f x))- )--let any- : ∀(a : Type) → (a → Bool) → List a → Bool- = λ(a : Type)- → λ(f : a → Bool)- → λ(xs : List a)- → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False--let filter- : ∀(a : Type) → (a → Bool) → List a → List a- = λ(a : Type)- → λ(f : a → Bool)- → λ(xs : List a)- → List/build- a- ( λ(list : Type)- → λ(cons : a → list → list)- → List/fold- a- xs- list- (λ(x : a) → λ(xs : list) → if f x then cons x xs else xs)- )--in sum (filter Natural Natural/even- (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000)))
− benchmark/examples/normalize/ListBenchAlt.dhall
@@ -1,45 +0,0 @@--let iterate =- λ(n : Natural)- → λ(a : Type)- → λ(f : a → a)- → λ(x : a)- → (Natural/fold n- (a → List a → {fst:a, snd:List a})- (λ (hyp : a → List a → {fst:a, snd:List a}) →- λ (x : a) → λ (xs : List a)- → let tup = hyp x xs- in {fst = f (tup.fst), snd = tup.snd # [tup.fst]})- (λ (x : a) → λ (xs : List a) → {fst=x, snd=xs})- x ([] : List a)).snd--let countTo =- λ (x : Natural)- → iterate x Natural (λ (x : Natural) → x + 1) 0--let sum =- λ (xs : List Natural)- → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0--let map- = λ(a : Type)- → λ(b : Type)- → λ(f : a → b)- → λ(xs : List a)- → List/fold a xs (List b) (λ (x : a) → λ (xs : List b) → [f x] # xs) ([] : List b)--let any- = λ(a : Type)- → λ(f : a → Bool)- → λ(xs : List a)- → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False--let filter- = λ(a : Type)- → λ(f : a → Bool)- → λ(xs : List a)- → List/fold a xs (List a)- (λ (x : a) → λ (xs : List a) → if f x then [x] # xs else xs) ([] : List a)--in sum (filter Natural Natural/even- (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000)))
benchmark/parser/Main.hs view
@@ -1,54 +1,54 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Main where import Control.Exception (throw) import Control.Monad (forM)-import Data.Map (Map, foldrWithKey, singleton, unions)+import Data.Map (Map)+import Data.Text (Text) import Data.Void (Void)-import Gauge (bench, bgroup, defaultMain, env, nf, whnf)--import System.Directory+import Test.Tasty.Bench import qualified Data.ByteString.Lazy-import qualified Data.Text as T-import qualified Data.Text.IO as TIO+import qualified Data.Map as Map+import qualified Data.Text as Text+import qualified Data.Text.IO import qualified Dhall.Binary import qualified Dhall.Core as Dhall import qualified Dhall.Parser as Dhall-import qualified Gauge+import qualified System.Directory as Directory -type PreludeFiles = Map FilePath T.Text+type PreludeFiles = Map FilePath Text loadPreludeFiles :: IO PreludeFiles loadPreludeFiles = loadDirectory "./dhall-lang/Prelude" where loadDirectory :: FilePath -> IO PreludeFiles loadDirectory dir =- withCurrentDirectory dir $ do- files <- getCurrentDirectory >>= listDirectory+ Directory.withCurrentDirectory dir $ do+ files <- Directory.getCurrentDirectory >>= Directory.listDirectory results <- forM files $ \file -> do- file' <- makeAbsolute file- doesExist <- doesFileExist file'+ file' <- Directory.makeAbsolute file+ doesExist <- Directory.doesFileExist file' if doesExist then loadFile file' else loadDirectory file'- pure $ unions results+ pure $ Map.unions results loadFile :: FilePath -> IO PreludeFiles- loadFile path = singleton path <$> TIO.readFile path+ loadFile path = Map.singleton path <$> Data.Text.IO.readFile path -benchParser :: PreludeFiles -> Gauge.Benchmark+benchParser :: PreludeFiles -> Benchmark benchParser = bgroup "exprFromText"- . foldrWithKey (\name expr -> (benchExprFromText name expr :)) []+ . Map.foldrWithKey (\name expr -> (benchExprFromText name expr :)) [] -benchExprFromText :: String -> T.Text -> Gauge.Benchmark-benchExprFromText name expr =+benchExprFromText :: String -> Text -> Benchmark+benchExprFromText name !expr = bench name $ whnf (Dhall.exprFromText "(input)") expr -benchExprFromBytes- :: String -> Data.ByteString.Lazy.ByteString -> Gauge.Benchmark+benchExprFromBytes :: String -> Data.ByteString.Lazy.ByteString -> Benchmark benchExprFromBytes name bs = bench name (nf f bs) where f bytes =@@ -56,8 +56,8 @@ Left exception -> error (show exception) Right expression -> expression :: Dhall.Expr Void Dhall.Import -benchNfExprFromText :: String -> T.Text -> Gauge.Benchmark-benchNfExprFromText name expr =+benchNfExprFromText :: String -> Text -> Benchmark+benchNfExprFromText name !expr = bench name $ nf (either throw id . Dhall.exprFromText "(input)") expr main :: IO ()@@ -71,20 +71,21 @@ ] , env kubernetesExample $ benchExprFromBytes "Kubernetes/Binary"- , benchExprFromText "Long variable names" (T.replicate 1000000 "x")- , benchExprFromText "Large number of function arguments" (T.replicate 10000 "x ")- , benchExprFromText "Long double-quoted strings" ("\"" <> T.replicate 1000000 "x" <> "\"")- , benchExprFromText "Long single-quoted strings" ("''" <> T.replicate 1000000 "x" <> "''")- , benchExprFromText "Whitespace" (T.replicate 1000000 " " <> "x")- , benchExprFromText "Line comment" ("x -- " <> T.replicate 1000000 " ")- , benchExprFromText "Block comment" ("x {- " <> T.replicate 1000000 " " <> "-}")+ , benchExprFromText "Long variable names" (Text.replicate 1000000 "x")+ , benchExprFromText "Large number of function arguments" (Text.replicate 10000 "x ")+ , benchExprFromText "Long double-quoted strings" ("\"" <> Text.replicate 1000000 "x" <> "\"")+ , benchExprFromText "Long single-quoted strings" ("''" <> Text.replicate 1000000 "x" <> "''")+ , benchExprFromText "Whitespace" (Text.replicate 1000000 " " <> "x")+ , benchExprFromText "Line comment" ("x -- " <> Text.replicate 1000000 " ")+ , benchExprFromText "Block comment" ("x {- " <> Text.replicate 1000000 " " <> "-}") , benchExprFromText "Deeply nested parentheses" "((((((((((((((((x))))))))))))))))" , benchParser prelude , env cpkgExample $ benchNfExprFromText "CPkg/Text" ]- where cpkgExample = TIO.readFile "benchmark/examples/cpkg.dhall"- issue108Text = TIO.readFile "benchmark/examples/issue108.dhall"- issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/examples/issue108.dhall.bin"- issues = (,) <$> issue108Text <*> issue108Bytes- kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/examples/kubernetes.dhall.bin"+ where+ cpkgExample = Data.Text.IO.readFile "benchmark/parser/examples/cpkg.dhall"+ issue108Text = Data.Text.IO.readFile "benchmark/parser/examples/issue108.dhall"+ issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/parser/examples/issue108.dhallb"+ issues = (,) <$> issue108Text <*> issue108Bytes+ kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/parser/examples/kubernetes.dhallb"
+ benchmark/parser/examples/cpkg.dhall view
file too large to diff
+ benchmark/parser/examples/issue108.dhall view
@@ -0,0 +1,63 @@+λ ( xs : List { cores : Natural , host : Text , key : Text , mandatoryFeatures :+List Text , platforms : List < AArch64_Linux : {} | ARMv5tel_Linux : {} |+ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} |+PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD :+{} | X86_64_Linux : {} | X86_64_Solaris : {} > , speedFactor : Natural ,+supportedFeatures : List Text , user : Optional Text } )→ List/fold { cores :+Natural , host : Text , key : Text , mandatoryFeatures : List Text , platforms :+List < AArch64_Linux : {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} |+I686_Cygwin : {} | I686_Linux : {} | MIPS64el_Linux : {} | PowerPC_Linux : {} |+X86_64_Cygwin : {} | X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux :+{} | X86_64_Solaris : {} > , speedFactor : Natural , supportedFeatures : List+Text , user : Optional Text } xs Text ( λ ( x : { cores : Natural , host : Text+, key : Text , mandatoryFeatures : List Text , platforms : List < AArch64_Linux+: {} | ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux :+{} | MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} |+X86_64_Darwin : {} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris :+{} > , speedFactor : Natural , supportedFeatures : List Text , user : Optional+Text } ) → λ(y : Text) →+merge { None = x.host, Some = λ(user : Text) → "${user}@${x.host}" } x.user+++ " " ++ ( merge { Empty = λ(_ : {}) → "",+NonEmpty = λ(result : Text) → result } ( List/fold < AArch64_Linux : {} |+ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} |+MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin :+{} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : {} > x.platforms+< Empty : {} | NonEmpty : Text > ( λ ( element : < AArch64_Linux : {} |+ARMv5tel_Linux : {} | ARMv7l_Linux : {} | I686_Cygwin : {} | I686_Linux : {} |+MIPS64el_Linux : {} | PowerPC_Linux : {} | X86_64_Cygwin : {} | X86_64_Darwin :+{} | X86_64_FreeBSD : {} | X86_64_Linux : {} | X86_64_Solaris : {} > ) →+λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → <+NonEmpty : Text | Empty : {} >.NonEmpty ( merge { AArch64_Linux = λ(_ : {}) →+"aarch64-linux" , ARMv5tel_Linux = λ(_ : {}) → "armv5tel-linux" , ARMv7l_Linux =+λ(_ : {}) → "armv7l-linux" , I686_Cygwin = λ(_ : {}) → "i686-cygwin" ,+I686_Linux = λ(_ : {}) → "i686-linux" , MIPS64el_Linux = λ(_ : {}) →+"mips64el-linux" , PowerPC_Linux = λ(_ : {}) → "powerpc-linux" , X86_64_Cygwin =+λ(_ : {}) → "x86_64-cygwin" , X86_64_Darwin = λ(_ : {}) → "x86_64-darwin" ,+X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd" , X86_64_Linux = λ(_ : {}) →+"x86_64-linux" , X86_64_Solaris = λ(_ : {}) → "x86_64-solaris" } element ) ,+NonEmpty = λ(result : Text) → < NonEmpty : Text | Empty : {} >.NonEmpty ( (+merge { AArch64_Linux = λ(_ : {}) → "aarch64-linux" , ARMv5tel_Linux = λ(_ : {})+→ "armv5tel-linux" , ARMv7l_Linux = λ(_ : {}) → "armv7l-linux" , I686_Cygwin =+λ(_ : {}) → "i686-cygwin" , I686_Linux = λ(_ : {}) → "i686-linux" ,+MIPS64el_Linux = λ(_ : {}) → "mips64el-linux" , PowerPC_Linux = λ(_ : {}) →+"powerpc-linux" , X86_64_Cygwin = λ(_ : {}) → "x86_64-cygwin" , X86_64_Darwin =+λ(_ : {}) → "x86_64-darwin" , X86_64_FreeBSD = λ(_ : {}) → "x86_64-freebsd" ,+X86_64_Linux = λ(_ : {}) → "x86_64-linux" , X86_64_Solaris = λ(_ : {}) →+"x86_64-solaris" } element ) ++ "," ++ result ) } status : < Empty : {} |+NonEmpty : Text > ) (< Empty : {} | NonEmpty : Text >.Empty {=}) ) : Text ) +++" " ++ x.key ++ " " ++ Integer/show (Natural/toInteger x.cores) ++ " " +++Integer/show (Natural/toInteger x.speedFactor) ++ " " ++ ( merge { Empty = λ(_ :+{}) → "", NonEmpty = λ(result : Text) → result } ( List/fold Text+x.supportedFeatures < Empty : {} | NonEmpty : Text > ( λ(element : Text) →+λ(status : < Empty : {} | NonEmpty : Text >) → merge { Empty = λ(_ : {}) → <+NonEmpty : Text | Empty : {} >.NonEmpty element , NonEmpty = λ(result : Text) →+< NonEmpty : Text | Empty : {} >.NonEmpty (element ++ "," ++ result) } status :+< Empty : {} | NonEmpty : Text > ) (< Empty : {} | NonEmpty : Text >.Empty {=})+) : Text ) ++ " " ++ ( merge { Empty = λ(_ : {}) → "", NonEmpty = λ(result :+Text) → result } ( List/fold Text x.mandatoryFeatures < Empty : {} | NonEmpty :+Text > ( λ(element : Text) → λ(status : < Empty : {} | NonEmpty : Text >) →+merge { Empty = λ(_ : {}) → < NonEmpty : Text | Empty : {} >.NonEmpty element ,+NonEmpty = λ(result : Text) → < NonEmpty : Text | Empty : {} >.NonEmpty+(element ++ "," ++ result) } status : < Empty : {} | NonEmpty : Text > ) (<+Empty : {} | NonEmpty : Text+>.Empty {=}) ) : Text ) ++ "\n" ++ y ) ""
+ benchmark/parser/examples/issue108.dhallb view
binary file changed (absent → 3818 bytes)
+ benchmark/parser/examples/kubernetes.dhallb view
file too large to diff
+ benchmark/parser/examples/normalize/ChurchEval.dhall view
@@ -0,0 +1,22 @@++let Nat = ∀(N : Type) → (N → N) → N → N+let n2 = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s z)+let n5 = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s (s (s (s z))))++let mul =+ λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N (b N s) z++let add =+ λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N s (b N s z)++let n10 = mul n2 n5+let n100 = mul n10 n10+let n1k = mul n10 n100+let n10k = mul n100 n100+let n100k = mul n10 n10k+let n1M = mul n10k n100+let n5M = mul n1M n5+let n10M = mul n1M n10+let n20M = mul n10M n2++in n1M Natural (λ (x:Natural) → x + 1) 0
+ benchmark/parser/examples/normalize/FunCompose.dhall view
@@ -0,0 +1,18 @@++let compose+ : ∀(a : Type) → ∀(b : Type) → ∀(c : Type) → (a → b) → (b → c) → a → c+ = λ(A : Type)+ → λ(B : Type)+ → λ(C : Type)+ → λ(f : A → B)+ → λ(g : B → C)+ → λ(x : A)+ → g (f x)++let composeN : ∀ (a : Type) → Natural → (a → a) → a → a+ = λ (a : Type)+ → λ (n : Natural)+ → λ (f : a → a)+ → Natural/fold n (a → a) (compose a a a f) (λ (x : a) → x)++in composeN Natural 100000 (λ (x : Natural) → x + 1) 0
+ benchmark/parser/examples/normalize/ListBench.dhall view
@@ -0,0 +1,75 @@++let iterate+ = λ(n : Natural)+ → λ(a : Type)+ → λ(f : a → a)+ → λ(x : a)+ → List/build+ a+ ( λ(list : Type)+ → λ(cons : a → list → list)+ → List/fold+ { index : Natural, value : {} }+ ( List/indexed+ {}+ ( List/build+ {}+ ( λ(list : Type)+ → λ(cons : {} → list → list)+ → Natural/fold n list (cons {=})+ )+ )+ )+ list+ ( λ(y : { index : Natural, value : {} })+ → cons (Natural/fold y.index a f x)+ )+ )++let countTo =+ λ (x : Natural)+ → iterate x Natural (λ (x : Natural) → x + 1) 0++let sum =+ λ (xs : List Natural)+ → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0+++let map+ : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b+ = λ(a : Type)+ → λ(b : Type)+ → λ(f : a → b)+ → λ(xs : List a)+ → List/build+ b+ ( λ(list : Type)+ → λ(cons : b → list → list)+ → List/fold a xs list (λ(x : a) → cons (f x))+ )++let any+ : ∀(a : Type) → (a → Bool) → List a → Bool+ = λ(a : Type)+ → λ(f : a → Bool)+ → λ(xs : List a)+ → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False++let filter+ : ∀(a : Type) → (a → Bool) → List a → List a+ = λ(a : Type)+ → λ(f : a → Bool)+ → λ(xs : List a)+ → List/build+ a+ ( λ(list : Type)+ → λ(cons : a → list → list)+ → List/fold+ a+ xs+ list+ (λ(x : a) → λ(xs : list) → if f x then cons x xs else xs)+ )++in sum (filter Natural Natural/even+ (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000)))
+ benchmark/parser/examples/normalize/ListBenchAlt.dhall view
@@ -0,0 +1,45 @@++let iterate =+ λ(n : Natural)+ → λ(a : Type)+ → λ(f : a → a)+ → λ(x : a)+ → (Natural/fold n+ (a → List a → {fst:a, snd:List a})+ (λ (hyp : a → List a → {fst:a, snd:List a}) →+ λ (x : a) → λ (xs : List a)+ → let tup = hyp x xs+ in {fst = f (tup.fst), snd = tup.snd # [tup.fst]})+ (λ (x : a) → λ (xs : List a) → {fst=x, snd=xs})+ x ([] : List a)).snd++let countTo =+ λ (x : Natural)+ → iterate x Natural (λ (x : Natural) → x + 1) 0++let sum =+ λ (xs : List Natural)+ → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0++let map+ = λ(a : Type)+ → λ(b : Type)+ → λ(f : a → b)+ → λ(xs : List a)+ → List/fold a xs (List b) (λ (x : a) → λ (xs : List b) → [f x] # xs) ([] : List b)++let any+ = λ(a : Type)+ → λ(f : a → Bool)+ → λ(xs : List a)+ → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False++let filter+ = λ(a : Type)+ → λ(f : a → Bool)+ → λ(xs : List a)+ → List/fold a xs (List a)+ (λ (x : a) → λ (xs : List a) → if f x then [x] # xs else xs) ([] : List a)++in sum (filter Natural Natural/even+ (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000)))
dhall-lang/Prelude/Function/compose.dhall view
@@ -1,12 +1,12 @@ --| Compose two functions into one. let compose : ∀(a : Type) → ∀(b : Type) → ∀(c : Type) → (a → b) → (b → c) → a → c- = λ(A : Type) →- λ(B : Type) →- λ(C : Type) →- λ(f : A → B) →- λ(g : B → C) →- λ(x : A) →+ = λ(a : Type) →+ λ(b : Type) →+ λ(c : Type) →+ λ(f : a → b) →+ λ(g : b → c) →+ λ(x : a) → g (f x) let example0 =
+ dhall-lang/Prelude/Function/composeList.dhall view
@@ -0,0 +1,35 @@+{-|+Composes a list of functions starting from the left.+-}+let compose =+ missing+ sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013+ ? ./compose.dhall++let identity =+ missing+ sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4+ ? ./identity.dhall++let composeList+ : ∀(a : Type) → List (a → a) → a → a+ = λ(a : Type) →+ λ(functions : List (a → a)) →+ List/fold (a → a) functions (a → a) (compose a a a) (identity a)++let example0 =+ assert+ : composeList+ Natural+ [ λ(x : Natural) → x * 2, λ(x : Natural) → x + 1 ]+ 1+ ≡ 3++let property0 =+ λ(a : Type) →+ λ(f : a → a) →+ λ(g : a → a) →+ λ(h : a → a) →+ assert : composeList a [ f, g, h ] ≡ (λ(x : a) → h (g (f x)))++in composeList
dhall-lang/Prelude/Function/package.dhall view
@@ -2,6 +2,10 @@ missing sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 ? ./compose.dhall+, composeList =+ missing+ sha256:2c6931544d8b5a5b14514098c07bd1813f67b16834588d056df3c0bc2e489937+ ? ./composeList.dhall , identity = missing sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4
dhall-lang/Prelude/Map/mapMaybe.dhall view
@@ -1,5 +1,5 @@ --| Apply a function across the values of a `Map k v`, dropping--- entries whose values return `None`.+-- entries whose values return `None`. let Map/empty = missing sha256:4c612558b8bbe8f955550ed3fb295d57b1b864c85cd52615b52d0ee0e9682e52
dhall-lang/Prelude/package.dhall view
@@ -12,7 +12,7 @@ ? ./Double/package.dhall , Function = missing- sha256:6d17cf0fd4fabe1737fb117f87c04b8ff82b299915a5b673c0a543b134b8fffe+ sha256:f4ca848f69034f9d7a74e12c556c3a3396966c1de3a9427a102d1aff4580192f ? ./Function/package.dhall , Integer = missing
dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall view
@@ -1,1 +1,1 @@-"hello world"+"hello" ++ " world"
+ dhall-lang/tests/parser/success/binaryA.dhall view
@@ -0,0 +1,8 @@+ λ(x : Bool)+→ λ(x : Bool)+→ { example0 = 0b0+ , example1 = 0b10+ , example2 = -0b11001+ , example3 = +0b100+ , example4 = x@0b01+ }
+ dhall-lang/tests/parser/success/binaryB.dhallb view
binary file changed (absent → 83 bytes)
dhall-lang/tests/parser/success/builtinsA.dhall view
@@ -29,6 +29,7 @@ , Integer , Double , Text+, Bytes , List , Type , Kind
dhall-lang/tests/parser/success/builtinsB.dhallb view
@@ -1,1 +1,1 @@-%ölNatural/foldmNatural/buildnNatural/isZerolNatural/evenkNatural/oddqNatural/toIntegerlNatural/showpInteger/toDoublelInteger/shownInteger/negatemInteger/clamppNatural/subtractkDouble/showjList/buildiList/foldkList/lengthiList/headiList/lastlList/indexedlList/reverseiText/showlText/replacedBoolõôhOptionaldNonegNaturalgIntegerfDoubledTextdListdTypedKinddSort+&ölNatural/foldmNatural/buildnNatural/isZerolNatural/evenkNatural/oddqNatural/toIntegerlNatural/showpInteger/toDoublelInteger/shownInteger/negatemInteger/clamppNatural/subtractkDouble/showjList/buildiList/foldkList/lengthiList/headiList/lastlList/indexedlList/reverseiText/showlText/replacedBoolõôhOptionaldNonegNaturalgIntegerfDoubledTexteBytesdListdTypedKinddSort
dhall-lang/tests/type-inference/success/preludeB.dhall view
@@ -15,13 +15,14 @@ , Double : { show : Double → Text } , Function : { compose :- ∀(A : Type) →- ∀(B : Type) →- ∀(C : Type) →- ∀(f : A → B) →- ∀(g : B → C) →- ∀(x : A) →- C+ ∀(a : Type) →+ ∀(b : Type) →+ ∀(c : Type) →+ ∀(f : a → b) →+ ∀(g : b → c) →+ ∀(x : a) →+ c+ , composeList : ∀(a : Type) → ∀(functions : List (a → a)) → a → a , identity : ∀(a : Type) → ∀(x : a) → a } , Integer :
dhall.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.4 Name: dhall-Version: 1.42.1+Version: 1.42.2 Build-Type: Simple License: BSD-3-Clause License-File: LICENSE@@ -26,6 +26,7 @@ Extra-Source-Files: CHANGELOG.md benchmark/**/*.dhall+ benchmark/**/*.dhallb dhall-lang/Prelude/**/*.dhall dhall-lang/Prelude/Bool/and dhall-lang/Prelude/Bool/build@@ -207,26 +208,26 @@ base >= 4.11.0.0 && < 5 , aeson >= 1.0.0.0 && < 2.3 , aeson-pretty < 0.9 ,- ansi-terminal >= 0.6.3.1 && < 1.1 ,+ ansi-terminal >= 0.6.3.1 && < 1.2 , atomic-write >= 0.2.0.7 && < 0.3 , base16-bytestring >= 1.0.0.0 , bytestring < 0.13, case-insensitive < 1.3 , cborg >= 0.2.0.0 && < 0.3 , cborg-json >= 0.2.2.0 && < 0.3 ,- containers >= 0.5.8.0 && < 0.7 ,+ containers >= 0.5.8.0 && < 0.8 , contravariant < 1.6 , data-fix < 0.4 , deepseq < 1.6 ,- Diff >= 0.2 && < 0.5 ,+ Diff >= 0.2 && < 1.1 , directory >= 1.3.0.0 && < 1.4 , dotgen >= 0.4.2 && < 0.5 , either >= 5 && < 5.1, exceptions >= 0.8.3 && < 0.11,- filepath >= 1.4 && < 1.5 ,+ filepath >= 1.4 && < 1.6 , half >= 0.2.2.3 && < 0.4 , haskeline >= 0.7.2.1 && < 0.9 ,- hashable >= 1.2 && < 1.5 ,+ hashable >= 1.2 && < 1.6 , indexed-traversable < 0.2 , lens-family-core >= 1.0.0 && < 2.2 , -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469@@ -244,12 +245,12 @@ 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.22,+ template-haskell >= 2.13.0.0 && < 2.23, text >= 0.11.1.0 && < 2.2 , text-manipulate >= 0.2.0.1 && < 0.4 , text-short >= 0.1 && < 0.2 , th-lift-instances >= 0.1.13 && < 0.2 ,- time >= 1.9 && < 1.13,+ time >= 1.9 && < 1.15, transformers >= 0.5.2.0 && < 0.7 , unix-compat >= 0.4.2 && < 0.8 , unordered-containers >= 0.1.3.0 && < 0.3 ,@@ -268,8 +269,10 @@ if flag(network-tests) CPP-Options: -DNETWORK_TESTS+ if flag(cross)+ CPP-Options: -DCROSS - GHC-Options: -Wall -Wcompat -Wincomplete-uni-patterns+ GHC-Options: -Wall -Wcompat -Wincomplete-uni-patterns -optP-Wno-unicode-homoglyph Library Import: common@@ -432,27 +435,29 @@ Dhall.Test.Schemas Dhall.Test.SemanticHash Dhall.Test.Substitution- Dhall.Test.TH Dhall.Test.Tutorial Dhall.Test.TypeInference Dhall.Test.Util+ if !flag(cross)+ Other-Modules:+ Dhall.Test.TH Build-Depends: dhall , foldl < 1.5 , generic-random >= 1.3.0.0 && < 1.6 , http-client , http-client-tls ,- QuickCheck >= 2.14 && < 2.15,+ QuickCheck >= 2.14 && < 2.16, quickcheck-instances >= 0.3.12 && < 0.4 , special-values < 0.2 , spoon < 0.4 ,- tasty >= 0.11.2 && < 1.5 ,+ tasty >= 0.11.2 && < 1.6 , tasty-expected-failure < 0.13, tasty-hunit >= 0.10 && < 0.11,- tasty-quickcheck >= 0.9.2 && < 0.11,+ tasty-quickcheck >= 0.9.2 && < 0.12, tasty-silver < 3.4 , temporary >= 1.2.1 && < 1.4 ,- turtle < 1.7 ,+ turtle >= 1.6 && < 1.7 , Default-Language: Haskell2010 Test-Suite doctest@@ -475,7 +480,7 @@ Main-Is: Main.hs Build-Depends: dhall ,- gauge >= 0.2.3 && < 0.3,+ tasty-bench >= 0.4 && < 0.5, Default-Language: Haskell2010 Other-Extensions: TypeApplications@@ -488,5 +493,5 @@ Main-Is: Main.hs Build-Depends: dhall ,- gauge >= 0.2.3 && < 0.3+ tasty-bench >= 0.4 && < 0.5, Default-Language: Haskell2010
doctest/Main.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -module Main where+module Main (main) where import System.FilePath ((</>)) @@ -13,10 +13,11 @@ main :: IO () main = do- GHC.IO.Encoding.setLocaleEncoding System.IO.utf8- pwd <- System.Directory.getCurrentDirectory+ args <- System.Environment.getArgs+ pwd <- System.Directory.getCurrentDirectory prefix <- System.Directory.makeAbsolute pwd+ let src = prefix </> "src" System.Environment.setEnv "XDG_CACHE_HOME" (pwd </> ".cache") @@ -34,11 +35,12 @@ , "in { name = \"Simon\", favoriteFont = Font.`Comic Sans` } : Person" ] - Test.DocTest.doctest+ Test.DocTest.doctest $ [ "-DWITH_HTTP" , "-DUSE_HTTP_CLIENT_TLS" , "--fast"- , prefix </> "ghc-src"+ ] <> args <>+ [ prefix </> "ghc-src" -- Unfortunately we cannot target the entire @src@ directory. -- The reason is that src/Dhall/Version.hs depends on@@ -47,11 +49,11 @@ -- Instead, we target a selection of modules whose combined module -- dependency tree covers all modules that contain doctests. - -- , prefix </> "src"- , "-i" <> (prefix </> "src")+ -- , src+ , "-i" <> src #if __GLASGOW_HASKELL__ >= 806- , prefix </> "src/Dhall/Deriving.hs"+ , src </> "Dhall/Deriving.hs" #endif- , prefix </> "src/Dhall/Tags.hs"- , prefix </> "src/Dhall/Tutorial.hs"+ , src </> "Dhall/Tags.hs"+ , src </> "Dhall/Tutorial.hs" ]
man/dhall.1 view
@@ -97,4 +97,4 @@ .SH BUGS .PP Please report any bugs you may come across to-https://github.com/dhall-language/dhall-haskell/issues.+https://github.com/dhall-lang/dhall-haskell/issues.
src/Dhall.hs view
@@ -50,6 +50,7 @@ -- * Individual phases , parseWithSettings , resolveWithSettings+ , resolveAndStatusWithSettings , typecheckWithSettings , checkWithSettings , expectWithSettings@@ -63,7 +64,7 @@ import Control.Monad.Catch (MonadThrow, throwM) import Data.Either.Validation (Validation (..)) import Data.Void (Void)-import Dhall.Import (Imported (..))+import Dhall.Import (Imported (..), Status) import Dhall.Parser (Src (..)) import Dhall.Syntax (Expr (..), Import) import Dhall.TypeCheck (DetailedTypeError (..), TypeError)@@ -262,7 +263,16 @@ `InputSettings` -} resolveWithSettings :: InputSettings -> Expr Src Import -> IO (Expr Src Void)-resolveWithSettings settings expression = do+resolveWithSettings settings expression =+ fst <$> resolveAndStatusWithSettings settings expression++-- | A version of 'resolveWithSettings' that also returns the import 'Status'+-- together with the resolved expression.+resolveAndStatusWithSettings+ :: InputSettings+ -> Expr Src Import+ -> IO (Expr Src Void, Status)+resolveAndStatusWithSettings settings expression = do let InputSettings{..} = settings let EvaluateSettings{..} = _evaluateSettings@@ -274,9 +284,11 @@ let status = transform (Dhall.Import.emptyStatusWithManager _newManager _rootDirectory) - resolved <- State.evalStateT (Dhall.Import.loadWith expression) status+ (resolved, status') <- State.runStateT (Dhall.Import.loadWith expression) status - pure (Dhall.Substitution.substitute resolved (view substitutions settings))+ let substituted = Dhall.Substitution.substitute resolved (view substitutions settings)++ pure (substituted, status') -- | Normalize an expression, using the supplied `InputSettings` normalizeWithSettings :: InputSettings -> Expr Src Void -> Expr Src Void
src/Dhall/Diff.hs view
@@ -41,16 +41,16 @@ 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.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 Prettyprinter as Pretty+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
@@ -42,6 +42,7 @@ import System.PosixCompat.Types (FileMode, GroupID, UserID) import qualified Control.Exception as Exception+import qualified Data.ByteString as ByteString import qualified Data.Foldable as Foldable import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO@@ -179,8 +180,8 @@ RecordLit keyValues -> Map.unorderedTraverseWithKey_ process $ recordFieldValue <$> keyValues - ListLit (Just (Record [ ("mapKey", recordFieldValue -> Text), ("mapValue", _) ])) [] ->- return ()+ ListLit (Just (App List (Record [ ("mapKey", recordFieldValue -> Text), ("mapValue", _) ]))) [] ->+ Directory.createDirectoryIfMissing allowSeparators path ListLit _ records | not (null records)@@ -279,7 +280,7 @@ -- | Resolve a `Group` to a numerical id. getGroup :: Group -> IO GroupID getGroup (GroupId gid) = return gid-getGroup (GroupName name) = +getGroup (GroupName name) = #ifdef mingw32_HOST_OS ioError $ mkIOError illegalOperationErrorType x Nothing Nothing where x = "System.Posix.User.getGroupEntryForName: not supported"@@ -290,21 +291,29 @@ -- | Process a `FilesystemEntry`. Writes the content to disk and apply the -- metadata to the newly created item. processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO ()-processFilesystemEntry allowSeparators path (DirectoryEntry entry) = do- let path' = path </> entryName entry- when (hasMetadata entry && not isMetadataSupported) $- Exception.throwIO $ MetadataUnsupportedError path'- Directory.createDirectoryIfMissing allowSeparators path'- processFilesystemEntryList allowSeparators path' $ entryContent entry- -- It is important that we write the metadata after we wrote the content of- -- the directories/files below this directory as we might lock ourself out- -- by changing ownership or permissions.- applyMetadata entry path'-processFilesystemEntry _ path (FileEntry entry) = do+processFilesystemEntry allowSeparators path (DirectoryEntry entry) =+ processEntryWith path entry $ \path' content -> do+ Directory.createDirectoryIfMissing allowSeparators path'+ processFilesystemEntryList allowSeparators path' content+processFilesystemEntry allowSeparators path (FileEntry entry) = do+ Util.printWarning "`file` is deprecated and will be removed eventually. Please use `text-file` instead."+ processFilesystemEntry allowSeparators path (TextFileEntry entry)+processFilesystemEntry _ path (BinaryFileEntry entry) =+ processEntryWith path entry ByteString.writeFile+processFilesystemEntry _ path (TextFileEntry entry) =+ processEntryWith path entry Text.IO.writeFile++-- | A helper function used by 'processFilesystemEntry'.+processEntryWith+ :: FilePath+ -> Entry a+ -> (FilePath -> a -> IO ())+ -> IO ()+processEntryWith path entry f = do let path' = path </> entryName entry when (hasMetadata entry && not isMetadataSupported) $- Exception.throwIO $ MetadataUnsupportedError path'- Text.IO.writeFile path' $ entryContent entry+ Exception.throwIO (MetadataUnsupportedError path')+ f path' (entryContent entry) -- It is important that we write the metadata after we wrote the content of -- the file as we might lock ourself out by changing ownership or -- permissions.
src/Dhall/DirectoryTree/Types.hs view
@@ -27,6 +27,7 @@ , isMetadataSupported ) where +import Data.ByteString (ByteString) import Data.Functor.Identity (Identity (..)) import Data.Sequence (Seq) import Data.Text (Text)@@ -72,6 +73,8 @@ data FilesystemEntry = DirectoryEntry (Entry (Seq FilesystemEntry)) | FileEntry (Entry Text)+ | BinaryFileEntry (Entry ByteString)+ | TextFileEntry (Entry Text) deriving (Eq, Generic, Ord, Show) instance FromDhall FilesystemEntry where@@ -82,6 +85,10 @@ DirectoryEntry <$> extract (autoWith normalizer) entry Make "file" entry -> FileEntry <$> extract (autoWith normalizer) entry+ Make "binary-file" entry ->+ BinaryFileEntry <$> extract (autoWith normalizer) entry+ Make "text-file" entry ->+ TextFileEntry <$> extract (autoWith normalizer) entry expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) expr }
src/Dhall/Eval.hs view
@@ -527,9 +527,12 @@ -- following issue: -- -- https://github.com/ghcjs/ghcjs/issues/782- let go !acc 0 = acc- go acc m = go (vApp succ acc) (m - 1)- in go zero (fromIntegral n' :: Integer)+ go zero (fromIntegral n' :: Integer) where+ go !acc 0 = acc+ go acc m =+ -- Detect a shortcut: if succ acc == acc then return acc immediately.+ let next = vApp succ acc+ in if conv env next acc then acc else go next (m - 1) _ -> inert NaturalBuild -> VPrim $ \case
src/Dhall/Import.hs view
@@ -172,6 +172,7 @@ import Data.Typeable (Typeable) import Data.Void (Void, absurd) import Dhall.TypeCheck (TypeError)+import Dhall.Util (printWarning) import Dhall.Syntax ( Chunks (..)@@ -1279,15 +1280,6 @@ loadWithStatus (makeEmptyStatus newManager defaultOriginHeaders ".") UseSemanticCache--printWarning :: (MonadIO m) => String -> m ()-printWarning message = do- let warning =- "\n"- <> "\ESC[1;33mWarning\ESC[0m: "- <> message-- liftIO $ System.IO.hPutStrLn System.IO.stderr warning -- | Resolve all imports within an expression, importing relative to the given -- directory.
src/Dhall/Import/Headers.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-}@@ -9,7 +10,12 @@ , toOriginHeaders ) where -import Control.Applicative (Alternative (..), liftA2)+import Control.Applicative+ ( Alternative (..)+#if !MIN_VERSION_base(4,18,0)+ , liftA2+#endif+ ) import Control.Exception (SomeException) import Control.Monad.Catch (handle, throwM) import Data.Text (Text)
src/Dhall/Map.hs view
@@ -77,7 +77,7 @@ import Prelude hiding (filter, lookup) import qualified Data.List-import qualified Data.Map+import qualified Data.Map.Strict import qualified Data.Set import qualified GHC.Exts import qualified Prelude@@ -89,7 +89,7 @@ This is done primarily to avoid a dependency on @insert-ordered-containers@ and also to improve performance -}-data Map k v = Map (Data.Map.Map k v) (Keys k)+data Map k v = Map (Data.Map.Strict.Map k v) (Keys k) deriving (Data, Generic, Lift, NFData) data Keys a@@ -99,7 +99,7 @@ instance (Ord k, Eq v) => Eq (Map k v) where m1 == m2 =- Data.Map.size (toMap m1) == Data.Map.size (toMap m2)+ Data.Map.Strict.size (toMap m1) == Data.Map.Strict.size (toMap m2) && toList m1 == toList m2 {-# INLINABLE (==) #-} @@ -142,7 +142,7 @@ prop> \x -> mempty <> x == (x :: Map Int Int) -} instance Ord k => Monoid (Map k v) where- mempty = Map Data.Map.empty (Original [])+ mempty = Map Data.Map.Strict.empty (Original []) {-# INLINABLE mempty #-} instance (Show k, Show v, Ord k) => Show (Map k v) where@@ -170,7 +170,7 @@ singleton :: k -> v -> Map k v singleton k v = Map m ks where- m = Data.Map.singleton k v+ m = Data.Map.Strict.singleton k v ks = Original [k] {-# INLINABLE singleton #-}@@ -194,7 +194,7 @@ fromList :: Ord k => [(k, v)] -> Map k v fromList kvs = Map m ks where- m = Data.Map.fromList kvs+ m = Data.Map.Strict.fromList kvs ks = Original (nubOrd (map fst kvs)) {-# INLINABLE fromList #-}@@ -207,13 +207,13 @@ fromListWithKey :: Ord k => (k -> v -> v -> v) -> [(k, v)] -> Map k v fromListWithKey f kvs = Map m ks where- m = Data.Map.fromListWithKey f kvs+ m = Data.Map.Strict.fromListWithKey f kvs ks = Original (nubOrd (map fst kvs)) {-# INLINABLE fromListWithKey #-} --- | Create a `Map` from a @"Data.Map".`Data.Map.Map`@-fromMap :: Data.Map.Map k v -> Map k v+-- | Create a `Map` from a @"Data.Map.Strict".`Data.Map.Strict.Map`@+fromMap :: Data.Map.Strict.Map k v -> Map k v fromMap m = Map m Sorted {-| Remove duplicates from a list@@ -242,7 +242,7 @@ unorderedSingleton :: k -> v -> Map k v unorderedSingleton k v = Map m Sorted where- m = Data.Map.singleton k v+ m = Data.Map.Strict.singleton k v {-# INLINABLE unorderedSingleton #-} {-| Create a `Map` from a list of key-value pairs@@ -259,7 +259,7 @@ unorderedFromList :: Ord k => [(k, v)] -> Map k v unorderedFromList kvs = Map m Sorted where- m = Data.Map.fromList kvs+ m = Data.Map.Strict.fromList kvs {-# INLINABLE unorderedFromList #-} {-| Sort the keys of a `Map`, forgetting the original ordering@@ -284,7 +284,7 @@ -} isSorted :: Eq k => Map k v -> Bool isSorted (Map _ Sorted) = True-isSorted (Map m (Original ks)) = Data.Map.keys m == ks -- Or shortcut to False here?+isSorted (Map m (Original ks)) = Data.Map.Strict.keys m == ks -- Or shortcut to False here? {-# INLINABLE isSorted #-} {-| Insert a key-value pair into a `Map`, overriding any previous value stored@@ -298,10 +298,10 @@ fromList [("C",1),("A",3)] -} insert :: Ord k => k -> v -> Map k v -> Map k v-insert k v (Map m Sorted) = Map (Data.Map.insert k v m) Sorted+insert k v (Map m Sorted) = Map (Data.Map.Strict.insert k v m) Sorted insert k v (Map m (Original ks)) = Map m' (Original ks') where- (mayOldV, m') = Data.Map.insertLookupWithKey (\_k new _old -> new) k v m+ (mayOldV, m') = Data.Map.Strict.insertLookupWithKey (\_k new _old -> new) k v m ks' | Just _ <- mayOldV = ks | otherwise = k : ks@@ -316,10 +316,10 @@ fromList [("C",3),("A",3)] -} insertWith :: Ord k => (v -> v -> v) -> k -> v -> Map k v -> Map k v-insertWith f k v (Map m Sorted) = Map (Data.Map.insertWith f k v m) Sorted+insertWith f k v (Map m Sorted) = Map (Data.Map.Strict.insertWith f k v m) Sorted insertWith f k v (Map m (Original ks)) = Map m' (Original ks') where- (mayOldV, m') = Data.Map.insertLookupWithKey (\_k new old -> f new old) k v m+ (mayOldV, m') = Data.Map.Strict.insertLookupWithKey (\_k new old -> f new old) k v m ks' | Just _ <- mayOldV = ks | otherwise = k : ks@@ -335,7 +335,7 @@ delete :: Ord k => k -> Map k v -> Map k v delete k (Map m ks) = Map m' ks' where- m' = Data.Map.delete k m+ m' = Data.Map.Strict.delete k m ks' = case ks of Sorted -> Sorted@@ -352,9 +352,9 @@ filter :: Ord k => (a -> Bool) -> Map k a -> Map k a filter predicate (Map m ks) = Map m' ks' where- m' = Data.Map.filter predicate m+ m' = Data.Map.Strict.filter predicate m - ks' = filterKeys (\k -> Data.Map.member k m') ks+ ks' = filterKeys (\k -> Data.Map.Strict.member k m') ks {-# INLINABLE filter #-} {-| Split the map into values that do and don't satisfy the predicate@@ -367,9 +367,9 @@ partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a) partition predicate (Map m ks) = (Map mpass kpass, Map mfail kfail) where- (mpass, mfail) = Data.Map.partition predicate m+ (mpass, mfail) = Data.Map.Strict.partition predicate m - (kpass, kfail) = partitionKeys (\k -> Data.Map.member k mpass) ks+ (kpass, kfail) = partitionKeys (\k -> Data.Map.Strict.member k mpass) ks {-# INLINABLE partition #-} {-| Restrict a 'Map' to only those keys found in a @"Data.Set".'Data.Set.Set'@.@@ -380,7 +380,7 @@ restrictKeys :: Ord k => Map k a -> Data.Set.Set k -> Map k a restrictKeys (Map m ks) s = Map m' ks' where- m' = Data.Map.restrictKeys m s+ m' = Data.Map.Strict.restrictKeys m s ks' = filterKeys (\k -> Data.Set.member k s) ks {-# INLINABLE restrictKeys #-}@@ -393,7 +393,7 @@ withoutKeys :: Ord k => Map k a -> Data.Set.Set k -> Map k a withoutKeys (Map m ks) s = Map m' ks' where- m' = Data.Map.withoutKeys m s+ m' = Data.Map.Strict.withoutKeys m s ks' = filterKeys (\k -> Data.Set.notMember k s) ks {-# INLINABLE withoutKeys #-}@@ -407,9 +407,9 @@ mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b mapMaybe f (Map m ks) = Map m' ks' where- m' = Data.Map.mapMaybe f m+ m' = Data.Map.Strict.mapMaybe f m - ks' = filterKeys (\k -> Data.Map.member k m') ks+ ks' = filterKeys (\k -> Data.Map.Strict.member k m') ks {-# INLINABLE mapMaybe #-} {-| Retrieve a key from a `Map`@@ -424,7 +424,7 @@ Nothing -} lookup :: Ord k => k -> Map k v -> Maybe v-lookup k (Map m _) = Data.Map.lookup k m+lookup k (Map m _) = Data.Map.Strict.lookup k m {-# INLINABLE lookup #-} {-| Retrieve the first key, value of the 'Map', if present,@@ -442,9 +442,9 @@ uncons :: Ord k => Map k v -> Maybe (k, v, Map k v) uncons (Map _ (Original [])) = Nothing uncons (Map m (Original (k:ks))) =- Just (k, m Data.Map.! k, Map (Data.Map.delete k m) (Original ks))+ Just (k, m Data.Map.Strict.! k, Map (Data.Map.Strict.delete k m) (Original ks)) uncons (Map m Sorted)- | Just ((k, v), m') <- Data.Map.minViewWithKey m = Just (k, v, Map m' Sorted)+ | Just ((k, v), m') <- Data.Map.Strict.minViewWithKey m = Just (k, v, Map m' Sorted) | otherwise = Nothing {-# INLINABLE uncons #-} @@ -460,7 +460,7 @@ False -} member :: Ord k => k -> Map k v -> Bool-member k (Map m _) = Data.Map.member k m+member k (Map m _) = Data.Map.Strict.member k m {-# INLINABLE member #-} {-|@@ -468,7 +468,7 @@ 1 -} size :: Map k v -> Int-size (Map m _) = Data.Map.size m+size (Map m _) = Data.Map.Strict.size m {-# INLINABLE size #-} {-| Combine two `Map`s, preferring keys from the first `Map`@@ -483,11 +483,11 @@ union :: Ord k => Map k v -> Map k v -> Map k v union (Map mL ksL) (Map mR ksR) = Map m ks where- m = Data.Map.union mL mR+ m = Data.Map.Strict.union mL mR ks = case (ksL, ksR) of (Original l, Original r) -> Original $- l <|> Prelude.filter (\k -> Data.Map.notMember k mL) r+ l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k mL) r _ -> Sorted {-# INLINABLE union #-} @@ -501,11 +501,11 @@ unionWith :: Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v unionWith combine (Map mL ksL) (Map mR ksR) = Map m ks where- m = Data.Map.unionWith combine mL mR+ m = Data.Map.Strict.unionWith combine mL mR ks = case (ksL, ksR) of (Original l, Original r) -> Original $- l <|> Prelude.filter (\k -> Data.Map.notMember k mL) r+ l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k mL) r _ -> Sorted {-# INLINABLE unionWith #-} @@ -526,7 +526,7 @@ -> Map k c outerJoin fa fb fab (Map ma ksA) (Map mb ksB) = Map m ks where- m = Data.Map.mergeWithKey+ m = Data.Map.Strict.mergeWithKey (\k a b -> Just (fab k a b)) (fmap fa) (fmap fb)@@ -535,7 +535,7 @@ ks = case (ksA, ksB) of (Original l, Original r) -> Original $- l <|> Prelude.filter (\k -> Data.Map.notMember k ma) r+ l <|> Prelude.filter (\k -> Data.Map.Strict.notMember k ma) r _ -> Sorted {-# INLINABLE outerJoin #-} @@ -550,10 +550,10 @@ intersection :: Ord k => Map k a -> Map k b -> Map k a intersection (Map mL ksL) (Map mR _) = Map m ks where- m = Data.Map.intersection mL mR+ m = Data.Map.Strict.intersection mL mR -- Or forget order unless both maps are ordered?!- ks = filterKeys (\k -> Data.Map.member k m) ksL+ ks = filterKeys (\k -> Data.Map.Strict.member k m) ksL {-# INLINABLE intersection #-} {-| Combine two `Map`s on their shared keys, using the supplied function to@@ -565,10 +565,10 @@ intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c intersectionWith combine (Map mL ksL) (Map mR _) = Map m ks where- m = Data.Map.intersectionWith combine mL mR+ m = Data.Map.Strict.intersectionWith combine mL mR -- Or forget order unless both maps are ordered?!- ks = filterKeys (\k -> Data.Map.member k m) ksL+ ks = filterKeys (\k -> Data.Map.Strict.member k m) ksL {-# INLINABLE intersectionWith #-} {-| Compute the difference of two `Map`s by subtracting all keys from the@@ -580,9 +580,9 @@ difference :: Ord k => Map k a -> Map k b -> Map k a difference (Map mL ksL) (Map mR _) = Map m ks where- m = Data.Map.difference mL mR+ m = Data.Map.Strict.difference mL mR - ks = filterKeys (\k -> Data.Map.notMember k mR) ksL+ ks = filterKeys (\k -> Data.Map.Strict.notMember k mR) ksL {-# INLINABLE difference #-} {-| Fold all of the key-value pairs in a `Map`, in their original order@@ -591,7 +591,7 @@ ("BA",[1,2]) -} foldMapWithKey :: (Monoid m, Ord k) => (k -> a -> m) -> Map k a -> m-foldMapWithKey f (Map m Sorted) = Data.Map.foldMapWithKey f m+foldMapWithKey f (Map m Sorted) = Data.Map.Strict.foldMapWithKey f m foldMapWithKey f m = foldMap (uncurry f) (toList m) {-# INLINABLE foldMapWithKey #-} @@ -611,7 +611,7 @@ mapWithKey :: (k -> a -> b) -> Map k a -> Map k b mapWithKey f (Map m ks) = Map m' ks where- m' = Data.Map.mapWithKey f m+ m' = Data.Map.Strict.mapWithKey f m {-# INLINABLE mapWithKey #-} {-| Traverse all of the key-value pairs in a `Map`, in their original order@@ -622,9 +622,9 @@ traverseWithKey :: Ord k => Applicative f => (k -> a -> f b) -> Map k a -> f (Map k b) traverseWithKey f (Map m Sorted) =- fmap (\m' -> Map m' Sorted) (Data.Map.traverseWithKey f m)-traverseWithKey f m =- fmap fromList (traverse f' (toList m))+ fmap (\m' -> Map m' Sorted) (Data.Map.Strict.traverseWithKey f m)+traverseWithKey f m@(Map _ ks) =+ flip Map ks . Data.Map.Strict.fromList <$> traverse f' (toList m) where f' (k, a) = fmap ((,) k) (f k a) {-# INLINABLE traverseWithKey #-}@@ -635,7 +635,7 @@ unorderedTraverseWithKey :: Ord k => Applicative f => (k -> a -> f b) -> Map k a -> f (Map k b) unorderedTraverseWithKey f (Map m ks) =- fmap (\m' -> Map m' ks) (Data.Map.traverseWithKey f m)+ fmap (\m' -> Map m' ks) (Data.Map.Strict.traverseWithKey f m) {-# INLINABLE unorderedTraverseWithKey #-} {-| Traverse all of the key-value pairs in a 'Map', not preserving their@@ -647,7 +647,7 @@ unorderedTraverseWithKey_ :: Ord k => Applicative f => (k -> a -> f ()) -> Map k a -> f () unorderedTraverseWithKey_ f (Map m _) =- Data.Map.foldlWithKey' (\acc k v -> acc *> f k v) (pure ()) m+ Data.Map.Strict.foldlWithKey' (\acc k v -> acc *> f k v) (pure ()) m {-# INLINABLE unorderedTraverseWithKey_ #-} {-| Convert a `Map` to a list of key-value pairs in the original order of keys@@ -656,22 +656,22 @@ [("B",1),("A",2)] -} toList :: Ord k => Map k v -> [(k, v)]-toList (Map m Sorted) = Data.Map.toList m-toList (Map m (Original ks)) = fmap (\k -> (k, m Data.Map.! k)) ks+toList (Map m Sorted) = Data.Map.Strict.toList m+toList (Map m (Original ks)) = fmap (\k -> (k, m Data.Map.Strict.! k)) ks {-# INLINABLE toList #-} {-| Convert a `Map` to a list of key-value pairs in ascending order of keys -} toAscList :: Map k v -> [(k, v)]-toAscList (Map m _) = Data.Map.toAscList m+toAscList (Map m _) = Data.Map.Strict.toAscList m {-# INLINABLE toAscList #-} -{-| Convert a @"Dhall.Map".`Map`@ to a @"Data.Map".`Data.Map.Map`@+{-| Convert a @"Dhall.Map".`Map`@ to a @"Data.Map.Strict".`Data.Map.Strict.Map`@ >>> toMap (fromList [("B",1),("A",2)]) -- Order is lost upon conversion fromList [("A",2),("B",1)] -}-toMap :: Map k v -> Data.Map.Map k v+toMap :: Map k v -> Data.Map.Strict.Map k v toMap (Map m _) = m {-# INLINABLE toMap #-} @@ -681,7 +681,7 @@ ["B","A"] -} keys :: Map k v -> [k]-keys (Map m Sorted) = Data.Map.keys m+keys (Map m Sorted) = Data.Map.Strict.keys m keys (Map _ (Original ks)) = ks {-# INLINABLE keys #-} @@ -691,8 +691,8 @@ [1,2] -} elems :: Ord k => Map k v -> [v]-elems (Map m Sorted) = Data.Map.elems m-elems (Map m (Original ks)) = fmap (\k -> m Data.Map.! k) ks+elems (Map m Sorted) = Data.Map.Strict.elems m+elems (Map m (Original ks)) = fmap (\k -> m Data.Map.Strict.! k) ks {-# INLINABLE elems #-} {-| Return the @"Data.Set".'Data.Set.Set'@ of the keys@@ -701,7 +701,7 @@ fromList ["A","B"] -} keysSet :: Map k v -> Data.Set.Set k-keysSet (Map m _) = Data.Map.keysSet m+keysSet (Map m _) = Data.Map.Strict.keysSet m {-# INLINABLE keysSet #-} filterKeys :: (a -> Bool) -> Keys a -> Keys a
src/Dhall/Marshal/Decode.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DerivingStrategies #-}@@ -135,7 +136,12 @@ ) where -import Control.Applicative (empty, liftA2)+import Control.Applicative+ ( empty+#if !MIN_VERSION_base(4,18,0)+ , liftA2+#endif+ ) import Control.Exception (Exception) import Control.Monad (guard) import Control.Monad.Trans.State.Strict@@ -1604,14 +1610,15 @@ instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractError s a) where show (TypeMismatch e) = show e show (ExpectedTypeError e) = show e- show (ExtractError es) =- _ERROR <> ": Failed extraction \n\- \ \n\- \The expression type-checked successfully but the transformation to the target \n\- \type failed with the following error: \n\- \ \n\- \" <> Data.Text.unpack es <> "\n\- \ \n"+ show (ExtractError es) = unlines+ [ _ERROR <> ": Failed extraction "+ , " "+ , "The expression type-checked successfully but the transformation to the target "+ , "type failed with the following error: "+ , " "+ , Data.Text.unpack es+ , " "+ ] instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractError s a) @@ -1669,24 +1676,22 @@ instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecoder s a) instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where- show InvalidDecoder { .. } =- _ERROR <> ": Invalid Dhall.Decoder \n\- \ \n\- \Every Decoder must provide an extract function that does not fail with a type \n\- \error if an expression matches the expected type. You provided a Decoder that \n\- \disobeys this contract \n\- \ \n\- \The Decoder provided has the expected dhall type: \n\- \ \n\- \" <> show txt0 <> "\n\- \ \n\- \and it threw a type error during extraction from the well-typed expression: \n\- \ \n\- \" <> show txt1 <> "\n\- \ \n"- where- txt0 = Dhall.Util.insert invalidDecoderExpected- txt1 = Dhall.Util.insert invalidDecoderExpression+ show InvalidDecoder { .. } = unlines+ [ _ERROR <> ": Invalid Dhall.Decoder "+ , " "+ , "Every Decoder must provide an extract function that does not fail with a type "+ , "error if an expression matches the expected type. You provided a Decoder that "+ , "disobeys this contract "+ , " "+ , "The Decoder provided has the expected dhall type: "+ , " "+ , show (Dhall.Util.insert invalidDecoderExpected)+ , " "+ , "and it threw a type error during extraction from the well-typed expression: "+ , " "+ , show (Dhall.Util.insert invalidDecoderExpression)+ , " "+ ] {-| Useful synonym for the `Validation` type used when marshalling Dhall expressions.
src/Dhall/Normalize.hs view
@@ -211,8 +211,16 @@ strict = strictLoop (fromIntegral n0 :: Integer) lazy = loop ( lazyLoop (fromIntegral n0 :: Integer)) - strictLoop 0 = loop zero- strictLoop !n = App succ' <$> strictLoop (n - 1) >>= loop+ strictLoop !n = do+ z <- loop zero+ strictLoopShortcut n z++ strictLoopShortcut 0 !previous = pure previous+ strictLoopShortcut !n !previous = do+ current <- loop (App succ' previous)+ if judgmentallyEqual previous current+ then pure previous+ else strictLoopShortcut (n - 1) current lazyLoop 0 = zero lazyLoop !n = App succ' (lazyLoop (n - 1))
src/Dhall/Parser/Combinators.hs view
@@ -23,7 +23,12 @@ ) where -import Control.Applicative (Alternative (..), liftA2)+import Control.Applicative+ ( Alternative (..)+#if !MIN_VERSION_base(4,18,0)+ , liftA2+#endif+ ) import Control.Exception (Exception) import Control.Monad (MonadPlus (..)) import Data.String (IsString (..))@@ -168,6 +173,10 @@ {-# INLINE getParserState #-} updateParserState f = Parser (Text.Megaparsec.updateParserState f)++#if MIN_VERSION_megaparsec(9,4,0)+ mkParsec f = Parser (Text.Megaparsec.mkParsec f)+#endif instance Semigroup a => Semigroup (Parser a) where (<>) = liftA2 (<>)
src/Dhall/Parser/Expression.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}@@ -7,7 +8,13 @@ -- | Parsing Dhall expressions. module Dhall.Parser.Expression where -import Control.Applicative (Alternative (..), liftA2, optional)+import Control.Applicative+ ( Alternative (..)+#if !MIN_VERSION_base(4,18,0)+ , liftA2+#endif+ , optional+ ) import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)
src/Dhall/Parser/Token.hs view
@@ -299,11 +299,14 @@ -} naturalLiteral :: Parser Natural naturalLiteral = (do- a <- try (char '0' >> char 'x' >> Text.Megaparsec.Char.Lexer.hexadecimal)+ a <- binary+ <|> hexadecimal <|> decimal <|> (char '0' $> 0) return a ) <?> "literal" where+ binary = try (char '0' >> char 'b' >> Text.Megaparsec.Char.Lexer.binary)+ hexadecimal = try (char '0' >> char 'x' >> Text.Megaparsec.Char.Lexer.hexadecimal) decimal = do n <- headDigit ns <- many tailDigit
src/Dhall/Pretty.hs view
@@ -15,6 +15,7 @@ , Dhall.Pretty.Internal.layoutOpts , escapeEnvironmentVariable+ , UnescapedLabel(..) , escapeLabel , temporalToText
src/Dhall/Pretty/Internal.hs view
@@ -31,6 +31,7 @@ , prettyEnvironmentVariable , prettyConst+ , UnescapedLabel(..) , escapeLabel , prettyLabel , prettyAnyLabel@@ -518,27 +519,45 @@ tailCharacter :: Char -> Bool tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/' +-- | The set of labels which do not need to be escaped+data UnescapedLabel+ = NonReservedLabel+ -- ^ This corresponds to the `nonreserved-label` rule in the grammar+ | AnyLabel+ -- ^ This corresponds to the `any-label` rule in the grammar+ | AnyLabelOrSome+ -- ^ This corresponds to the `any-label-or-some` rule in the grammar+ -- | Escape a label if it is not valid when unquoted-escapeLabel :: Bool -> Text -> Text-escapeLabel allowReserved l =+escapeLabel :: UnescapedLabel -> Text -> Text+escapeLabel allowedLabel l = case Text.uncons l of Just (h, t)- | headCharacter h && Text.all tailCharacter t && (notReservedIdentifier || (allowReserved && someOrNotLanguageKeyword)) && l /= "?"+ | headCharacter h && Text.all tailCharacter t && allowed && l /= "?" -> l _ -> "`" <> l <> "`"- where- notReservedIdentifier = not (Data.HashSet.member l reservedIdentifiers)- someOrNotLanguageKeyword = l == "Some" || not (Data.HashSet.member l reservedKeywords)+ where+ allowed = case allowedLabel of+ NonReservedLabel -> notReservedIdentifier+ AnyLabel -> notReservedKeyword+ AnyLabelOrSome -> notReservedKeyword || l == "Some" -prettyLabelShared :: Bool -> Text -> Doc Ann+ notReservedIdentifier = not (Data.HashSet.member l reservedIdentifiers)++ notReservedKeyword = not (Data.HashSet.member l reservedKeywords)++prettyLabelShared :: UnescapedLabel -> Text -> Doc Ann prettyLabelShared b l = label (Pretty.pretty (escapeLabel b l)) prettyLabel :: Text -> Doc Ann-prettyLabel = prettyLabelShared False+prettyLabel = prettyLabelShared NonReservedLabel prettyAnyLabel :: Text -> Doc Ann-prettyAnyLabel = prettyLabelShared True+prettyAnyLabel = prettyLabelShared AnyLabel +prettyAnyLabelOrSome :: Text -> Doc Ann+prettyAnyLabelOrSome = prettyLabelShared AnyLabelOrSome+ prettyKeys :: Foldable list => (key -> Doc Ann)@@ -571,7 +590,7 @@ prettyLabels :: [Text] -> Doc Ann prettyLabels a | null a = lbrace <> rbrace- | otherwise = braces (map (duplicate . prettyAnyLabel) a)+ | otherwise = braces (map (duplicate . prettyAnyLabelOrSome) a) prettyNumber :: Integer -> Doc Ann prettyNumber = literal . Pretty.pretty@@ -846,7 +865,7 @@ prettyKeyValue prettyKey prettyOperatorExpression equals (makeKeyValue b c) - prettyKey (WithLabel text) = prettyAnyLabel text+ prettyKey (WithLabel text) = prettyAnyLabelOrSome text prettyKey WithQuestion = syntax "?" prettyExpression (Assert a) = Pretty.group (Pretty.flatAlt long short)@@ -1558,7 +1577,7 @@ prettyRecord :: Pretty a => Map Text (RecordField Src a) -> Doc Ann prettyRecord = ( braces- . map (prettyKeyValue prettyAnyLabel prettyExpression colon . adapt)+ . map (prettyKeyValue prettyAnyLabelOrSome prettyExpression colon . adapt) . Map.toList ) where@@ -1615,14 +1634,14 @@ | Var (V key' 0) <- Dhall.Syntax.shallowDenote val , key == key' , not (containsComment mSrc2) ->- duplicate (prettyKeys prettyAnyLabel [(mSrc0, key, mSrc1)])+ duplicate (prettyKeys prettyAnyLabelOrSome [(mSrc0, key, mSrc1)]) _ ->- prettyKeyValue prettyAnyLabel prettyExpression equals kv+ prettyKeyValue prettyAnyLabelOrSome prettyExpression equals kv prettyAlternative (key, Just val) =- prettyKeyValue prettyAnyLabel prettyExpression colon (makeKeyValue (pure key) val)+ prettyKeyValue prettyAnyLabelOrSome prettyExpression colon (makeKeyValue (pure key) val) prettyAlternative (key, Nothing) =- duplicate (prettyAnyLabel key)+ duplicate (prettyAnyLabelOrSome key) prettyUnion :: Pretty a => Map Text (Maybe (Expr Src a)) -> Doc Ann prettyUnion =
src/Dhall/Syntax/Chunks.hs-boot view
@@ -1,3 +1,8 @@+{-# LANGUAGE StandaloneKindSignatures #-}+ module Dhall.Syntax.Chunks where +import Data.Kind (Type)++type Chunks :: Type -> Type -> Type data Chunks s a
src/Dhall/Syntax/Expr.hs view
@@ -1,10 +1,12 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneKindSignatures #-} module Dhall.Syntax.Expr ( Expr(..) ) where import Data.ByteString (ByteString)+import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty (..)) import Data.Sequence (Seq) import Data.String (IsString (..))@@ -41,6 +43,7 @@ * If @a = `Data.Void.Void`@ then the code has no `Dhall.Syntax.Import.Import`s -}+type Expr :: Type -> Type -> Type data Expr s a -- | > Const c ~ c = Const Const
src/Dhall/Syntax/Expr.hs-boot view
@@ -1,3 +1,8 @@+{-# LANGUAGE StandaloneKindSignatures #-}+ module Dhall.Syntax.Expr where +import Data.Kind (Type)++type Expr :: Type -> Type -> Type data Expr s a
src/Dhall/Syntax/Types.hs-boot view
@@ -1,9 +1,14 @@+{-# LANGUAGE StandaloneKindSignatures #-}+ module Dhall.Syntax.Types where +import Data.Kind (Type)+ data DhallDouble data PreferAnnotation +type FieldSelection :: Type -> Type data FieldSelection s data WithComponent
src/Dhall/TH.hs view
@@ -20,12 +20,14 @@ , defaultGenerateOptions ) where +import Control.Monad (forM_) import Data.Bifunctor (first) import Data.Text (Text) import Dhall (FromDhall, ToDhall) import Dhall.Syntax (Expr (..), FunctionBinding (..), Var (..)) import GHC.Generics (Generic) import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ)+import Lens.Family (view) import Prettyprinter (Pretty) import Language.Haskell.TH.Syntax@@ -52,16 +54,17 @@ import qualified Data.Typeable as Typeable import qualified Dhall import qualified Dhall.Core as Core+import qualified Dhall.Import 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 TH 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 resulting AST is self-contained. @@ -88,15 +91,35 @@ -} staticDhallExpression :: Text -> Q Exp staticDhallExpression text = do- Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)+ TH.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) - expression <- Syntax.runIO (Dhall.inputExpr text)+ (expression, status) <- TH.runIO $ do+ parsed <- Dhall.parseWithSettings Dhall.defaultInputSettings text + (resolved, status) <- Dhall.resolveAndStatusWithSettings Dhall.defaultInputSettings parsed++ _ <- Dhall.typecheckWithSettings Dhall.defaultInputSettings resolved++ let normalized = Dhall.normalizeWithSettings Dhall.defaultInputSettings resolved++ pure (normalized, status)++ forM_ (Dhall.Map.keys (view Dhall.Import.cache status)) $ \chained ->+ case Dhall.Import.chainedImport chained of+ Core.Import+ { importHashed = Core.ImportHashed+ { importType = Core.Local prefix file+ }+ } -> do+ fp <- Dhall.Import.localToPath prefix file+ TH.addDependentFile fp+ _ -> return ()+ dataToExpQ (fmap liftText . Typeable.cast) expression where -- A workaround for a problem in TemplateHaskell (see -- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable)- liftText = fmap (AppE (VarE 'Text.pack)) . Syntax.lift . Text.unpack+ liftText = fmap (AppE (VarE 'Text.pack)) . TH.lift . Text.unpack {-| A quasi-quoter for Dhall expressions. @@ -161,9 +184,9 @@ , " \n" , "... which did not fit any of the above criteria." ]- + message dhallType = Pretty.renderString (Dhall.Pretty.layout (document dhallType))- + loop dhallType = case dhallType of Bool -> return (ConT ''Bool)@@ -204,17 +227,17 @@ haskellElementType <- loop dhallElementType return (AppT haskellAppType haskellElementType)- + Var v | Just (V param index) <- List.find (v ==) typeParams -> do- let name = Syntax.mkName $ (Text.unpack param) ++ (show index)+ let name = TH.mkName $ (Text.unpack param) ++ (show index) return (VarT name) | otherwise -> fail $ message v _ | Just haskellType <- List.find (predicate dhallType) haskellTypes -> do- let name = Syntax.mkName (Text.unpack (typeName haskellType))+ let name = TH.mkName (Text.unpack (typeName haskellType)) return (ConT name) | otherwise -> fail $ message dhallType@@ -225,7 +248,7 @@ -- | Generates a `FromDhall` instances. fromDhallInstance- :: Syntax.Name -- ^ The name of the type the instances is for+ :: TH.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|@@ -235,7 +258,7 @@ -- | Generates a `ToDhall` instances. toDhallInstance- :: Syntax.Name -- ^ The name of the type the instances is for+ :: TH.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|@@ -256,7 +279,7 @@ MultipleConstructors{..} -> uncurry (fromMulti typeName) $ getTypeParams code where getTypeParams = first numberConsecutive . getTypeParams_ []- + getTypeParams_ acc (Lam _ (FunctionBinding _ v _ _ _) rest) = getTypeParams_ (v:acc) rest getTypeParams_ acc rest = (acc, rest) @@ -265,15 +288,15 @@ interpretOptions = generateToInterpretOptions generateOptions typ #if MIN_VERSION_template_haskell(2,21,0)- toTypeVar (V n i) = Syntax.PlainTV (Syntax.mkName (Text.unpack n ++ show i)) Syntax.BndrInvis+ toTypeVar (V n i) = TH.PlainTV (TH.mkName (Text.unpack n ++ show i)) TH.BndrReq #elif MIN_VERSION_template_haskell(2,17,0)- toTypeVar (V n i) = Syntax.PlainTV (Syntax.mkName (Text.unpack n ++ show i)) ()+ toTypeVar (V n i) = TH.PlainTV (TH.mkName (Text.unpack n ++ show i)) () #else- toTypeVar (V n i) = Syntax.PlainTV (Syntax.mkName (Text.unpack n ++ show i))+ toTypeVar (V n i) = TH.PlainTV (TH.mkName (Text.unpack n ++ show i)) #endif toDataD typeName typeParams constructors = do- let name = Syntax.mkName (Text.unpack typeName)+ let name = TH.mkName (Text.unpack typeName) let params = fmap toTypeVar typeParams @@ -284,17 +307,17 @@ fromSingle typeName constructorName typeParams dhallType = do constructor <- toConstructor typeParams generateOptions haskellTypes typeName (constructorName, Just dhallType)- + toDataD typeName typeParams [constructor]- + fromMulti typeName typeParams dhallType = case dhallType of Union kts -> do constructors <- traverse (toConstructor typeParams generateOptions haskellTypes typeName) (Dhall.Map.toList kts) toDataD typeName typeParams constructors- - _ -> fail $ message dhallType + _ -> fail $ message dhallType+ message dhallType = Pretty.renderString (Dhall.Pretty.layout $ document dhallType) document dhallType =@@ -355,7 +378,7 @@ -- ^ @(constructorName, fieldType)@ -> Q Con toConstructor typeParams GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do- let name = Syntax.mkName (Text.unpack $ constructorModifier constructorName)+ let name = TH.mkName (Text.unpack $ constructorModifier constructorName) let strictness = if makeStrict then SourceStrict else NoSourceStrictness @@ -368,7 +391,7 @@ && typeName haskellType /= outerTypeName , Just haskellType <- List.find predicate haskellTypes -> do let innerName =- Syntax.mkName (Text.unpack (typeName haskellType))+ TH.mkName (Text.unpack (typeName haskellType)) return (NormalC name [ (bang, ConT innerName) ]) @@ -376,7 +399,7 @@ let process (key, dhallFieldType) = do haskellFieldType <- toNestedHaskellType typeParams haskellTypes dhallFieldType - return (Syntax.mkName (Text.unpack $ fieldModifier key), bang, haskellFieldType)+ return (TH.mkName (Text.unpack $ fieldModifier key), bang, haskellFieldType) varBangTypes <- traverse process (Dhall.Map.toList $ Core.recordFieldValue <$> kts) @@ -508,16 +531,16 @@ mkMatch n = Match (textToPat $ f n) (NormalB $ textToExp n) [] nameE :: Exp- nameE = Syntax.VarE $ Syntax.mkName "n"+ nameE = TH.VarE $ TH.mkName "n" nameP :: Pat- nameP = Syntax.VarP $ Syntax.mkName "n"+ nameP = TH.VarP $ TH.mkName "n" textToExp :: Text -> Exp- textToExp = Syntax.LitE . Syntax.StringL . Text.unpack+ textToExp = TH.LitE . TH.StringL . Text.unpack textToPat :: Text -> Pat- textToPat = Syntax.LitP . Syntax.StringL . Text.unpack+ textToPat = TH.LitP . TH.StringL . Text.unpack -- | Generate a Haskell datatype declaration with one constructor from a Dhall -- type.@@ -605,8 +628,8 @@ -- > makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions makeHaskellTypesWith :: GenerateOptions -> [HaskellType Text] -> Q [Dec] makeHaskellTypesWith generateOptions haskellTypes = do- Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)+ TH.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) - haskellTypes' <- traverse (traverse (Syntax.runIO . Dhall.inputExpr)) haskellTypes+ haskellTypes' <- traverse (traverse (TH.runIO . Dhall.inputExpr)) haskellTypes concat <$> traverse (toDeclaration generateOptions haskellTypes') haskellTypes'
src/Dhall/Tutorial.hs view
@@ -1857,7 +1857,7 @@ -- You can find an up-to-date list of available built-in functions and operators -- here: ----- <https://github.com/dhall-lang/dhall-lang/wiki/Built-in-types%2C-functions%2C-and-operators Built-in types, functions, and operators>+-- <https://docs.dhall-lang.org/references/Built-in-types.html> -- $caveats --@@ -1882,9 +1882,13 @@ -- > -- > (input):1:1 ----- In fact, there are no built-in functions for @Integer@s (or @Double@s) other--- than @Integer/show@ and @Double/show@. As far as the language is concerned--- they are opaque values that can only be shuffled around but not used in any+-- There are no built-in functions for @Integer@ arithmetic; however, conversion+-- to and from @Natural@s is possible usinng @Integer/clamp@, @Integer/negate@+-- and @Natural/toInteger@.+--+-- For @Double@s the situation is even more extreme: there are no built-in+-- functions other than @Double/show@. As far as the language is concerned they+-- are opaque values that can only be shuffled around but not used in any -- meaningful way until they have been loaded into Haskell. -- -- Second, the equality @(==)@ and inequality @(!=)@ operators only work on@@ -2312,4 +2316,4 @@ -- $faq ----- <https://github.com/dhall-lang/dhall-lang/wiki/Frequently-Asked-Questions-(FAQ) Frequently Asked Questions (FAQ)>+-- <https://docs.dhall-lang.org/howtos/FAQ.html>
src/Dhall/TypeCheck.hs view
@@ -47,7 +47,7 @@ , Val (..) , (~>) )-import Dhall.Pretty (Ann)+import Dhall.Pretty (Ann, UnescapedLabel(..)) import Dhall.Src (Src) import Lens.Family (over) import Prettyprinter (Doc, Pretty (..), vsep)@@ -2915,7 +2915,7 @@ \ \n\ \... which is not a record type \n" where- txt0 = insert (Dhall.Pretty.Internal.escapeLabel True k)+ txt0 = insert (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome k) txt1 = insert expr0 txt2 = insert expr1 @@ -3073,7 +3073,7 @@ \ \n\ \" <> txt1 <> "\n" where- txt0 = insert (Dhall.Pretty.Internal.escapeLabel True (NonEmpty.head ks))+ txt0 = insert (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome (NonEmpty.head ks)) txt1 = insert (toPath ks) @@ -5055,7 +5055,7 @@ toPath :: (Functor list, Foldable list) => list Text -> Text toPath ks = Text.intercalate "."- (Foldable.toList (fmap (Dhall.Pretty.Internal.escapeLabel True) ks))+ (Foldable.toList (fmap (Dhall.Pretty.Internal.escapeLabel AnyLabelOrSome) ks)) duplicateElement :: Ord a => [a] -> Maybe a duplicateElement = go Data.Set.empty
src/Dhall/Util.hs view
@@ -9,6 +9,8 @@ , snipDoc , insert , _ERROR+ , _WARNING+ , printWarning , Censor(..) , Input(..) , Transitivity(..)@@ -110,6 +112,21 @@ -- | Prefix used for error messages _ERROR :: IsString string => string _ERROR = "\ESC[1;31mError\ESC[0m"++-- | Prefix used for error messages+_WARNING :: IsString string => string+_WARNING = "\ESC[1;33mWarning\ESC[0m"++-- | Output a warning message on stderr.+printWarning :: (MonadIO m) => String -> m ()+printWarning message = do+ let warning =+ "\n"+ <> _WARNING+ <> ": "+ <> message++ liftIO $ IO.hPutStrLn IO.stderr warning get :: (String -> Text -> Either ParseError a)
tests/Dhall/Test/Diff.hs view
@@ -3,9 +3,7 @@ module Dhall.Test.Diff where 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/Format.hs view
@@ -7,7 +7,6 @@ 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 Dhall.Core as Core@@ -27,7 +26,7 @@ let skip = [ "./tests/format/asciiA.dhall" ] - Monad.guard (path `notElem` skip)+ path `Test.Util.pathNotIn` skip return path
tests/Dhall/Test/Freeze.hs view
@@ -1,15 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} --- FIXME: Re-enable deprecation warnings after removing support for turtle < 1.6.-{-# OPTIONS_GHC -Wno-deprecations #-}- module Dhall.Test.Freeze where import Data.Text (Text) import Dhall.Freeze (Intent (..), Scope (..))-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@@ -53,7 +48,7 @@ parsedInput <- Core.throws (Parser.exprFromText mempty inputText) - actualExpression <- Freeze.freezeExpression (Turtle.encodeString dir) AllImports intent parsedInput+ actualExpression <- Freeze.freezeExpression dir AllImports intent parsedInput let actualText = Core.pretty actualExpression <> "\n"
tests/Dhall/Test/Import.hs view
@@ -2,21 +2,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} --- FIXME: Re-enable deprecation warnings after removing support for turtle < 1.6.-{-# OPTIONS_GHC -Wno-deprecations #-}- module Dhall.Test.Import where import Control.Exception (SomeException)-import Data.Foldable (fold)-import Data.Text (Text, isSuffixOf)+import Data.Text (Text) import Data.Void (Void)-import Prelude hiding (FilePath)+import System.FilePath ((</>)) import Test.Tasty (TestTree)-import Turtle (FilePath, toText, (</>)) import qualified Control.Exception as Exception-import qualified Control.Monad as Monad import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO@@ -31,8 +25,8 @@ import qualified Turtle #if defined(WITH_HTTP) && defined(NETWORK_TESTS)-import qualified Network.HTTP.Client as HTTP-import qualified Network.HTTP.Client.TLS as HTTP+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Client.TLS as HTTP #endif @@ -77,7 +71,7 @@ successTests <- Test.Util.discover (Turtle.chars <* "A.dhall") successTest (do path <- Turtle.lstree (importDirectory </> "success") - Monad.guard (path `notElem` flakyTests)+ path `Test.Util.pathNotIn` flakyTests return path ) @@ -101,8 +95,9 @@ #endif ] - _ <- Monad.guard (path `notElem` expectedSuccesses)- _ <- Monad.guard (not ("ENV.dhall" `isSuffixOf` (fold (toText path))))+ path `Test.Util.pathNotIn` expectedSuccesses+ "ENV.dhall" `Test.Util.pathNotSuffixOf` path+ return path ) let testTree =@@ -176,7 +171,7 @@ not (null (Turtle.match (Turtle.ends path') (Test.Util.toDhallPath prefix))) let buildNewCache = do- tempdir <- fmap Turtle.decodeString (Turtle.managed (Temp.withSystemTempDirectory "dhall-cache"))+ tempdir <- Turtle.managed (Temp.withSystemTempDirectory "dhall-cache") Turtle.liftIO (Turtle.cptree originalCache tempdir) return tempdir
tests/Dhall/Test/Lint.hs view
@@ -4,9 +4,7 @@ import Data.Text (Text) import Dhall.Parser (Header (..))-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/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Main where import System.FilePath ((</>))@@ -17,7 +18,9 @@ import qualified Dhall.Test.Regression import qualified Dhall.Test.Schemas import qualified Dhall.Test.SemanticHash+#ifndef CROSS import qualified Dhall.Test.TH+#endif import qualified Dhall.Test.Tags import qualified Dhall.Test.Tutorial import qualified Dhall.Test.TypeInference@@ -69,7 +72,9 @@ , Dhall.Test.Tutorial.tests , Dhall.Test.QuickCheck.tests , Dhall.Test.Dhall.tests+#ifndef CROSS , Dhall.Test.TH.tests+#endif , Dhall.Test.Package.tests ]
tests/Dhall/Test/Normalization.hs view
@@ -2,12 +2,11 @@ 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 System.FilePath ((</>))+import Test.Tasty (TestTree) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO@@ -17,6 +16,7 @@ import qualified Dhall.Parser as Parser import qualified Dhall.Test.Util as Test.Util import qualified Dhall.TypeCheck as TypeCheck+import qualified System.FilePath as FilePath import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as Tasty.HUnit import qualified Turtle@@ -24,32 +24,41 @@ normalizationDirectory :: FilePath normalizationDirectory = "./dhall-lang/tests/normalization/success" +unitDirectory :: FilePath+unitDirectory = normalizationDirectory </> "unit/"+ getTests :: IO TestTree getTests = do let pattern = Turtle.chars <* "A.dhall" let normalizationFiles = do- path <- Turtle.lstree normalizationDirectory+ path <- FilePath.normalise <$> Turtle.lstree normalizationDirectory - Nothing <- return (Turtle.stripPrefix (normalizationDirectory </> "unit/") path)+ unitDirectory `Test.Util.pathNotPrefixOf` path return path betaNormalizationTests <- Test.Util.discover pattern betaNormalizationTest normalizationFiles - alphaNormalizationTests <- do+ alphaNormalizationTests <- Test.Util.discover pattern alphaNormalizationTest (Turtle.lstree "./dhall-lang/tests/alpha-normalization/success/") - let unitTestFiles = Turtle.lstree (normalizationDirectory </> "unit/")+ let unitTestFiles = Turtle.lstree unitDirectory unitTests <- Test.Util.discover pattern unitTest unitTestFiles let testTree = Tasty.testGroup "normalization"- [ betaNormalizationTests- , unitTests- , alphaNormalizationTests+ [ Tasty.testGroup "beta-normalization"+ [ betaNormalizationTests+ ]+ , Tasty.testGroup "unit tests"+ [ unitTests+ ]+ , Tasty.testGroup "alpha-normalization"+ [ alphaNormalizationTests+ ] , customization ] @@ -128,7 +137,7 @@ let expectedNormalized = Core.denote expectedResolved :: Expr Void Void let message =- "The normalized expression did not match the expected output"+ "The alpha-normalized expression did not match the expected output" Tasty.HUnit.assertEqual message expectedNormalized actualNormalized @@ -200,6 +209,6 @@ Core.alphaNormalize (Core.denote expectedResolved) let message =- "The normalized expression did not match the expected output"+ "The beta-normalized expression did not match the expected output" Tasty.HUnit.assertEqual message expectedNormalized actualNormalized
tests/Dhall/Test/Parser.hs view
@@ -2,12 +2,11 @@ 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 System.FilePath ((</>))+import Test.Tasty (TestTree) import qualified Control.Monad as Monad import qualified Data.Bifunctor as Bifunctor
tests/Dhall/Test/Schemas.hs view
@@ -4,9 +4,7 @@ import Data.Text (Text) import Dhall.Parser (Header (..))-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/SemanticHash.hs view
@@ -3,9 +3,7 @@ module Dhall.Test.SemanticHash where 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/Tags.hs view
@@ -2,11 +2,10 @@ 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 System.FilePath ((</>))+import Test.Tasty (TestTree) import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO@@ -30,7 +29,9 @@ tagsTest :: Text -> TestTree tagsTest prefix = Tasty.HUnit.testCase (Text.unpack prefix) $ do- let inputFile = Text.unpack (prefix <> ".dhall")+ -- The use of toDhallPah is a hack to ensure we always get the same file+ -- paths, i.e. ones with a '.' prefixed and UNIX path separators.+ let inputFile = Text.unpack (Test.Util.toDhallPath prefix <> ".dhall") let outputFile = Text.unpack (prefix <> ".tags") actualTags <- fixPathSeparators <$> Tags.generate (InputFile inputFile) Nothing False@@ -44,7 +45,7 @@ tagsDirTest :: TestTree tagsDirTest = Tasty.HUnit.testCase "all" $ do- let outputFile = Text.unpack . Turtle.format Turtle.fp $ tagsDirectory Turtle.</> "all.tags"+ let outputFile = Text.unpack . Turtle.format Turtle.fp $ tagsDirectory </> "all.tags" actualTags <- fmap fixPathSeparators (Tags.generate
tests/Dhall/Test/TypeInference.hs view
@@ -5,12 +5,10 @@ import Control.Exception (SomeException (..)) import Data.Text (Text)-import Prelude hiding (FilePath)+import System.FilePath ((</>)) import Test.Tasty (TestTree)-import Turtle (FilePath, (</>)) import qualified Control.Exception as Exception-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@@ -38,7 +36,7 @@ , typeInferenceDirectory </> "success/CacheImportsCanonicalizeA.dhall" ] - Monad.guard (path `notElem` skip)+ path `Test.Util.pathNotIn` skip return path
tests/Dhall/Test/Util.hs view
@@ -20,11 +20,15 @@ , assertDoesntTypeCheck , discover , Dhall.Test.Util.testCase+ , pathIn+ , pathNotIn+ , pathNotPrefixOf+ , pathNotSuffixOf , toDhallPath , managedTestEnvironment ) where -import Control.Applicative (liftA2, (<|>))+import Control.Applicative (Alternative, liftA2, (<|>)) import Control.Exception (tryJust) import Control.Monad (guard) import Control.Monad.Trans.State.Strict (StateT)@@ -41,16 +45,16 @@ ) import Dhall.Import (SemanticCacheMode (..), Status (..)) import Dhall.Parser (Src)-import Prelude hiding (FilePath) import System.IO.Error (isDoesNotExistError) import Test.Tasty (TestTree) import Test.Tasty.HUnit-import Turtle (FilePath, Pattern, Shell, fp)+import Turtle (Pattern, Shell, fp) import qualified Control.Exception import qualified Control.Foldl as Foldl import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Functor+import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import qualified Dhall.Context@@ -68,7 +72,7 @@ import qualified Data.Foldable #else import Control.Monad.IO.Class (MonadIO (..))-import Dhall.Core (URL (..), File (..), Directory (..))+import Dhall.Core (Directory (..), File (..), URL (..)) import Lens.Family.State.Strict (zoom) import qualified Data.Foldable@@ -289,7 +293,7 @@ let shell = do path_ <- paths - let pathText = Turtle.format fp path_+ let pathText = Turtle.format fp (FilePath.normalise path_) prefix : _ <- return (Turtle.match pattern pathText) @@ -301,15 +305,29 @@ testCase :: Text -> [ FilePath ] -> Assertion -> TestTree testCase prefix expectedFailures assertion =- if prefix `elem` map (Turtle.format fp) expectedFailures+ if prefix `elem` map (Turtle.format fp . FilePath.normalise) expectedFailures then Tasty.ExpectedFailure.expectFail test else test where test = Test.Tasty.HUnit.testCase (Text.unpack prefix) assertion +pathIn :: Alternative f => FilePath -> [FilePath] -> f ()+pathIn this = guard . any (FilePath.equalFilePath this)++pathNotIn :: Alternative f => FilePath -> [FilePath] -> f ()+pathNotIn this = guard . not . any (FilePath.equalFilePath this)++pathNotPrefixOf :: Alternative f => FilePath -> FilePath -> f ()+pathNotPrefixOf this =+ guard . not . List.isPrefixOf (FilePath.normalise this) . FilePath.normalise++pathNotSuffixOf :: Alternative f => FilePath -> FilePath -> f ()+pathNotSuffixOf this =+ guard . not . List.isSuffixOf (FilePath.normalise this) . FilePath.normalise+ {-| Path names on Windows are not valid Dhall paths due to using backslashes instead of forwardslashes to separate path components. This utility fixes them if necessary -} toDhallPath :: Text -> Text-toDhallPath = Text.replace "\\" "/"+toDhallPath = ("./" <>) . Text.replace "\\" "/"
+ tests/format/issue2601A.dhall view
@@ -0,0 +1,11 @@+let T = < Some | Type >++let t+ : T+ = T.`Some`++let x+ : T+ = T.Type++in True
+ tests/format/issue2601B.dhall view
@@ -0,0 +1,11 @@+let T = < Some | Type >++let t+ : T+ = T.`Some`++let x+ : T+ = T.Type++in True
tests/format/numericLiteralsA.dhall view
@@ -1,1 +1,1 @@-{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 }+{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 }
tests/format/numericLiteralsB.dhall view
@@ -1,1 +1,1 @@-{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 }+{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 }