Fix import logic with --file for dhall-to-{json,yaml} (#1191)

Fixes #1183.

dhall-json/dhall-json.cabal

@@ -49,6 +49,7 @@ Library
         containers                                     ,
         dhall                     >= 1.25.0   && < 1.26,
         exceptions                >= 0.8.3    && < 0.11,
+        filepath                                 < 1.5 ,
         optparse-applicative      >= 0.14.0.0 && < 0.16,
         scientific                >= 0.3.0.0  && < 0.4 ,
         text                      >= 0.11.1.0 && < 1.3 ,

dhall-json/dhall-to-json/Main.hs

@@ -17,7 +17,6 @@ import qualified Data.Aeson
 import qualified Data.Aeson.Encode.Pretty
 import qualified Data.ByteString.Char8
 import qualified Data.ByteString.Lazy
-import qualified Data.Text                as Text
 import qualified Data.Text.IO             as Text.IO
 import qualified Dhall
 import qualified Dhall.JSON
@@ -133,11 +132,7 @@ main = do
             Nothing   -> Text.IO.getContents
             Just path -> Text.IO.readFile path
 
-        let path = case file of
-                Nothing -> "(stdin)"
-                Just p  -> Text.pack p
-
-        json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode path text)
+        json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode file text)
 
         Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json
 

dhall-json/dhall-to-yaml/Main.hs

@@ -11,7 +11,6 @@ import Options.Applicative (Parser, ParserInfo)
 
 import qualified Control.Exception
 import qualified Data.ByteString
-import qualified Data.Text           as Text
 import qualified Data.Text.IO        as Text.IO
 import qualified GHC.IO.Encoding
 import qualified Options.Applicative as Options
@@ -60,11 +59,7 @@ main = do
             Nothing   -> Text.IO.getContents
             Just path -> Text.IO.readFile path
 
-        let path = case file of
-                Nothing -> "(stdin)"
-                Just p  -> Text.pack p
-
-        Data.ByteString.putStr =<< dhallToYaml options path contents
+        Data.ByteString.putStr =<< dhallToYaml options file contents
 
 handle :: IO a -> IO a
 handle = Control.Exception.handle handler

dhall-json/src/Dhall/JSON.hs

@@ -183,6 +183,7 @@ import Control.Applicative (empty, (<|>))
 import Control.Monad (guard)
 import Control.Exception (Exception, throwIO)
 import Data.Aeson (Value(..), ToJSON(..))
+import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>), mempty)
 import Data.Text (Text)
 import Dhall.Core (Expr)
@@ -205,6 +206,7 @@ import qualified Dhall.Optics
 import qualified Dhall.Parser
 import qualified Dhall.TypeCheck
 import qualified Options.Applicative
+import qualified System.FilePath
 
 {-| This is the exception type for errors that might arise when translating
     Dhall to JSON
@@ -951,13 +953,18 @@ handleSpecialDoubles specialDoubleMode =
 codeToValue
   :: Conversion
   -> SpecialDoubleMode
-  -> Text  -- ^ Describe the input for the sake of error location.
+  -> Maybe FilePath  -- ^ The source file path. If no path is given, imports
+                     -- are resolved relative to the current directory.
   -> Text  -- ^ Input text.
   -> IO Value
-codeToValue conversion specialDoubleMode name code = do
-    parsedExpression <- Core.throws (Dhall.Parser.exprFromText (Data.Text.unpack name) code)
+codeToValue conversion specialDoubleMode mFilePath code = do
+    parsedExpression <- Core.throws (Dhall.Parser.exprFromText (fromMaybe "(stdin)" mFilePath) code)
 
-    resolvedExpression <- Dhall.Import.load parsedExpression
+    let rootDirectory = case mFilePath of
+            Nothing -> "."
+            Just fp -> System.FilePath.takeDirectory fp
+
+    resolvedExpression <- Dhall.Import.loadRelativeTo rootDirectory parsedExpression
 
     _ <- Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
 

dhall-json/src/Dhall/Yaml.hs

@@ -68,14 +68,15 @@ parseQuoted =
 -}
 dhallToYaml
   :: Options
-  -> Text  -- ^ Describe the input for the sake of error location.
+  -> Maybe FilePath  -- ^ The source file path. If no path is given, imports
+                     -- are resolved relative to the current directory.
   -> Text  -- ^ Input text.
   -> IO ByteString
-dhallToYaml Options{..} name code = do
+dhallToYaml Options{..} mFilePath code = do
 
   let explaining = if explain then Dhall.detailed else id
 
-  json <- omission <$> explaining (codeToValue conversion UseYAMLEncoding name code)
+  json <- omission <$> explaining (codeToValue conversion UseYAMLEncoding mFilePath code)
 
   return $ jsonToYaml json documents quoted
 

