dhall 1.15.1 → 1.16.0

raw patch · 20 files changed

+345/−183 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• dhall.cabal +1/−1
• src/Dhall.hs +187/−58
• src/Dhall/Core.hs +6/−0
• src/Dhall/Format.hs +4/−10
• src/Dhall/Freeze.hs +5/−13
• src/Dhall/Hash.hs +0/−2
• src/Dhall/Import.hs +53/−38
• src/Dhall/Import/Types.hs +28/−6
• src/Dhall/Main.hs +7/−15
• src/Dhall/Parser/Token.hs +1/−1
• src/Dhall/Pretty.hs +8/−1
• src/Dhall/Repl.hs +1/−5
• src/Dhall/TH.hs +6/−5
• src/Dhall/TypeCheck.hs +3/−11
• tests/Format.hs +2/−8
• tests/Import.hs +16/−0
• tests/Regression.hs +2/−8
• tests/import/relative.dhall +2/−0
• tests/parser/quotedLabel.dhall +4/−1

@@ -1,3 +1,12 @@+1.16.0++* BREAKING CHANGE: Consolidate `input` family of functions+    * These now take a record of options+    * This also `_stack` field of the `Status` type from `[Import]` to+      `NonEmpty Import`+* Permit `$` in quoted variable names+    * See: https://github.com/dhall-lang/dhall-haskell/pull/510+ 1.15.1  * Fix infinite loop when formatting expressions containing `?`

@@ -1,5 +1,5 @@ Name: dhall-Version: 1.15.1+Version: 1.16.0 Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 8.0.1

