SourceError now uses GHC Messages

23 files changed, 527 insertions, 447 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 24b82e2ecd..aaab5ad112 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -390,7 +390,7 @@ import GHC.Types.Name.Env
 import GHC.Types.Name.Ppr
 import GHC.Types.TypeEnv
 import GHC.Types.SourceFile
-import GHC.Types.Error ( DiagnosticMessage )
+import GHC.Types.Error ( mkMessages, DiagnosticMessage )
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -1598,7 +1598,7 @@ getTokenStream mod = do
   let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
   case lexTokenStream (initParserOpts dflags) source startLoc of
     POk _ ts    -> return ts
-    PFailed pst -> throwErrors (fmap mkParserErr (getErrorMessages pst))
+    PFailed pst -> throwErrors $ mkMessages (fmap mkParserErr (getErrorMessages pst))
 
 -- | Give even more information on the source than 'getTokenStream'
 -- This function allows reconstructing the source completely with
@@ -1609,7 +1609,7 @@ getRichTokenStream mod = do
   let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
   case lexTokenStream (initParserOpts dflags) source startLoc of
     POk _ ts    -> return $ addSourceToTokens startLoc source ts
-    PFailed pst -> throwErrors (fmap mkParserErr (getErrorMessages pst))
+    PFailed pst -> throwErrors $ mkMessages (fmap mkParserErr (getErrorMessages pst))
 
 -- | Given a source location and a StringBuffer corresponding to this
 -- location, return a rich token stream with the source associated to the
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 11b38f71d3..4808515be9 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -43,6 +43,7 @@ import GHC.Tc.Utils.Monad
 import GHC.Iface.Recomp
 import GHC.Builtin.Names
 
+import GHC.Types.Error ( mkMessages )
 import GHC.Types.SrcLoc
 import GHC.Types.SourceError
 import GHC.Types.SourceText
@@ -107,7 +108,7 @@ doBackpack [src_filename] = do
     buf <- liftIO $ hGetStringBuffer src_filename
     let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 -- TODO: not great
     case unP parseBackpack (initParserState (initParserOpts dflags) buf loc) of
-        PFailed pst -> throwErrors (fmap mkParserErr (getErrorMessages pst))
+        PFailed pst -> throwErrors $ mkMessages (fmap mkParserErr (getErrorMessages pst))
         POk _ pkgname_bkp -> do
             -- OK, so we have an LHsUnit PackageName, but we want an
             -- LHsUnit HsComponentId.  So let's rename it.
diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs
index eafcfe73f3..bbbacc8067 100644
--- a/compiler/GHC/Driver/Errors.hs
+++ b/compiler/GHC/Driver/Errors.hs
@@ -58,6 +58,6 @@ handleFlagWarnings logger dflags warns = do
 printOrThrowDiagnostics :: Logger -> DynFlags -> Bag WarnMsg -> IO ()
 printOrThrowDiagnostics logger dflags warns
   | any ((==) SevError . errMsgSeverity) warns
-  = throwIO (mkSrcErr warns)
+  = throwIO (mkSrcErr . mkMessages $ warns)
   | otherwise
   = printBagOfErrors logger dflags warns
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 2e8a726bad..cafa522ab8 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-} -- Diagnostic for DriverMessage and GhcMessage
 
 module GHC.Driver.Errors.Ppr where
 
@@ -11,37 +11,49 @@ import GHC.Types.Basic
 import GHC.Types.Error
 import GHC.Types.Name ( nameSrcSpan, getName )
 import GHC.Driver.Errors.Types
-import GHC.Iface.Load  ( cannotFindModule )
+-- import GHC.Iface.Load  ( cannotFindModule )
 import GHC.Unit.State
 import GHC.Utils.Error
 import GHC.Utils.Outputable
 
-import GHC.Parser.Errors.Ppr ()
+import GHC.Parser.Errors.Ppr ()   -- instance Diagnostic PsMessage
 import GHC.Tc.Errors.Types
-import GHC.Tc.Errors.Ppr ()
-import GHC.HsToCore.Errors.Ppr ()
+import GHC.Tc.Errors.Ppr ()       -- instance Diagnostic TcRnMessage
+import GHC.HsToCore.Errors.Ppr () -- instance Diagnostic DsMessage
 
-instance RenderableDiagnostic GhcMessage where
-  renderDiagnostic = \case
+instance Diagnostic GhcMessage where
+  diagnosticMessage = \case
     GhcPsMessage m
-      -> renderDiagnostic m
+      -> diagnosticMessage m
     GhcTcRnMessage m
-      -> renderDiagnostic m
+      -> diagnosticMessage m
     GhcDsMessage m
-      -> renderDiagnostic m
+      -> diagnosticMessage m
     GhcDriverMessage m
-      -> renderDiagnostic m
+      -> diagnosticMessage m
     GhcUnknownMessage m
-      -> renderDiagnostic m
+      -> diagnosticMessage m
+  diagnosticReason = \case
+    GhcPsMessage m
+      -> diagnosticReason m
+    GhcTcRnMessage m
+      -> diagnosticReason m
+    GhcDsMessage m
+      -> diagnosticReason m
+    GhcDriverMessage m
+      -> diagnosticReason m
+    GhcUnknownMessage m
+      -> diagnosticReason m
 
-instance RenderableDiagnostic DriverMessage where
-  renderDiagnostic = \case
+instance Diagnostic DriverMessage where
+  diagnosticReason _ = ErrorWithoutFlag -- FIXME(adn)
+  diagnosticMessage = \case
 
     DriverUnknownMessage d
       -> d
 
-    DriverCannotFindModule env m res
-      -> mkDecorated [ cannotFindModule env m res ]
+    DriverCannotFindModule _env _m _res
+      -> mkDecorated [ {- cannotFindModule env m res -} ]
 
     DriverNotAnExpression str
       -> mkDecorated [ text "not an expression:" <+> quotes (text str) ]
@@ -71,16 +83,16 @@ instance RenderableDiagnostic DriverMessage where
                      ]
          where
            getReasons :: Messages TcRnMessage -> [SDoc]
-           getReasons = pprMsgEnvelopeBagWithLoc . getMessages . fmap renderDiagnostic
+           getReasons = pprMsgEnvelopeBagWithLoc . getMessages
 
            badFlags df   = concatMap (badFlag df) unsafeFlagsForInfer
            badFlag df (str,loc,on,_)
