dhall 1.5.1 → 1.6.0

raw patch · 11 files changed

+370/−153 lines, 11 filesdep +exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• Prelude/List/concatMap +27/−0
• dhall.cabal +7/−3
• src/Dhall.hs +147/−78
• src/Dhall/Import.hs +38/−28
• src/Dhall/Parser.hs +15/−11
• src/Dhall/Tutorial.hs +30/−30
• src/Dhall/TypeCheck.hs +5/−3
• tests/Examples.hs +16/−0
• tests/Regression.hs +64/−0
• tests/Tests.hs +2/−0

@@ -1,3 +1,22 @@+1.6.0++* BREAKING CHANGE TO THE API: Drop support for GHC 7.*+* BREAKING CHANGE TO THE API: Add support for customizing Dhall import+    * This is a breaking change because this changes the type of `loadWith`+* BREAKING CHANGE TO THE API: Add field to `UnboundVariable` error containing+* BUG FIX: Fix parsing single quotes in string literals+  the name of the unbound variable+* Add `List/concatMap` to the Prelude+* You can now derive `Inject` and `Interpret` for types with unlabeled fields+* Add new instances for `Interpret`:+    * `[]`+    * `(,)`+* Add new instance for `Inject`+    * `[]`, `Data.Set.Set`, `Data.Sequence.Seq`+    * `(,)`+    * `Int`, `Word8`, `Word16`, `Word32`, `Word64`+* Add `Eq` instance for `Src`+ 1.5.1  * Increase upper bound on `vector` and `optparse-generic`

@@ -0,0 +1,27 @@+{-+Tranform a list by applying a function to each element and flattening the+results++Examples:++```+./concatMap Natural Natural (λ(n : Natural) → [n, n]) [+2, +3, +5]+= [+2, +2, +3, +3, +5, +5] : List Natural++./concatMap Natural Natural (λ(n : Natural) → [n, n]) ([] : List Natural)+= [] : List Natural+```+-}+let concatMap : ∀(a : Type) → ∀(b : Type) → (a → List b) → List a → List b+    =   λ(a : Type)+    →   λ(b : Type)+    →   λ(f : a → List b)+    →   λ(xs : List a)+    →   List/build+        b+        (   λ(list : Type)+        →   λ(cons : b → list → list)+        →   List/fold a xs list (λ(x : a) → List/fold b (f x) list cons)+        )++in  concatMap

@@ -1,8 +1,8 @@ Name: dhall-Version: 1.5.1+Version: 1.6.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple-Tested-With: GHC == 7.10.2, GHC == 8.0.1+Tested-With: GHC == 8.0.1 License: BSD3 License-File: LICENSE Copyright: 2017 Gabriel Gonzalez@@ -38,6 +38,7 @@     Prelude/List/any     Prelude/List/build     Prelude/List/concat+    Prelude/List/concatMap     Prelude/List/filter     Prelude/List/fold     Prelude/List/generate@@ -88,13 +89,14 @@ Library     Hs-Source-Dirs: src     Build-Depends:-        base                 >= 4.8.0.0  && < 5   ,+        base                 >= 4.9.0.0  && < 5   ,         ansi-wl-pprint                      < 0.7 ,         bytestring                          < 0.11,         case-insensitive                    < 1.3 ,         charset                             < 0.4 ,         containers           >= 0.5.0.0  && < 0.6 ,         contravariant                       < 1.5 ,+        exceptions           >= 0.8.3    && < 0.9 ,         http-client          >= 0.4.30   && < 0.6 ,         http-client-tls      >= 0.2.0    && < 0.4 ,         lens                 >= 2.4      && < 4.16,@@ -138,10 +140,12 @@     Other-Modules:         Examples         Normalization+        Regression         Tutorial         Util     Build-Depends:         base               >= 4        && < 5   ,+        containers         >= 0.5.0.0  && < 0.6 ,         dhall                                   ,         tasty              >= 0.11.2   && < 0.12,         tasty-hunit        >= 0.9.2    && < 0.10,

