Add source position information for missing imports

dhall/src/Dhall/Import.hs

@@ -167,7 +167,7 @@ import Dhall.Import.HTTP
 import Dhall.Import.Types
 import Text.Dot ((.->.), userNodeId)
 
-import Dhall.Parser (Parser(..), ParseError(..), Src(..))
+import Dhall.Parser (Parser(..), ParseError(..), Src(..), SourcedException(..))
 import Dhall.TypeCheck (X(..))
 import Lens.Family.State.Strict (zoom)
 
@@ -278,7 +278,6 @@ instance Show MissingFile where
             "\n"
         <>  "\ESC[1;31mError\ESC[0m: Missing file "
         <>  path
-        <>  "\n"
 
 -- | Exception thrown when an environment variable is missing
 newtype MissingEnvironmentVariable = MissingEnvironmentVariable { name :: Text }
@@ -302,19 +301,16 @@ instance Show MissingImports where
     show (MissingImports []) =
             "\n"
         <>  "\ESC[1;31mError\ESC[0m: No valid imports"
-        <>  "\n"
     show (MissingImports [e]) = show e
     show (MissingImports es) =
             "\n"
         <>  "\ESC[1;31mError\ESC[0m: Failed to resolve imports. Error list:"
         <>  "\n"
         <>  concatMap (\e -> "\n" <> show e <> "\n") es
-        <>  "\n"
 
 throwMissingImport :: (MonadCatch m, Exception e) => e -> m a
 throwMissingImport e = throwM (MissingImports [(toException e)])
 
-
 -- | Exception thrown when a HTTP url is imported but dhall was built without
 -- the @with-http@ Cabal flag.
 data CannotImportHTTPURL =
@@ -850,11 +846,12 @@ loadWith expr₀ = case expr₀ of
     return expr
   ImportAlt a b -> loadWith a `catch` handler₀
     where
-      handler₀ (MissingImports es₀) =
-        loadWith b `catch` handler₁
+      handler₀ (SourcedException (Src begin _ text) (MissingImports es₀)) =
+          loadWith b `catch` handler₁
         where
-          handler₁ (MissingImports es₁) =
-            throwM (MissingImports (es₀ ++ es₁))
+          handler₁ (SourcedException (Src _ end _) (MissingImports es₁)) =
+            throwM (SourcedException (Src begin end text) (MissingImports (es₀ ++ es₁)))
+
   Const a              -> pure (Const a)
   Var a                -> pure (Var a)
   Lam a b c            -> Lam <$> pure a <*> loadWith b <*> loadWith c
@@ -919,7 +916,15 @@ loadWith expr₀ = case expr₀ of
   Constructors a       -> Constructors <$> loadWith a
   Field a b            -> Field <$> loadWith a <*> pure b
   Project a b          -> Project <$> loadWith a <*> pure b
-  Note a b             -> Note <$> pure a <*> loadWith b
+  Note a b             -> do
+      let handler₀ e = throwM (SourcedException a (e :: MissingImports))
+
+      let handler₁ (SourcedException _ e) =
+              throwM (SourcedException a (e :: MissingImports))
+
+      let handlers = [ Handler handler₀, Handler handler₁ ]
+
+      (Note <$> pure a <*> loadWith b) `catches` handlers
 
 -- | Resolve all imports within an expression
 load :: Expr Src Import -> IO (Expr Src X)

dhall/src/Dhall/Import/HTTP.hs

@@ -57,19 +57,19 @@ renderPrettyHttpException (HttpExceptionRequest _ e) =
       "\n"
       <>  "\ESC[1;31mError\ESC[0m: Invalid remote host name\n"
       <>  "\n"
-      <>  "↳ " <> show host <> "\n"
+      <>  "↳ " <> show host
     ResponseTimeout ->
       "\n"