@@ -19,11 +19,20 @@     (     -- * Input       input-    , inputFrom-    , inputWith-    , inputFromWith+    , inputWithSettings+    , inputFile+    , inputFileWithSettings     , inputExpr-    , inputExprWith+    , inputExprWithSettings+    , rootDirectory+    , sourceName+    , startingContext+    , normalizer+    , defaultInputSettings+    , InputSettings+    , defaultEvaluateSettings+    , EvaluateSettings+    , HasEvaluateSettings     , detailed      -- * Types@@ -85,8 +94,10 @@ import Dhall.Parser (Src(..)) import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X) import GHC.Generics+import Lens.Family (LensLike', view) import Numeric.Natural (Natural) import Prelude hiding (maybe, sequence)+import System.FilePath (takeDirectory)  import qualified Control.Applicative import qualified Control.Exception@@ -98,6 +109,7 @@ import qualified Data.Sequence import qualified Data.Set import qualified Data.Text+import qualified Data.Text.IO import qualified Data.Text.Lazy import qualified Data.Vector import qualified Dhall.Context@@ -135,6 +147,98 @@  instance Exception InvalidType +-- | @since 1.16+data InputSettings = InputSettings+  { _rootDirectory :: FilePath+  , _sourceName :: FilePath+  , _evaluateSettings :: EvaluateSettings+  }++-- | Default input settings: resolves imports relative to @.@ (the+-- current working directory), report errors as coming from @(input)@,+-- and default evaluation settings from 'defaultEvaluateSettings'.+--+-- @since 1.16+defaultInputSettings :: InputSettings+defaultInputSettings = InputSettings+  { _rootDirectory = "."+  , _sourceName = "(input)"+  , _evaluateSettings = defaultEvaluateSettings+  }++-- | Access the directory to resolve imports relative to.+--+-- @since 1.16+rootDirectory+  :: (Functor f)+  => LensLike' f InputSettings FilePath+rootDirectory k s =+  fmap (\x -> s { _rootDirectory = x }) (k (_rootDirectory s))++-- | Access the name of the source to report locations from; this is+-- only used in error messages, so it's okay if this is a best guess+-- or something symbolic.+--+-- @since 1.16+sourceName+  :: (Functor f)+  => LensLike' f InputSettings FilePath+sourceName k s =+  fmap (\x -> s { _sourceName = x}) (k (_sourceName s))++-- | @since 1.16+data EvaluateSettings = EvaluateSettings+  { _startingContext :: Dhall.Context.Context (Expr Src X)+  , _normalizer :: Dhall.Core.ReifiedNormalizer X+  }++-- | Default evaluation settings: no extra entries in the initial+-- context, and no special normalizer behaviour.+--+-- @since 1.16+defaultEvaluateSettings :: EvaluateSettings+defaultEvaluateSettings = EvaluateSettings+  { _startingContext = Dhall.Context.empty+  , _normalizer = Dhall.Core.ReifiedNormalizer (const Nothing)+  }++-- | Access the starting context used for evaluation and type-checking.+--+-- @since 1.16+startingContext+  :: (Functor f, HasEvaluateSettings s)+  => LensLike' f s (Dhall.Context.Context (Expr Src X))+startingContext = evaluateSettings . l+  where+    l :: (Functor f)+      => LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src X))+    l k s = fmap (\x -> s { _startingContext = x}) (k (_startingContext s))++-- | Access the custom normalizer.+--+-- @since 1.16+normalizer+  :: (Functor f, HasEvaluateSettings s)+  => LensLike' f s (Dhall.Core.ReifiedNormalizer X)+normalizer = evaluateSettings . l+  where+    l :: (Functor f)+      => LensLike' f EvaluateSettings (Dhall.Core.ReifiedNormalizer X)+    l k s = fmap (\x -> s { _normalizer = x }) (k (_normalizer s))++-- | @since 1.16+class HasEvaluateSettings s where+  evaluateSettings+    :: (Functor f)+    => LensLike' f s EvaluateSettings++instance HasEvaluateSettings InputSettings where+  evaluateSettings k s =+    fmap (\x -> s { _evaluateSettings = x }) (k (_evaluateSettings s))++instance HasEvaluateSettings EvaluateSettings where+  evaluateSettings = id+ {-| Type-check and evaluate a Dhall program, decoding the result into Haskell      The first argument determines the type of value that you decode:@@ -149,6 +253,8 @@  >>> input auto "True" :: IO Bool True++    This uses the settings from 'defaultInputSettings'. -} input     :: Type a@@ -158,54 +264,30 @@     -> IO a     -- ^ The decoded value in Haskell input =-  inputFrom "(input)"--inputFrom-    :: FilePath-    -- ^ The source file to report locations from; only used in error messages-    -> Type a-    -- ^ The type of value to decode from Dhall to Haskell-    -> Text-    -- ^ The Dhall program-    -> IO a-    -- ^ The decoded value in Haskell-inputFrom filename ty txt =-  inputFromWith filename ty Dhall.Context.empty (const Nothing) txt--{-| Extend 'input' with a custom typing context and normalization process.---}-inputWith-    :: Type a-    -- ^ The type of value to decode from Dhall to Haskell-    -> Dhall.Context.Context (Expr Src X)-    -- ^ The starting context for type-checking-    -> Dhall.Core.Normalizer X-    -> Text-    -- ^ The Dhall program-    -> IO a-    -- ^ The decoded value in Haskell-inputWith =-  inputFromWith "(input)"+  inputWithSettings defaultInputSettings -{-| Extend 'inputFrom' with a custom typing context and normalization process.+{-| Extend 'input' with a root directory to resolve imports relative+    to, a file to mention in errors as the source, a custom typing+    context, and a custom normalization process. +@since 1.16 -}-inputFromWith-    :: FilePath-    -- ^ The source file to report locations from; only used in error messages+inputWithSettings+    :: InputSettings     -> Type a     -- ^ The type of value to decode from Dhall to Haskell-    -> Dhall.Context.Context (Expr Src X)-    -- ^ The starting context for type-checking-    -> Dhall.Core.Normalizer X     -> Text     -- ^ The Dhall program     -> IO a     -- ^ The decoded value in Haskell-inputFromWith filename (Type {..}) ctx n txt = do-    expr  <- throws (Dhall.Parser.exprFromText filename txt)-    expr' <- Dhall.Import.loadWithContext ctx n expr+inputWithSettings settings (Type {..}) txt = do+    expr  <- throws (Dhall.Parser.exprFromText (view sourceName settings) txt)+    expr' <- Dhall.Import.loadDirWith+               (view rootDirectory settings)+               Dhall.Import.exprFromImport+               (view startingContext settings)+               (Dhall.Core.getReifiedNormalizer (view normalizer settings))+               expr     let suffix = Dhall.Pretty.Internal.prettyToStrictText expected     let annot = case expr' of             Note (Src begin end bytes) _ ->@@ -214,36 +296,85 @@                 bytes' = bytes <> " : " <> suffix             _ ->                 Annot expr' expected-    _ <- throws (Dhall.TypeCheck.typeWith ctx annot)-    case extract (Dhall.Core.normalizeWith n expr') of+    _ <- throws (Dhall.TypeCheck.typeWith (view startingContext settings) annot)+    case extract (Dhall.Core.normalizeWith (Dhall.Core.getReifiedNormalizer (view normalizer settings)) expr') of         Just x  -> return x         Nothing -> Control.Exception.throwIO InvalidType +{-| Type-check and evaluate a Dhall program that is read from the+    file-system.++    This uses the settings from 'defaultEvaluateSettings'.++    @since 1.16+-}+inputFile+  :: Type a+  -- ^ The type of value to decode from Dhall to Haskell+  -> FilePath+  -- ^ The path to the Dhall program.+  -> IO a+  -- ^ The decoded value in Haskell.+inputFile =+  inputFileWithSettings defaultEvaluateSettings++{-| Extend 'inputFile' with a custom typing context and a custom+    normalization process.++@since 1.16+-}+inputFileWithSettings+  :: EvaluateSettings+  -> Type a+  -- ^ The type of value to decode from Dhall to Haskell+  -> FilePath+  -- ^ The path to the Dhall program.+  -> IO a+  -- ^ The decoded value in Haskell.+inputFileWithSettings settings ty path = do+  text <- Data.Text.IO.readFile path+  let inputSettings = InputSettings+        { _rootDirectory = takeDirectory path+        , _sourceName = path+        , _evaluateSettings = settings+        }+  inputWithSettings inputSettings ty text+ {-| Similar to `input`, but without interpreting the Dhall `Expr` into a Haskell     type.++    Uses the settings from 'defaultInputSettings'. -} inputExpr     :: Text     -- ^ The Dhall program     -> IO (Expr Src X)     -- ^ The fully normalized AST-inputExpr = inputExprWith Dhall.Context.empty (const Nothing)+inputExpr =+  inputExprWithSettings defaultInputSettings -{-| Extend `inputExpr` with a custom typing context and normalization process.+{-| Extend 'inputExpr' with a root directory to resolve imports relative+    to, a file to mention in errors as the source, a custom typing+    context, and a custom normalization process.++@since 1.16 -}-inputExprWith-    :: Dhall.Context.Context (Expr Src X)-    -- ^ The starting context for type-checking-    -> Dhall.Core.Normalizer X+inputExprWithSettings+    :: InputSettings     -> Text     -- ^ The Dhall program     -> IO (Expr Src X)     -- ^ The fully normalized AST-inputExprWith ctx n txt = do-    expr  <- throws (Dhall.Parser.exprFromText "(input)" txt)-    expr' <- Dhall.Import.loadWithContext ctx n expr-    _ <- throws (Dhall.TypeCheck.typeWith ctx expr')-    pure (Dhall.Core.normalizeWith n expr')+inputExprWithSettings settings txt = do+    expr  <- throws (Dhall.Parser.exprFromText (view sourceName settings) txt)+    expr' <- Dhall.Import.loadDirWith+               (view rootDirectory settings)+               Dhall.Import.exprFromImport+               (view startingContext settings)+               (Dhall.Core.getReifiedNormalizer (view normalizer settings))+               expr+    _ <- throws (Dhall.TypeCheck.typeWith (view startingContext settings) expr')+    pure (Dhall.Core.normalizeWith (Dhall.Core.getReifiedNormalizer (view normalizer settings)) expr')  -- | Use this function to extract Haskell values directly from Dhall AST. --   The intended use case is to allow easy extraction of Dhall values for@@ -263,8 +394,6 @@     case extract (Dhall.Core.normalize expr) of         Just x  -> pure x         Nothing -> empty--  {-| Use this to provide more detailed error messages 

@@ -36,6 +36,7 @@     , normalize     , normalizeWith     , Normalizer+    , ReifiedNormalizer (..)     , judgmentallyEqual     , subst     , shift@@ -1713,6 +1714,11 @@ -- | Use this to wrap you embedded functions (see `normalizeWith`) to make them --   polymorphic enough to be used. type Normalizer a = forall s. Expr s a -> Maybe (Expr s a)++-- | A reified 'Normalizer', which can be stored in structures without+-- running into impredicative polymorphism.+data ReifiedNormalizer a = ReifiedNormalizer+  { getReifiedNormalizer :: Normalizer a }  -- | Check if an expression is in a normal form given a context of evaluation. --   Unlike `isNormalized`, this will fully normalize and traverse through the expression.

@@ -3,7 +3,7 @@ module Dhall.Format ( format ) where  import Dhall.Parser (exprAndHeaderFromText)-import Dhall.Pretty (annToAnsiStyle, prettyExpr)+import Dhall.Pretty (annToAnsiStyle, prettyExpr, layoutOpts)  import Data.Monoid ((<>)) @@ -14,11 +14,6 @@ import qualified System.Console.ANSI import qualified System.IO -opts :: Pretty.LayoutOptions-opts =-    Pretty.defaultLayoutOptions-        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }- format :: Maybe FilePath -> IO () format inplace = do         case inplace of@@ -30,10 +25,9 @@                  let doc = Pretty.pretty header <> Pretty.pretty expr                 System.IO.withFile file System.IO.WriteMode (\handle -> do-                    Pretty.renderIO handle (Pretty.layoutSmart opts doc)+                    Pretty.renderIO handle (Pretty.layoutSmart layoutOpts doc)                     Data.Text.IO.hPutStrLn handle "" )             Nothing -> do-                System.IO.hSetEncoding System.IO.stdin System.IO.utf8                 inText <- Data.Text.IO.getContents                  (header, expr) <- case exprAndHeaderFromText "(stdin)" inText of@@ -48,8 +42,8 @@                   then                     Pretty.renderIO                       System.IO.stdout-                      (fmap annToAnsiStyle (Pretty.layoutSmart opts doc))+                      (fmap annToAnsiStyle (Pretty.layoutSmart layoutOpts doc))                   else                     Pretty.renderIO                       System.IO.stdout-                      (Pretty.layoutSmart opts (Pretty.unAnnotate doc))+                      (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))

