Convert interface file loading errors into proper diagnosticswip/interface-loading-errs

This patch converts all the errors to do with loading interface files
into proper structured diagnostics.

* DriverMessage: Sometimes in the driver we attempt to load an interface
  file so we embed the IfaceMessage into the DriverMessage.
* TcRnMessage: Most the time we are loading interface files during
  typechecking, so we embed the IfaceMessage

This patch also removes the TcRnInterfaceLookupError constructor which
is superceded by the IfaceMessage, which is now structured compared to
just storing an SDoc before.

7 files changed, 43 insertions, 37 deletions

diff --git a/compiler/GHC/Driver/Config/Diagnostic.hs b/compiler/GHC/Driver/Config/Diagnostic.hs
index f4b709301b..1e8b5a1e67 100644
--- a/compiler/GHC/Driver/Config/Diagnostic.hs
+++ b/compiler/GHC/Driver/Config/Diagnostic.hs
@@ -8,11 +8,13 @@ module GHC.Driver.Config.Diagnostic
   , initDsMessageOpts
   , initTcMessageOpts
   , initDriverMessageOpts
+  , initIfaceMessageOpts
   )
 where
 
 import GHC.Driver.Flags
 import GHC.Driver.Session
+import GHC.Prelude
 
 import GHC.Utils.Outputable
 import GHC.Utils.Error (DiagOpts (..))
@@ -22,6 +24,8 @@ import GHC.Tc.Errors.Types
 import GHC.HsToCore.Errors.Types
 import GHC.Types.Error
 import GHC.Tc.Errors.Ppr
+import GHC.Iface.Errors.Types
+import GHC.Iface.Errors.Ppr
 
 -- | Initialise the general configuration for printing diagnostic messages
 -- For example, this configuration controls things like whether warnings are
@@ -50,11 +54,17 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
 initPsMessageOpts _ = NoDiagnosticOpts
 
 initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
-initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags }
+initTcMessageOpts dflags =
+  TcRnMessageOpts { tcOptsShowContext    = gopt Opt_ShowErrorContext dflags
+                  , tcOptsIfaceOpts      = initIfaceMessageOpts dflags }
 
 initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
 initDsMessageOpts _ = NoDiagnosticOpts
 
+initIfaceMessageOpts :: DynFlags -> DiagnosticOpts IfaceMessage
+initIfaceMessageOpts dflags =
+                  IfaceMessageOpts { ifaceShowTriedFiles = verbosity dflags >= 3 }
+
 initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage
-initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags)
+initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags) (initIfaceMessageOpts dflags)
 
diff --git a/compiler/GHC/Driver/Config/Tidy.hs b/compiler/GHC/Driver/Config/Tidy.hs
index 89bdf31b2c..a02321ab78 100644
--- a/compiler/GHC/Driver/Config/Tidy.hs
+++ b/compiler/GHC/Driver/Config/Tidy.hs
@@ -17,11 +17,8 @@ import GHC.Driver.Env
 import GHC.Driver.Backend
 
 import GHC.Core.Make (getMkStringIds)
-import GHC.Data.Maybe
-import GHC.Utils.Panic
-import GHC.Utils.Outputable
 import GHC.Builtin.Names
-import GHC.Tc.Utils.Env (lookupGlobal_maybe)
+import GHC.Tc.Utils.Env (lookupGlobal)
 import GHC.Types.TyThing
 import GHC.Platform.Ways
 
@@ -49,13 +46,9 @@ initStaticPtrOpts :: HscEnv -> IO StaticPtrOpts
 initStaticPtrOpts hsc_env = do
   let dflags = hsc_dflags hsc_env
 