dhall-json/tasty/Main.hs

@@ -11,7 +11,6 @@ import Test.Tasty (TestTree)
 import qualified Data.Aeson           as Aeson
 import qualified Data.ByteString
 import qualified Data.ByteString.Lazy
-import qualified Data.Text
 import qualified Data.Text.IO
 import qualified Dhall.Core           as Core
 import qualified Dhall.Import
@@ -131,7 +130,7 @@ testDhallToYaml options prefix = Test.Tasty.HUnit.testCase prefix $ do
     text <- Data.Text.IO.readFile inputFile
 
     actualValue <- do
-        Dhall.Yaml.dhallToYaml options (Data.Text.pack inputFile) text
+        Dhall.Yaml.dhallToYaml options (Just inputFile) text
 
     expectedValue <- Data.ByteString.readFile outputFile
 

dhall-json/tasty/data/normal.dhall

@@ -1,5 +1,5 @@
 { string_value = "2000-01-01"
-, text = ./tasty/data/yaml.txt as Text
+, text = ./yaml.txt as Text
 , int_value = 1
 , bool_value = True
 }

dhall-json/tasty/data/quoted.dhall

@@ -1,5 +1,5 @@
 { string_value = "2000-01-01"
-, text = ./tasty/data/yaml.txt as Text
+, text = ./yaml.txt as Text
 , int_value = 1
 , bool_value = True
 }

dhall/src/Dhall/Import.hs

@@ -101,6 +101,7 @@
 module Dhall.Import (
     -- * Import
       load
+    , loadRelativeTo
     , loadWith
     , localToPath
     , hashExpression
@@ -970,7 +971,13 @@ loadWith expr₀ = case expr₀ of
 
 -- | Resolve all imports within an expression
 load :: Expr Src Import -> IO (Expr Src X)
-load expression = State.evalStateT (loadWith expression) (emptyStatus ".")
+load = loadRelativeTo "."
+
+-- | Resolve all imports within an expression, importing relative to the given
+-- directory.
+loadRelativeTo :: FilePath -> Expr Src Import -> IO (Expr Src X)
+loadRelativeTo rootDirectory expression =
+    State.evalStateT (loadWith expression) (emptyStatus rootDirectory)
 
 encodeExpression
     :: forall s

dhall/src/Dhall/Main.hs

@@ -3,6 +3,7 @@
 -}
 
 {-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
@@ -273,7 +274,6 @@ getExpression :: Maybe FilePath -> IO (Expr Src Import)
 getExpression maybeFile = do
     inText <- do
         case maybeFile of
-            Just "-"  -> Data.Text.IO.getContents
             Just file -> Data.Text.IO.readFile file
             Nothing   -> Data.Text.IO.getContents
 
@@ -297,12 +297,11 @@ command (Options {..}) = do
 
     GHC.IO.Encoding.setLocaleEncoding System.IO.utf8
 
-    let toStatus maybeFile = Dhall.Import.emptyStatus file
-          where
-            file = case maybeFile of
-                Just "-" -> "."
-                Just f   -> System.FilePath.takeDirectory f
-                Nothing  -> "."
+    let rootDirectory = \case
+            Just f   -> System.FilePath.takeDirectory f
+            Nothing  -> "."
+
+    let toStatus = Dhall.Import.emptyStatus . rootDirectory
 
     let handle =
                 Control.Exception.handle handler2
@@ -362,7 +361,7 @@ command (Options {..}) = do
         Default {..} -> do
             expression <- getExpression file
 
-            resolvedExpression <- State.evalStateT (Dhall.Import.loadWith expression) (toStatus file)
+            resolvedExpression <- Dhall.Import.loadRelativeTo (rootDirectory file) expression
 
             inferredType <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
 
@@ -433,8 +432,7 @@ command (Options {..}) = do
         Resolve { resolveMode = Nothing, ..} -> do
             expression <- getExpression file
 
-            (resolvedExpression, _) <-
-                State.runStateT (Dhall.Import.loadWith expression) (toStatus file)
+            resolvedExpression <- Dhall.Import.loadRelativeTo (rootDirectory file) expression
             render System.IO.stdout resolvedExpression
 
         Normalize {..} -> do
@@ -564,7 +562,7 @@ command (Options {..}) = do
         Text {..} -> do
             expression <- getExpression file
 
-            resolvedExpression <- State.evalStateT (Dhall.Import.loadWith expression) (toStatus file)
+            resolvedExpression <- Dhall.Import.loadRelativeTo (rootDirectory file) expression
 
             _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf (Annot resolvedExpression Dhall.Core.Text))