@@ -8,7 +8,7 @@ import Dhall.Core import Dhall.Import (load, hashExpression) import Dhall.Parser (exprAndHeaderFromText, Src)-import Dhall.Pretty (annToAnsiStyle)+import Dhall.Pretty (annToAnsiStyle, layoutOpts)  import System.Console.ANSI (hSupportsANSI) import Data.Monoid ((<>))@@ -21,15 +21,8 @@ import qualified Data.Text.IO import qualified System.IO -opts :: Pretty.LayoutOptions-opts =-    Pretty.defaultLayoutOptions-        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }- readInput :: Maybe FilePath -> IO Text-readInput = maybe fromStdin Data.Text.IO.readFile-    where -        fromStdin = System.IO.hSetEncoding System.IO.stdin System.IO.utf8 >> Data.Text.IO.getContents+readInput = maybe Data.Text.IO.getContents Data.Text.IO.readFile  hashImport :: Import -> IO Import hashImport import_ = do@@ -52,8 +45,7 @@ writeExpr :: Maybe FilePath -> (Text, Expr s Import) -> IO () writeExpr inplace (header, expr) = do     let doc = Pretty.pretty header <> Pretty.pretty expr-    let layoutOptions = opts-    let stream = Pretty.layoutSmart layoutOptions doc+    let stream = Pretty.layoutSmart layoutOpts doc      case inplace of         Just f ->@@ -64,9 +56,9 @@             supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout             if supportsANSI                 then -                 Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Pretty.layoutSmart opts doc)+                 Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Pretty.layoutSmart layoutOpts doc)                else-                 Pretty.renderIO System.IO.stdout (Pretty.layoutSmart opts (Pretty.unAnnotate doc)) +                 Pretty.renderIO System.IO.stdout (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))   freeze :: Maybe FilePath -> IO () freeze inplace = do