-  let lookupM n = lookupGlobal_maybe hsc_env n >>= \case
-        Succeeded r -> pure r
-        Failed err  -> pprPanic "initStaticPtrOpts: couldn't find" (ppr (err,n))
-
-  mk_string <- getMkStringIds (fmap tyThingId . lookupM)
-  static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName
-  static_ptr_datacon      <- tyThingDataCon <$> lookupM staticPtrDataConName
+  mk_string <- getMkStringIds (fmap tyThingId . lookupGlobal hsc_env )
+  static_ptr_info_datacon <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrInfoDataConName
+  static_ptr_datacon      <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrDataConName
 
   pure $ StaticPtrOpts
     { opt_platform = targetPlatform dflags
diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs
index dd6834046b..ab62682517 100644
--- a/compiler/GHC/Driver/Errors.hs
+++ b/compiler/GHC/Driver/Errors.hs
@@ -13,7 +13,7 @@ import GHC.Types.SrcLoc
 import GHC.Types.SourceError
 import GHC.Types.Error
 import GHC.Utils.Error
-import GHC.Utils.Outputable (hang, ppr, ($$), SDocContext,  text, withPprStyle, mkErrStyle, sdocStyle )
+import GHC.Utils.Outputable (hang, ppr, ($$),  text, mkErrStyle, sdocStyle, updSDocContext )
 import GHC.Utils.Logger
 import qualified GHC.Driver.CmdLine as CmdLine
 
@@ -22,21 +22,21 @@ printMessages logger msg_opts opts msgs
   = sequence_ [ let style = mkErrStyle name_ppr_ctx
                     ctx   = (diag_ppr_ctx opts) { sdocStyle = style }
                 in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $
-                   withPprStyle style (messageWithHints ctx dia)
+                   updSDocContext (\_ -> ctx) (messageWithHints dia)
               | MsgEnvelope { errMsgSpan       = s,
                               errMsgDiagnostic = dia,
                               errMsgSeverity   = sev,
                               errMsgContext    = name_ppr_ctx }
                   <- sortMsgBag (Just opts) (getMessages msgs) ]
   where
-    messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc
-    messageWithHints ctx e =
-      let main_msg = formatBulleted ctx $ diagnosticMessage msg_opts e
+    messageWithHints :: Diagnostic a => a -> SDoc
+    messageWithHints e =
+      let main_msg = formatBulleted $ diagnosticMessage msg_opts e
           in case diagnosticHints e of
                []  -> main_msg
                [h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h)
                hs  -> main_msg $$ hang (text "Suggested fixes:") 2
-                                       (formatBulleted ctx . mkDecorated . map ppr $ hs)
+                                       (formatBulleted  $ mkDecorated . map ppr $ hs)
 
 handleFlagWarnings :: Logger -> GhcMessageOpts -> DiagOpts -> [CmdLine.Warn] -> IO ()
 handleFlagWarnings logger print_config opts warns = do
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 9e3822e460..a89e7992b1 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -16,7 +16,6 @@ import GHC.Driver.Flags
 import GHC.Driver.Session
 import GHC.HsToCore.Errors.Ppr ()
 import GHC.Parser.Errors.Ppr ()
-import GHC.Tc.Errors.Ppr ()
 import GHC.Types.Error
 import GHC.Types.Error.Codes ( constructorCode )
 import GHC.Unit.Types
@@ -30,6 +29,9 @@ import Data.Version
 import Language.Haskell.Syntax.Decls (RuleDecl(..))
 import GHC.Tc.Errors.Types (TcRnMessage)
 import GHC.HsToCore.Errors.Types (DsMessage)
+import GHC.Iface.Errors.Types
+import GHC.Tc.Errors.Ppr ()
+import GHC.Iface.Errors.Ppr ()
 
 --
 -- Suggestions
@@ -86,7 +88,7 @@ instance Diagnostic GhcMessage where
 
 instance Diagnostic DriverMessage where
   type DiagnosticOpts DriverMessage = DriverMessageOpts
-  defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage)
+  defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage)
   diagnosticMessage opts = \case
     DriverUnknownMessage (UnknownDiagnostic @e m)
       -> diagnosticMessage (defaultDiagnosticOpts @e) m
@@ -218,6 +220,7 @@ instance Diagnostic DriverMessage where
       -> mkSimpleDecorated $ vcat ([text "Home units are not closed."
                                   , text "It is necessary to also load the following units:" ]
                                   ++ map (\uid -> text "-" <+> ppr uid) needed_unit_ids)
+    DriverInterfaceError reason -> diagnosticMessage (ifaceDiagnosticOpts opts) reason
 
   diagnosticReason = \case
     DriverUnknownMessage m
@@ -272,6 +275,7 @@ instance Diagnostic DriverMessage where
       -> ErrorWithoutFlag
     DriverHomePackagesNotClosed {}
       -> ErrorWithoutFlag