-               | on df     = [mkLocMessage SevOutput (loc df) $
+               | on df     = [mkLocMessage MCOutput (loc df) $ -- FIXME(adn) MCOutput is fishy.
                                    text str <+> text "is not allowed in Safe Haskell"]
                | otherwise = []
 
            badInst ins | checkOverlap (overlapMode (is_flag ins))
-                       = [mkLocMessage SevOutput (nameSrcSpan $ getName $ is_dfun ins) $
+                       = [mkLocMessage MCOutput (nameSrcSpan $ getName $ is_dfun ins) $ -- FIXME(adn) MCOutput is fishy.
                              ppr (overlapMode $ is_flag ins) <+>
                              text "overlap mode isn't allowed in Safe Haskell"]
                        | otherwise = []
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index dec80d1fac..a5851ff9f2 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -5,30 +5,46 @@ module GHC.Driver.Errors.Types (
   , DriverMessage(..)
   -- * Constructors
   , ghcUnknownMessage
-  , mkDriverWarn
   ) where
 
 import Data.Typeable
 
 import GHC.Core.InstEnv ( ClsInst )
 import GHC.Driver.Env.Types
-import GHC.Driver.Flags
 import GHC.Driver.Session ( DynFlags )
 import GHC.Prelude ( String )
 import GHC.Types.Error
-import GHC.Types.SrcLoc
 import GHC.Unit.Finder.Types ( FindResult )
 import GHC.Unit.Module.Name ( ModuleName )
 import GHC.Unit.State
 import GHC.Unit.Types ( UnitId, Module )
-import GHC.Utils.Outputable
 
 import GHC.Parser.Errors.Types ( PsMessage )
 import GHC.Tc.Errors.Types ( TcRnMessage )
 import GHC.HsToCore.Errors.Types ( DsMessage )
 
+{- Note [GhcMessage]
+~~~~~~~~~~~~~~~~~~~~
+
+Things can go wrong within GHC, and we might need to report diagnostics (error and/or warnings) to the
+users. The 'GhcMessage' type is the root of the diagnostic hierarchy.
+
+It's useful to have a separate type constructor for the different stages of the compilation pipeline.
+This is not just helpful for tools, as it gives a clear indication on where the error occurred exactly,
+but it's also necessary to allow 'handleSourceError' to be able to catch the relevant exception. In
+particular, it allows the user to write something like:
+
+handleMyErrors = handleSourceError (map handleInvididualError $ getMessages srcErrorMessages )
+  where
+    handleInvididualError e = case errMsgDiagnostic of
+      GhcPsMessage _   -> .. -- error arose during parsing;
+      GhcTcRnMessage _ -> .. -- error arose during TcRn
+      ...
+
+-}
+
 -- | The umbrella type that encompasses all the different messages that GHC might output during the
--- different compilation stages.
+-- different compilation stages. See Note [GhcMessage].
 data GhcMessage where
   -- | A message from the parsing phase.
   GhcPsMessage      :: PsMessage -> GhcMessage
@@ -39,23 +55,26 @@ data GhcMessage where
   -- | A message from the driver.
   GhcDriverMessage  :: DriverMessage -> GhcMessage
   -- | An \"escape\" hatch which can be used when we don't know the source of the message or
-  -- if the message is not one of the typed ones. The 'RenderableDiagnostic' and 'Typeable' constraints
+  -- if the message is not one of the typed ones. The 'Diagnostic' and 'Typeable' constraints
   -- ensure that if we /know/, at pattern-matching time, the originating type, we can attempt a cast and
   -- access the fully-structured error. This would be the case for a GHC plugin that offers a domain-specific
   -- error type but that doesn't want to place the burden on IDEs/application code to \"know\" it.
-  -- The 'RenderableDiagnostic' constraints ensures that worst case scenario we can still render this
+  -- The 'Diagnostic' constraints ensures that worst case scenario we can still render this
   -- into something which can be eventually converted into an 'SDoc'.
-  GhcUnknownMessage :: forall a. (RenderableDiagnostic a, Typeable a) => a -> GhcMessage
+  GhcUnknownMessage :: forall a. (Diagnostic a, Typeable a) => a -> GhcMessage
 
-ghcUnknownMessage :: DecoratedSDoc -> GhcMessage
+-- | Creates a new 'GhcMessage' out of a 'DiagnosticMessage'. This function is provided to ease the integration
+-- of #18516 (structured-error-messages) by allowing unstructured errors to be wrapped into the general
+-- (but structured) 'GhcMessage' type, so that the conversion can happen gradually. Ideally, this function
+-- should be needed very rarely within GHC, as it would typically be used by plugin or library authors
+-- (see comment for the 'GhcUnknownMessage' type constructor).
+ghcUnknownMessage :: (Diagnostic a, Typeable a) => a -> GhcMessage
 ghcUnknownMessage = GhcUnknownMessage
 
-type Reasons = Messages TcRnMessage
-
 -- | A message from the driver.
 data DriverMessage
   = -- Warnings
-    DriverWarnModuleInferredUnsafe !DynFlags !ModuleName [ClsInst] Reasons
+    DriverWarnModuleInferredUnsafe !DynFlags !ModuleName [ClsInst] !(Messages TcRnMessage)
   | DriverWarnInferredSafeImports  !ModuleName
 
     -- Errors
@@ -65,8 +84,3 @@ data DriverMessage
   | DriverPkgRequiredTrusted !UnitState !UnitId
   | DriverCantLoadIfaceForSafe !Module
   | DriverUnknownMessage !DecoratedSDoc
-
--- | Construct an structured error out of the input driver message.
-mkDriverWarn :: WarnReason -> SrcSpan -> PrintUnqualified -> DriverMessage -> MsgEnvelope DriverMessage
-mkDriverWarn reason loc qual warn =
-  makeIntoWarning reason (mkErr loc qual warn)
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 0e75dd74b5..b43da83b07 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -94,6 +94,7 @@ import GHC.Driver.Session
 import GHC.Driver.Backend
 import GHC.Driver.Env
 import GHC.Driver.Errors
+import GHC.Driver.Errors.Types ( ghcUnknownMessage )
 import GHC.Driver.CodeOutput
 import GHC.Driver.Config
 import GHC.Driver.Hooks
@@ -299,7 +300,8 @@ logWarningsReportErrors (warnings,errors) = do
     let warns = fmap (mkParserWarn dflags) warnings
         errs  = fmap mkParserErr errors
     logDiagnostics warns
-    when (not $ isEmptyBag errs) $ throwErrors errs
+    when (not $ isEmptyBag errs)
+      $ throwErrors $ mkMessages errs
 
 -- | Log warnings and throw errors, assuming the messages
 -- contain at least one error (e.g. coming from PFailed)
@@ -312,7 +314,7 @@ handleWarningsThrowErrors (warnings, errors) = do
     logger <- getLogger
     let (wWarns, wErrs) = partitionMessageBag warns
     liftIO $ printBagOfErrors logger dflags wWarns
-    throwErrors (unionBags errs wErrs)
+    throwErrors . mkMessages $ unionBags errs wErrs
 
 -- | Deal with errors and warnings returned by a compilation step
 --
@@ -336,7 +338,7 @@ ioMsgMaybe ioA = do
     let (warns, errs) = partitionMessages msgs
     logDiagnostics warns
     case mb_r of
-        Nothing -> throwErrors errs
+        Nothing -> throwErrors . mkMessages $ errs
         Just r  -> ASSERT( isEmptyBag errs ) return r
 
 -- | like ioMsgMaybe, except that we ignore error messages and return
@@ -433,7 +435,8 @@ hscParse' mod_summary
                                                    rdr_module)
             liftIO $ dumpIfSet_dyn logger dflags Opt_D_source_stats "Source Statistics"
                         FormatText (ppSourceStats False rdr_module)
-            when (not $ isEmptyBag errs) $ throwErrors errs
+            when (not $ isEmptyBag errs) $
+              throwErrors . mkMessages $ errs
 
             -- To get the list of extra source files, we take the list
             -- that the parser gave us,
@@ -1200,7 +1203,8 @@ checkSafeImports tcg_env
 
         case (isEmptyBag safeErrs) of
           -- Failed safe check
-          False -> liftIO . throwIO . mkSrcErr $ safeErrs
+          False ->
+            liftIO . throwIO . mkSrcErr . mkMessages $ safeErrs
 
           -- Passed safe check
           True -> do
@@ -1228,7 +1232,7 @@ checkSafeImports tcg_env
     cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
     cond' v1 v2
         | imv_is_safe v1 /= imv_is_safe v2
-        = throwOneError $ mkPlainErrorMsgEnvelope (imv_span v1)
+        = throwOneError . fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope (imv_span v1)
             (text "Module" <+> ppr (imv_name v1) <+>
             (text $ "is imported both as a safe and unsafe import!"))
         | otherwise
@@ -1296,7 +1300,7 @@ hscCheckSafe' m l = do
         iface <- lookup' m
         case iface of
             -- can't load iface to check trust!
-            Nothing -> throwOneError $ mkPlainErrorMsgEnvelope l
+            Nothing -> throwOneError . fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope l
                          $ text "Can't load the interface file for" <+> ppr m
                            <> text ", to check that it can be safely imported"
 
@@ -1398,7 +1402,7 @@ checkPkgTrust pkgs = do
                         <> text ") is required to be trusted but it isn't!"
     case errors of
         [] -> return ()
-        _  -> (liftIO . throwIO . mkSrcErr . listToBag) errors
+        _  -> (liftIO . throwIO . mkSrcErr . mkMessages . listToBag) errors
 
 -- | Set module to unsafe and (potentially) wipe trust information.
 --
@@ -2009,7 +2013,7 @@ hscImport hsc_env str = runInteractiveHsc hsc_env $ do
        hscParseThing parseModule str
     case is of
         [L _ i] -> return i
-        _ -> liftIO $ throwOneError $
+        _ -> liftIO $ throwOneError . fmap ghcUnknownMessage $
                  mkPlainErrorMsgEnvelope noSrcSpan $
                      text "parse error in import declaration"
 
@@ -2039,7 +2043,7 @@ hscParseExpr expr = do
   maybe_stmt <- hscParseStmt expr
   case maybe_stmt of
     Just (L _ (BodyStmt _ expr _ _)) -> return expr
-    _ -> throwOneError $ mkPlainErrorMsgEnvelope noSrcSpan
+    _ -> throwOneError . fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope noSrcSpan
       (text "not an expression:" <+> quotes (text expr))
 
 hscParseStmt :: String -> Hsc (Maybe (GhciLStmt GhcPs))
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 3315a96255..43b47df50f 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -61,6 +61,7 @@ import GHC.Driver.Backend
 import GHC.Driver.Monad
 import GHC.Driver.Env
 import GHC.Driver.Errors
+import GHC.Driver.Errors.Types ( GhcMessage, ghcUnknownMessage )
 import GHC.Driver.Main
 
 import GHC.Parser.Header
@@ -70,7 +71,7 @@ import GHC.Iface.Load      ( cannotFindModule )
 import GHC.IfaceToCore     ( typecheckIface )
 import GHC.Iface.Recomp    ( RecompileRequired ( MustCompile ) )
 
-import GHC.Data.Bag        ( unitBag, listToBag, unionManyBags, isEmptyBag )
+import GHC.Data.Bag        ( listToBag )
 import GHC.Data.Graph.Directed
 import GHC.Data.FastString
 import GHC.Data.Maybe      ( expectJust )
@@ -164,7 +165,7 @@ depanal :: GhcMonad m =>
         -> m ModuleGraph
 depanal excluded_mods allow_dup_roots = do
     (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots
-    if isEmptyBag errs
+    if isEmptyMessages errs
       then pure mod_graph
       else throwErrors errs
 
@@ -173,11 +174,11 @@ depanal excluded_mods allow_dup_roots = do
 depanalE :: GhcMonad m =>     -- New for #17459
             [ModuleName]      -- ^ excluded modules
             -> Bool           -- ^ allow duplicate roots
-            -> m (ErrorMessages, ModuleGraph)
+            -> m (Messages GhcMessage, ModuleGraph)
 depanalE excluded_mods allow_dup_roots = do
     hsc_env <- getSession
     (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots
-    if isEmptyBag errs
+    if isEmptyMessages errs
       then do
         warnMissingHomeModules hsc_env mod_graph
         setSession hsc_env { hsc_mod_graph = mod_graph }
@@ -202,7 +203,7 @@ depanalPartial
     :: GhcMonad m
     => [ModuleName]  -- ^ excluded modules
     -> Bool          -- ^ allow duplicate roots
-    -> m (ErrorMessages, ModuleGraph)
+    -> m (Messages GhcMessage, ModuleGraph)
     -- ^ possibly empty 'Bag' of errors and a module graph.
 depanalPartial excluded_mods allow_dup_roots = do
   hsc_env <- getSession
@@ -230,7 +231,7 @@ depanalPartial excluded_mods allow_dup_roots = do
       (errs, mod_summaries) = partitionEithers mod_summariesE
       mod_graph = mkModuleGraph' $
         fmap ModuleNode mod_summaries ++ instantiationNodes (hsc_units hsc_env)
-    return (unionManyBags errs, mod_graph)
+    return (foldl' unionMessages emptyMessages errs, mod_graph)
 
 -- | Collect the instantiations of dependencies to create 'InstantiationNode' work graph nodes.
 -- These are used to represent the type checking that is done after
@@ -351,7 +352,7 @@ load how_much = do
     (errs, mod_graph) <- depanalE [] False                        -- #17459
     success <- load' how_much (Just batchMsg) mod_graph
     warnUnusedPackages
-    if isEmptyBag errs
+    if isEmptyMessages errs
       then pure success
       else throwErrors errs
 
@@ -1418,7 +1419,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_logger lcl_tmpfs lcl_dflags
         hsc_env <- readMVar hsc_env_var
         old_hpt <- readIORef old_hpt_var
 
-        let logg err = printBagOfErrors lcl_logger lcl_dflags (srcErrorMessages err)
+        let logg err = printBagOfErrors lcl_logger lcl_dflags (getMessages $ srcErrorMessages err)
 
         -- Limit the number of parallel compiles.
         let withSem sem = MC.bracket_ (waitQSem sem) (signalQSem sem)
@@ -2249,7 +2250,7 @@ downsweep :: HscEnv
           -> Bool               -- True <=> allow multiple targets to have
                                 --          the same module name; this is
                                 --          very useful for ghc -M
-          -> IO [Either ErrorMessages ExtendedModSummary]
+          -> IO [Either (Messages GhcMessage) ExtendedModSummary]
                 -- The non-error elements of the returned list all have distinct
                 -- (Modules, IsBoot) identifiers, unless the Bool is true in
                 -- which case there can be repeats
@@ -2285,7 +2286,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
         old_summary_map :: ModNodeMap ExtendedModSummary
         old_summary_map = mkNodeMap old_summaries
 
-        getRootSummary :: Target -> IO (Either ErrorMessages ExtendedModSummary)
+        getRootSummary :: Target -> IO (Either (Messages GhcMessage) ExtendedModSummary)
         getRootSummary Target { targetId = TargetFile file mb_phase
                               , targetAllowObjCode = obj_allowed
                               , targetContents = maybe_buf
@@ -2294,7 +2295,8 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
                 if exists || isJust maybe_buf
                     then summariseFile hsc_env old_summaries file mb_phase
                                        obj_allowed maybe_buf
-                    else return $ Left $ unitBag $ mkPlainErrorMsgEnvelope noSrcSpan $
+                    else return $ Left $ singleMessage $
+                           fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope noSrcSpan $
                            text "can't find file:" <+> text file
         getRootSummary Target { targetId = TargetModule modl
                               , targetAllowObjCode = obj_allowed
@@ -2304,7 +2306,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
                                            (L rootLoc modl) obj_allowed
                                            maybe_buf excl_mods
                 case maybe_summary of
-                   Nothing -> return $ Left $ moduleNotFoundErr modl
+                   Nothing -> return $ Left (singleMessage $ moduleNotFoundErr modl)
                    Just s  -> return s
 
         rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
@@ -2315,7 +2317,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
         -- ignored, leading to confusing behaviour).
         checkDuplicates
           :: ModNodeMap
-               [Either ErrorMessages
+               [Either (Messages GhcMessage)
                        ExtendedModSummary]
           -> IO ()
         checkDuplicates root_map
@@ -2328,11 +2330,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 
         loop :: [GenWithIsBoot (Located ModuleName)]
                         -- Work list: process these modules
-             -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
+             -> ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary]
                         -- Visited set; the range is a list because
                         -- the roots can have the same module names
                         -- if allow_dup_roots is True
-             -> IO (ModNodeMap [Either ErrorMessages ExtendedModSummary])
+             -> IO (ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary])
                         -- The result is the completed NodeMap
         loop [] done = return done
         loop (s : ss) done
@@ -2372,8 +2374,8 @@ enableCodeGenForTH
   -> TmpFs
   -> HomeUnit
   -> Backend
-  -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
-  -> IO (ModNodeMap [Either ErrorMessages ExtendedModSummary])
+  -> ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary]
+  -> IO (ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary])
 enableCodeGenForTH logger tmpfs home_unit =
   enableCodeGenWhen logger tmpfs condition should_modify TFL_CurrentModule TFL_GhcSession
   where
@@ -2398,8 +2400,8 @@ enableCodeGenWhen
   -> TempFileLifetime
   -> TempFileLifetime
   -> Backend
-  -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
-  -> IO (ModNodeMap [Either ErrorMessages ExtendedModSummary])
+  -> ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary]
+  -> IO (ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary])
 enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd nodemap =
   traverse (traverse (traverse enable_code_gen)) nodemap
   where