@@ -8,11 +8,9 @@ import qualified Control.Exception import qualified Dhall.TypeCheck import qualified Data.Text.IO-import qualified System.IO  hash :: IO () hash = do-        System.IO.hSetEncoding System.IO.stdin System.IO.utf8         inText <- Data.Text.IO.getContents          expr <- case exprFromText "(stdin)" inText of

@@ -102,6 +102,7 @@       exprFromImport     , load     , loadWith+    , loadDirWith     , loadWithContext     , hashExpression     , hashExpressionToCode@@ -158,8 +159,8 @@ import qualified Data.CaseInsensitive import qualified Data.Foldable -import qualified Data.List                               as List import qualified Data.HashMap.Strict.InsOrd+import qualified Data.List.NonEmpty                      as NonEmpty import qualified Data.Map.Strict                         as Map import qualified Data.Text.Encoding import qualified Data.Text                               as Text@@ -225,23 +226,23 @@  -- | Extend another exception with the current import stack data Imported e = Imported-    { importStack :: [Import] -- ^ Imports resolved so far, in reverse order-    , nested      :: e        -- ^ The nested exception+    { importStack :: NonEmpty Import -- ^ Imports resolved so far, in reverse order+    , nested      :: e               -- ^ The nested exception     } deriving (Typeable)  instance Exception e => Exception (Imported e)  instance Show e => Show (Imported e) where     show (Imported imports e) =-            (case imports of [] -> ""; _ -> "\n")-        ++  unlines (map indent imports')-        ++  show e+           concat (zipWith indent [0..] toDisplay)+        ++ show e       where-        indent (n, import_) =-            take (2 * n) (repeat ' ') ++ "↳ " ++ Dhall.Pretty.Internal.prettyToString import_-        -- Canonicalize all imports-        imports' = zip [0..] (drop 1 (reverse (canonicalizeAll imports)))-+        indent n import_ =+            "\n" ++ replicate (2 * n) ' ' ++ "↳ " ++ Dhall.Pretty.Internal.prettyToString import_+        canonical = NonEmpty.toList (canonicalizeAll imports)+        -- Tthe final (outermost) import is fake to establish the base+        -- directory. Also, we need outermost-first.+        toDisplay = drop 1 (reverse canonical)  -- | Exception thrown when an imported file is missing data MissingFile = MissingFile FilePath@@ -312,8 +313,10 @@         <>  url         <>  "\n" -canonicalizeAll :: [Import] -> [Import]-canonicalizeAll = map canonicalizeImport . List.tails+canonicalizeAll :: NonEmpty Import -> NonEmpty Import+canonicalizeAll = NonEmpty.scanr1 step+  where+    step a parent = canonicalizeImport (a :| [parent])  {-| > canonicalize (canonicalize x) = canonicalize x@@ -369,18 +372,9 @@     canonicalize (Import importHashed importMode) =         Import (canonicalize importHashed) importMode -canonicalizeImport :: [Import] -> Import+canonicalizeImport :: NonEmpty Import -> Import canonicalizeImport imports =-    canonicalize (sconcat (defaultImport :| reverse imports))-  where-    defaultImport =-        Import-            { importMode   = Code-            , importHashed = ImportHashed-                { hash       = Nothing-                , importType = Local Here (File (Directory []) ".")-                }-            }+    canonicalize (sconcat (NonEmpty.reverse imports))  toHeaders   :: Expr s a@@ -534,8 +528,11 @@         RawText -> do             return (TextLit (Chunks [] text)) --- | Resolve all imports within an expression using a custom typing context and--- `Import`-resolving callback in arbitrary `MonadCatch` monad.+-- | Resolve all imports within an expression using a custom typing+-- context and `Import`-resolving callback in arbitrary `MonadCatch`+-- monad.+--+-- This resolves imports relative to @.@ (the current working directory). loadWith     :: MonadCatch m     => (Import -> StateT Status m (Expr Src Import))@@ -544,10 +541,27 @@     -> Expr Src Import     -> m (Expr Src X) loadWith from_import ctx n expr =-    State.evalStateT (loadStaticWith from_import ctx n expr) emptyStatus+    loadDirWith "." from_import ctx n expr --- | Resolve all imports within an expression using a custom typing context.+-- | Resolve all imports within an expression using a custom typing+-- context and `Import`-resolving callback in arbitrary `MonadCatch`+-- monad, relative to a given directory. --+-- @since 1.16+loadDirWith+    :: MonadCatch m+    => FilePath+    -> (Import -> StateT Status m (Expr Src Import))+    -> Dhall.Context.Context (Expr Src X)+    -> Dhall.Core.Normalizer X+    -> Expr Src Import+    -> m (Expr Src X)+loadDirWith dir from_import ctx n expr = do+    State.evalStateT (loadStaticWith from_import ctx n expr) (emptyStatus dir)++-- | Resolve all imports within an expression, relative to @.@ (the+-- current working directory), using a custom typing context.+-- -- @load = loadWithContext Dhall.Context.empty@ loadWithContext     :: Dhall.Context.Context (Expr Src X)@@ -555,8 +569,9 @@     -> Expr Src Import     -> IO (Expr Src X) loadWithContext ctx n expr =-    State.evalStateT (loadStaticWith exprFromImport ctx n expr) emptyStatus+    loadDirWith "." exprFromImport ctx n expr + -- | This loads a \"static\" expression (i.e. an expression free of imports) loadStaticWith     :: MonadCatch m@@ -574,8 +589,9 @@         local (Import (ImportHashed _ (Env     {})) _) = True         local (Import (ImportHashed _ (Missing {})) _) = True -    let parent = canonicalizeImport imports-    let here   = canonicalizeImport (import_:imports)+    let parent   = canonicalizeImport imports+    let imports' = NonEmpty.cons import_ imports+    let here     = canonicalizeImport imports'      if local here && not (local parent)         then throwMissingImport (Imported imports (ReferentiallyOpaque import_))@@ -601,27 +617,26 @@                             -> StateT Status m (Expr Src Import)                         handler₀ e@(MissingImports []) = throwM e                         handler₀ (MissingImports [e]) =-                          throwMissingImport (Imported (import_:imports) e)+                          throwMissingImport (Imported imports' e)                         handler₀ (MissingImports es) = throwM                           (MissingImports                            (fmap-                             (\e -> (toException (Imported (import_:imports) e)))+                             (\e -> (toException (Imported imports' e)))                              es))                         handler₁                             :: (MonadCatch m)                             => SomeException                             -> StateT Status m (Expr Src Import)                         handler₁ e =-                          throwMissingImport (Imported (import_:imports) e)+                          throwMissingImport (Imported imports' e)                      -- This loads a \"dynamic\" expression (i.e. an expression                     -- that might still contain imports)                     let loadDynamic =-                            from_import (canonicalizeImport (import_:imports))+                            from_import here                      expr' <- loadDynamic `catches` [ Handler handler₀, Handler handler₁ ] -                    let imports' = import_:imports                     zoom stack (State.put imports')                     expr'' <- loadStaticWith from_import ctx n expr'                     zoom stack (State.put imports)@@ -637,7 +652,7 @@                     -- There is no need to check expressions that have been                     -- cached, since they have already been checked                     expr''' <- case Dhall.TypeCheck.typeWith ctx expr'' of-                        Left  err -> throwM (Imported (import_:imports) err)+                        Left  err -> throwM (Imported imports' err)                         Right _   -> return (Dhall.Core.normalizeWith n expr'')                     zoom cache (State.put $! Map.insert here expr''' m)                     return expr'''@@ -649,7 +664,7 @@             let actualHash = hashExpression expr             if expectedHash == actualHash                 then return ()-                else throwMissingImport (Imported (import_:imports) (HashMismatch {..}))+                else throwMissingImport (Imported imports' (HashMismatch {..}))      return expr   ImportAlt a b -> loop a `catch` handler₀

@@ -1,23 +1,30 @@+{-# LANGUAGE OverloadedStrings   #-} {-# OPTIONS_GHC -Wall #-}  module Dhall.Import.Types where  import Control.Exception (Exception) import Data.Dynamic+import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.Semigroup ((<>)) import Lens.Family (LensLike')+import System.FilePath (isRelative, splitDirectories)  import qualified Data.Map as Map+import qualified Data.Text -import Dhall.Core (Import, Expr)+import Dhall.Core+  ( Directory (..), Expr, File (..), FilePrefix (..), Import (..)+  , ImportHashed (..), ImportMode (..), ImportType (..)+  ) import Dhall.Parser (Src) import Dhall.TypeCheck (X)   -- | State threaded throughout the import process data Status = Status-    { _stack   :: [Import]+    { _stack   :: NonEmpty Import     -- ^ Stack of `Import`s that we've imported along the way to get to the     -- current point     , _cache   :: Map Import (Expr Src X)@@ -27,11 +34,26 @@     -- ^ Cache for the HTTP `Manager` so that we only acquire it once     } --- | Default starting `Status`-emptyStatus :: Status-emptyStatus = Status [] Map.empty Nothing+-- | Default starting `Status`, importing relative to the given directory.+emptyStatus :: FilePath -> Status+emptyStatus dir = Status (pure rootImport) Map.empty Nothing+  where+    prefix = if isRelative dir+      then Here+      else Absolute+    pathComponents = fmap Data.Text.pack (reverse (splitDirectories dir))+    dirAsFile = File (Directory pathComponents) "."+    -- Fake import to set the directory we're relative to.+    rootImport = Import+      { importHashed = ImportHashed+        { hash = Nothing+        , importType = Local prefix dirAsFile+        }+      , importMode = Code+      } -stack :: Functor f => LensLike' f Status [Import]++stack :: Functor f => LensLike' f Status (NonEmpty Import) stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))  cache :: Functor f => LensLike' f Status (Map Import (Expr Src X))

@@ -19,7 +19,7 @@ import Dhall.Core (Expr, Import) import Dhall.Import (Imported(..), load) import Dhall.Parser (Src)-import Dhall.Pretty (annToAnsiStyle, prettyExpr)+import Dhall.Pretty (annToAnsiStyle, prettyExpr, layoutOpts) import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X) import Options.Applicative (Parser, ParserInfo) import System.Exit (exitFailure)@@ -42,6 +42,7 @@ import qualified Dhall.Parser import qualified Dhall.Repl import qualified Dhall.TypeCheck+import qualified GHC.IO.Encoding import qualified Options.Applicative import qualified System.Console.ANSI import qualified System.IO@@ -146,11 +147,6 @@         where             parseFreeze = Freeze <$> optional parseInplace -opts :: Pretty.LayoutOptions-opts =-    Pretty.defaultLayoutOptions-        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }- data ImportResolutionDisabled = ImportResolutionDisabled deriving (Exception)  instance Show ImportResolutionDisabled where@@ -180,7 +176,7 @@  command :: Options -> IO () command (Options {..}) = do-    System.IO.hSetEncoding System.IO.stdin System.IO.utf8+    GHC.IO.Encoding.setLocaleEncoding System.IO.utf8      let handle =                 Control.Exception.handle handler2@@ -207,7 +203,6 @@              handler2 e = do                 let _ = e :: SomeException-                System.IO.hSetEncoding System.IO.stderr System.IO.utf8                 System.IO.hPrint System.IO.stderr e                 System.Exit.exitFailure @@ -215,9 +210,7 @@         render h e = do             let doc = prettyExpr e -            let layoutOptions = opts--            let stream = Pretty.layoutSmart layoutOptions doc+            let stream = Pretty.layoutSmart layoutOpts doc              supportsANSI <- System.Console.ANSI.hSupportsANSI h             let ansiStream =@@ -304,10 +297,9 @@                     let doc = Pretty.pretty header <> Pretty.pretty lintedExpression                      System.IO.withFile file System.IO.WriteMode (\h -> do-                        Pretty.renderIO h (Pretty.layoutSmart opts doc)+                        Pretty.renderIO h (Pretty.layoutSmart layoutOpts doc)                         Data.Text.IO.hPutStrLn h "" )                 Nothing -> do-                    System.IO.hSetEncoding System.IO.stdin System.IO.utf8                     text <- Data.Text.IO.getContents                      (header, expression) <- throws (Dhall.Parser.exprAndHeaderFromText "(stdin)" text)@@ -322,11 +314,11 @@                       then                         Pretty.renderIO                           System.IO.stdout-                          (fmap annToAnsiStyle (Pretty.layoutSmart opts doc))+                          (fmap annToAnsiStyle (Pretty.layoutSmart layoutOpts doc))                       else                         Pretty.renderIO                           System.IO.stdout-                          (Pretty.layoutSmart opts (Pretty.unAnnotate doc))+                          (Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))  main :: IO () main = do

@@ -173,7 +173,7 @@     _ <- Text.Parser.Char.char '`'     return (Data.Text.pack t)   where-    predicate c = alpha c || digit c || elem c ("-/_:." :: String)+    predicate c = alpha c || digit c || elem c ("$-/_:." :: String)  labels :: Parser (Set Text) labels = do

@@ -1,6 +1,13 @@ {-| This module contains logic for pretty-printing expressions, including     support for syntax highlighting -}-module Dhall.Pretty ( Ann(..), annToAnsiStyle, prettyExpr ) where+module Dhall.Pretty ( Ann(..), annToAnsiStyle, prettyExpr, layoutOpts ) where  import Dhall.Pretty.Internal+import qualified Data.Text.Prettyprint.Doc as Pretty++layoutOpts :: Pretty.LayoutOptions+layoutOpts =+    Pretty.defaultLayoutOptions+        { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }+

@@ -241,11 +241,7 @@ output handle expr = do   liftIO (System.IO.hPutStrLn handle "")  -- Visual spacing -  let opts =-          Pretty.defaultLayoutOptions-              { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }--  let stream = Pretty.layoutSmart opts (Dhall.Pretty.prettyExpr expr)+  let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts (Dhall.Pretty.prettyExpr expr)   supportsANSI <- liftIO (System.Console.ANSI.hSupportsANSI handle)   let ansiStream =           if supportsANSI

@@ -23,22 +23,23 @@ -} module Dhall.TH where -import Control.Monad import Data.Typeable import Language.Haskell.TH.Quote (dataToExpQ) -- 7.10 compatibility. import Language.Haskell.TH.Syntax  import qualified Data.Text as Text import qualified Dhall+import qualified GHC.IO.Encoding+import qualified System.IO  -- | This fully resolves, type checks, and normalizes the expression, so the --   resulting AST is self-contained. staticDhallExpression :: Text.Text -> Q Exp-staticDhallExpression =-    dataToExpQ (\a -> liftText <$> cast a) <=< runIO . Dhall.inputExpr+staticDhallExpression text = do+    runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8)+    expression <- runIO (Dhall.inputExpr text)+    dataToExpQ (\a -> liftText <$> cast a) 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)) . lift . Text.unpack--