+    DriverInterfaceError reason -> diagnosticReason reason
 
   diagnosticHints = \case
     DriverUnknownMessage m
@@ -328,5 +332,6 @@ instance Diagnostic DriverMessage where
       -> noHints
     DriverHomePackagesNotClosed {}
       -> noHints
+    DriverInterfaceError reason -> diagnosticHints reason
 
   diagnosticCode = constructorCode
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index c2ec9cbb0c..cbf0622025 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -8,7 +8,6 @@ module GHC.Driver.Errors.Types (
   , DriverMessage(..)
   , DriverMessageOpts(..)
   , DriverMessages, PsMessage(PsHeaderMessage)
-  , BuildingCabalPackage(..)
   , WarningMessages
   , ErrorMessages
   , WarnMsg
@@ -32,7 +31,6 @@ import GHC.Unit.Module
 import GHC.Unit.State
 
 import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) )
-import GHC.Tc.Errors.Types     ( TcRnMessage )
 import GHC.HsToCore.Errors.Types ( DsMessage )
 import GHC.Hs.Extension          (GhcTc)
 
@@ -40,6 +38,9 @@ import Language.Haskell.Syntax.Decls (RuleDecl)
 
 import GHC.Generics ( Generic )
 
+import GHC.Tc.Errors.Types
+import GHC.Iface.Errors.Types
+
 -- | A collection of warning messages.
 -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity.
 type WarningMessages = Messages GhcMessage
@@ -369,21 +370,18 @@ data DriverMessage where
 
   DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage
 
+  DriverInterfaceError :: !IfaceMessage -> DriverMessage
+
 deriving instance Generic DriverMessage
 
 data DriverMessageOpts =
-  DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage }
+  DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage
+                    , ifaceDiagnosticOpts :: DiagnosticOpts IfaceMessage }
 
--- | Pass to a 'DriverMessage' the information whether or not the
--- '-fbuilding-cabal-package' flag is set.
-data BuildingCabalPackage
-  = YesBuildingCabalPackage
-  | NoBuildingCabalPackage
-  deriving Eq
 
 -- | Checks if we are building a cabal package by consulting the 'DynFlags'.
 checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage
 checkBuildingCabalPackage dflags =
   if gopt Opt_BuildingCabalPackage dflags
      then YesBuildingCabalPackage
-     else NoBuildingCabalPackage
+     else NoBuildingCabalPackage
\ No newline at end of file
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 7f60d5a8a0..d72b452d2e 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -153,6 +153,7 @@ import GHC.Utils.Constants
 import GHC.Types.Unique.DFM (udfmRestrictKeysSet)
 import qualified Data.IntSet as I
 import GHC.Types.Unique
+import GHC.Iface.Errors.Types
 
 
 -- -----------------------------------------------------------------------------
@@ -2336,8 +2337,8 @@ noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMe
 -- ToDo: we don't have a proper line number for this error
 noModError hsc_env loc wanted_mod err
   = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $
-    DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $
-    cannotFindModule hsc_env wanted_mod err
+    DriverInterfaceError $
+    (Can'tFindInterface (cannotFindModule hsc_env wanted_mod err) (LookingForModule wanted_mod NotBoot))
 
 {-
 noHsFileErr :: SrcSpan -> String -> DriverMessages
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index a770637311..be20bfd89f 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -27,7 +27,6 @@ import GHC.Data.Graph.Directed ( SCC(..) )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
-import GHC.Types.Error (UnknownDiagnostic(..))
 import GHC.Types.SourceError
 import GHC.Types.SrcLoc
 import GHC.Types.PkgQual
@@ -53,6 +52,7 @@ import Control.Monad    ( when, forM_ )
 import Data.Maybe       ( isJust )
 import Data.IORef
 import qualified Data.Set as Set
+import GHC.Iface.Errors.Types
 
 -----------------------------------------------------------------
 --
@@ -307,9 +307,8 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
     fail ->
         throwOneError $
           mkPlainErrorMsgEnvelope srcloc $
-          GhcDriverMessage $ DriverUnknownMessage $
-             UnknownDiagnostic $ mkPlainError noHints $
-             cannotFindModule hsc_env imp fail
+          GhcDriverMessage $ DriverInterfaceError $
+             (Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot))
 
 -----------------------------
 writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()