-      <>  "\ESC[1;31mError\ESC[0m: The remote host took too long to respond\n"
+      <>  "\ESC[1;31mError\ESC[0m: The remote host took too long to respond"
     StatusCodeException response _
         | statusCode == 404 ->
             "\n"
-            <>  "\ESC[1;31mError\ESC[0m: Remote file not found\n"
+            <>  "\ESC[1;31mError\ESC[0m: Remote file not found"
         | otherwise ->
             "\n"
             <>  "\ESC[1;31mError\ESC[0m: Unexpected HTTP status code:\n"
             <>  "\n"
-            <>  "↳ " <> show statusCode <> "\n"
+            <>  "↳ " <> show statusCode
       where
         statusCode =
             Network.HTTP.Types.Status.statusCode

dhall/src/Dhall/Parser.hs

@@ -12,6 +12,7 @@ module Dhall.Parser (
 
     -- * Types
     , Src(..)
+    , SourcedException(..)
     , ParseError(..)
     , Parser(..)
     ) where

dhall/src/Dhall/Parser/Combinators.hs

@@ -1,11 +1,13 @@
 {-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 module Dhall.Parser.Combinators where
 
 
 import           Control.Applicative        (Alternative (..), liftA2)
+import           Control.Exception          (Exception)
 import           Control.Monad              (MonadPlus (..))
 import           Data.Data                  (Data)
 import           Data.Semigroup             (Semigroup (..))
@@ -25,7 +27,10 @@ import qualified Data.Char
 import qualified Data.Sequence
 import qualified Data.Set
 import qualified Data.Text
+import qualified Data.Text.Prettyprint.Doc               as Pretty
+import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
 import qualified Dhall.Map
+import qualified Dhall.Pretty
 import qualified Dhall.Util
 import qualified Dhall.Set
 import qualified Text.Megaparsec
@@ -39,6 +44,18 @@ data Src = Src !Text.Megaparsec.SourcePos !Text.Megaparsec.SourcePos Text
   -- Text field is intentionally lazy
   deriving (Data, Eq, Show)
 
+data SourcedException e = SourcedException Src e
+
+instance Exception e => Exception (SourcedException e)
+
+instance Show e => Show (SourcedException e) where
+    show (SourcedException source exception) =
+            show exception
+        <>  "\n"
+        <>  "\n"
+        <>  Pretty.renderString
+                (Pretty.layoutPretty Dhall.Pretty.layoutOpts (pretty source))
+
 -- | Doesn't force the 'Text' part
 laxSrcEq :: Src -> Src -> Bool
 laxSrcEq (Src p q _) (Src p' q' _) = eq p  p' && eq q q'

dhall/src/Dhall/Tutorial.hs

@@ -426,6 +426,7 @@ import Dhall
 --   ↳ ./file2
 -- ...
 -- Cyclic import: ./file1
+-- ...
 --
 -- You can also import expressions by URL.  For example, you can find a Dhall
 -- expression hosted at this GitHub URL:

dhall/tests/Dhall/Test/Import.hs

@@ -5,6 +5,7 @@ module Dhall.Test.Import where
 import Data.Text (Text)
 import Test.Tasty (TestTree)
 import Dhall.Import (MissingImports(..))
+import Dhall.Parser (SourcedException(..))
 import Control.Exception (catch, throwIO)
 import Data.Monoid ((<>))
 
@@ -84,9 +85,13 @@ shouldFail failures name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name
       (do
           _ <- Dhall.Import.load actualExpr
           fail "Import should have failed, but it succeeds")
-      (\(MissingImports es) -> case length es == failures of
-                                True -> pure ()
-                                False -> fail ("Should have failed "
-                                               <> show failures
-                                               <> " times, but failed with: \n"
-                                               <> show es)) )
+      (\(SourcedException _ (MissingImports es)) ->
+          case length es == failures of
+              True -> pure ()
+              False -> fail
+                  (   "Should have failed "
+                  <>  show failures
+                  <>  " times, but failed with: \n"
+                  <>  show es
+                  )
+      ) )