dhall 1.22.0 → 1.23.0
raw patch · 15 files changed
+568/−182 lines, 15 filesdep +transformers-compatdep ~megaparsecdep ~prettyprinterdep ~replinePVP ok
version bump matches the API change (PVP)
Dependencies added: transformers-compat
Dependency ranges changed: megaparsec, prettyprinter, repline
API changes (from Hackage documentation)
+ Dhall: genericInject :: (Generic a, GenericInject (Rep a)) => InputType a
- Dhall.Freeze: freeze :: Maybe FilePath -> Bool -> StandardVersion -> IO ()
+ Dhall.Freeze: freeze :: Maybe FilePath -> Bool -> CharacterSet -> StandardVersion -> IO ()
Files
- CHANGELOG.md +56/−0
- dhall.cabal +44/−6
- src/Dhall.hs +198/−125
- src/Dhall/Eval.hs +2/−2
- src/Dhall/Freeze.hs +12/−9
- src/Dhall/Main.hs +1/−1
- src/Dhall/Parser.hs +10/−1
- src/Dhall/Parser/Combinators.hs +31/−1
- src/Dhall/Parser/Expression.hs +37/−5
- src/Dhall/Repl.hs +19/−17
- src/Dhall/Tutorial.hs +4/−3
- src/Dhall/TypeCheck.hs +2/−0
- src/Dhall/Util.hs +5/−3
- tests/Dhall/Test/Dhall.hs +147/−5
- tests/Dhall/Test/Normalization.hs +0/−4
CHANGELOG.md view
@@ -1,7 +1,63 @@+1.23.0++* BREAKING CHANGE: Fix marshaling union literals+ * 1.22.0 introduced two separate bugs in marshaling union literals between+ Dhall and Haskell, which this release fixes:+ * Dhall enums did not correctly map onto Haskell enums+ * New-style union literals (i.e. `< A : T >.A x`) were not correctly+ supported+ * See: https://github.com/dhall-lang/dhall-haskell/pull/918+ * See: https://github.com/dhall-lang/dhall-haskell/pull/927+ * See: https://github.com/dhall-lang/dhall-haskell/pull/936+* BUG FIX: Fix α-normalization+ * Version 1.22.0 introduced a new faster evaluation algorithm, but the new+ algorithm introduced two α-normalization regression, which this release+ fixes+ * The primary effect of this bug was that semantic integrity checks would+ fail for expressions that contain an `if`/`then`/else` expression in their+ normal form+ * See: https://github.com/dhall-lang/dhall-haskell/pull/931+ * See: https://github.com/dhall-lang/dhall-haskell/pull/938+* BUG FIX: Fix merging of sort-level record types+ * The language standard requires that `{ a : Kind } ⩓ { b : Kind }` is+ valid, which this change fixes+ * See: https://github.com/dhall-lang/dhall-haskell/pull/891+* BUG FIX: `dhall freeze` respects the `--ascii` flag+ * See: https://github.com/dhall-lang/dhall-haskell/pull/934+* BUG FIX: Don't autocomplete fields for record types+ * This prevents the REPL from expanding `{ x : T }.<TAB>` to `{ x : T }.x`+ * See: https://github.com/dhall-lang/dhall-haskell/pull/937+* Support `MonadFail`-related changes in GHC 8.8+ * See: https://github.com/dhall-lang/dhall-haskell/pull/912+* Add `cross` flag to simplify cross-compilation+ * This allows the `dhall` package to be built without using+ `TemplateHaskell`+ * See: https://github.com/dhall-lang/dhall-haskell/pull/928+* Increase lines of context for error messages + * Error messages now provide at least 20 lines of context instead of 3+ before truncating large expressions+ * See: https://github.com/dhall-lang/dhall-haskell/pull/916+* Add line numbers to error messages+ * The bottom of every Dhall type error includes the original source code,+ which now has line numbers on the left margin+ * See: https://github.com/dhall-lang/dhall-haskell/pull/919+* Expand lower bounds on `megaparsec`/`transformers-compat` dependencies+ * This is to support `dhall` on Debian Sid+ * See: https://github.com/dhall-lang/dhall-haskell/pull/939+ 1.22.0 * Supports version 7.0.0 of the standard * See: https://github.com/dhall-lang/dhall-lang/releases/tag/v7.0.0+* BREAKING CHANGE: Add support for empty alternatives+ * The `Union` type now has an optional (`Maybe`) type for each alternative+ * See the changelog for standard version 7.0.0 for more details+ * See: https://github.com/dhall-lang/dhall-haskell/pull/863+* BREAKING CHANGE: Remove support for URL fragments+ * The `URL` type no longer has a field for a URL fragment since the language+ no longer supports fragments+ * See the changelog for standard version 7.0.0 for more details+ * See: https://github.com/dhall-lang/dhall-haskell/pull/851 * BREAKING CHANGE: Remove deprecated `Path` type synonym * See: https://github.com/dhall-lang/dhall-haskell/pull/858 * BUG FIX: Correctly parse identifiers beginning with `http`
dhall.cabal view
@@ -1,6 +1,6 @@ Name: dhall-Version: 1.22.0-Cabal-Version: >=1.10+Version: 1.23.0+cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 7.10.3, GHC == 8.4.3, GHC == 8.6.1 License: BSD3@@ -375,6 +375,11 @@ Default: True Manual: True +Flag cross+ Description: Disable TemplateHaskell to make cross-compiling easier+ Default: False+ Manual: True+ Library Hs-Source-Dirs: src Build-Depends:@@ -396,19 +401,20 @@ filepath >= 1.4 && < 1.5 , haskeline >= 0.7.2.1 && < 0.8 , lens-family-core >= 1.0.0 && < 1.3 ,- megaparsec >= 7.0.0 && < 7.1 ,+ megaparsec >= 6.5.0 && < 7.1 , memory >= 0.14 && < 0.15, mtl >= 2.2.1 && < 2.3 , optparse-applicative >= 0.14.0.0 && < 0.15, parsers >= 0.12.4 && < 0.13, prettyprinter >= 1.2.0.1 && < 1.3 , prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 ,- repline >= 0.2.0.0 && < 0.3 ,+ repline >= 0.2.1.0 && < 0.3 , serialise >= 0.2.0.0 && < 0.3 , scientific >= 0.3.0.0 && < 0.4 , template-haskell < 2.15, text >= 0.11.1.0 && < 1.3 , transformers >= 0.2.0.0 && < 0.6 ,+ transformers-compat >= 0.6.2 && < 0.7 , unordered-containers >= 0.1.3.0 && < 0.3 , uri-encode < 1.6 , vector >= 0.11.0.0 && < 0.13@@ -424,6 +430,34 @@ if impl(ghcjs) Build-Depends: ghcjs-xhr + Other-Extensions:+ BangPatterns+ CPP+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ FlexibleContexts+ FlexibleInstances+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ NamedFieldPuns+ OverloadedLists+ OverloadedStrings+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TupleSections+ TypeFamilies+ TypeOperators+ UnicodeSyntax+ if !flag(cross)+ Other-Extensions:+ TemplateHaskell+ Exposed-Modules: Dhall, Dhall.Binary,@@ -441,9 +475,11 @@ Dhall.Parser, Dhall.Pretty, Dhall.Repl,- Dhall.TH, Dhall.Tutorial, Dhall.TypeCheck+ if !flag(cross)+ Exposed-Modules:+ Dhall.TH Other-Modules: Dhall.Pretty.Internal, Dhall.Parser.Expression,@@ -539,6 +575,8 @@ serialise , text >= 0.11.1.0 && < 1.3 Default-Language: Haskell2010+ Other-Extensions:+ TypeApplications ghc-options: -rtsopts Benchmark deep-nested-large-record@@ -571,4 +609,4 @@ criterion >= 1.1 && < 1.6, dhall Default-Language: Haskell2010--- ghc-options: -rtsopts -O2+ ghc-options: -rtsopts -O2
src/Dhall.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -71,6 +72,7 @@ , Inject(..) , inject+ , genericInject , RecordInputType(..) , inputFieldWith , inputField@@ -146,6 +148,7 @@ -- $setup -- >>> :set -XOverloadedStrings+-- >>> :set -XRecordWildCards {-| Every `Type` must obey the contract that if an expression's type matches the the `expected` type then the `extract` function must succeed. If not, then@@ -921,9 +924,11 @@ unsafeExpectUnionLit :: Text -> Expr Src X- -> (Text, Expr Src X, Dhall.Map.Map Text (Maybe (Expr Src X)))-unsafeExpectUnionLit _ (UnionLit k v kts) =- (k, v, kts)+ -> (Text, Maybe (Expr Src X))+unsafeExpectUnionLit _ (Field (Union _) k) =+ (k, Nothing)+unsafeExpectUnionLit _ (App (Field (Union _) k) v) =+ (k, Just v) unsafeExpectUnionLit name expression = Dhall.Core.internalError (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression)@@ -935,11 +940,26 @@ Dhall.Core.internalError (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression) -possible :: Expr s a -> Maybe (Expr s a)-possible e = case e of+notEmptyRecordLit :: Expr s a -> Maybe (Expr s a)+notEmptyRecordLit e = case e of RecordLit m | null m -> Nothing _ -> Just e +notEmptyRecord :: Expr s a -> Maybe (Expr s a)+notEmptyRecord e = case e of+ Record m | null m -> Nothing+ _ -> Just e+extractUnionConstructor+ :: Expr s a -> Maybe (Text, Expr s a, Dhall.Map.Map Text (Maybe (Expr s a)))+extractUnionConstructor (UnionLit fld e rest) =+ return (fld, e, rest)+extractUnionConstructor (App (Field (Union kts) fld) e) =+ return (fld, e, Dhall.Map.delete fld kts)+extractUnionConstructor (Field (Union kts) fld) =+ return (fld, RecordLit mempty, Dhall.Map.delete fld kts)+extractUnionConstructor _ =+ empty+ instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret f2) => GenericInterpret (M1 C c1 f1 :+: M1 C c2 f2) where genericAutoWith options@(InterpretOptions {..}) = pure (Type {..}) where@@ -952,16 +972,19 @@ nameL = constructorModifier (Data.Text.pack (conName nL)) nameR = constructorModifier (Data.Text.pack (conName nR)) - extract (UnionLit name e _)- | name == nameL = fmap (L1 . M1) (extractL e)- | name == nameR = fmap (R1 . M1) (extractR e)- | otherwise = Nothing- extract _ = Nothing+ extract e0 = do+ (name, e1, _) <- extractUnionConstructor e0+ if+ | name == nameL -> fmap (L1 . M1) (extractL e1)+ | name == nameR -> fmap (R1 . M1) (extractR e1)+ | otherwise -> Nothing expected = Union (Dhall.Map.fromList- [(nameL, possible expectedL), (nameR, possible expectedR)]+ [ (nameL, notEmptyRecord expectedL)+ , (nameR, notEmptyRecord expectedR)+ ] ) Type extractL expectedL = evalState (genericAutoWith options) 1@@ -975,13 +998,14 @@ name = constructorModifier (Data.Text.pack (conName n)) - extract u@(UnionLit name' e _)- | name == name' = fmap (R1 . M1) (extractR e)- | otherwise = fmap L1 (extractL u)- extract _ = Nothing+ extract u = do+ (name', e, _) <- extractUnionConstructor u+ if+ | name == name' -> fmap (R1 . M1) (extractR e)+ | otherwise -> fmap L1 (extractL u) expected =- Union (Dhall.Map.insert name (possible expectedR) ktsL)+ Union (Dhall.Map.insert name (notEmptyRecord expectedR) ktsL) Type extractL expectedL = evalState (genericAutoWith options) 1 Type extractR expectedR = evalState (genericAutoWith options) 1@@ -996,13 +1020,14 @@ name = constructorModifier (Data.Text.pack (conName n)) - extract u@(UnionLit name' e _)- | name == name' = fmap (L1 . M1) (extractL e)- | otherwise = fmap R1 (extractR u)- extract _ = Nothing+ extract u = do+ (name', e, _) <- extractUnionConstructor u+ if+ | name == name' -> fmap (L1 . M1) (extractL e)+ | otherwise -> fmap R1 (extractR u) expected =- Union (Dhall.Map.insert name (possible expectedL) ktsR)+ Union (Dhall.Map.insert name (notEmptyRecord expectedL) ktsR) Type extractL expectedL = evalState (genericAutoWith options) 1 Type extractR expectedR = evalState (genericAutoWith options) 1@@ -1116,6 +1141,17 @@ inject :: Inject a => InputType a inject = injectWith defaultInterpretOptions +{-| Use the default options for injecting a value, whose structure is+determined generically.++This can be used when you want to use 'Inject' on types that you don't+want to define orphan instances for.+-}+genericInject+ :: (Generic a, GenericInject (Rep a)) => InputType a+genericInject+ = contramap GHC.Generics.from (evalState (genericInjectWith defaultInterpretOptions) 1)+ instance Inject Bool where injectWith _ = InputType {..} where@@ -1253,21 +1289,25 @@ genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) where embed (L1 (M1 l)) =- UnionLit- keyL- (embedL l)- (Dhall.Map.singleton keyR (possible declaredR))+ case notEmptyRecordLit (embedL l) of+ Nothing ->+ Field declared keyL+ Just valL ->+ App (Field declared keyL) valL embed (R1 (M1 r)) =- UnionLit- keyR- (embedR r)- (Dhall.Map.singleton keyL (possible declaredL))+ case notEmptyRecordLit (embedR r) of+ Nothing ->+ Field declared keyR+ Just valR ->+ App (Field declared keyR) valR declared = Union (Dhall.Map.fromList- [(keyL, possible declaredL), (keyR, possible declaredR)]+ [ (keyL, notEmptyRecord declaredL)+ , (keyR, notEmptyRecord declaredR)+ ] ) nL :: M1 i c1 f1 a@@ -1286,38 +1326,42 @@ genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) where embed (L1 l) =- UnionLit- keyL- valL- (Dhall.Map.insert keyR (possible declaredR) ktsL')+ case maybeValL of+ Nothing -> Field declared keyL+ Just valL -> App (Field declared keyL) valL where- (keyL, valL, ktsL') =+ (keyL, maybeValL) = unsafeExpectUnionLit "genericInjectWith (:+:)" (embedL l)- embed (R1 (M1 r)) = UnionLit keyR (embedR r) ktsL+ embed (R1 (M1 r)) =+ case notEmptyRecordLit (embedR r) of+ Nothing -> Field declared keyR+ Just valR -> App (Field declared keyR) valR nR :: M1 i c h a nR = undefined keyR = constructorModifier (Data.Text.pack (conName nR)) - declared = Union (Dhall.Map.insert keyR (possible declaredR) ktsL)+ declared = Union (Dhall.Map.insert keyR (notEmptyRecord declaredR) ktsL) - InputType embedL declaredL = evalState (genericInjectWith options) 1- InputType embedR declaredR = evalState (genericInjectWith options) 1+ InputType embedL declaredL = evalState (genericInjectWith options) 1+ InputType embedR declaredR = evalState (genericInjectWith options) 1 ktsL = unsafeExpectUnion "genericInjectWith (:+:)" declaredL instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInject (M1 C c f :+: (g :+: h)) where genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..}) where- embed (L1 (M1 l)) = UnionLit keyL (embedL l) ktsR+ embed (L1 (M1 l)) =+ case notEmptyRecordLit (embedL l) of+ Nothing -> Field declared keyL+ Just valL -> App (Field declared keyL) valL embed (R1 r) =- UnionLit- keyR- valR- (Dhall.Map.insert keyL (possible declaredL) ktsR')+ case maybeValR of+ Nothing -> Field declared keyR+ Just valR -> App (Field declared keyR) valR where- (keyR, valR, ktsR') =+ (keyR, maybeValR) = unsafeExpectUnionLit "genericInjectWith (:+:)" (embedR r) nL :: M1 i c f a@@ -1325,7 +1369,7 @@ keyL = constructorModifier (Data.Text.pack (conName nL)) - declared = Union (Dhall.Map.insert keyL (possible declaredL) ktsR)+ declared = Union (Dhall.Map.insert keyL (notEmptyRecord declaredL) ktsR) InputType embedL declaredL = evalState (genericInjectWith options) 1 InputType embedR declaredR = evalState (genericInjectWith options) 1@@ -1336,14 +1380,18 @@ genericInjectWith options = pure (InputType {..}) where embed (L1 l) =- UnionLit keyL valL (Dhall.Map.union ktsL' ktsR)+ case maybeValL of+ Nothing -> Field declared keyL+ Just valL -> App (Field declared keyL) valL where- (keyL, valL, ktsL') =+ (keyL, maybeValL) = unsafeExpectUnionLit "genericInjectWith (:+:)" (embedL l) embed (R1 r) =- UnionLit keyR valR (Dhall.Map.union ktsL ktsR')+ case maybeValR of+ Nothing -> Field declared keyR+ Just valR -> App (Field declared keyR) valR where- (keyR, valR, ktsR') =+ (keyR, maybeValR) = unsafeExpectUnionLit "genericInjectWith (:+:)" (embedR r) declared = Union (Dhall.Map.union ktsL ktsR)@@ -1401,11 +1449,13 @@ For example, let's take the following Haskell data type: -> data Project = Project-> { projectName :: Text-> , projectDescription :: Text-> , projectStars :: Natural-> }+>>> :{+data Project = Project+ { projectName :: Text+ , projectDescription :: Text+ , projectStars :: Natural+ }+:} And assume that we have the following Dhall record that we would like to parse as a @Project@:@@ -1422,14 +1472,15 @@ smaller parsers, as 'Type's cannot be combined (they are only 'Functor's). However, we can use a 'RecordType' to build a 'Type' for @Project@: -> project :: Type Project-> project =-> record-> ( Project <$> field "name" string-> <*> field "description" string-> <*> field "stars" natural-> )-+>>> :{+project :: Type Project+project =+ record+ ( Project <$> field "name" strictText+ <*> field "description" strictText+ <*> field "stars" natural+ )+:} -} newtype RecordType a =@@ -1489,9 +1540,11 @@ For example, let's take the following Haskell data type: -> data Status = Queued Natural-> | Result Text-> | Errored Text+>>> :{+data Status = Queued Natural+ | Result Text+ | Errored Text+:} And assume that we have the following Dhall union that we would like to parse as a @Status@:@@ -1505,13 +1558,14 @@ smaller parsers, as 'Type's cannot be combined (they are only 'Functor's). However, we can use a 'UnionType' to build a 'Type' for @Status@: -> status :: Type Status-> status =-> union-> ( Queued <$> constructor "Queued" natural-> <> Result <$> constructor "Result" string-> <> Errored <$> constructor "Errored" string-> )+>>> :{+status :: Type Status+status = union+ ( ( Queued <$> constructor "Queued" natural )+ <> ( Result <$> constructor "Result" strictText )+ <> ( Errored <$> constructor "Errored" strictText )+ )+:} -} newtype UnionType a =@@ -1533,14 +1587,18 @@ , expected = Union expect } where- expect = (possible . Dhall.expected) <$> mp+ expect = (notEmptyRecord . Dhall.expected) <$> mp+ extractF e0 = do- UnionLit fld e1 rest <- Just e0+ (fld, e1, rest) <- extractUnionConstructor e0+ t <- Dhall.Map.lookup fld mp+ guard $ Dhall.Core.Union rest `Dhall.Core.judgmentallyEqual` Dhall.Core.Union (Dhall.Map.delete fld expect)- Dhall.extract t e1 + extract t e1+ -- | Parse a single constructor of a union constructor :: Text -> Type a -> UnionType a constructor key valueType = UnionType@@ -1551,11 +1609,13 @@ For example, let's take the following Haskell data type: -> data Project = Project-> { projectName :: Text-> , projectDescription :: Text-> , projectStars :: Natural-> }+>>> :{+data Project = Project+ { projectName :: Text+ , projectDescription :: Text+ , projectStars :: Natural+ }+:} And assume that we have the following Dhall record that we would like to parse as a @Project@:@@ -1572,27 +1632,31 @@ smaller injectors, as 'InputType's cannot be combined (they are only 'Contravariant's). However, we can use an 'InputRecordType' to build an 'InputType' for @Project@: -> injectProject :: InputType Project-> injectProject =-> inputRecord-> ( adapt >$< inputFieldWith "name" inject-> >*< inputFieldWith "description" inject-> >*< inputFieldWith "stars" inject-> )-> where-> adapt (Project{..}) = (projectName, (projectDescription, projectStars))+>>> :{+injectProject :: InputType Project+injectProject =+ inputRecord+ ( adapt >$< inputFieldWith "name" inject+ >*< inputFieldWith "description" inject+ >*< inputFieldWith "stars" inject+ )+ where+ adapt (Project{..}) = (projectName, (projectDescription, projectStars))+:} Or, since we are simply using the `Inject` instance to inject each field, we could write -> injectProject :: InputType Project-> injectProject =-> inputRecord-> ( adapt >$< inputField "name"-> >*< inputField "description"-> >*< inputField "stars"-> )-> where-> adapt (Project{..}) = (projectName, (projectDescription, projectStars))+>>> :{+injectProject :: InputType Project+injectProject =+ inputRecord+ ( adapt >$< inputField "name"+ >*< inputField "description"+ >*< inputField "stars"+ )+ where+ adapt (Project{..}) = (projectName, (projectDescription, projectStars))+:} -} @@ -1633,9 +1697,11 @@ For example, let's take the following Haskell data type: -> data Status = Queued Natural-> | Result Text-> | Errored Text+>>> :{+data Status = Queued Natural+ | Result Text+ | Errored Text+:} And assume that we have the following Dhall union that we would like to parse as a @Status@:@@ -1647,31 +1713,36 @@ Our injector has type 'InputType' @Status@, but we can't build that out of any smaller injectors, as 'InputType's cannot be combined.- However, we can use an 'InputUnionType' to build an 'InputType' for @Status@:+ However, we can use an 'UnionInputType' to build an 'InputType' for @Status@: -> injectStatus :: InputType Status-> injectStatus =-> adapt-> >$< inputConstructorWith "Queued" inject-> >|< inputConstructorWith "Result" inject-> >|< inputConstructorWith "Errored" inject-> where-> adapt (Queued n) = Left (Left n)-> adapt (Result t) = Left (Right t)-> adapt (Errored e) = Right e+>>> :{+injectStatus :: InputType Status+injectStatus = adapt >$< inputUnion+ ( inputConstructorWith "Queued" inject+ >|< inputConstructorWith "Result" inject+ >|< inputConstructorWith "Errored" inject+ )+ where+ adapt (Queued n) = Left n+ adapt (Result t) = Right (Left t)+ adapt (Errored e) = Right (Right e)+:} Or, since we are simply using the `Inject` instance to inject each branch, we could write -> injectStatus :: InputType Status-> injectStatus =-> adapt-> >$< inputConstructor "Queued"-> >|< inputConstructor "Result"-> >|< inputConstructor "Errored"-> where-> adapt (Queued n) = Left (Left n)-> adapt (Result t) = Left (Right t)-> adapt (Errored e) = Right e+>>> :{+injectStatus :: InputType Status+injectStatus = adapt >$< inputUnion+ ( inputConstructor "Queued"+ >|< inputConstructor "Result"+ >|< inputConstructor "Errored"+ )+ where+ adapt (Queued n) = Left n+ adapt (Result t) = Right (Left t)+ adapt (Errored e) = Right (Right e)+:}+ -} newtype UnionInputType a = UnionInputType@@ -1709,12 +1780,14 @@ InputType { embed = \x -> let (name, y) = embedF x- in UnionLit name y (Dhall.Map.delete name fields')+ in case notEmptyRecordLit y of+ Nothing -> Field (Union fields') name+ Just val -> App (Field (Union fields') name) val , declared = Union fields' } where- fields' = fmap possible fields+ fields' = fmap notEmptyRecord fields inputConstructorWith :: Text
src/Dhall/Eval.hs view
@@ -843,7 +843,7 @@ go !acc (NBind env x) !i | x == topX = if i == 0 then Var (V "_" acc) else go (acc + 1) env (i - 1) | otherwise = go (acc + 1) env i- go acc NEmpty i = Var (V topX topI)+ go acc NEmpty i = Var (V topX i) goEnv :: Names -> Expr s a -> Expr s a goEnv !e t = let@@ -878,7 +878,7 @@ BoolOr t u -> BoolOr (go t) (go u) BoolEQ t u -> BoolEQ (go t) (go u) BoolNE t u -> BoolNE (go t) (go u)- BoolIf b t f -> BoolIf (go t) (go t) (go f)+ BoolIf b t f -> BoolIf (go b) (go t) (go f) Natural -> Natural NaturalLit n -> NaturalLit n NaturalFold -> NaturalFold
src/Dhall/Freeze.hs view
@@ -17,7 +17,7 @@ import Dhall.Core (Expr(..), Import(..), ImportHashed(..), ImportType(..)) import Dhall.Import (standardVersion) import Dhall.Parser (exprAndHeaderFromText, Src)-import Dhall.Pretty (annToAnsiStyle, layoutOpts)+import Dhall.Pretty (CharacterSet, annToAnsiStyle, layoutOpts, prettyCharacterSet) import Dhall.TypeCheck (X) import Lens.Family (set) import System.Console.ANSI (hSupportsANSI)@@ -100,15 +100,17 @@ Left err -> Control.Exception.throwIO err Right x -> return x -writeExpr :: Maybe FilePath -> (Text, Expr s Import) -> IO ()-writeExpr inplace (header, expr) = do- let doc = Pretty.pretty header <> Pretty.pretty expr- let stream = Pretty.layoutSmart layoutOpts doc+writeExpr :: Maybe FilePath -> (Text, Expr s Import) -> CharacterSet -> IO ()+writeExpr inplace (header, expr) characterSet = do+ let doc = Pretty.pretty header+ <> Dhall.Pretty.prettyCharacterSet characterSet expr + let unAnnotated = Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc)+ case inplace of Just f -> System.IO.withFile f System.IO.WriteMode (\handle -> do- Pretty.renderIO handle (annToAnsiStyle <$> stream)+ Pretty.renderIO handle unAnnotated Data.Text.IO.hPutStrLn handle "" ) Nothing -> do@@ -117,7 +119,7 @@ then Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Pretty.layoutSmart layoutOpts doc) else- Pretty.renderIO System.IO.stdout (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))+ Pretty.renderIO System.IO.stdout unAnnotated -- | Implementation of the @dhall freeze@ subcommand freeze@@ -126,9 +128,10 @@ -- to @stdout@ -> Bool -- ^ If `True` then freeze all imports, otherwise freeze only remote imports+ -> CharacterSet -> StandardVersion -> IO ()-freeze inplace everything _standardVersion = do+freeze inplace everything characterSet _standardVersion = do (text, directory) <- case inplace of Nothing -> do text <- Data.Text.IO.getContents@@ -145,6 +148,6 @@ let freezeFunction = if everything then freezeImport else freezeRemoteImport frozenExpression <- traverse (freezeFunction directory _standardVersion) parsedExpression- writeExpr inplace (header, frozenExpression)+ writeExpr inplace (header, frozenExpression) characterSet where srcInfo = fromMaybe "(stdin)" inplace
src/Dhall/Main.hs view
@@ -440,7 +440,7 @@ Dhall.Format.format (Dhall.Format.Format {..}) Freeze {..} -> do- Dhall.Freeze.freeze inplace all_ standardVersion+ Dhall.Freeze.freeze inplace all_ characterSet standardVersion Hash -> do Dhall.Hash.hash standardVersion
src/Dhall/Parser.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} -- | This module contains Dhall's parsing logic @@ -42,13 +43,21 @@ -- | A parsing error data ParseError = ParseError+#if MIN_VERSION_megaparsec(7, 0, 0) { unwrap :: Text.Megaparsec.ParseErrorBundle Text Void+#else+ { unwrap :: Text.Megaparsec.ParseError Char Void+#endif , input :: Text } instance Show ParseError where show (ParseError {..}) =+#if MIN_VERSION_megaparsec(7, 0, 0) "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.errorBundlePretty unwrap+#else+ "\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.parseErrorPretty unwrap+#endif instance Exception ParseError
src/Dhall/Parser/Combinators.hs view
@@ -34,10 +34,14 @@ import qualified Dhall.Util import qualified Dhall.Set import qualified Text.Megaparsec+#if !MIN_VERSION_megaparsec(7, 0, 0)+import qualified Text.Megaparsec.Char as Text.Megaparsec (satisfy)+#endif import qualified Text.Megaparsec.Char import qualified Text.Parser.Char import qualified Text.Parser.Combinators import qualified Text.Parser.Token.Style+import qualified Text.Printf -- | Source code extract data Src = Src !Text.Megaparsec.SourcePos !Text.Megaparsec.SourcePos Text@@ -68,7 +72,7 @@ instance Pretty Src where pretty (Src begin _ text) =- pretty (Dhall.Util.snip (prefix <> text))+ pretty (Dhall.Util.snip numberedLines) <> "\n" <> pretty (Text.Megaparsec.sourcePosPretty begin) where@@ -76,6 +80,28 @@ where n = Text.Megaparsec.unPos (Text.Megaparsec.sourceColumn begin) + ls = Data.Text.lines (prefix <> text)++ numberOfLines = length ls++ minimumNumber =+ Text.Megaparsec.unPos (Text.Megaparsec.sourceLine begin)++ maximumNumber = minimumNumber + numberOfLines - 1++ numberWidth :: Int+ numberWidth =+ truncate (logBase (10 :: Double) (fromIntegral maximumNumber)) + 1++ adapt n line = Data.Text.pack outputString+ where+ inputString = Data.Text.unpack line++ outputString =+ Text.Printf.printf ("%" <> show numberWidth <> "d: %s") n inputString++ numberedLines = Data.Text.unlines (zipWith adapt [minimumNumber..] ls)+ {-| A `Parser` that is almost identical to @"Text.Megaparsec".`Text.Megaparsec.Parsec`@ except treating Haskell-style comments as whitespace@@ -210,7 +236,11 @@ notChar = Text.Megaparsec.Char.char +#if MIN_VERSION_megaparsec(7, 0, 0) anyChar = Text.Megaparsec.anySingle+#else+ anyChar = Text.Megaparsec.Char.anyChar+#endif string = fmap Data.Text.unpack . Text.Megaparsec.Char.string . fromString
src/Dhall/Parser/Expression.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedLists #-}@@ -27,16 +28,47 @@ import qualified Data.Text import qualified Data.Text.Encoding import qualified Text.Megaparsec+#if !MIN_VERSION_megaparsec(7, 0, 0)+import qualified Text.Megaparsec.Char as Text.Megaparsec+#endif import qualified Text.Parser.Char import Dhall.Parser.Combinators import Dhall.Parser.Token +getSourcePos :: Text.Megaparsec.MonadParsec e s m =>+ m Text.Megaparsec.SourcePos+getSourcePos =+#if MIN_VERSION_megaparsec(7, 0, 0)+ Text.Megaparsec.getSourcePos+#else+ Text.Megaparsec.getPosition+#endif+{-# INLINE getSourcePos #-}++getOffset :: Text.Megaparsec.MonadParsec e s m => m Int+#if MIN_VERSION_megaparsec(7, 0, 0)+getOffset = Text.Megaparsec.stateOffset <$> Text.Megaparsec.getParserState+#else+getOffset = Text.Megaparsec.stateTokensProcessed <$> Text.Megaparsec.getParserState+#endif+{-# INLINE getOffset #-}++setOffset :: Text.Megaparsec.MonadParsec e s m => Int -> m ()+#if MIN_VERSION_megaparsec(7, 0, 0)+setOffset o = Text.Megaparsec.updateParserState $ \(Text.Megaparsec.State s _ pst) ->+ Text.Megaparsec.State s o pst+#else+setOffset o = Text.Megaparsec.updateParserState $ \(Text.Megaparsec.State s p _ stw) ->+ Text.Megaparsec.State s p o stw+#endif+{-# INLINE setOffset #-}+ noted :: Parser (Expr Src a) -> Parser (Expr Src a) noted parser = do- before <- Text.Megaparsec.getSourcePos+ before <- getSourcePos (tokens, e) <- Text.Megaparsec.match parser- after <- Text.Megaparsec.getSourcePos+ after <- getSourcePos let src₀ = Src before after tokens case e of Note src₁ _ | laxSrcEq src₀ src₁ -> return e@@ -240,10 +272,10 @@ <|> alternative38 where alternative00 = do- n <- Text.Megaparsec.getOffset+ n <- getOffset a <- try doubleLiteral b <- if isInfinite a- then Text.Megaparsec.setOffset n *> fail "double out of bounds"+ then setOffset n *> fail "double out of bounds" else return a return (DoubleLit b) @@ -390,7 +422,7 @@ ) && c /= '$' unescapedCharacterSlow = do- _ <- Text.Megaparsec.single '$'+ _ <- Text.Parser.Char.char '$' return (Chunks [] "$") escapedCharacter = do
src/Dhall/Repl.hs view
@@ -12,9 +12,12 @@ import Control.Exception ( SomeException(SomeException), displayException, throwIO ) import Control.Monad ( forM_ )+import Control.Monad.Fail ( MonadFail ) import Control.Monad.IO.Class ( MonadIO, liftIO ) import Control.Monad.State.Class ( MonadState, get, modify ) import Control.Monad.State.Strict ( evalStateT )+-- For the MonadFail instance for StateT.+import Control.Monad.Trans.Instances () import Data.List ( isPrefixOf, nub ) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe ( mapMaybe )@@ -30,6 +33,7 @@ import System.Directory ( getDirectoryContents ) import System.Environment ( getEnvironment ) +import qualified Control.Monad.Fail as Fail import qualified Control.Monad.Trans.State.Strict as State import qualified Data.HashSet import qualified Data.Text as Text@@ -149,8 +153,8 @@ -typeOf :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-typeOf [] = fail ":type requires an argument to check the type of"+typeOf :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m ()+typeOf [] = Fail.fail ":type requires an argument to check the type of" typeOf srcs = do loaded <-@@ -217,7 +221,7 @@ | otherwise = str : strs -addBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m ()+addBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m () addBinding (k : "=" : srcs) = do let varName =@@ -245,10 +249,10 @@ output ( Expr.Annot ( Expr.Var ( Dhall.V varName 0 ) ) t ) -addBinding _ = fail ":let should be of the form `:let x = y`"+addBinding _ = Fail.fail ":let should be of the form `:let x = y`" -hashBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m ()-hashBinding [] = fail ":hash should be of the form `:hash expr"+hashBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m ()+hashBinding [] = Fail.fail ":hash should be of the form `:hash expr" hashBinding tokens = do loadedExpression <- parseAndLoad (unwords tokens) @@ -296,7 +300,7 @@ pure $ saveFilePrefix <> "-" <> show nextIndex loadBinding- :: ( MonadIO m, MonadState Env m, Haskeline.MonadException m )+ :: ( MonadFail m, MonadIO m, MonadState Env m, Haskeline.MonadException m ) => [String] -> m () loadBinding [] = do mFile <- currentSaveFile@@ -304,7 +308,7 @@ case mFile of Just file -> loadBinding [file] Nothing ->- fail $ ":load couldn't find any `" <> saveFilePrefix <> "-*` files"+ Fail.fail $ ":load couldn't find any `" <> saveFilePrefix <> "-*` files" loadBinding [file] = do -- Read commands from the save file@@ -314,7 +318,7 @@ | c == optionsPrefix , Just action <- lookup cmd options = action opts- runCommand _ = fail $+ runCommand _ = Fail.fail $ ":load expects `" <> file <> "` to contain one command per line" -- Keep current handle in scope@@ -331,9 +335,9 @@ writeOutputHandle $ "Loaded `" <> Text.pack file <> "`\n" -loadBinding _ = fail ":load should be of the form `:load` or `:load file`"+loadBinding _ = Fail.fail ":load should be of the form `:load` or `:load file`" -saveBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m ()+saveBinding :: ( MonadFail m, MonadIO m, MonadState Env m ) => [String] -> m () -- Save all the bindings into a context save file saveBinding [] = do file <- nextSaveFile@@ -380,7 +384,7 @@ writeOutputHandle $ "Expression saved to `" <> Text.pack file <> "`\n" -saveBinding _ = fail ":save should be of the form `:save`, `:save file`, or `:save file = expr`"+saveBinding _ = Fail.fail ":save should be of the form `:save`, `:save file`, or `:save file = expr`" setOption :: ( MonadIO m, MonadState Env m ) => [String] -> m () setOption [ "--explain" ] = do@@ -405,7 +409,7 @@ options- :: ( Haskeline.MonadException m, MonadIO m, MonadState Env m )+ :: ( Haskeline.MonadException m, MonadFail m, MonadIO m, MonadState Env m ) => Repline.Options m options = [ ( "type", dontCrash . typeOf )@@ -420,7 +424,7 @@ completer- :: (Monad m, MonadIO m, MonadState Env m)+ :: (Monad m, MonadFail m, MonadIO m, MonadState Env m) => Repline.CompleterStyle m completer = Repline.Prefix@@ -433,7 +437,7 @@ separators = " \t[(,=+*&|}#?>:" completeFunc- :: (Monad m, MonadIO m, MonadState Env m)+ :: (Monad m, MonadFail m, MonadIO m, MonadState Env m) => String -> String -> m [Completion] completeFunc reversedPrev word @@ -500,10 +504,8 @@ fmap (("." <> f) <>) (algebraicComplete fs e) in case expr of- Dhall.Core.Record m -> withMap (fmap Just m) Dhall.Core.RecordLit m -> withMap (fmap Just m) Dhall.Core.Union m -> withMap m- Dhall.Core.UnionLit _ _ m -> withMap m _ -> []
src/Dhall/Tutorial.hs view
@@ -314,7 +314,7 @@ -- - Bool -- + Natural -- ...--- 1 : Bool+-- 1: 1 : Bool -- ... -- (input):1:1 -- ...@@ -514,7 +514,8 @@ -- *** Exception: -- ...Error...: An empty list requires a type annotation -- ...--- []+-- 1: []+-- ... -- (input):1:1 -- -- Also, list elements must all have the same type. You will get an error if@@ -527,7 +528,7 @@ -- - Natural -- + Bool -- ...--- True+-- 1: True -- ... -- (input):1:5 -- ...
src/Dhall/TypeCheck.hs view
@@ -626,6 +626,8 @@ return Type decide Kind Kind = return Kind+ decide Sort Sort =+ return Sort decide x y = Left (TypeError ctx e (RecordTypeMismatch x y l r)) c <- decide cL cR
src/Dhall/Util.hs view
@@ -23,15 +23,17 @@ -- | Utility function to cut out the interior of a large text block snip :: Text -> Text snip text- | length ls <= 7 = text+ | length ls <= numberOfLinesOfContext * 2 + 1 = text | otherwise = if Data.Text.last text == '\n' then preview else Data.Text.init preview where+ numberOfLinesOfContext = 20+ ls = Data.Text.lines text - header = take 3 ls+ header = take numberOfLinesOfContext ls - footer = takeEnd 3 ls+ footer = takeEnd numberOfLinesOfContext ls excerpt = filter (Data.Text.any (/= ' ')) (header <> footer)
tests/Dhall/Test/Dhall.hs view
@@ -1,21 +1,38 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Dhall.Test.Dhall where import Control.Exception (SomeException, try)+import Data.Text (Text)+import Dhall (Inject, Interpret)+import Dhall.Core (Expr(..))+import GHC.Generics (Generic) import Numeric.Natural (Natural) import Test.Tasty import Test.Tasty.HUnit import qualified Dhall import qualified Dhall.Core+import qualified Dhall.Import import qualified Dhall.Map+import qualified Dhall.Parser tests :: TestTree tests = testGroup "Input"- [ shouldShowDetailedTypeError ]+ [ shouldShowDetailedTypeError+ , shouldHandleBothUnionLiterals+ , shouldHaveWorkingGenericAuto+ , shouldHandleUnionsCorrectly+ , shouldTreatAConstructorStoringUnitAsEmptyAlternative+ ] data MyType = MyType { foo :: String , bar :: Natural } @@ -55,5 +72,130 @@ case inputEx of Left ex -> assertEqual assertMsg expectedMsg (show ex) Right _ -> fail "The extraction using a wrong type succeded"- - ++-- https://github.com/dhall-lang/dhall-haskell/issues/915+shouldHandleBothUnionLiterals :: TestTree+shouldHandleBothUnionLiterals = testCase "Marshal union literals" $ do+ let example :: Dhall.Type Bool+ example = Dhall.union (Dhall.constructor "Test" Dhall.bool)++ _ <- Dhall.input example "< Test : Bool >.Test True"+ _ <- Dhall.input example "< Test = True >"++ return ()++shouldTreatAConstructorStoringUnitAsEmptyAlternative :: TestTree+shouldTreatAConstructorStoringUnitAsEmptyAlternative = testCase "Handle unit constructors" $ do+ let exampleType :: Dhall.Type ()+ exampleType = Dhall.union (Dhall.constructor "A" Dhall.unit)++ () <- Dhall.input exampleType "< A >.A"++ let exampleInputType :: Dhall.InputType ()+ exampleInputType = Dhall.inputUnion (Dhall.inputConstructor "A")++ Dhall.embed exampleInputType () @=? Field (Union (Dhall.Map.singleton "A" Nothing)) "A"++data CompilerFlavor3 =+ GHC3 | GHCJS3 | Helium3+ deriving (Generic, Show, Eq)++data CompilerFlavor2 =+ GHC2 | GHCJS2+ deriving (Generic, Show, Eq)++-- https://github.com/dhall-lang/dhall-haskell/issues/926+shouldHaveWorkingGenericAuto :: TestTree+shouldHaveWorkingGenericAuto = testGroup "genericAuto"+ [ testCase "works for a three-constructor enum" $ do+ compiler <- Dhall.input Dhall.genericAuto "< GHC3 | GHCJS3 | Helium3 >.GHC3"+ assertEqual "genericAuto didn't give us what we wanted" GHC3 compiler++ , testCase "works for a two-constructor enum" $ do+ compiler <- Dhall.input Dhall.genericAuto "< GHC2 | GHCJS2 >.GHC2"+ assertEqual "genericAuto didn't give us what we wanted" GHC2 compiler+ ]++data NonEmptyUnion = N0 Bool | N1 Natural | N2 Text+ deriving (Eq, Generic, Inject, Interpret, Show)++data Enum = E0 | E1 | E2+ deriving (Eq, Generic, Inject, Interpret, Show)++data Mixed = M0 Bool | M1 | M2 ()+ deriving (Eq, Generic, Inject, Interpret, Show)++deriving instance Interpret ()++shouldHandleUnionsCorrectly :: TestTree+shouldHandleUnionsCorrectly =+ testGroup "Handle union literals"+ [ "λ(x : < N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >) → x"+ `shouldPassThrough` [ N0 True, N1 5, N2 "ABC" ]+ , "λ(x : < E0 | E1 | E2 >) → x"+ `shouldPassThrough` [ E0, E1, E2 ]+ , "λ(x : < M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >) → x"+ `shouldPassThrough` [ M0 True, M1, M2 () ]++ , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }"+ `shouldMarshalInto` N0 True+ , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }"+ `shouldMarshalInto` N1 5+ , "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }"+ `shouldMarshalInto` N2 "ABC"++ , "< N0 = { _1 = True } | N1 : { _1 : Natural } | N2 : { _1 : Text } >"+ `shouldMarshalInto` N0 True+ , "< N0 : { _1 : Bool } | N1 = { _1 = 5 } | N2 : { _1 : Text } >"+ `shouldMarshalInto` N1 5+ , "< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 = { _1 = \"ABC\" } >"+ `shouldMarshalInto` N2 "ABC"++ , "(< E0 | E1 | E2>).E0" `shouldMarshalInto` E0+ , "(< E0 | E1 | E2>).E1" `shouldMarshalInto` E1+ , "(< E0 | E1 | E2>).E2" `shouldMarshalInto` E2++ , "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M0 { _1 = True }"+ `shouldMarshalInto` M0 True+ , "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M1"+ `shouldMarshalInto` M1+ , "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M2 { _1 = {=} }"+ `shouldMarshalInto` M2 ()++ , "< M0 = { _1 = True } | M1 | M2 : { _1 : {} } >"+ `shouldMarshalInto` M0 True++ , N0 True+ `shouldInjectInto`+ "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N0 { _1 = True }"+ , N1 5+ `shouldInjectInto`+ "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N1 { _1 = 5 }"+ , N2 "ABC"+ `shouldInjectInto`+ "(< N0 : { _1 : Bool } | N1 : { _1 : Natural } | N2 : { _1 : Text } >).N2 { _1 = \"ABC\" }"++ , E0 `shouldInjectInto` "< E0 | E1 | E2 >.E0"+ , E1 `shouldInjectInto` "< E0 | E1 | E2 >.E1"+ , E2 `shouldInjectInto` "< E0 | E1 | E2 >.E2"++ , M0 True `shouldInjectInto` "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M0 { _1 = True }"+ , M1 `shouldInjectInto` "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M1"+ , M2 () `shouldInjectInto` "(< M0 : { _1 : Bool } | M1 | M2 : { _1 : {} } >).M2 { _1 = {=} }"+ ]+ where+ code `shouldPassThrough` values = testCase "Pass through" $ do+ f <- Dhall.input Dhall.auto code++ values @=? map f values++ code `shouldMarshalInto` expectedValue = testCase "Marshal" $ do+ actualValue <- Dhall.input Dhall.auto code+ expectedValue @=? actualValue++ value `shouldInjectInto` expectedCode = testCase "Inject" $ do+ parsedExpression <- Dhall.Core.throws (Dhall.Parser.exprFromText "(test)" expectedCode)++ resolvedExpression <- Dhall.Import.assertNoImports parsedExpression++ Dhall.Core.denote resolvedExpression @=? Dhall.embed Dhall.inject value
tests/Dhall/Test/Normalization.hs view
@@ -41,10 +41,6 @@ alphaNormalizationTests <- do Test.Util.discover pattern alphaNormalizationTest- -- Hackage rejects packages with Unicode directory names. This- -- will be fixed in the next release of `dhall` but for now we- -- disable the tests that depend on the `α-normalization` directory- -- (Turtle.lstree "./dhall-lang/tests/α-normalization/success/") Turtle.empty let unitTestFiles = do