diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/benchmark/deep-nested-large-record/Main.hs b/benchmark/deep-nested-large-record/Main.hs --- a/benchmark/deep-nested-large-record/Main.hs +++ b/benchmark/deep-nested-large-record/Main.hs @@ -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) diff --git a/benchmark/examples/cpkg.dhall b/benchmark/examples/cpkg.dhall deleted file mode 100644 # file too large to diff: benchmark/examples/cpkg.dhall diff --git a/benchmark/examples/issue108.dhall b/benchmark/examples/issue108.dhall deleted file mode 100644 --- a/benchmark/examples/issue108.dhall +++ /dev/null @@ -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 ) "" diff --git a/benchmark/examples/normalize/ChurchEval.dhall b/benchmark/examples/normalize/ChurchEval.dhall deleted file mode 100644 --- a/benchmark/examples/normalize/ChurchEval.dhall +++ /dev/null @@ -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 diff --git a/benchmark/examples/normalize/FunCompose.dhall b/benchmark/examples/normalize/FunCompose.dhall deleted file mode 100644 --- a/benchmark/examples/normalize/FunCompose.dhall +++ /dev/null @@ -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 diff --git a/benchmark/examples/normalize/ListBench.dhall b/benchmark/examples/normalize/ListBench.dhall deleted file mode 100644 --- a/benchmark/examples/normalize/ListBench.dhall +++ /dev/null @@ -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))) diff --git a/benchmark/examples/normalize/ListBenchAlt.dhall b/benchmark/examples/normalize/ListBenchAlt.dhall deleted file mode 100644 --- a/benchmark/examples/normalize/ListBenchAlt.dhall +++ /dev/null @@ -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))) diff --git a/benchmark/parser/Main.hs b/benchmark/parser/Main.hs --- a/benchmark/parser/Main.hs +++ b/benchmark/parser/Main.hs @@ -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" diff --git a/benchmark/parser/examples/cpkg.dhall b/benchmark/parser/examples/cpkg.dhall new file mode 100644 # file too large to diff: benchmark/parser/examples/cpkg.dhall diff --git a/benchmark/parser/examples/issue108.dhall b/benchmark/parser/examples/issue108.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/issue108.dhall @@ -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 ) "" diff --git a/benchmark/parser/examples/issue108.dhallb b/benchmark/parser/examples/issue108.dhallb new file mode 100644 Binary files /dev/null and b/benchmark/parser/examples/issue108.dhallb differ diff --git a/benchmark/parser/examples/kubernetes.dhallb b/benchmark/parser/examples/kubernetes.dhallb new file mode 100644 # file too large to diff: benchmark/parser/examples/kubernetes.dhallb diff --git a/benchmark/parser/examples/normalize/ChurchEval.dhall b/benchmark/parser/examples/normalize/ChurchEval.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/ChurchEval.dhall @@ -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 diff --git a/benchmark/parser/examples/normalize/FunCompose.dhall b/benchmark/parser/examples/normalize/FunCompose.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/FunCompose.dhall @@ -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 diff --git a/benchmark/parser/examples/normalize/ListBench.dhall b/benchmark/parser/examples/normalize/ListBench.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/ListBench.dhall @@ -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))) diff --git a/benchmark/parser/examples/normalize/ListBenchAlt.dhall b/benchmark/parser/examples/normalize/ListBenchAlt.dhall new file mode 100644 --- /dev/null +++ b/benchmark/parser/examples/normalize/ListBenchAlt.dhall @@ -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))) diff --git a/dhall-lang/Prelude/Function/compose.dhall b/dhall-lang/Prelude/Function/compose.dhall --- a/dhall-lang/Prelude/Function/compose.dhall +++ b/dhall-lang/Prelude/Function/compose.dhall @@ -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 = diff --git a/dhall-lang/Prelude/Function/composeList.dhall b/dhall-lang/Prelude/Function/composeList.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/Prelude/Function/composeList.dhall @@ -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 diff --git a/dhall-lang/Prelude/Function/package.dhall b/dhall-lang/Prelude/Function/package.dhall --- a/dhall-lang/Prelude/Function/package.dhall +++ b/dhall-lang/Prelude/Function/package.dhall @@ -2,6 +2,10 @@ missing sha256:65ad8bbea530b3d8968785a7cf4a9a7976b67059aa15e3b61fcba600a40ae013 ? ./compose.dhall +, composeList = + missing + sha256:2c6931544d8b5a5b14514098c07bd1813f67b16834588d056df3c0bc2e489937 + ? ./composeList.dhall , identity = missing sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 diff --git a/dhall-lang/Prelude/Map/mapMaybe.dhall b/dhall-lang/Prelude/Map/mapMaybe.dhall --- a/dhall-lang/Prelude/Map/mapMaybe.dhall +++ b/dhall-lang/Prelude/Map/mapMaybe.dhall @@ -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 diff --git a/dhall-lang/Prelude/package.dhall b/dhall-lang/Prelude/package.dhall --- a/dhall-lang/Prelude/package.dhall +++ b/dhall-lang/Prelude/package.dhall @@ -12,7 +12,7 @@ ? ./Double/package.dhall , Function = missing - sha256:6d17cf0fd4fabe1737fb117f87c04b8ff82b299915a5b673c0a543b134b8fffe + sha256:f4ca848f69034f9d7a74e12c556c3a3396966c1de3a9427a102d1aff4580192f ? ./Function/package.dhall , Integer = missing diff --git a/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall b/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall --- a/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall +++ b/dhall-lang/tests/import/success/unit/ImportRelativeToHomeB.dhall @@ -1,1 +1,1 @@ -"hello world" +"hello" ++ " world" diff --git a/dhall-lang/tests/parser/success/binaryA.dhall b/dhall-lang/tests/parser/success/binaryA.dhall new file mode 100644 --- /dev/null +++ b/dhall-lang/tests/parser/success/binaryA.dhall @@ -0,0 +1,8 @@ + λ(x : Bool) +→ λ(x : Bool) +→ { example0 = 0b0 + , example1 = 0b10 + , example2 = -0b11001 + , example3 = +0b100 + , example4 = x@0b01 + } diff --git a/dhall-lang/tests/parser/success/binaryB.dhallb b/dhall-lang/tests/parser/success/binaryB.dhallb new file mode 100644 Binary files /dev/null and b/dhall-lang/tests/parser/success/binaryB.dhallb differ diff --git a/dhall-lang/tests/parser/success/builtinsA.dhall b/dhall-lang/tests/parser/success/builtinsA.dhall --- a/dhall-lang/tests/parser/success/builtinsA.dhall +++ b/dhall-lang/tests/parser/success/builtinsA.dhall @@ -29,6 +29,7 @@ , Integer , Double , Text +, Bytes , List , Type , Kind diff --git a/dhall-lang/tests/parser/success/builtinsB.dhallb b/dhall-lang/tests/parser/success/builtinsB.dhallb --- a/dhall-lang/tests/parser/success/builtinsB.dhallb +++ b/dhall-lang/tests/parser/success/builtinsB.dhallb @@ -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 diff --git a/dhall-lang/tests/type-inference/success/preludeB.dhall b/dhall-lang/tests/type-inference/success/preludeB.dhall --- a/dhall-lang/tests/type-inference/success/preludeB.dhall +++ b/dhall-lang/tests/type-inference/success/preludeB.dhall @@ -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 : diff --git a/dhall.cabal b/dhall.cabal --- a/dhall.cabal +++ b/dhall.cabal @@ -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 diff --git a/doctest/Main.hs b/doctest/Main.hs --- a/doctest/Main.hs +++ b/doctest/Main.hs @@ -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" ] diff --git a/man/dhall.1 b/man/dhall.1 --- a/man/dhall.1 +++ b/man/dhall.1 @@ -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. diff --git a/src/Dhall.hs b/src/Dhall.hs --- a/src/Dhall.hs +++ b/src/Dhall.hs @@ -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 diff --git a/src/Dhall/Diff.hs b/src/Dhall/Diff.hs --- a/src/Dhall/Diff.hs +++ b/src/Dhall/Diff.hs @@ -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 diff --git a/src/Dhall/DirectoryTree.hs b/src/Dhall/DirectoryTree.hs --- a/src/Dhall/DirectoryTree.hs +++ b/src/Dhall/DirectoryTree.hs @@ -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. diff --git a/src/Dhall/DirectoryTree/Types.hs b/src/Dhall/DirectoryTree/Types.hs --- a/src/Dhall/DirectoryTree/Types.hs +++ b/src/Dhall/DirectoryTree/Types.hs @@ -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 } diff --git a/src/Dhall/Eval.hs b/src/Dhall/Eval.hs --- a/src/Dhall/Eval.hs +++ b/src/Dhall/Eval.hs @@ -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 diff --git a/src/Dhall/Import.hs b/src/Dhall/Import.hs --- a/src/Dhall/Import.hs +++ b/src/Dhall/Import.hs @@ -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. diff --git a/src/Dhall/Import/Headers.hs b/src/Dhall/Import/Headers.hs --- a/src/Dhall/Import/Headers.hs +++ b/src/Dhall/Import/Headers.hs @@ -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) diff --git a/src/Dhall/Map.hs b/src/Dhall/Map.hs --- a/src/Dhall/Map.hs +++ b/src/Dhall/Map.hs @@ -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 diff --git a/src/Dhall/Marshal/Decode.hs b/src/Dhall/Marshal/Decode.hs --- a/src/Dhall/Marshal/Decode.hs +++ b/src/Dhall/Marshal/Decode.hs @@ -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. diff --git a/src/Dhall/Normalize.hs b/src/Dhall/Normalize.hs --- a/src/Dhall/Normalize.hs +++ b/src/Dhall/Normalize.hs @@ -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)) diff --git a/src/Dhall/Parser/Combinators.hs b/src/Dhall/Parser/Combinators.hs --- a/src/Dhall/Parser/Combinators.hs +++ b/src/Dhall/Parser/Combinators.hs @@ -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 (<>) diff --git a/src/Dhall/Parser/Expression.hs b/src/Dhall/Parser/Expression.hs --- a/src/Dhall/Parser/Expression.hs +++ b/src/Dhall/Parser/Expression.hs @@ -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) diff --git a/src/Dhall/Parser/Token.hs b/src/Dhall/Parser/Token.hs --- a/src/Dhall/Parser/Token.hs +++ b/src/Dhall/Parser/Token.hs @@ -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 diff --git a/src/Dhall/Pretty.hs b/src/Dhall/Pretty.hs --- a/src/Dhall/Pretty.hs +++ b/src/Dhall/Pretty.hs @@ -15,6 +15,7 @@ , Dhall.Pretty.Internal.layoutOpts , escapeEnvironmentVariable + , UnescapedLabel(..) , escapeLabel , temporalToText diff --git a/src/Dhall/Pretty/Internal.hs b/src/Dhall/Pretty/Internal.hs --- a/src/Dhall/Pretty/Internal.hs +++ b/src/Dhall/Pretty/Internal.hs @@ -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 = diff --git a/src/Dhall/Syntax/Chunks.hs-boot b/src/Dhall/Syntax/Chunks.hs-boot --- a/src/Dhall/Syntax/Chunks.hs-boot +++ b/src/Dhall/Syntax/Chunks.hs-boot @@ -1,3 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + module Dhall.Syntax.Chunks where +import Data.Kind (Type) + +type Chunks :: Type -> Type -> Type data Chunks s a diff --git a/src/Dhall/Syntax/Expr.hs b/src/Dhall/Syntax/Expr.hs --- a/src/Dhall/Syntax/Expr.hs +++ b/src/Dhall/Syntax/Expr.hs @@ -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 diff --git a/src/Dhall/Syntax/Expr.hs-boot b/src/Dhall/Syntax/Expr.hs-boot --- a/src/Dhall/Syntax/Expr.hs-boot +++ b/src/Dhall/Syntax/Expr.hs-boot @@ -1,3 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + module Dhall.Syntax.Expr where +import Data.Kind (Type) + +type Expr :: Type -> Type -> Type data Expr s a diff --git a/src/Dhall/Syntax/Types.hs-boot b/src/Dhall/Syntax/Types.hs-boot --- a/src/Dhall/Syntax/Types.hs-boot +++ b/src/Dhall/Syntax/Types.hs-boot @@ -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 diff --git a/src/Dhall/TH.hs b/src/Dhall/TH.hs --- a/src/Dhall/TH.hs +++ b/src/Dhall/TH.hs @@ -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' diff --git a/src/Dhall/Tutorial.hs b/src/Dhall/Tutorial.hs --- a/src/Dhall/Tutorial.hs +++ b/src/Dhall/Tutorial.hs @@ -1857,7 +1857,7 @@ -- You can find an up-to-date list of available built-in functions and operators -- here: -- --- +-- -- $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 -- --- +-- diff --git a/src/Dhall/TypeCheck.hs b/src/Dhall/TypeCheck.hs --- a/src/Dhall/TypeCheck.hs +++ b/src/Dhall/TypeCheck.hs @@ -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 diff --git a/src/Dhall/Util.hs b/src/Dhall/Util.hs --- a/src/Dhall/Util.hs +++ b/src/Dhall/Util.hs @@ -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) diff --git a/tests/Dhall/Test/Diff.hs b/tests/Dhall/Test/Diff.hs --- a/tests/Dhall/Test/Diff.hs +++ b/tests/Dhall/Test/Diff.hs @@ -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 diff --git a/tests/Dhall/Test/Format.hs b/tests/Dhall/Test/Format.hs --- a/tests/Dhall/Test/Format.hs +++ b/tests/Dhall/Test/Format.hs @@ -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 diff --git a/tests/Dhall/Test/Freeze.hs b/tests/Dhall/Test/Freeze.hs --- a/tests/Dhall/Test/Freeze.hs +++ b/tests/Dhall/Test/Freeze.hs @@ -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" diff --git a/tests/Dhall/Test/Import.hs b/tests/Dhall/Test/Import.hs --- a/tests/Dhall/Test/Import.hs +++ b/tests/Dhall/Test/Import.hs @@ -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 diff --git a/tests/Dhall/Test/Lint.hs b/tests/Dhall/Test/Lint.hs --- a/tests/Dhall/Test/Lint.hs +++ b/tests/Dhall/Test/Lint.hs @@ -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 diff --git a/tests/Dhall/Test/Main.hs b/tests/Dhall/Test/Main.hs --- a/tests/Dhall/Test/Main.hs +++ b/tests/Dhall/Test/Main.hs @@ -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 ] diff --git a/tests/Dhall/Test/Normalization.hs b/tests/Dhall/Test/Normalization.hs --- a/tests/Dhall/Test/Normalization.hs +++ b/tests/Dhall/Test/Normalization.hs @@ -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 diff --git a/tests/Dhall/Test/Parser.hs b/tests/Dhall/Test/Parser.hs --- a/tests/Dhall/Test/Parser.hs +++ b/tests/Dhall/Test/Parser.hs @@ -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 diff --git a/tests/Dhall/Test/Schemas.hs b/tests/Dhall/Test/Schemas.hs --- a/tests/Dhall/Test/Schemas.hs +++ b/tests/Dhall/Test/Schemas.hs @@ -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 diff --git a/tests/Dhall/Test/SemanticHash.hs b/tests/Dhall/Test/SemanticHash.hs --- a/tests/Dhall/Test/SemanticHash.hs +++ b/tests/Dhall/Test/SemanticHash.hs @@ -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 diff --git a/tests/Dhall/Test/Tags.hs b/tests/Dhall/Test/Tags.hs --- a/tests/Dhall/Test/Tags.hs +++ b/tests/Dhall/Test/Tags.hs @@ -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 diff --git a/tests/Dhall/Test/TypeInference.hs b/tests/Dhall/Test/TypeInference.hs --- a/tests/Dhall/Test/TypeInference.hs +++ b/tests/Dhall/Test/TypeInference.hs @@ -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 diff --git a/tests/Dhall/Test/Util.hs b/tests/Dhall/Test/Util.hs --- a/tests/Dhall/Test/Util.hs +++ b/tests/Dhall/Test/Util.hs @@ -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 "\\" "/" diff --git a/tests/format/issue2601A.dhall b/tests/format/issue2601A.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2601A.dhall @@ -0,0 +1,11 @@ +let T = < Some | Type > + +let t + : T + = T.`Some` + +let x + : T + = T.Type + +in True diff --git a/tests/format/issue2601B.dhall b/tests/format/issue2601B.dhall new file mode 100644 --- /dev/null +++ b/tests/format/issue2601B.dhall @@ -0,0 +1,11 @@ +let T = < Some | Type > + +let t + : T + = T.`Some` + +let x + : T + = T.Type + +in True diff --git a/tests/format/numericLiteralsA.dhall b/tests/format/numericLiteralsA.dhall --- a/tests/format/numericLiteralsA.dhall +++ b/tests/format/numericLiteralsA.dhall @@ -1,1 +1,1 @@ -{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 } +{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 } diff --git a/tests/format/numericLiteralsB.dhall b/tests/format/numericLiteralsB.dhall --- a/tests/format/numericLiteralsB.dhall +++ b/tests/format/numericLiteralsB.dhall @@ -1,1 +1,1 @@ -{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20 } +{ example0 = 0x42, example1 = +0x42, example2 = 1.2e20, example3 = -0b0111 }