@@ -2468,7 +2470,7 @@ enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd
 
 mkRootMap
   :: [ExtendedModSummary]
-  -> ModNodeMap [Either ErrorMessages ExtendedModSummary]
+  -> ModNodeMap [Either (Messages GhcMessage) ExtendedModSummary]
 mkRootMap summaries = ModNodeMap $ Map.insertListWith
   (flip (++))
   [ (msKey $ emsModSummary s, [Right s]) | s <- summaries ]
@@ -2513,7 +2515,7 @@ summariseFile
         -> Maybe Phase                  -- start phase
         -> Bool                         -- object code allowed?
         -> Maybe (StringBuffer,UTCTime)
-        -> IO (Either ErrorMessages ExtendedModSummary)
+        -> IO (Either (Messages GhcMessage) ExtendedModSummary)
 
 summariseFile hsc_env old_summaries src_fn mb_phase obj_allowed maybe_buf
         -- we can use a cached summary if one is available and the
@@ -2641,7 +2643,7 @@ summariseModule
           -> Bool               -- object code allowed?
           -> Maybe (StringBuffer, UTCTime)
           -> [ModuleName]               -- Modules to exclude
-          -> IO (Maybe (Either ErrorMessages ExtendedModSummary))      -- Its new summary
+          -> IO (Maybe (Either (Messages GhcMessage) ExtendedModSummary))      -- Its new summary
 
 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                 obj_allowed maybe_buf excl_mods
@@ -2708,7 +2710,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                 -- It might have been deleted since the Finder last found it
         maybe_t <- modificationTimeIfExists src_fn
         case maybe_t of
-          Nothing -> return $ Left $ noHsFileErr loc src_fn
+          Nothing -> return $ Left $ singleMessage $ noHsFileErr loc src_fn
           Just t  -> new_summary location' mod src_fn t
 
     new_summary location mod src_fn src_timestamp
@@ -2729,10 +2731,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
               | otherwise = HsSrcFile
 
         when (pi_mod_name /= wanted_mod) $
-                throwE $ unitBag $ mkPlainErrorMsgEnvelope pi_mod_name_loc $
-                              text "File name does not match module name:"
-                              $$ text "Saw:" <+> quotes (ppr pi_mod_name)
-                              $$ text "Expected:" <+> quotes (ppr wanted_mod)
+                throwE $ singleMessage . fmap ghcUnknownMessage $
+                  mkPlainErrorMsgEnvelope pi_mod_name_loc $
+                    text "File name does not match module name:"
+                    $$ text "Saw:" <+> quotes (ppr pi_mod_name)
+                    $$ text "Expected:" <+> quotes (ppr wanted_mod)
 
         when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations home_unit))) $
             let suggested_instantiated_with =
@@ -2741,16 +2744,17 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                         | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name)
                                 : homeUnitInstantiations home_unit)
                         ])