@@ -1,10 +1,13 @@ {-# LANGUAGE DefaultSignatures   #-}+{-# LANGUAGE DeriveAnyClass      #-} {-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-} {-# LANGUAGE TypeOperators       #-}  {-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining@@ -50,12 +53,14 @@  import Control.Applicative (empty, liftA2, (<|>), Alternative) import Control.Exception (Exception)+import Control.Monad.Trans.State.Strict import Data.Functor.Contravariant (Contravariant(..)) import Data.Monoid ((<>)) import Data.Text.Buildable (Buildable(..)) import Data.Text.Lazy (Text) import Data.Typeable (Typeable) import Data.Vector (Vector)+import Data.Word (Word8, Word16, Word32, Word64) import Dhall.Core (Expr(..)) import Dhall.Import (Imported(..)) import Dhall.Parser (Src(..))@@ -67,7 +72,10 @@  import qualified Control.Exception import qualified Data.ByteString.Lazy+import qualified Data.Foldable import qualified Data.Map+import qualified Data.Sequence+import qualified Data.Set import qualified Data.Text import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder@@ -423,7 +431,7 @@     autoWith:: InterpretOptions -> Type a     default autoWith         :: (Generic a, GenericInterpret (Rep a)) => InterpretOptions -> Type a-    autoWith options = fmap GHC.Generics.to (genericAutoWith options)+    autoWith options = fmap GHC.Generics.to (evalState (genericAutoWith options) 1)  instance Interpret Bool where     autoWith _ = bool@@ -449,6 +457,9 @@ instance Interpret a => Interpret (Vector a) where     autoWith opts = vector (autoWith opts) +instance Interpret a => Interpret [a] where+    autoWith = fmap (fmap Data.Vector.toList) autoWith+ instance (Inject a, Interpret b) => Interpret (a -> b) where     autoWith opts = Type extractOut expectedOut       where@@ -462,6 +473,8 @@          Type extractIn expectedIn = autoWith opts +deriving instance (Interpret a, Interpret b) => Interpret (a, b)+ {-| Use the default options for interpreting a configuration file  > auto = autoWith defaultInterpretOptions@@ -496,20 +509,22 @@     for automatically deriving a generic implementation -} class GenericInterpret f where-    genericAutoWith :: InterpretOptions -> Type (f a)+    genericAutoWith :: InterpretOptions -> State Int (Type (f a))  instance GenericInterpret f => GenericInterpret (M1 D d f) where-    genericAutoWith = fmap (fmap M1) genericAutoWith+    genericAutoWith options = do+        res <- genericAutoWith options+        pure (fmap M1 res)  instance GenericInterpret V1 where-    genericAutoWith _ = Type {..}+    genericAutoWith _ = pure Type {..}       where         extract _ = Nothing          expected = Union Data.Map.empty  instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret f2) => GenericInterpret (M1 C c1 f1 :+: M1 C c2 f2) where-    genericAutoWith options@(InterpretOptions {..}) = Type {..}+    genericAutoWith options@(InterpretOptions {..}) = pure (Type {..})       where         nL :: M1 i c1 f1 a         nL = undefined@@ -529,11 +544,11 @@         expected =             Union (Data.Map.fromList [(nameL, expectedL), (nameR, expectedR)]) -        Type extractL expectedL = genericAutoWith options-        Type extractR expectedR = genericAutoWith options+        Type extractL expectedL = evalState (genericAutoWith options) 1+        Type extractR expectedR = evalState (genericAutoWith options) 1  instance (Constructor c, GenericInterpret (f :+: g), GenericInterpret h) => GenericInterpret ((f :+: g) :+: M1 C c h) where-    genericAutoWith options@(InterpretOptions {..}) = Type {..}+    genericAutoWith options@(InterpretOptions {..}) = pure (Type {..})       where         n :: M1 i c h a         n = undefined@@ -547,11 +562,11 @@          expected = Union (Data.Map.insert name expectedR expectedL) -        Type extractL (Union expectedL) = genericAutoWith options-        Type extractR        expectedR  = genericAutoWith options+        Type extractL (Union expectedL) = evalState (genericAutoWith options) 1+        Type extractR        expectedR  = evalState (genericAutoWith options) 1  instance (Constructor c, GenericInterpret f, GenericInterpret (g :+: h)) => GenericInterpret (M1 C c f :+: (g :+: h)) where-    genericAutoWith options@(InterpretOptions {..}) = Type {..}+    genericAutoWith options@(InterpretOptions {..}) = pure (Type {..})       where         n :: M1 i c f a         n = undefined@@ -565,59 +580,62 @@          expected = Union (Data.Map.insert name expectedL expectedR) -        Type extractL        expectedL  = genericAutoWith options-        Type extractR (Union expectedR) = genericAutoWith options+        Type extractL        expectedL  = evalState (genericAutoWith options) 1+        Type extractR (Union expectedR) = evalState (genericAutoWith options) 1  instance (GenericInterpret (f :+: g), GenericInterpret (h :+: i)) => GenericInterpret ((f :+: g) :+: (h :+: i)) where-    genericAutoWith options = Type {..}+    genericAutoWith options = pure (Type {..})       where         extract e = fmap L1 (extractL e) <|> fmap R1 (extractR e)          expected = Union (Data.Map.union expectedL expectedR) -        Type extractL (Union expectedL) = genericAutoWith options-        Type extractR (Union expectedR) = genericAutoWith options+        Type extractL (Union expectedL) = evalState (genericAutoWith options) 1+        Type extractR (Union expectedR) = evalState (genericAutoWith options) 1  instance GenericInterpret f => GenericInterpret (M1 C c f) where-    genericAutoWith = fmap (fmap M1) genericAutoWith+    genericAutoWith options = do+        res <- genericAutoWith options+        pure (fmap M1 res)  instance GenericInterpret U1 where-    genericAutoWith _ = Type {..}+    genericAutoWith _ = pure (Type {..})       where         extract _ = Just U1          expected = Record (Data.Map.fromList [])  instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g) where-    genericAutoWith options = Type {..}-      where-        extract = liftA2 (liftA2 (:*:)) extractL extractR+    genericAutoWith options = do+        Type extractL expectedL <- genericAutoWith options+        Type extractR expectedR <- genericAutoWith options+        let Record ktsL = expectedL+        let Record ktsR = expectedR+        pure (Type { extract = liftA2 (liftA2 (:*:)) extractL extractR+                        , expected = Record (Data.Map.union ktsL ktsR) }) -        expected = Record (Data.Map.union ktsL ktsR)-          where-            Record ktsL = expectedL-            Record ktsR = expectedR-        Type extractL expectedL = genericAutoWith options-        Type extractR expectedR = genericAutoWith options+getSelName :: Selector s => M1 i s f a -> State Int String+getSelName n = case selName n of+    "" -> do i <- get+             put (i + 1)+             pure ("_" ++ show i)+    nn -> pure nn  instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where-    genericAutoWith opts@(InterpretOptions {..}) = Type {..}-      where-        n :: M1 i s f a-        n = undefined--        extract (RecordLit m) = do-            case selName n of-                ""   -> Nothing-                name -> do+    genericAutoWith opts@(InterpretOptions {..}) = do+        name <- getSelName n+        let extract (RecordLit m) = do                     let name' = fieldModifier (Data.Text.Lazy.pack name)                     e <- Data.Map.lookup name' m                     fmap (M1 . K1) (extract' e)-        extract  _            = Nothing--        expected = Record (Data.Map.fromList [(key, expected')])-          where-            key = fieldModifier (Data.Text.Lazy.pack (selName n))+            extract _            = Nothing+        let expected = Record (Data.Map.fromList [(key, expected')])+              where+                key = fieldModifier (Data.Text.Lazy.pack name)+        pure (Type {..})+      where+        n :: M1 i s f a+        n = undefined          Type extract' expected' = autoWith opts @@ -654,7 +672,8 @@     injectWith :: InterpretOptions -> InputType a     default injectWith         :: (Generic a, GenericInject (Rep a)) => InterpretOptions -> InputType a-    injectWith options = contramap GHC.Generics.from (genericInjectWith options)+    injectWith options+        = contramap GHC.Generics.from (evalState (genericInjectWith options) 1)  {-| Use the default options for injecting a value @@ -698,6 +717,42 @@          declared = Integer +instance Inject Int where+    injectWith _ = InputType {..}+      where+        embed = IntegerLit . toInteger++        declared = Integer++instance Inject Word8 where+    injectWith _ = InputType {..}+      where+        embed = IntegerLit . toInteger++        declared = Integer++instance Inject Word16 where+    injectWith _ = InputType {..}+      where+        embed = IntegerLit . toInteger++        declared = Integer++instance Inject Word32 where+    injectWith _ = InputType {..}+      where+        embed = IntegerLit . toInteger++        declared = Integer++instance Inject Word64 where+    injectWith _ = InputType {..}+      where+        embed = IntegerLit . toInteger++        declared = Integer++ instance Inject Double where     injectWith _ = InputType {..}       where@@ -726,20 +781,37 @@          InputType embedIn declaredIn = injectWith options +instance Inject a => Inject [a] where+    injectWith = fmap (contramap Data.Vector.fromList) injectWith++instance Inject a => Inject (Data.Set.Set a) where+    injectWith = fmap (contramap go) injectWith where+        go se = Data.Vector.fromListN (Data.Set.size se) (Data.Foldable.toList se)++instance Inject a => Inject (Data.Sequence.Seq a) where+    injectWith = fmap (contramap go) injectWith where+        go se = Data.Vector.fromListN (Data.Sequence.length se) (Data.Foldable.toList se)++deriving instance (Inject a, Inject b) => Inject (a, b)+ {-| This is the underlying class that powers the `Interpret` class's support     for automatically deriving a generic implementation -} class GenericInject f where-    genericInjectWith :: InterpretOptions -> InputType (f a)+    genericInjectWith :: InterpretOptions -> State Int (InputType (f a))  instance GenericInject f => GenericInject (M1 D d f) where-    genericInjectWith = fmap (contramap unM1) genericInjectWith+    genericInjectWith options = do+        res <- genericInjectWith options+        pure (contramap unM1 res)  instance GenericInject f => GenericInject (M1 C c f) where-    genericInjectWith = fmap (contramap unM1) genericInjectWith+    genericInjectWith options = do+        res <- genericInjectWith options+        pure (contramap unM1 res)  instance (Constructor c1, Constructor c2, GenericInject f1, GenericInject f2) => GenericInject (M1 C c1 f1 :+: M1 C c2 f2) where-    genericInjectWith options@(InterpretOptions {..}) = InputType {..}+    genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..})       where         embed (L1 (M1 l)) = UnionLit keyL (embedL l) Data.Map.empty         embed (R1 (M1 r)) = UnionLit keyR (embedR r) Data.Map.empty@@ -756,11 +828,11 @@         keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))         keyR = constructorModifier (Data.Text.Lazy.pack (conName nR)) -        InputType embedL declaredL = genericInjectWith options-        InputType embedR declaredR = genericInjectWith options+        InputType embedL declaredL = evalState (genericInjectWith options) 1+        InputType embedR declaredR = evalState (genericInjectWith options) 1  instance (Constructor c, GenericInject (f :+: g), GenericInject h) => GenericInject ((f :+: g) :+: M1 C c h) where-    genericInjectWith options@(InterpretOptions {..}) = InputType {..}+    genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..})       where         embed (L1 l) = UnionLit keyL valL (Data.Map.insert keyR declaredR ktsL')           where@@ -774,11 +846,11 @@          declared = Union (Data.Map.insert keyR declaredR ktsL) -        InputType embedL (Union ktsL) = genericInjectWith options-        InputType embedR  declaredR   = genericInjectWith options+        InputType embedL (Union ktsL) = evalState (genericInjectWith options) 1+        InputType embedR  declaredR   = evalState (genericInjectWith options) 1  instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInject (M1 C c f :+: (g :+: h)) where-    genericInjectWith options@(InterpretOptions {..}) = InputType {..}+    genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..})       where         embed (L1 (M1 l)) = UnionLit keyL (embedL l) ktsR         embed (R1 r) = UnionLit keyR valR (Data.Map.insert keyL declaredL ktsR')@@ -792,11 +864,11 @@          declared = Union (Data.Map.insert keyL declaredL ktsR) -        InputType embedL  declaredL   = genericInjectWith options-        InputType embedR (Union ktsR) = genericInjectWith options+        InputType embedL  declaredL   = evalState (genericInjectWith options) 1+        InputType embedR (Union ktsR) = evalState (genericInjectWith options) 1  instance (GenericInject (f :+: g), GenericInject (h :+: i)) => GenericInject ((f :+: g) :+: (h :+: i)) where-    genericInjectWith options = InputType {..}+    genericInjectWith options = pure (InputType {..})       where         embed (L1 l) = UnionLit keyL valR (Data.Map.union ktsL' ktsR)           where@@ -807,44 +879,41 @@          declared = Union (Data.Map.union ktsL ktsR) -        InputType embedL (Union ktsL) = genericInjectWith options-        InputType embedR (Union ktsR) = genericInjectWith options+        InputType embedL (Union ktsL) = evalState (genericInjectWith options) 1+        InputType embedR (Union ktsR) = evalState (genericInjectWith options) 1  instance (GenericInject f, GenericInject g) => GenericInject (f :*: g) where-    genericInjectWith options = InputType embedOut declaredOut-      where-        embedOut (l :*: r) = RecordLit (Data.Map.union mapL mapR)-          where-            RecordLit mapL = embedInL l-            RecordLit mapR = embedInR r+    genericInjectWith options = do+        InputType embedInL declaredInL <- genericInjectWith options+        InputType embedInR declaredInR <- genericInjectWith options -        declaredOut = Record (Data.Map.union mapL mapR)-          where-            Record mapL = declaredInL-            Record mapR = declaredInR+        let embed (l :*: r) = RecordLit (Data.Map.union mapL mapR)+              where+                RecordLit mapL = embedInL l+                RecordLit mapR = embedInR r -        InputType embedInL declaredInL = genericInjectWith options+        let declared = Record (Data.Map.union mapL mapR)+              where+                Record mapL = declaredInL+                Record mapR = declaredInR -        InputType embedInR declaredInR = genericInjectWith options+        pure (InputType {..})  instance GenericInject U1 where-    genericInjectWith _ = InputType {..}+    genericInjectWith _ = pure (InputType {..})       where         embed _ = RecordLit Data.Map.empty          declared = Record Data.Map.empty  instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where-    genericInjectWith opts@(InterpretOptions {..}) =-        InputType embedOut declaredOut+    genericInjectWith opts@(InterpretOptions {..}) = do+        name <- fieldModifier . Data.Text.Lazy.pack <$> getSelName n+        let embed (M1 (K1 x)) = RecordLit (Data.Map.singleton name (embedIn x))+        let declared = Record (Data.Map.singleton name declaredIn)+        pure (InputType {..})       where         n :: M1 i s f a         n = undefined--        name = fieldModifier (Data.Text.Lazy.pack (selName n))--        embedOut (M1 (K1 x)) = RecordLit (Data.Map.singleton name (embedIn x))--        declaredOut = Record (Data.Map.singleton name declaredIn)          InputType embedIn declaredIn = injectWith opts

@@ -1,7 +1,8 @@-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards     #-} {-# OPTIONS_GHC -Wall #-}  {-| Dhall lets you import external expressions located either in local files or@@ -112,9 +113,11 @@  import Control.Applicative (empty) import Control.Exception-    (Exception, IOException, SomeException, catch, onException, throwIO)+    (Exception, IOException, SomeException, onException, throwIO) import Control.Lens (Lens', zoom) import Control.Monad (join)+import Control.Monad.Catch (throwM, MonadCatch(catch))+import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.State.Strict (StateT) import Data.ByteString.Lazy (ByteString)@@ -662,21 +665,30 @@     This also returns the true final path (i.e. explicit "/@" at the end for     directories) -}-loadDynamic :: Path -> StateT Status IO (Expr Src Path)-loadDynamic p = do+loadDynamic :: forall m . MonadCatch m => (Path -> m (Expr Src Path))+    -> Path -> StateT Status m (Expr Src Path)+loadDynamic from_path p = do     paths <- zoom stack State.get -    let handler :: SomeException -> IO (Expr Src Path)-        handler e = throwIO (Imported (p:paths) e)+    let handler :: SomeException -> m (Expr Src Path)+        handler e = throwM (Imported (p:paths) e)++    lift (from_path (canonicalizePath (p:paths)) `catch` handler)++loadStaticIO :: Dhall.Context.Context (Expr Src X) -> Path -> StateT Status IO (Expr Src X)+loadStaticIO ctx path = do     m <- needManager-    liftIO (exprFromPath m (canonicalizePath (p:paths)) `catch` handler)+    loadStaticWith (exprFromPath m) ctx path --- | Load a `Path` as a \"static\" expression (with all imports resolved)-loadStatic :: Path -> StateT Status IO (Expr Src X)-loadStatic = loadStaticWith Dhall.Context.empty+-- | Resolve all imports within an expression using a custom typing context and Path+-- resolving callback in arbitrary `MonadCatch` monad.+loadWith :: MonadCatch m => (Path -> m (Expr Src Path))+    -> Dhall.Context.Context (Expr Src X) -> Expr Src Path -> m (Expr Src X)+loadWith from_path ctx = evalStatus (loadStaticWith from_path ctx) -loadStaticWith :: Dhall.Context.Context (Expr Src X) -> Path -> StateT Status IO (Expr Src X)-loadStaticWith ctx path = do+loadStaticWith :: MonadCatch m => (Path -> m (Expr Src Path))+    -> Dhall.Context.Context (Expr Src X) -> Path -> StateT Status m (Expr Src X)+loadStaticWith from_path ctx path = do     paths <- zoom stack State.get      let local (Path (URL url _) _) =@@ -693,17 +705,17 @@     let here   = canonicalizePath (path:paths)      if local here && not (local parent)-        then liftIO (throwIO (Imported paths (ReferentiallyOpaque path)))+        then throwM (Imported paths (ReferentiallyOpaque path))         else return ()      (expr, cached) <- if here `elem` canonicalizeAll paths-        then liftIO (throwIO (Imported paths (Cycle path)))+        then throwM (Imported paths (Cycle path))         else do             m <- zoom cache State.get             case Map.lookup here m of                 Just expr -> return (expr, True)                 Nothing   -> do-                    expr'  <- loadDynamic path+                    expr'  <- loadDynamic from_path path                     expr'' <- case traverse (\_ -> Nothing) expr' of                         -- No imports left                         Just expr -> do@@ -713,7 +725,7 @@                         Nothing   -> do                             let paths' = path:paths                             zoom stack (State.put paths')-                            expr'' <- fmap join (traverse (loadStaticWith ctx)+                            expr'' <- fmap join (traverse (loadStaticWith from_path ctx)                                                            expr')                             zoom stack (State.put paths)                             return expr''@@ -729,19 +741,17 @@     if cached         then return ()         else case Dhall.TypeCheck.typeWith ctx expr of-            Left  err -> liftIO (throwIO (Imported (path:paths) err))+            Left  err -> throwM (Imported (path:paths) err)             Right _   -> return ()      return expr --- | Resolve all imports within an expression-load :: Expr Src Path -> IO (Expr Src X)-load expr = State.evalStateT (fmap join (traverse loadStatic expr)) status+evalStatus :: (Traversable f, Monad m, Monad f) =>+                    (a -> StateT Status m (f b)) -> f a -> m (f b)+evalStatus cb expr = State.evalStateT (fmap join (traverse cb expr)) status   where     status = Status [] Map.empty Nothing --- | Resolve all imports within an expression using a custom typing context-loadWith :: Dhall.Context.Context (Expr Src X) -> Expr Src Path -> IO (Expr Src X)-loadWith ctx expr = State.evalStateT (fmap join (traverse (loadStaticWith ctx) expr)) status-  where-    status = Status [] Map.empty Nothing+-- | Resolve all imports within an expression+load :: Expr Src Path -> IO (Expr Src X)+load = evalStatus (loadStaticIO Dhall.Context.empty)

@@ -46,7 +46,6 @@ import qualified Data.ByteString.Lazy import qualified Data.List import qualified Data.Sequence-import qualified Data.Text import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder import qualified Data.Text.Lazy.Encoding@@ -60,7 +59,7 @@ import qualified Text.Trifecta  -- | Source code extract-data Src = Src Delta Delta ByteString deriving (Show)+data Src = Src Delta Delta ByteString deriving (Eq, Show)  instance Buildable Src where     build (Src begin _ bytes) =@@ -102,11 +101,6 @@      highlight h (Parser m) = Parser (highlight h m) -    token parser = do-        r <- parser-        Text.Parser.Token.whiteSpace-        return r- identifierStyle :: IdentifierStyle Parser identifierStyle = IdentifierStyle     { _styleName     = "dhall"@@ -202,7 +196,7 @@         return e      go3 = do-        a <- Text.Parser.Token.characterChar+        a <- stringChar         b <- go         let e = case b of                 TextLit cs ->@@ -215,7 +209,7 @@  doubleSingleQuoteString :: Show a => Parser a -> Parser (Expr Src a) doubleSingleQuoteString embedded = do-    expr0 <- Text.Parser.Token.token p0+    expr0 <- p0      let builder0      = concatFragments expr0     let text0         = Data.Text.Lazy.Builder.toLazyText builder0@@ -326,6 +320,17 @@         s3 <- p1         return (TextAppend s1 s3) +stringChar :: Parser Char+stringChar =+        Text.Parser.Char.satisfy predicate+    <|> (do _ <- Text.Parser.Char.text "\\\\"; return '\\')+    <|> (do _ <- Text.Parser.Char.text "\\\""; return '"' )+    <|> (do _ <- Text.Parser.Char.text "\\n" ; return '\n')+    <|> (do _ <- Text.Parser.Char.text "\\r" ; return '\r')+    <|> (do _ <- Text.Parser.Char.text "\\t" ; return '\t')+  where+    predicate c = c /= '"' && c /= '\\' && c > '\026'+ lambda :: Parser () lambda = symbol "\\" <|> symbol "λ" @@ -503,8 +508,7 @@     es <- many (noted (try (exprE embedded)))     let app nL@(Note (Src before _ bytesL) _) nR@(Note (Src _ after bytesR) _) =             Note (Src before after (bytesL <> bytesR)) (App nL nR)-        app _ _ = Dhall.Core.internalError-            ("Dhall.Parser.exprD: foldl1 app (" <> Data.Text.pack (show es) <> ")")+        app nL nR = App nL nR     return (Data.List.foldl1 app (e:es))  exprE :: Show a => Parser a -> Parser (Expr Src a)

@@ -465,12 +465,12 @@ -- -- __Exercise:__ There is a @not@ function hosted online here: ----- <https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not>+-- <https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not> -- -- Visit that link and read the documentation.  Then try to guess what this -- code returns: ----- > >>> input auto "https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not https://ipfs.io/ipfs/QmVf6hhTCXc9y2pRvhUmLk3AZYEgjeAz5PNwjt1GBYqsVB" :: IO Bool+-- > >>> input auto "https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not https://ipfs.io/ipfs/QmVf6hhTCXc9y2pRvhUmLk3AZYEgjeAz5PNwjt1GBYqsVB" :: IO Bool -- > ??? -- -- Run the code to test your guess@@ -981,7 +981,7 @@ -- You can also use @let@ expressions to rename imports, like this: -- -- > $ dhall--- > let not = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not+-- > let not = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not -- > in  not True -- > <Ctrl-D> -- > Bool@@ -1267,7 +1267,7 @@ -- complex example: -- -- > $ dhall--- >     let List/map = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/map+-- >     let List/map = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/map -- > in  λ(f : Integer → Integer) → List/map Integer Integer f [1, 2, 3] -- > <Ctrl-D> -- > ∀(f : Integer → Integer) → List Integer@@ -1291,11 +1291,11 @@ -- __Exercise__: The Dhall Prelude provides a @replicate@ function which you can -- find here: ----- <https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/replicate>+-- <https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/replicate> -- -- Test what the following Dhall expression normalizes to: ----- > let replicate = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/replicate+-- > let replicate = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/replicate -- > in  replicate +10 -- -- __Exercise__: If you have a lot of spare time, try to \"break the compiler\" by@@ -1914,7 +1914,7 @@ -- -- Rules: ----- > let List/concat = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concat+-- > let List/concat = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concat -- > -- > List/fold a (List/concat a xss) b c -- >     = List/fold (List a) xss b (λ(x : List a) → List/fold a x b c)@@ -1983,10 +1983,10 @@ -- -- Rules: ----- > let Optional/head  = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Optional/head--- > let List/concat    = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concat--- > let List/concatMap = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concatMap--- > let List/map       = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/map+-- > let Optional/head  = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Optional/head+-- > let List/concat    = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concat+-- > let List/concatMap = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concatMap+-- > let List/map       = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/map -- >  -- > List/head a (List/concat a xss) = -- >     Optional/head a (List/map (List a) (Optional a) (List/head a) xss)@@ -2014,10 +2014,10 @@ -- -- Rules: ----- > let Optional/last  = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Optional/last--- > let List/concat    = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concat--- > let List/concatMap = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concatMap--- > let List/map       = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/map+-- > let Optional/last  = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Optional/last+-- > let List/concat    = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concat+-- > let List/concatMap = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concatMap+-- > let List/map       = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/map -- >  -- > List/last a (List/concat a xss) = -- >     Optional/last a (List/map (List a) (Optional a) (List/last a) xss)@@ -2045,9 +2045,9 @@ -- -- Rules: ----- > let List/shifted = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/shifted--- > let List/concat  = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concat--- > let List/map     = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/map+-- > let List/shifted = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/shifted+-- > let List/concat  = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concat+-- > let List/map     = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/map -- >  -- > List/indexed a (List/concat a xss) = -- >     List/shifted a (List/map (List a) (List { index : Natural, value : a }) (List/indexed a) xss)@@ -2070,9 +2070,9 @@ -- -- Rules: ----- > let List/map       = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/map--- > let List/concat    = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concat--- > let List/concatMap = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/List/concatMap+-- > let List/map       = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/map+-- > let List/concat    = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concat+-- > let List/concatMap = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concatMap -- >  -- > List/reverse a (List/concat a xss) -- >     = List/concat a (List/reverse (List a) (List/map (List a) (List a) (List/reverse a) xss))@@ -2126,7 +2126,7 @@ -- -- There is also a Prelude available at: ----- <https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude>+-- <https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude> -- -- There is nothing \"official\" or \"standard\" about this Prelude other than -- the fact that it is mentioned in this tutorial.  The \"Prelude\" is just a@@ -2137,12 +2137,12 @@ -- subdirectories.  For example, the @Bool@ subdirectory has a @not@ file -- located here: ----- <https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not>+-- <https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not> -- -- The @not@ function is just a UTF8-encoded text file hosted online with the -- following contents ----- > $ curl https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not+-- > $ curl https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not -- > {- -- > Flip the value of a `Bool` -- > @@ -2175,7 +2175,7 @@ -- You can use this @not@ function either directly: -- -- > $ dhall--- > https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not True+-- > https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not True -- > <Ctrl-D> -- > Bool -- > @@ -2184,7 +2184,7 @@ -- ... or assign the URL to a shorter name: -- -- > $ dhall--- > let Bool/not = https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Bool/not+-- > let Bool/not = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Bool/not -- > in  Bool/not True -- > <Ctrl-D> -- > Bool@@ -2195,7 +2195,7 @@ -- consistency and documentation, such as @Prelude\/Natural\/even@, which -- re-exports the built-in @Natural/even@ function: ----- > $ curl https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/Natural/even+-- > $ curl https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/Natural/even -- > {- -- > Returns `True` if a number if even and returns `False` otherwise -- > @@ -2216,7 +2216,7 @@ -- using local relative paths instead of URLs.  For example, you can use @wget@, -- like this: ----- > $ wget -np -nH -r --cut-dirs=2 https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude/+-- > $ wget -np -nH -r --cut-dirs=2 https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/ -- > $ tree Prelude -- > Prelude -- > ├── Bool@@ -2280,12 +2280,12 @@ -- locally like this: -- -- > $ ipfs mount--- > $ cd /ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude+-- > $ cd /ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude -- -- Browse the Prelude online to learn more by seeing what functions are -- available and reading their inline documentation: ----- <https://ipfs.io/ipfs/QmRHdo2Jg59EZUT8Toq7MCZFN6e7wNbBtvaF7HCTrDFPxG/Prelude>+-- <https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude> -- -- __Exercise__: Try to use a new Prelude function that has not been covered -- previously in this tutorial

@@ -125,7 +125,7 @@     fmap Const (axiom c) typeWith ctx e@(Var (V x n)     ) = do     case Dhall.Context.lookup x n ctx of-        Nothing -> Left (TypeError ctx e UnboundVariable)+        Nothing -> Left (TypeError ctx e (UnboundVariable x))         Just a  -> return a typeWith ctx   (Lam x _A  b     ) = do     let ctx' = fmap (Dhall.Core.shift 1 (V x 0)) (Dhall.Context.insert x _A ctx)@@ -653,7 +653,7 @@  -- | The specific type error data TypeMessage s-    = UnboundVariable+    = UnboundVariable Text     | InvalidInputType (Expr s X)     | InvalidOutputType (Expr s X)     | NotAFunction (Expr s X) (Expr s X)@@ -726,7 +726,9 @@ _NOT = "\ESC[1mnot\ESC[0m"  prettyTypeMessage :: TypeMessage s -> ErrorMessages-prettyTypeMessage UnboundVariable = ErrorMessages {..}+prettyTypeMessage (UnboundVariable _) = ErrorMessages {..}+  -- We do not need to print variable name here. For the discussion see:+  -- https://github.com/Gabriel439/Haskell-Dhall-Library/pull/116   where     short = "Unbound variable" 

@@ -78,6 +78,10 @@                 [ _List_concat_0                 , _List_concat_1                 ]+            , Test.Tasty.testGroup "concatMap"+                [ _List_concatMap_0+                , _List_concatMap_1+                ]             , Test.Tasty.testGroup "filter"                 [ _List_filter_0                 , _List_filter_1@@ -456,6 +460,18 @@         \    ]   : List (List Integer)\n\         \)                            \n"     Util.assertNormalizesTo e "[] : List Integer" )++_List_concatMap_0 :: TestTree+_List_concatMap_0 = Test.Tasty.HUnit.testCase "Example #0" (do+    e <- Util.code+        "./Prelude/List/concatMap Natural Natural (λ(n : Natural) → [n, n]) [+2, +3, +5]"+    Util.assertNormalizesTo e "[+2, +2, +3, +3, +5, +5] : List Natural" )++_List_concatMap_1 :: TestTree+_List_concatMap_1 = Test.Tasty.HUnit.testCase "Example #1" (do+    e <- Util.code+        "./Prelude/List/concatMap Natural Natural (λ(n : Natural) → [n, n]) ([] : List Natural)"+    Util.assertNormalizesTo e "[] : List Natural" )  _List_filter_0 :: TestTree _List_filter_0 = Test.Tasty.HUnit.testCase "Example #0" (do

@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Regression where++import qualified Data.Map+import qualified Dhall+import qualified Dhall.Core+import qualified Test.Tasty+import qualified Test.Tasty.HUnit+import qualified Util++import Test.Tasty (TestTree)++regressionTests :: TestTree+regressionTests =+    Test.Tasty.testGroup "regression tests"+        [ issue96+        , unnamedFields+        , trailingSpaceAfterStringLiterals+        ]++data Foo = Foo Integer Bool | Bar Bool Bool Bool | Baz Integer Integer+    deriving (Show, Dhall.Generic, Dhall.Interpret, Dhall.Inject)++unnamedFields :: TestTree+unnamedFields = Test.Tasty.HUnit.testCase "Unnamed Fields" (do+    let ty = Dhall.auto @Foo+    Test.Tasty.HUnit.assertEqual "Good type" (Dhall.expected ty) (Dhall.Core.Union (+            Data.Map.fromList [+                ("Bar",Dhall.Core.Record (Data.Map.fromList [+                    ("_1",Dhall.Core.Bool),("_2",Dhall.Core.Bool),("_3",Dhall.Core.Bool)]))+                , ("Baz",Dhall.Core.Record (Data.Map.fromList [+                    ("_1",Dhall.Core.Integer),("_2",Dhall.Core.Integer)]))+                ,("Foo",Dhall.Core.Record (Data.Map.fromList [+                    ("_1",Dhall.Core.Integer),("_2",Dhall.Core.Bool)]))]))++    let inj = Dhall.inject @Foo+    Test.Tasty.HUnit.assertEqual "Good Inject" (Dhall.declared inj) (Dhall.expected ty)++    let tu_ty = Dhall.auto @(Integer, Bool)+    Test.Tasty.HUnit.assertEqual "Auto Tuple" (Dhall.expected tu_ty) (Dhall.Core.Record (+            Data.Map.fromList [ ("_1",Dhall.Core.Integer),("_2",Dhall.Core.Bool) ]))++    let tu_in = Dhall.inject @(Integer, Bool)+    Test.Tasty.HUnit.assertEqual "Inj. Tuple" (Dhall.declared tu_in) (Dhall.expected tu_ty)++    return () )++issue96 :: TestTree+issue96 = Test.Tasty.HUnit.testCase "Issue #96" (do+    -- Verify that parsing should not fail+    _ <- Util.code "\"bar'baz\""+    return () )++trailingSpaceAfterStringLiterals :: TestTree+trailingSpaceAfterStringLiterals =+    Test.Tasty.HUnit.testCase "Trailing space after string literals" (do+        -- Verify that string literals parse correctly with trailing space+        -- (Yes, I did get this wrong at some point)+        _ <- Util.code "(''ABC'' ++ \"DEF\" )"+        return () )

@@ -2,6 +2,7 @@  import Normalization (normalizationTests) import Examples (exampleTests)+import Regression (regressionTests) import Tutorial (tutorialTests) import Test.Tasty @@ -11,6 +12,7 @@         [ normalizationTests         , exampleTests         , tutorialTests+        , regressionTests         ]  main :: IO ()