@@ -33,7 +33,7 @@ import Data.Typeable (Typeable) import Dhall.Core (Const(..), Chunks(..), Expr(..), Var(..)) import Dhall.Context (Context)-import Dhall.Pretty (Ann)+import Dhall.Pretty (Ann, layoutOpts)  import qualified Data.Foldable import qualified Data.HashMap.Strict@@ -3494,11 +3494,7 @@     }  instance (Eq a, Pretty s, Pretty a) => Show (TypeError s a) where-    show = Pretty.renderString . Pretty.layoutPretty options . Pretty.pretty-      where-        options =-            Pretty.LayoutOptions-                { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }+    show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty  instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (TypeError s a) @@ -3533,11 +3529,7 @@     deriving (Typeable)  instance (Eq a, Pretty s, Pretty a) => Show (DetailedTypeError s a) where-    show = Pretty.renderString . Pretty.layoutPretty options . Pretty.pretty-      where-        options =-            Pretty.LayoutOptions-                { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }+    show = Pretty.renderString . Pretty.layoutPretty layoutOpts . Pretty.pretty  instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (DetailedTypeError s a) 

@@ -12,6 +12,7 @@ import qualified Data.Text.Prettyprint.Doc import qualified Data.Text.Prettyprint.Doc.Render.Text import qualified Dhall.Parser+import qualified Dhall.Pretty import qualified Test.Tasty import qualified Test.Tasty.HUnit @@ -56,13 +57,6 @@             "importSuffix"         ] -opts :: Data.Text.Prettyprint.Doc.LayoutOptions-opts =-    Data.Text.Prettyprint.Doc.defaultLayoutOptions-        { Data.Text.Prettyprint.Doc.layoutPageWidth =-            Data.Text.Prettyprint.Doc.AvailablePerLine 80 1.0-        }- should :: Text -> Text -> TestTree should name basename =     Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do@@ -77,7 +71,7 @@             Right expr -> return expr          let doc        = Data.Text.Prettyprint.Doc.pretty expr-        let docStream  = Data.Text.Prettyprint.Doc.layoutSmart opts doc+        let docStream  = Data.Text.Prettyprint.Doc.layoutSmart Dhall.Pretty.layoutOpts doc         let actualText = Data.Text.Prettyprint.Doc.Render.Text.renderStrict docStream          expectedText <- Data.Text.IO.readFile outputFile