-            in throwE $ unitBag $ mkPlainErrorMsgEnvelope pi_mod_name_loc $
-                text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
-                $$ if gopt Opt_BuildingCabalPackage dflags
-                    then parens (text "Try adding" <+> quotes (ppr pi_mod_name)
-                            <+> text "to the"
-                            <+> quotes (text "signatures")
-                            <+> text "field in your Cabal file.")
-                    else parens (text "Try passing -instantiated-with=\"" <>
-                                 suggested_instantiated_with <> text "\"" $$
-                                text "replacing <" <> ppr pi_mod_name <> text "> as necessary.")
+            in throwE $ singleMessage . fmap ghcUnknownMessage $
+                mkPlainErrorMsgEnvelope pi_mod_name_loc $
+                  text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
+                  $$ if gopt Opt_BuildingCabalPackage dflags
+                      then parens (text "Try adding" <+> quotes (ppr pi_mod_name)
+                              <+> text "to the"
+                              <+> quotes (text "signatures")
+                              <+> text "field in your Cabal file.")
+                      else parens (text "Try passing -instantiated-with=\"" <>
+                                   suggested_instantiated_with <> text "\"" $$
+                                  text "replacing <" <> ppr pi_mod_name <> text "> as necessary.")
 
         liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
             { nms_src_fn = src_fn
@@ -2844,7 +2848,7 @@ getPreprocessedImports
     -> Maybe Phase
     -> Maybe (StringBuffer, UTCTime)
     -- ^ optional source code buffer and modification time
-    -> ExceptT ErrorMessages IO PreprocessedImports
+    -> ExceptT (Messages GhcMessage) IO PreprocessedImports
 getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
   (pi_local_dflags, pi_hspp_fn)
       <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase
@@ -2854,7 +2858,7 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
           let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags
               popts = initParserOpts pi_local_dflags
           mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn
-          return (first (fmap mkParserErr) mimps)
+          return (first (mkMessages . fmap (fmap ghcUnknownMessage . mkParserErr)) mimps)
   return PreprocessedImports {..}
 
 
@@ -2898,24 +2902,24 @@ withDeferredDiagnostics f = do
       (\_ -> popLogHookM >> printDeferredDiagnostics)
       (\_ -> f)
 
-noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope DiagnosticMessage
+noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage
 -- ToDo: we don't have a proper line number for this error
 noModError hsc_env loc wanted_mod err
-  = mkPlainErrorMsgEnvelope loc $ cannotFindModule hsc_env wanted_mod err
+  = fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope loc $ cannotFindModule hsc_env wanted_mod err
 
-noHsFileErr :: SrcSpan -> String -> ErrorMessages
+noHsFileErr :: SrcSpan -> String -> MsgEnvelope GhcMessage
 noHsFileErr loc path
-  = unitBag $ mkPlainErrorMsgEnvelope loc $ text "Can't find" <+> text path
+  = fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope loc $ text "Can't find" <+> text path
 
-moduleNotFoundErr :: ModuleName -> ErrorMessages
+moduleNotFoundErr :: ModuleName -> MsgEnvelope GhcMessage
 moduleNotFoundErr mod
-  = unitBag $ mkPlainErrorMsgEnvelope noSrcSpan $
+  = fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope noSrcSpan $
         text "module" <+> quotes (ppr mod) <+> text "cannot be found locally"
 
 multiRootsErr :: [ModSummary] -> IO ()
 multiRootsErr [] = panic "multiRootsErr"
 multiRootsErr summs@(summ1:_)
-  = throwOneError $ mkPlainErrorMsgEnvelope noSrcSpan $
+  = throwOneError . fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope noSrcSpan $
         text "module" <+> quotes (ppr mod) <+>
         text "is defined in multiple files:" <+>
         sep (map text files)
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index ea1bf1f501..df288d4a21 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -23,6 +23,7 @@ import GHC.Driver.Session
 import GHC.Driver.Ppr
 import GHC.Utils.Misc
 import GHC.Driver.Env
+import GHC.Driver.Errors.Types ( ghcUnknownMessage )
 import qualified GHC.SysTools as SysTools
 import GHC.Data.Graph.Directed ( SCC(..) )
 import GHC.Utils.Outputable
@@ -305,7 +306,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
         -> return Nothing
 
     fail ->
-        throwOneError $ mkPlainErrorMsgEnvelope srcloc $
+        throwOneError $ fmap ghcUnknownMessage $ mkPlainErrorMsgEnvelope srcloc $
              cannotFindModule hsc_env imp fail
 
 -----------------------------
diff --git a/compiler/GHC/Driver/Monad.hs b/compiler/GHC/Driver/Monad.hs
index 1a42d8402f..62a719eef0 100644
--- a/compiler/GHC/Driver/Monad.hs
+++ b/compiler/GHC/Driver/Monad.hs
@@ -44,6 +44,7 @@ import GHC.Utils.Error
 import GHC.Utils.Logger
 
 import GHC.Types.SrcLoc
+import GHC.Types.Error ( getMessages )
 import GHC.Types.SourceError
 
 import Control.Monad
@@ -246,7 +247,7 @@ printException :: GhcMonad m => SourceError -> m ()
 printException err = do
   dflags <- getSessionDynFlags
   logger <- getLogger
-  liftIO $ printBagOfErrors logger dflags (srcErrorMessages err)
+  liftIO $ printBagOfErrors logger dflags (getMessages $ srcErrorMessages err)
 
 -- | A function called to log warnings and errors.
 type WarnErrLogger = forall m. GhcMonad m => Maybe SourceError -> m ()
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 7f604a8258..2c605de92f 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -47,6 +47,7 @@ import GHC.Tc.Types
 import GHC.Driver.Main
 import GHC.Driver.Env hiding ( Hsc )
 import GHC.Driver.Errors
+import GHC.Driver.Errors.Types ( GhcMessage, ghcUnknownMessage )
 import GHC.Driver.Pipeline.Monad
 import GHC.Driver.Config
 import GHC.Driver.Phases
@@ -81,7 +82,6 @@ import GHC.CmmToLlvm         ( llvmFixupAsm, llvmVersionList )
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Settings
 
-import GHC.Data.Bag            ( unitBag )
 import GHC.Data.FastString     ( mkFastString )
 import GHC.Data.StringBuffer   ( hGetStringBuffer, hPutStringBuffer )
 import GHC.Data.Maybe          ( expectJust )
@@ -90,6 +90,7 @@ import GHC.Iface.Make          ( mkFullIface )
 import GHC.Iface.UpdateIdInfos ( updateModDetailsIdInfos )
 
 import GHC.Types.Basic       ( SuccessFlag(..) )
+import GHC.Types.Error       ( mkMessages, singleMessage )
 import GHC.Types.Target
 import GHC.Types.SrcLoc
 import GHC.Types.SourceFile
@@ -132,7 +133,7 @@ preprocess :: HscEnv
            -> Maybe InputFileBuffer
            -- ^ optional buffer to use instead of reading the input file
            -> Maybe Phase -- ^ starting phase
-           -> IO (Either ErrorMessages (DynFlags, FilePath))
+           -> IO (Either (Messages GhcMessage) (DynFlags, FilePath))
 preprocess hsc_env input_fn mb_input_buf mb_phase =
   handleSourceError (\err -> return (Left (srcErrorMessages err))) $
   MC.handle handler $
@@ -150,7 +151,8 @@ preprocess hsc_env input_fn mb_input_buf mb_phase =
   return (dflags, fp)
   where
     srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1
-    handler (ProgramError msg) = return $ Left $ unitBag $
+    handler (ProgramError msg) =
+      return $ Left $ fmap ghcUnknownMessage . singleMessage $
         mkPlainErrorMsgEnvelope srcspan $ text msg
     handler ex = throwGhcExceptionIO ex
 
@@ -1256,7 +1258,8 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn
                 popts = initParserOpts dflags
             eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff)
             case eimps of
-              Left errs -> throwErrors (fmap mkParserErr errs)
+              Left errs
+                -> throwErrors $ mkMessages $ fmap mkParserErr errs
               Right (src_imps,imps,L _ mod_name) -> return
                   (Just buf, mod_name, imps, src_imps)
 
diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs
index 862d3b345d..28dfac2a24 100644
--- a/compiler/GHC/HsToCore/Errors/Ppr.hs
+++ b/compiler/GHC/HsToCore/Errors/Ppr.hs
@@ -1,5 +1,7 @@
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-orphans #-} -- instance RenderableDiagnostic DsMessage
 
 module GHC.HsToCore.Errors.Ppr where
 
@@ -7,5 +9,6 @@ import GHC.Types.Error
 import GHC.HsToCore.Errors.Types
 
 -- This is a totally uninteresting instance will will be populated in the context of #18516.