@@ -10,6 +10,7 @@  import qualified Data.Text import qualified Data.Text.IO+import qualified Dhall.Context import qualified Dhall.Parser import qualified Dhall.Import import qualified Test.Tasty@@ -41,6 +42,12 @@                 "alternative of a Natural and missing"                 "./tests/import/alternativeNatural.dhall"             ]+        , Test.Tasty.testGroup "import relative to argument"+            [ shouldNotFailRelative+                "works"+                "./tests/import/data/foo/bar"+                "./tests/import/relative.dhall"+            ]         ]  shouldNotFail :: Text -> FilePath -> TestTree@@ -50,6 +57,15 @@                      Left  err  -> throwIO err                      Right expr -> return expr     _ <- Dhall.Import.load actualExpr+    return ())++shouldNotFailRelative :: Text -> FilePath -> FilePath -> TestTree+shouldNotFailRelative name dir path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) (do+    text <- Data.Text.IO.readFile path+    expr <- case Dhall.Parser.exprFromText mempty text of+                     Left  err  -> throwIO err+                     Right expr -> return expr+    _ <- Dhall.Import.loadDirWith dir Dhall.Import.exprFromImport Dhall.Context.empty (const Nothing) expr     return ())  shouldFail :: Int -> Text -> FilePath -> TestTree