-instance RenderableDiagnostic DsMessage where
-  renderDiagnostic _ = mkDecorated []
+instance Diagnostic DsMessage where
+  diagnosticMessage  = \case {}
+  diagnosticReason _ = ErrorWithoutFlag
diff --git a/compiler/GHC/Iface/Errors.hs b/compiler/GHC/Iface/Errors.hs
new file mode 100644
index 0000000000..68ee3522fa
--- /dev/null
+++ b/compiler/GHC/Iface/Errors.hs
@@ -0,0 +1,287 @@
+
+{-# LANGUAGE FlexibleContexts #-}
+
+module GHC.Iface.Errors
+  ( cannotFindInterface
+  , cantFindInstalledErr
+  , cannotFindModule
+  , cantFindErr
+  -- * Utility functions
+  , mayShowLocations
+  ) where
+
+import GHC.Platform.Profile
+import GHC.Platform.Ways
+import GHC.Utils.Panic.Plain
+import GHC.Data.FastString
+import GHC.Driver.Session
+import GHC.Driver.Env.Types
+import GHC.Data.Maybe
+import GHC.Prelude
+import GHC.Unit
+import GHC.Unit.Env
+import GHC.Unit.Finder.Types
+import GHC.Unit.State
+import GHC.Utils.Outputable as Outputable
+
+-- -----------------------------------------------------------------------------
+-- Error messages
+
+cannotFindInterface :: UnitState -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
+cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
+                                           (sLit "Ambiguous interface for")
+
+cantFindInstalledErr
+    :: PtrString
+    -> PtrString
+    -> UnitState
+    -> HomeUnit
+    -> Profile
+    -> ([FilePath] -> SDoc)
+    -> ModuleName
+    -> InstalledFindResult
+    -> SDoc
+cantFindInstalledErr cannot_find _ unit_state home_unit profile tried_these mod_name find_result
+  = ptext cannot_find <+> quotes (ppr mod_name)
+    $$ more_info
+  where
+    build_tag  = waysBuildTag (profileWays profile)
+
+    more_info
+      = case find_result of
+            InstalledNoPackage pkg
+                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
+                   text "was found" $$ looks_like_srcpkgid pkg
+
+            InstalledNotFound files mb_pkg
+                | Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg)
+                -> not_found_in_package pkg files
+
+                | null files
+                -> text "It is not a module in the current program, or in any known package."
+
+                | otherwise
+                -> tried_these files
+
+            _ -> panic "cantFindInstalledErr"
+
+    looks_like_srcpkgid :: UnitId -> SDoc
+    looks_like_srcpkgid pk
+     -- Unsafely coerce a unit id (i.e. an installed package component
+     -- identifier) into a PackageId and see if it means anything.
+     | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk))
+     = parens (text "This unit ID looks like the source package ID;" $$
+       text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
+       (if null pkgs then Outputable.empty
+        else text "and" <+> int (length pkgs) <+> text "other candidates"))
+     -- Todo: also check if it looks like a package name!
+     | otherwise = Outputable.empty
+
+    not_found_in_package pkg files
+       | build_tag /= ""
+       = let
+            build = if build_tag == "p" then "profiling"
+                                        else "\"" ++ build_tag ++ "\""
+         in
+         text "Perhaps you haven't installed the " <> text build <>
+         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
+         tried_these files
+
+       | otherwise
+       = text "There are files missing in the " <> quotes (ppr pkg) <>
+         text " package," $$
+         text "try running 'ghc-pkg check'." $$
+         tried_these files
+
+mayShowLocations :: DynFlags -> [FilePath] -> SDoc
+mayShowLocations dflags files
+    | null files = Outputable.empty
+    | verbosity dflags < 3 =
+          text "Use -v (or `:set -v` in ghci) " <>
+              text "to see a list of the files searched for."
+    | otherwise =
+          hang (text "Locations searched:") 2 $ vcat (map text files)
+
+cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
+cannotFindModule hsc_env = cannotFindModule'
+    (hsc_dflags   hsc_env)
+    (hsc_unit_env hsc_env)
+    (targetProfile (hsc_dflags hsc_env))
+
+
+cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
+cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $
+  cantFindErr (gopt Opt_BuildingCabalPackage dflags)
+              (sLit cannotFindMsg)
+              (sLit "Ambiguous module name")
+              unit_env
+              profile
+              (mayShowLocations dflags)
+              mod
+              res
+  where
+    cannotFindMsg =
+      case res of
+        NotFound { fr_mods_hidden = hidden_mods
+                 , fr_pkgs_hidden = hidden_pkgs
+                 , fr_unusables = unusables }
+          | not (null hidden_mods && null hidden_pkgs && null unusables)
+          -> "Could not load module"
+        _ -> "Could not find module"
+
+cantFindErr
+    :: Bool -- ^ Using Cabal?
+    -> PtrString
+    -> PtrString
+    -> UnitEnv
+    -> Profile
+    -> ([FilePath] -> SDoc)
+    -> ModuleName
+    -> FindResult
+    -> SDoc
+cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods)
+  | Just pkgs <- unambiguousPackages
+  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
+       sep [text "it was found in multiple packages:",
+                hsep (map ppr pkgs) ]
+    )
+  | otherwise
+  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
+       vcat (map pprMod mods)
+    )
+  where
+    unambiguousPackages = foldl' unambiguousPackage (Just []) mods
+    unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
+        = Just (moduleUnit m : xs)
+    unambiguousPackage _ _ = Nothing
+
+    pprMod (m, o) = text "it is bound as" <+> ppr m <+>
+                                text "by" <+> pprOrigin m o
+    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
+    pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
+    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
+      if e == Just True
+          then [text "package" <+> ppr (moduleUnit m)]
+          else [] ++
+      map ((text "a reexport in package" <+>)
+                .ppr.mkUnit) res ++
+      if f then [text "a package flag"] else []
+      )
+
+cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result
+  = ptext cannot_find <+> quotes (ppr mod_name)
+    $$ more_info
+  where
+    home_unit  = ue_home_unit unit_env
+    more_info
+      = case find_result of
+            NoPackage pkg
+                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
+                   text "was found"
+
+            NotFound { fr_paths = files, fr_pkg = mb_pkg
+                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
+                     , fr_unusables = unusables, fr_suggestions = suggest }
+                | Just pkg <- mb_pkg, not (isHomeUnit home_unit pkg)
+                -> not_found_in_package pkg files
+
+                | not (null suggest)
+                -> pp_suggestions suggest $$ tried_these files
+
+                | null files && null mod_hiddens &&
+                  null pkg_hiddens && null unusables
+                -> text "It is not a module in the current program, or in any known package."
+
+                | otherwise
+                -> vcat (map pkg_hidden pkg_hiddens) $$
+                   vcat (map mod_hidden mod_hiddens) $$
+                   vcat (map unusable unusables) $$
+                   tried_these files
+
+            _ -> panic "cantFindErr"
+
+    build_tag = waysBuildTag (profileWays profile)
+
+    not_found_in_package pkg files
+       | build_tag /= ""
+       = let
+            build = if build_tag == "p" then "profiling"
+                                        else "\"" ++ build_tag ++ "\""
+         in
+         text "Perhaps you haven't installed the " <> text build <>
+         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
+         tried_these files
+
+       | otherwise
+       = text "There are files missing in the " <> quotes (ppr pkg) <>
+         text " package," $$
+         text "try running 'ghc-pkg check'." $$
+         tried_these files
+
+    pkg_hidden :: Unit -> SDoc
+    pkg_hidden uid =
+        text "It is a member of the hidden package"
+        <+> quotes (ppr uid)
+        --FIXME: we don't really want to show the unit id here we should
+        -- show the source package id or installed package id if it's ambiguous
+        <> dot $$ pkg_hidden_hint uid
+
+    pkg_hidden_hint uid
+     | using_cabal
+        = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid)
+           in text "Perhaps you need to add" <+>
+              quotes (ppr (unitPackageName pkg)) <+>
+              text "to the build-depends in your .cabal file."
+     | Just pkg <- lookupUnit (ue_units unit_env) uid
+         = text "You can run" <+>
+           quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
+           text "to expose it." $$
+           text "(Note: this unloads all the modules in the current scope.)"
+     | otherwise = Outputable.empty
+
+    mod_hidden pkg =
+        text "it is a hidden module in the package" <+> quotes (ppr pkg)
+
+    unusable (pkg, reason)
+      = text "It is a member of the package"
+      <+> quotes (ppr pkg)
+      $$ pprReason (text "which is") reason
+
+    pp_suggestions :: [ModuleSuggestion] -> SDoc
+    pp_suggestions sugs
+      | null sugs = Outputable.empty
+      | otherwise = hang (text "Perhaps you meant")
+                       2 (vcat (map pp_sugg sugs))
+
+    -- NB: Prefer the *original* location, and then reexports, and then
+    -- package flags when making suggestions.  ToDo: if the original package
+    -- also has a reexport, prefer that one
+    pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
+      where provenance ModHidden = Outputable.empty
+            provenance (ModUnusable _) = Outputable.empty
+            provenance (ModOrigin{ fromOrigUnit = e,
+                                   fromExposedReexport = res,
+                                   fromPackageFlag = f })
+              | Just True <- e
+                 = parens (text "from" <+> ppr (moduleUnit mod))
+              | f && moduleName mod == m
+                 = parens (text "from" <+> ppr (moduleUnit mod))
+              | (pkg:_) <- res
+                 = parens (text "from" <+> ppr (mkUnit pkg)
+                    <> comma <+> text "reexporting" <+> ppr mod)
+              | f
+                 = parens (text "defined via package flags to be"
+                    <+> ppr mod)
+              | otherwise = Outputable.empty
+    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
+      where provenance ModHidden =  Outputable.empty
+            provenance (ModUnusable _) = Outputable.empty
+            provenance (ModOrigin{ fromOrigUnit = e,
+                                   fromHiddenReexport = rhs })
+              | Just False <- e
+                 = parens (text "needs flag -package-id"
+                    <+> ppr (moduleUnit mod))
+              | (pkg:_) <- rhs
+                 = parens (text "needs flag -package-id"
+                    <+> ppr (mkUnit pkg))
+              | otherwise = Outputable.empty
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 10033ad2ce..a79c7cd8d4 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -33,14 +33,12 @@ module GHC.Iface.Load (
         pprModIfaceSimple,
         ifaceStats, pprModIface, showIface,
 
-        cannotFindModule
+        module Iface_Errors  -- avoids boot files in Ppr modules
    ) where
 
 #include "HsVersions.h"
 
 import GHC.Prelude
-import GHC.Platform.Ways
-import GHC.Platform.Profile
 
 import {-# SOURCE #-} GHC.IfaceToCore
    ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
@@ -58,6 +56,7 @@ import GHC.Iface.Ext.Fields
 import GHC.Iface.Binary
 import GHC.Iface.Rename
 import GHC.Iface.Env
+import GHC.Iface.Errors as Iface_Errors
 
 import GHC.Tc.Utils.Monad
 
@@ -85,6 +84,7 @@ import GHC.Types.Name
 import GHC.Types.Name.Cache
 import GHC.Types.Name.Env
 import GHC.Types.Avail
+import GHC.Types.Error ( mkMessages )
 import GHC.Types.Fixity
 import GHC.Types.Fixity.Env
 import GHC.Types.SourceError
@@ -106,13 +106,11 @@ import GHC.Unit.State
 import GHC.Unit.Home
 import GHC.Unit.Home.ModInfo
 import GHC.Unit.Finder
-import GHC.Unit.Env
 
 import GHC.Data.Maybe
 import GHC.Data.FastString
 
 import Control.Monad
-import Control.Exception
 import Data.Map ( toList )
 import System.FilePath
 import System.Directory
@@ -704,7 +702,7 @@ computeInterface hsc_env doc_str hi_boot_file mod0 = do
           Succeeded (iface0, path) ->
             rnModIface hsc_env (instUnitInsts (moduleUnit indef)) Nothing iface0 >>= \case
               Right x   -> return (Succeeded (x, path))
-              Left errs -> throwIO . mkSrcErr $ errs
+              Left errs -> throwErrors . mkMessages $ errs
           Failed err -> return (Failed err)
       (mod, _) -> find_iface mod
 
@@ -904,7 +902,7 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str
                                       unit_state
                                       home_unit
                                       profile
-                                      (may_show_locations dflags)
+                                      (mayShowLocations dflags)
                                       (moduleName mod)
                                       err
 
@@ -1293,266 +1291,3 @@ homeModError mod location
            Nothing   -> Outputable.empty)
     <+> text "which is not loaded"
 
-
--- -----------------------------------------------------------------------------
--- Error messages
-
-cannotFindInterface :: UnitState -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
-cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
-                                           (sLit "Ambiguous interface for")
-
-cantFindInstalledErr
-    :: PtrString
-    -> PtrString
-    -> UnitState
-    -> HomeUnit
-    -> Profile
-    -> ([FilePath] -> SDoc)
-    -> ModuleName
-    -> InstalledFindResult
-    -> SDoc
-cantFindInstalledErr cannot_find _ unit_state home_unit profile tried_these mod_name find_result
-  = ptext cannot_find <+> quotes (ppr mod_name)
-    $$ more_info
-  where
-    build_tag  = waysBuildTag (profileWays profile)
-
-    more_info
-      = case find_result of
-            InstalledNoPackage pkg
-                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
-                   text "was found" $$ looks_like_srcpkgid pkg
-
-            InstalledNotFound files mb_pkg
-                | Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg)
-                -> not_found_in_package pkg files
-
-                | null files
-                -> text "It is not a module in the current program, or in any known package."
-
-                | otherwise
-                -> tried_these files
-
-            _ -> panic "cantFindInstalledErr"
-
-    looks_like_srcpkgid :: UnitId -> SDoc
-    looks_like_srcpkgid pk
-     -- Unsafely coerce a unit id (i.e. an installed package component
-     -- identifier) into a PackageId and see if it means anything.
-     | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk))
-     = parens (text "This unit ID looks like the source package ID;" $$
-       text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
-       (if null pkgs then Outputable.empty
-        else text "and" <+> int (length pkgs) <+> text "other candidates"))
-     -- Todo: also check if it looks like a package name!
-     | otherwise = Outputable.empty
-
-    not_found_in_package pkg files
-       | build_tag /= ""
-       = let
-            build = if build_tag == "p" then "profiling"
-                                        else "\"" ++ build_tag ++ "\""
-         in
-         text "Perhaps you haven't installed the " <> text build <>
-         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
-         tried_these files
-
-       | otherwise
-       = text "There are files missing in the " <> quotes (ppr pkg) <>
-         text " package," $$
-         text "try running 'ghc-pkg check'." $$
-         tried_these files
-
-may_show_locations :: DynFlags -> [FilePath] -> SDoc
-may_show_locations dflags files
-    | null files = Outputable.empty
-    | verbosity dflags < 3 =
-          text "Use -v (or `:set -v` in ghci) " <>
-              text "to see a list of the files searched for."
-    | otherwise =
-          hang (text "Locations searched:") 2 $ vcat (map text files)
-
-cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
-cannotFindModule hsc_env = cannotFindModule'
-    (hsc_dflags   hsc_env)
-    (hsc_unit_env hsc_env)
-    (targetProfile (hsc_dflags hsc_env))
-
-
-cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
-cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $
-  cantFindErr (gopt Opt_BuildingCabalPackage dflags)
-              (sLit cannotFindMsg)
-              (sLit "Ambiguous module name")
-              unit_env
-              profile
-              (may_show_locations dflags)
-              mod
-              res
-  where
-    cannotFindMsg =
-      case res of
-        NotFound { fr_mods_hidden = hidden_mods
-                 , fr_pkgs_hidden = hidden_pkgs
-                 , fr_unusables = unusables }
-          | not (null hidden_mods && null hidden_pkgs && null unusables)
-          -> "Could not load module"
-        _ -> "Could not find module"
-
-cantFindErr
-    :: Bool -- ^ Using Cabal?
-    -> PtrString
-    -> PtrString
-    -> UnitEnv
-    -> Profile
-    -> ([FilePath] -> SDoc)
-    -> ModuleName
-    -> FindResult
-    -> SDoc
-cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods)
-  | Just pkgs <- unambiguousPackages
-  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
-       sep [text "it was found in multiple packages:",
-                hsep (map ppr pkgs) ]
-    )
-  | otherwise
-  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
-       vcat (map pprMod mods)
-    )
-  where
-    unambiguousPackages = foldl' unambiguousPackage (Just []) mods
-    unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
-        = Just (moduleUnit m : xs)
-    unambiguousPackage _ _ = Nothing
-
-    pprMod (m, o) = text "it is bound as" <+> ppr m <+>
-                                text "by" <+> pprOrigin m o
-    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
-    pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
-    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
-      if e == Just True
-          then [text "package" <+> ppr (moduleUnit m)]
-          else [] ++
-      map ((text "a reexport in package" <+>)
-                .ppr.mkUnit) res ++
-      if f then [text "a package flag"] else []
-      )
-
-cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result
-  = ptext cannot_find <+> quotes (ppr mod_name)
-    $$ more_info
-  where
-    home_unit  = ue_home_unit unit_env
-    more_info
-      = case find_result of
-            NoPackage pkg
-                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
-                   text "was found"
-
-            NotFound { fr_paths = files, fr_pkg = mb_pkg
-                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
-                     , fr_unusables = unusables, fr_suggestions = suggest }
-                | Just pkg <- mb_pkg, not (isHomeUnit home_unit pkg)
-                -> not_found_in_package pkg files
-
-                | not (null suggest)
-                -> pp_suggestions suggest $$ tried_these files
-
-                | null files && null mod_hiddens &&
-                  null pkg_hiddens && null unusables
-                -> text "It is not a module in the current program, or in any known package."
-
-                | otherwise
-                -> vcat (map pkg_hidden pkg_hiddens) $$
-                   vcat (map mod_hidden mod_hiddens) $$
-                   vcat (map unusable unusables) $$
-                   tried_these files
-
-            _ -> panic "cantFindErr"
-
-    build_tag = waysBuildTag (profileWays profile)
-
-    not_found_in_package pkg files
-       | build_tag /= ""
-       = let
-            build = if build_tag == "p" then "profiling"
-                                        else "\"" ++ build_tag ++ "\""
-         in
-         text "Perhaps you haven't installed the " <> text build <>
-         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
-         tried_these files
-
-       | otherwise
-       = text "There are files missing in the " <> quotes (ppr pkg) <>
-         text " package," $$
-         text "try running 'ghc-pkg check'." $$
-         tried_these files
-
-    pkg_hidden :: Unit -> SDoc
-    pkg_hidden uid =
-        text "It is a member of the hidden package"
-        <+> quotes (ppr uid)
-        --FIXME: we don't really want to show the unit id here we should
-        -- show the source package id or installed package id if it's ambiguous
-        <> dot $$ pkg_hidden_hint uid
-
-    pkg_hidden_hint uid
-     | using_cabal
-        = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid)
-           in text "Perhaps you need to add" <+>
-              quotes (ppr (unitPackageName pkg)) <+>
-              text "to the build-depends in your .cabal file."
-     | Just pkg <- lookupUnit (ue_units unit_env) uid
-         = text "You can run" <+>
-           quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
-           text "to expose it." $$
-           text "(Note: this unloads all the modules in the current scope.)"
-     | otherwise = Outputable.empty
-
-    mod_hidden pkg =
-        text "it is a hidden module in the package" <+> quotes (ppr pkg)
-
-    unusable (pkg, reason)
-      = text "It is a member of the package"
-      <+> quotes (ppr pkg)
-      $$ pprReason (text "which is") reason
-
-    pp_suggestions :: [ModuleSuggestion] -> SDoc
-    pp_suggestions sugs
-      | null sugs = Outputable.empty
-      | otherwise = hang (text "Perhaps you meant")
-                       2 (vcat (map pp_sugg sugs))
-
-    -- NB: Prefer the *original* location, and then reexports, and then
-    -- package flags when making suggestions.  ToDo: if the original package
-    -- also has a reexport, prefer that one
-    pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
-      where provenance ModHidden = Outputable.empty
-            provenance (ModUnusable _) = Outputable.empty
-            provenance (ModOrigin{ fromOrigUnit = e,
-                                   fromExposedReexport = res,
-                                   fromPackageFlag = f })
-              | Just True <- e
-                 = parens (text "from" <+> ppr (moduleUnit mod))
-              | f && moduleName mod == m
-                 = parens (text "from" <+> ppr (moduleUnit mod))
-              | (pkg:_) <- res
-                 = parens (text "from" <+> ppr (mkUnit pkg)
-                    <> comma <+> text "reexporting" <+> ppr mod)
-              | f
-                 = parens (text "defined via package flags to be"
-                    <+> ppr mod)
-              | otherwise = Outputable.empty
-    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
-      where provenance ModHidden =  Outputable.empty
-            provenance (ModUnusable _) = Outputable.empty
-            provenance (ModOrigin{ fromOrigUnit = e,
-                                   fromHiddenReexport = rhs })
-              | Just False <- e
-                 = parens (text "needs flag -package-id"
-                    <+> ppr (moduleUnit mod))
-              | (pkg:_) <- rhs
-                 = parens (text "needs flag -package-id"
-                    <+> ppr (mkUnit pkg))
-              | otherwise = Outputable.empty
-
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 6625864c12..6f2260dfc7 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -1,8 +1,9 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE FlexibleContexts #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-} -- instance RenderableDiagnostic PsMessage
 
 module GHC.Parser.Errors.Ppr
    ( mkParserWarn
@@ -37,9 +38,6 @@ instance Diagnostic PsMessage where
 
 mk_parser_err :: SrcSpan -> SDoc -> MsgEnvelope DiagnosticMessage
 mk_parser_err span doc = MsgEnvelope
-
-mkParserErr :: SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
-mkParserErr span doc = MsgEnvelope
    { errMsgSpan        = span
    , errMsgContext     = alwaysQualify
    , errMsgDiagnostic  = DiagnosticMessage (mkDecorated [doc]) ErrorWithoutFlag
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 84faa5df13..727a47dd10 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -53,7 +53,7 @@ import GHC.Utils.Exception as Exception
 
 import GHC.Data.StringBuffer
 import GHC.Data.Maybe
-import GHC.Data.Bag         ( Bag, listToBag, unitBag, isEmptyBag )
+import GHC.Data.Bag         ( Bag, listToBag, isEmptyBag )
 import GHC.Data.FastString
 
 import Control.Monad
@@ -91,7 +91,7 @@ getImports popts implicit_prelude buf filename source_filename = do
       -- don't log warnings: they'll be reported when we parse the file
       -- for real.  See #2500.
       if not (isEmptyBag errs)
-        then throwIO $ mkSrcErr (fmap mkParserErr errs)
+        then throwErrors $ mkMessages $ fmap mkParserErr errs
         else
           let   hsmod = unLoc rdr_module
                 mb_mod = hsmodName hsmod
@@ -313,7 +313,7 @@ getOptions' dflags toks
 checkProcessArgsResult :: MonadIO m => [Located String] -> m ()
 checkProcessArgsResult flags
   = when (notNull flags) $
-      liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags
+      liftIO . throwErrors . mkMessages . listToBag . map mkMsg $ flags
     where mkMsg (L loc flag)
               = mkPlainErrorMsgEnvelope loc $
                   (text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+>
@@ -372,4 +372,4 @@ optionsParseError str loc =
 
 throwErr :: SrcSpan -> SDoc -> a                -- #15053
 throwErr loc doc =
-  throw $ mkSrcErr $ unitBag $ mkPlainErrorMsgEnvelope loc doc
+  throw . mkSrcErr . singleMessage $ mkPlainErrorMsgEnvelope loc doc
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index c94235f151..31ed358236 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -347,7 +347,7 @@ importSuggestions where_look global_env hpt currMod imports rdr_name
   (helpful_imports_hiding, helpful_imports_non_hiding)
     = partition (imv_is_hiding . snd) helpful_imports
 
-  -- See note [When to show/hide the module-not-imported line]
+  -- See Note [When to show/hide the module-not-imported line]
   show_not_imported_line :: ModuleName -> Bool                    -- #15611
   show_not_imported_line modnam
       | modnam `elem` globMods                = False    -- #14225     -- 1
@@ -364,6 +364,26 @@ importSuggestions where_look global_env hpt currMod imports rdr_name
                      , (mod, _) <- qualsInScope gre
                      ]
 
+{- Note [When to show/hide the module-not-imported line]           -- #15611
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+For the error message:
+    Not in scope X.Y
+    Module X does not export Y
+    No module named ‘X’ is imported:
+there are 2 cases, where we hide the last "no module is imported" line:
+1. If the module X has been imported.
+2. If the module X is the current module. There are 2 subcases:
+   2.1 If the unknown module name is in a input source file,
+       then we can use the getModule function to get the current module name.
+       (See test T15611a)
+   2.2 If the unknown module name has been entered by the user in GHCi,
+       then the getModule function returns something like "interactive:Ghci1",
+       and we have to check the current module in the last added entry of
+       the HomePackageTable. (See test T15611b)
+-}
+
+
 extensionSuggestions :: RdrName -> SDoc
 extensionSuggestions rdrName
   | rdrName == mkUnqual varName (fsLit "mdo") ||
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index b97f1860f8..e9fa6b0680 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -21,9 +21,11 @@ import GHC.Types.Name.Reader
 import GHC.Types.SrcLoc
 import GHC.Unit.State ( pprWithUnitState )
 import GHC.Utils.Outputable
+import qualified Data.List.NonEmpty as NE
 
-instance RenderableDiagnostic TcRnMessage where
-  renderDiagnostic = pprTcRnMessage
+instance Diagnostic TcRnMessage where
+  diagnosticMessage = pprTcRnMessage
+  diagnosticReason _ = ErrorWithoutFlag -- FIXME(adn)
 
 notInScopeErr :: RdrName -> SDoc
 notInScopeErr rdr_name
@@ -34,23 +36,6 @@ notInScopeErr rdr_name
   where
     what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
 
-{- Note [When to show/hide the module-not-imported line]           -- #15611
-For the error message:
-    Not in scope X.Y
-    Module X does not export Y
-    No module named ‘X’ is imported:
-there are 2 cases, where we hide the last "no module is imported" line:
-1. If the module X has been imported.
-2. If the module X is the current module. There are 2 subcases:
-   2.1 If the unknown module name is in a input source file,
-       then we can use the getModule function to get the current module name.
-       (See test T15611a)
-   2.2 If the unknown module name has been entered by the user in GHCi,
-       then the getModule function returns something like "interactive:Ghci1",
-       and we have to check the current module in the last added entry of
-       the HomePackageTable. (See test T15611b)
--}
-
 exactNameErr :: Name -> SDoc
 exactNameErr name =
   hang (text "The exact Name" <+> quotes (ppr name) <+> ptext (sLit "is not in scope"))
@@ -133,7 +118,7 @@ instance Outputable ImportSuggestion where
            , text "is imported."
            ]
     SuggestModulesDoNotExport mods occ
-      | [mod] <- mods ->
+      | mod NE.:| [] <- mods ->
           hsep [ text "Module"
                , quotes (ppr mod)
                , text "does not export"
@@ -141,12 +126,12 @@ instance Outputable ImportSuggestion where
                ]
       | otherwise ->
           hsep [ text "Neither"
-               , quotedListWithNor (map ppr mods)
+               , quotedListWithNor (map ppr $ NE.toList mods)
                , text "exports"
                , quotes (ppr occ) <> dot
                ]
     SuggestAddNameToImportLists occ mods
-      | [(mod, imvspan)] <- mods ->
+      | (mod, imvspan) NE.:| [] <- mods ->
           fsep [ text "Perhaps you want to add"
                , quotes (ppr occ)
                , text "to the import list"
@@ -162,10 +147,10 @@ instance Outputable ImportSuggestion where
           $$
           nest 2 (vcat
               [ quotes (ppr mod) <+> parens (ppr imvspan)
-              | (mod, imvspan) <- mods
+              | (mod, imvspan) <- NE.toList mods
               ])
     SuggestRemoveNameFromHidingLists occ mods
-      | [(mod, imvspan)] <- mods ->
+      | (mod, imvspan) NE.:| [] <- mods ->
           fsep [ text "Perhaps you want to remove"
                , quotes (ppr occ)
                , text "from the explicit hiding list"
@@ -182,7 +167,7 @@ instance Outputable ImportSuggestion where
           $$
           nest 2 (vcat
               [ quotes (ppr mod) <+> parens (ppr imvspan)
-              | (mod, imvspan) <- mods
+              | (mod, imvspan) <- NE.toList mods
               ])
 
 instance Outputable ExtensionSuggestion where
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 42aab4e24c..39c4bec816 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -8,12 +8,11 @@ module GHC.Tc.Errors.Types (
   , ExtensionSuggestion(..)
   , OutOfScopeSuggestions(..)
   -- * Constructing messages
-  , mkTcRnWarn
+  -- , mkTcRnWarn
   -- * Constructing suggestions
   , noOutOfScopeSuggestions
   ) where
 
-import GHC.Driver.Flags
 import GHC.Prelude
 import GHC.Tc.Types.Origin ( RenderableTyVarBndr )
 import GHC.Tc.Utils.TcType
@@ -25,18 +24,18 @@ import GHC.Types.Var
 import GHC.Unit.Module.Name
 import GHC.Unit.State ( UnitState )
 import GHC.Unit.Types
-import GHC.Utils.Outputable
+import Data.List.NonEmpty (NonEmpty)
 
 -- | Creates a new 'ErrMsg' parameterised over the input 'Warning', attaching the
 -- correct 'WarnReason' to it.
-mkTcRnWarn :: WarnReason -> SrcSpan -> PrintUnqualified -> TcRnMessage -> MsgEnvelope TcRnMessage
-mkTcRnWarn reason loc printer warn = makeIntoWarning reason (mkErr loc printer warn)
+--mkTcRnWarn :: WarnReason -> SrcSpan -> PrintUnqualified -> TcRnMessage -> MsgEnvelope TcRnMessage
+--mkTcRnWarn reason loc printer warn = makeIntoWarning reason (mkErr loc printer warn)
 
 -- | An error which might arise during typechecking/renaming.
 data TcRnMessage
   = TcRnUnknownMessage !DecoratedSDoc
 
-  -- See 'mkErrDocAt' in 'GHC.Tc.Utils.Monad', where we need the 'UnitState'
+  -- See 'mkDecoratedSDocAt' in 'GHC.Tc.Utils.Monad', where we need the 'UnitState'
   -- to render the 'Unit' properly. This is a type constructor to build an embellished
   -- 'Error' which can be pretty-printed with the fully qualified 'UnitState'.
   | TcRnMessageWithUnitState !UnitState !TcRnMessage
@@ -45,12 +44,12 @@ data TcRnMessage
   | TcRnBadTelescope
       [RenderableTyVarBndr] -- telescope
       [TyCoVar] -- sorted tyvars (in a correct order)
-      !SDoc      -- context
+      !SDoc     -- context. TODO: Make it structured, eventually (#18516).
   | TcRnOutOfScope
       !RdrName -- name tried
       !OutOfScopeSuggestions -- similar name, import, etc suggestions
-      !SDoc -- extra contents (see 'unboundNameX')
-      !SDoc -- context lines
+      !SDoc -- extra contents (see 'unboundNameX'). TODO: Make it structured, eventually (#18516).
+      !SDoc -- context lines. TODO: Make it structured, eventually (#18516).
   | TcRnOutOfScopeHole
       !OccName -- out of scope name
       !TcType  -- type of the hole
@@ -73,8 +72,8 @@ newtype NameSuggestions = NameSuggestions [(RdrName, HowInScope)]
 
 data ImportSuggestion
   = SuggestNoModuleImported !ModuleName
-  | SuggestModulesDoNotExport [Module] !OccName
-  | SuggestAddNameToImportLists !OccName [(Module, SrcSpan)]
-  | SuggestRemoveNameFromHidingLists !OccName [(Module, SrcSpan)]
+  | SuggestModulesDoNotExport (NonEmpty Module) !OccName
+  | SuggestAddNameToImportLists !OccName (NonEmpty (Module, SrcSpan))
+  | SuggestRemoveNameFromHidingLists !OccName (NonEmpty (Module, SrcSpan))
 
 data ExtensionSuggestion = SuggestRecursiveDo
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 5ea38e6d69..911774d4ff 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -172,10 +172,10 @@ isSigMaybe _                = Nothing
 -- pretty-print a particular 'LHsTyVarBndr'.
 data RenderableTyVarBndr where
   RenderableTyVarBndr :: forall flag pass.
-                      ( OutputableBndrFlag flag
-                      , Outputable (LHsTyVarBndr flag pass)
+                      ( OutputableBndrFlag flag pass
+                      , Outputable (LHsTyVarBndr flag (GhcPass pass))
                       )
-                      => LHsTyVarBndr flag pass
+                      => LHsTyVarBndr flag (GhcPass pass)
                       -> RenderableTyVarBndr
 
 -- SkolemInfo gives the origin of *given* constraints
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index 58ff793380..7516b96880 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -11,6 +11,7 @@ module GHC.Types.Error
    , getMessages
    , emptyMessages
    , isEmptyMessages
+   , singleMessage
    , addMessage
    , unionMessages
    , MsgEnvelope (..)
@@ -28,7 +29,6 @@ module GHC.Types.Error
 
    , SDoc
    , DecoratedSDoc (unDecorated)
-   , Severity (..)
    , mapDecorated
    , pprMessageBag
    , mkDecorated
@@ -93,6 +93,9 @@ mkMessages = Messages
 isEmptyMessages :: Messages e -> Bool
 isEmptyMessages (Messages msgs) = isEmptyBag msgs
 
+singleMessage :: MsgEnvelope e -> Messages e
+singleMessage e = addMessage e emptyMessages
+
 {- Note [Discarding Messages]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -305,14 +308,6 @@ instance ToJson MessageClass where
   json (MCDiagnostic sev reason) =
     JSString $ renderWithContext defaultSDocContext (ppr $ text "MCDiagnostic" <+> ppr sev <+> ppr reason)
 
-instance Show (MsgEnvelope DiagnosticMessage) where
-    show = showMsgEnvelope
-
--- | Shows an 'MsgEnvelope'.
-showMsgEnvelope :: Diagnostic a => MsgEnvelope a -> String
-showMsgEnvelope err =
-  renderWithContext defaultSDocContext (vcat (unDecorated . diagnosticMessage $ errMsgDiagnostic err))
-
 mapDecorated :: (SDoc -> SDoc) -> DecoratedSDoc -> DecoratedSDoc
 mapDecorated f (Decorated xs) = Decorated (map f xs)
 
diff --git a/compiler/GHC/Types/SourceError.hs b/compiler/GHC/Types/SourceError.hs
index b8a1e932e0..d4a71dd298 100644
--- a/compiler/GHC/Types/SourceError.hs
+++ b/compiler/GHC/Types/SourceError.hs
@@ -10,25 +10,29 @@ module GHC.Types.SourceError
 where
 
 import GHC.Prelude
-import GHC.Data.Bag
 import GHC.Types.Error
+import GHC.Driver.Errors.Types (ghcUnknownMessage,  GhcMessage )
+import GHC.Driver.Errors.Ppr () -- instance Diagnostic GhcMessage
 import GHC.Utils.Monad
 import GHC.Utils.Panic
 import GHC.Utils.Exception
 
 import Control.Monad.Catch as MC (MonadCatch, catch)
+import GHC.Utils.Error (pprMsgEnvelopeBagWithLoc)
+import GHC.Utils.Outputable
+import Data.Data (Typeable)
 
-mkSrcErr :: ErrorMessages -> SourceError
-mkSrcErr = SourceError
+mkSrcErr :: (Diagnostic e, Typeable e) => Messages e -> SourceError
+mkSrcErr = SourceError . fmap ghcUnknownMessage
 
-srcErrorMessages :: SourceError -> ErrorMessages
+srcErrorMessages :: SourceError -> Messages GhcMessage
 srcErrorMessages (SourceError msgs) = msgs
 
-throwErrors :: MonadIO io => ErrorMessages -> io a
+throwErrors :: (Diagnostic e, Typeable e, MonadIO io) => Messages e -> io a
 throwErrors = liftIO . throwIO . mkSrcErr
 
-throwOneError :: MonadIO io => MsgEnvelope DiagnosticMessage -> io a
-throwOneError = throwErrors . unitBag
+throwOneError :: (Diagnostic e, Typeable e, MonadIO io) => MsgEnvelope e -> io a
+throwOneError = throwErrors . singleMessage
 
 -- | A source error is an error that is caused by one or more errors in the
 -- source code.  A 'SourceError' is thrown by many functions in the
@@ -46,10 +50,15 @@ throwOneError = throwErrors . unitBag
 --
 -- See 'printExceptionAndWarnings' for more information on what to take care
 -- of when writing a custom error handler.
-newtype SourceError = SourceError ErrorMessages
+newtype SourceError = SourceError (Messages GhcMessage)
 
 instance Show SourceError where
-  show (SourceError msgs) = unlines . map show . bagToList $ msgs
+  show (SourceError msgs) =
+      renderWithContext defaultSDocContext
+    . vcat
+    . pprMsgEnvelopeBagWithLoc
+    . getMessages
+    $ msgs
 
 instance Exception SourceError
 
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index b3f9b2c732..8f6fb100d5 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -442,6 +442,7 @@ Library
         GHC.Hs.Utils
         GHC.Iface.Binary
         GHC.Iface.Env
+        GHC.Iface.Errors
         GHC.Iface.Ext.Ast
         GHC.Iface.Ext.Binary
         GHC.Iface.Ext.Debug
diff --git a/utils/check-exact/Preprocess.hs b/utils/check-exact/Preprocess.hs
index dfe795e532..1f58932d71 100644
--- a/utils/check-exact/Preprocess.hs
+++ b/utils/check-exact/Preprocess.hs
@@ -21,17 +21,20 @@ import qualified GHC.Data.FastString   as GHC
 import qualified GHC.Data.StringBuffer as GHC
 import qualified GHC.Driver.Config     as GHC
 import qualified GHC.Driver.Env        as GHC
+import qualified GHC.Driver.Errors.Types as GHC
 import qualified GHC.Driver.Phases     as GHC
 import qualified GHC.Driver.Pipeline   as GHC
 import qualified GHC.Fingerprint.Type  as GHC
 import qualified GHC.Parser.Errors.Ppr as GHC
-import qualified GHC.Parser.Lexer      as GHC
+import qualified GHC.Parser.Lexer      as GHC hiding (getMessages)
 import qualified GHC.Settings          as GHC
+import qualified GHC.Types.Error       as GHC (getMessages, mkMessages)
 import qualified GHC.Types.SourceError as GHC
 import qualified GHC.Types.SourceFile  as GHC
 import qualified GHC.Types.SrcLoc      as GHC
 import qualified GHC.Utils.Error       as GHC
 import qualified GHC.Utils.Fingerprint as GHC
+import qualified GHC.Utils.Outputable  as GHC
 import GHC.Types.SrcLoc (mkSrcSpan, mkSrcLoc)
 import GHC.Data.FastString (mkFastString)
 
@@ -222,8 +225,13 @@ getPreprocessedSrcDirectPrim cppOptions src_fn = do
       txt <- GHC.liftIO $ readFileGhc hspp_fn
       return (txt, buf, dflags')
 
-showErrorMessages :: GHC.ErrorMessages -> String
-showErrorMessages msgs = intercalate "\n" $ map show $ GHC.bagToList msgs
+showErrorMessages :: GHC.Messages GHC.GhcMessage -> String
+showErrorMessages msgs =
+  GHC.renderWithContext GHC.defaultSDocContext
+    $ GHC.vcat
+    $ GHC.pprMsgEnvelopeBagWithLoc
+    $ GHC.getMessages
+    $ msgs
 
 injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags
 injectCppOptions CppOptions{..} dflags =
@@ -277,7 +285,7 @@ parseError pst = do
      let
        -- (warns,errs) = GHC.getMessages pst dflags
      -- throw $ GHC.mkSrcErr (GHC.unitBag $ GHC.mkPlainErrMsg dflags sspan err)
-     GHC.throwErrors (fmap GHC.mkParserErr (GHC.getErrorMessages pst))
+     GHC.throwErrors $ GHC.mkMessages (fmap GHC.mkParserErr (GHC.getErrorMessages pst))
 
 -- ---------------------------------------------------------------------