@@ -14,6 +14,7 @@ import qualified Dhall.Context import qualified Dhall.Core import qualified Dhall.Parser+import qualified Dhall.Pretty import qualified Dhall.TypeCheck import qualified System.Timeout import qualified Test.Tasty@@ -141,19 +142,12 @@     Just _ <- System.Timeout.timeout 1000000 (Control.Exception.evaluate $!! text)     return () ) -opts :: Data.Text.Prettyprint.Doc.LayoutOptions-opts =-    Data.Text.Prettyprint.Doc.defaultLayoutOptions-        { Data.Text.Prettyprint.Doc.layoutPageWidth =-            Data.Text.Prettyprint.Doc.AvailablePerLine 80 1.0-        }- issue216 :: TestTree issue216 = Test.Tasty.HUnit.testCase "Issue #216" (do     -- Verify that pretty-printing preserves string interpolation     e <- Util.code "./tests/regression/issue216a.dhall"     let doc       = Data.Text.Prettyprint.Doc.pretty e-    let docStream = Data.Text.Prettyprint.Doc.layoutSmart opts doc+    let docStream = Data.Text.Prettyprint.Doc.layoutSmart Dhall.Pretty.layoutOpts doc     let text0 = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream      text1 <- Data.Text.Lazy.IO.readFile "./tests/regression/issue216b.dhall"

@@ -0,0 +1,2 @@+-- This file assumes its base directory is actually ./data/foo/bar/+./a.dhall : Natural

@@ -1,1 +1,4 @@-{ example1 = let `let` = 1 in `let`, example2 = let `:.` = 1 in `:.` }+{ example1 = let `let` = 1 in `let`+, example2 = let `:.` = 1 in `:.`+, example3 = let `$ref` = 1 in `$ref`+}