Remove errShortString, cleanup error-related functions

This commit removes the errShortString field from the ErrMsg type,
allowing us to cleanup a lot of dynflag-dependent error functions, and
move them in a more specialised 'GHC.Driver.Errors' closer to the
driver, where they are actually used.

Metric Increase:
  T4801
  T9961

23 files changed, 237 insertions, 211 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 60b7a3e639..f52dc5b657 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -301,6 +301,7 @@ import GHC.Platform.Ways
 import GHC.Driver.Phases   ( Phase(..), isHaskellSrcFilename
                            , isSourceFilename, startPhase )
 import GHC.Driver.Env
+import GHC.Driver.Errors
 import GHC.Driver.CmdLine
 import GHC.Driver.Session hiding (WarnReason(..))
 import GHC.Driver.Backend
@@ -889,7 +890,7 @@ checkNewInteractiveDynFlags dflags0 = do
   -- the REPL. See #12356.
   if xopt LangExt.StaticPointers dflags0
   then do liftIO $ printOrThrowWarnings dflags0 $ listToBag
-            [mkPlainWarnMsg dflags0 interactiveSrcSpan
+            [mkPlainWarnMsg interactiveSrcSpan
              $ text "StaticPointers is not supported in GHCi interactive expressions."]
           return $ xopt_unset dflags0 LangExt.StaticPointers
   else return dflags0
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 3a3f94d4f0..e5f1844474 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -30,6 +30,7 @@ import GHC.Driver.Ppr
 import GHC.Driver.Main
 import GHC.Driver.Make
 import GHC.Driver.Env
+import GHC.Driver.Errors
 
 import GHC.Parser
 import GHC.Parser.Header
@@ -96,7 +97,7 @@ doBackpack [src_filename] = do
     (dflags, unhandled_flags, warns) <- liftIO $ parseDynamicFilePragma dflags1 src_opts
     modifySession (\hsc_env -> hsc_env {hsc_dflags = dflags})
     -- Cribbed from: preprocessFile / GHC.Driver.Pipeline
-    liftIO $ checkProcessArgsResult dflags unhandled_flags
+    liftIO $ checkProcessArgsResult unhandled_flags
     liftIO $ handleFlagWarnings dflags warns
     -- TODO: Preprocessing not implemented
 
@@ -776,7 +777,6 @@ summariseDecl :: PackageName
 summariseDecl pn hsc_src (L _ modname) (Just hsmod) = hsModuleToModSummary pn hsc_src modname hsmod
 summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
     = do hsc_env <- getSession
-         let dflags = hsc_dflags hsc_env
          -- TODO: this looks for modules in the wrong place
          r <- liftIO $ summariseModule hsc_env
                          emptyModNodeMap -- GHC API recomp not supported
@@ -786,7 +786,7 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
                          Nothing -- GHC API buffer support not supported
                          [] -- No exclusions
          case r of
-            Nothing -> throwOneError (mkPlainErrMsg dflags loc (text "module" <+> ppr modname <+> text "was not found"))
+            Nothing -> throwOneError (mkPlainErrMsg loc (text "module" <+> ppr modname <+> text "was not found"))
             Just (Left err) -> throwErrors err
             Just (Right summary) -> return summary
 
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 1dfb88f8e4..5608c12b15 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -29,6 +29,7 @@ import GHC.Prelude
 
 import GHC.Driver.Ppr
 import GHC.Driver.Session
+import GHC.Driver.Errors ( printOrThrowWarnings )
 
 import GHC.Runtime.Context
 import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) )
@@ -59,7 +60,6 @@ import GHC.Data.Bag
 
 import GHC.Utils.Outputable
 import GHC.Utils.Monad
-import GHC.Utils.Error
 import GHC.Utils.Panic
 import GHC.Utils.Misc
 
diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs
new file mode 100644
index 0000000000..de66b60a2c
--- /dev/null
+++ b/compiler/GHC/Driver/Errors.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module GHC.Driver.Errors (
+    warningsToMessages
+  , printOrThrowWarnings
+  , printBagOfErrors
+  , isWarnMsgFatal
+  , handleFlagWarnings
+  ) where
+
+import GHC.Driver.Session
+import GHC.Data.Bag
+import GHC.Utils.Exception
+import GHC.Utils.Error ( formatErrDoc, sortMsgBag )
+import GHC.Types.SourceError ( mkSrcErr )
+import GHC.Prelude
+import GHC.Types.SrcLoc
+import GHC.Types.Error
+import GHC.Utils.Outputable ( text, withPprStyle, mkErrStyle )
+import qualified GHC.Driver.CmdLine as CmdLine
+
+-- | Converts a list of 'WarningMessages' into 'Messages', where the second element contains only
+-- error, i.e. warnings that are considered fatal by GHC based on the input 'DynFlags'.
+warningsToMessages :: DynFlags -> WarningMessages -> Messages
+warningsToMessages dflags =
+  partitionBagWith $ \warn ->
+    case isWarnMsgFatal dflags warn of
+      Nothing -> Left warn
+      Just err_reason ->
+        Right warn{ errMsgSeverity = SevError
+                  , errMsgReason = ErrReason err_reason }
+
+printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
+printBagOfErrors dflags bag_of_errors
+  = sequence_ [ let style = mkErrStyle unqual
+                    ctx   = initSDocContext dflags style
+                in putLogMsg dflags reason sev s $ withPprStyle style (formatErrDoc ctx doc)
+              | ErrMsg { errMsgSpan      = s,
+                         errMsgDoc       = doc,
+                         errMsgSeverity  = sev,
+                         errMsgReason    = reason,
+                         errMsgContext   = unqual } <- sortMsgBag (Just dflags)
+                                                                  bag_of_errors ]
+
+handleFlagWarnings :: DynFlags -> [CmdLine.Warn] -> IO ()
+handleFlagWarnings dflags warns = do
+  let warns' = filter (shouldPrintWarning dflags . CmdLine.warnReason)  warns
+
+      -- It would be nicer if warns :: [Located MsgDoc], but that
+      -- has circular import problems.
+      bag = listToBag [ mkPlainWarnMsg loc (text warn)
+                      | CmdLine.Warn _ (L loc warn) <- warns' ]
+
+  printOrThrowWarnings dflags bag
+
+-- | Checks if given 'WarnMsg' is a fatal warning.
+isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)
+isWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}
+  = if wopt_fatal wflag dflags
+      then Just (Just wflag)
+      else Nothing
+isWarnMsgFatal dflags _
+  = if gopt Opt_WarnIsError dflags
+      then Just Nothing
+      else Nothing
+
+-- Given a warn reason, check to see if it's associated -W opt is enabled
+shouldPrintWarning :: DynFlags -> CmdLine.WarnReason -> Bool
+shouldPrintWarning dflags CmdLine.ReasonDeprecatedFlag
+  = wopt Opt_WarnDeprecatedFlags dflags
+shouldPrintWarning dflags CmdLine.ReasonUnrecognisedFlag
+  = wopt Opt_WarnUnrecognisedWarningFlags dflags
+shouldPrintWarning _ _
+  = True
+
+-- | Given a bag of warnings, turn them into an exception if
+-- -Werror is enabled, or print them out otherwise.
+printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
+printOrThrowWarnings dflags warns = do
+  let (make_error, warns') =
+        mapAccumBagL
+          (\make_err warn ->
+            case isWarnMsgFatal dflags warn of
+              Nothing ->
+                (make_err, warn)
+              Just err_reason ->
+                (True, warn{ errMsgSeverity = SevError
+                           , errMsgReason = ErrReason err_reason
+                           }))
+          False warns
+  if make_error
+    then throwIO (mkSrcErr warns')
+    else printBagOfErrors dflags warns
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 22b0f1a07e..fe49f2a8e2 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -93,6 +93,7 @@ import GHC.Driver.Plugins
 import GHC.Driver.Session
 import GHC.Driver.Backend
 import GHC.Driver.Env
+import GHC.Driver.Errors
 import GHC.Driver.CodeOutput
 import GHC.Driver.Config
 import GHC.Driver.Hooks
@@ -562,7 +563,7 @@ tcRnModule' sum save_rn_syntax mod = do
           && wopt Opt_WarnMissingSafeHaskellMode dflags) $
         logWarnings $ unitBag $
         makeIntoWarning (Reason Opt_WarnMissingSafeHaskellMode) $
-        mkPlainWarnMsg dflags (getLoc (hpm_module mod)) $
+        mkPlainWarnMsg (getLoc (hpm_module mod)) $
         warnMissingSafeHaskellMode
 
     tcg_res <- {-# SCC "Typecheck-Rename" #-}
@@ -591,13 +592,13 @@ tcRnModule' sum save_rn_syntax mod = do
                 | safeHaskell dflags == Sf_Safe -> return ()
                 | otherwise -> (logWarnings $ unitBag $
                        makeIntoWarning (Reason Opt_WarnSafe) $
-                       mkPlainWarnMsg dflags (warnSafeOnLoc dflags) $
+                       mkPlainWarnMsg (warnSafeOnLoc dflags) $
                        errSafe tcg_res')
               False | safeHaskell dflags == Sf_Trustworthy &&
                       wopt Opt_WarnTrustworthySafe dflags ->
                       (logWarnings $ unitBag $
                        makeIntoWarning (Reason Opt_WarnTrustworthySafe) $
-                       mkPlainWarnMsg dflags (trustworthyOnLoc dflags) $
+                       mkPlainWarnMsg (trustworthyOnLoc dflags) $
                        errTwthySafe tcg_res')
               False -> return ()
           return tcg_res'
@@ -1119,22 +1120,22 @@ hscCheckSafeImports tcg_env = do
       case safeLanguageOn dflags of
           True -> do
               -- XSafe: we nuke user written RULES
-              logWarnings $ warns dflags (tcg_rules tcg_env')
+              logWarnings $ warns (tcg_rules tcg_env')
               return tcg_env' { tcg_rules = [] }
           False
                 -- SafeInferred: user defined RULES, so not safe
               | safeInferOn dflags && not (null $ tcg_rules tcg_env')
-              -> markUnsafeInfer tcg_env' $ warns dflags (tcg_rules tcg_env')
+              -> markUnsafeInfer tcg_env' $ warns (tcg_rules tcg_env')
 
                 -- Trustworthy OR SafeInferred: with no RULES
               | otherwise
               -> return tcg_env'
 
-    warns dflags rules = listToBag $ map (warnRules dflags) rules
+    warns rules = listToBag $ map warnRules rules
 
-    warnRules :: DynFlags -> GenLocated SrcSpan (RuleDecl GhcTc) -> ErrMsg
-    warnRules dflags (L loc (HsRule { rd_name = n })) =
-        mkPlainWarnMsg dflags loc $
+    warnRules :: GenLocated SrcSpan (RuleDecl GhcTc) -> ErrMsg
+    warnRules (L loc (HsRule { rd_name = n })) =
+        mkPlainWarnMsg loc $
             text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$
             text "User defined rules are disabled under Safe Haskell"
 
@@ -1211,8 +1212,7 @@ checkSafeImports tcg_env
     cond' v1 v2
         | imv_is_safe v1 /= imv_is_safe v2
         = do
-            dflags <- getDynFlags
-            throwOneError $ mkPlainErrMsg dflags (imv_span v1)
+            throwOneError $ mkPlainErrMsg (imv_span v1)
               (text "Module" <+> ppr (imv_name v1) <+>
               (text $ "is imported both as a safe and unsafe import!"))
         | otherwise
@@ -1280,7 +1280,7 @@ hscCheckSafe' m l = do
         iface <- lookup' m
         case iface of
             -- can't load iface to check trust!
-            Nothing -> throwOneError $ mkPlainErrMsg dflags l
+            Nothing -> throwOneError $ mkPlainErrMsg l
                          $ text "Can't load the interface file for" <+> ppr m
                            <> text ", to check that it can be safely imported"
 
@@ -1314,20 +1314,20 @@ hscCheckSafe' m l = do
                     state = hsc_units hsc_env
                     inferredImportWarn = unitBag
                         $ makeIntoWarning (Reason Opt_WarnInferredSafeImports)
-                        $ mkWarnMsg dflags l (pkgQual state)
+                        $ mkWarnMsg l (pkgQual state)
                         $ sep
                             [ text "Importing Safe-Inferred module "
                                 <> ppr (moduleName m)
                                 <> text " from explicitly Safe module"
                             ]
-                    pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual state) $
+                    pkgTrustErr = unitBag $ mkErrMsg l (pkgQual state) $
                         sep [ ppr (moduleName m)
                                 <> text ": Can't be safely imported!"
                             , text "The package ("
                                 <> (pprWithUnitState state $ ppr (moduleUnit m))
                                 <> text ") the module resides in isn't trusted."
                             ]
-                    modTrustErr = unitBag $ mkErrMsg dflags l (pkgQual state) $
+                    modTrustErr = unitBag $ mkErrMsg l (pkgQual state) $
                         sep [ ppr (moduleName m)
                                 <> text ": Can't be safely imported!"
                             , text "The module itself isn't safe." ]
@@ -1366,7 +1366,6 @@ hscCheckSafe' m l = do
 -- | Check the list of packages are trusted.
 checkPkgTrust :: Set UnitId -> Hsc ()
 checkPkgTrust pkgs = do
-    dflags <- getDynFlags
     hsc_env <- getHscEnv
     let errors = S.foldr go [] pkgs
         state  = hsc_units hsc_env
@@ -1374,7 +1373,7 @@ checkPkgTrust pkgs = do
             | unitIsTrusted $ unsafeLookupUnitId state pkg
             = acc
             | otherwise
-            = (:acc) $ mkErrMsg dflags noSrcSpan (pkgQual state)
+            = (:acc) $ mkErrMsg noSrcSpan (pkgQual state)
                      $ pprWithUnitState state
                      $ text "The package ("
                         <> ppr pkg
@@ -1399,7 +1398,7 @@ markUnsafeInfer tcg_env whyUnsafe = do
 
     when (wopt Opt_WarnUnsafe dflags)
          (logWarnings $ unitBag $ makeIntoWarning (Reason Opt_WarnUnsafe) $
-             mkPlainWarnMsg dflags (warnUnsafeOnLoc dflags) (whyUnsafe' dflags))
+             mkPlainWarnMsg (warnUnsafeOnLoc dflags) (whyUnsafe' dflags))
 
     liftIO $ writeIORef (tcg_safeInfer tcg_env) (False, whyUnsafe)
     -- NOTE: Only wipe trust when not in an explicitly safe haskell mode. Other
@@ -1925,7 +1924,7 @@ hscImport hsc_env str = runInteractiveHsc hsc_env $ do
     case is of
         [L _ i] -> return i
         _ -> liftIO $ throwOneError $
-                 mkPlainErrMsg (hsc_dflags hsc_env) noSrcSpan $
+                 mkPlainErrMsg noSrcSpan $
                      text "parse error in import declaration"
 
 -- | Typecheck an expression (but don't run it)
@@ -1951,11 +1950,10 @@ hscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do
 
 hscParseExpr :: String -> Hsc (LHsExpr GhcPs)
 hscParseExpr expr = do
-  hsc_env <- getHscEnv
   maybe_stmt <- hscParseStmt expr
   case maybe_stmt of
     Just (L _ (BodyStmt _ expr _ _)) -> return expr
-    _ -> throwOneError $ mkPlainErrMsg (hsc_dflags hsc_env) noSrcSpan
+    _ -> throwOneError $ mkPlainErrMsg 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 04354baf17..8c460b4b5c 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -59,6 +59,7 @@ import GHC.Driver.Session
 import GHC.Driver.Backend
 import GHC.Driver.Monad
 import GHC.Driver.Env
+import GHC.Driver.Errors
 import GHC.Driver.Main
 
 import GHC.Parser.Header
@@ -315,7 +316,7 @@ warnMissingHomeModules hsc_env mod_graph =
           (sep (map ppr missing))
     warn = makeIntoWarning
       (Reason Opt_WarnMissingHomeModules)
-      (mkPlainErrMsg dflags noSrcSpan msg)
+      (mkPlainErrMsg noSrcSpan msg)
 
 -- | Describes which modules of the module graph need to be loaded.
 data LoadHowMuch
@@ -382,7 +383,7 @@ warnUnusedPackages = do
 
     let warn = makeIntoWarning
           (Reason Opt_WarnUnusedPackages)
-          (mkPlainErrMsg dflags noSrcSpan msg)
+          (mkPlainErrMsg noSrcSpan msg)
         msg = vcat [ text "The following packages were specified" <+>
                      text "via -package or -package-id flags,"
                    , text "but were not needed for compilation:"
@@ -2200,15 +2201,15 @@ warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
 warnUnnecessarySourceImports sccs = do
   dflags <- getDynFlags
   when (wopt Opt_WarnUnusedImports dflags)
-    (logWarnings (listToBag (concatMap (check dflags . flattenSCC) sccs)))
-  where check dflags ms =
+    (logWarnings (listToBag (concatMap (check . flattenSCC) sccs)))
+  where check ms =
            let mods_in_this_cycle = map ms_mod_name ms in
-           [ warn dflags i | m <- ms, i <- ms_home_srcimps m,
-                             unLoc i `notElem`  mods_in_this_cycle ]
+           [ warn i | m <- ms, i <- ms_home_srcimps m,
+                      unLoc i `notElem`  mods_in_this_cycle ]
 
-        warn :: DynFlags -> Located ModuleName -> WarnMsg
-        warn dflags (L loc mod) =
-           mkPlainErrMsg dflags loc
+        warn :: Located ModuleName -> WarnMsg
+        warn (L loc mod) =
+           mkPlainErrMsg loc
                 (text "Warning: {-# SOURCE #-} unnecessary in import of "
                  <+> quotes (ppr mod))
 
@@ -2277,14 +2278,14 @@ 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 $ mkPlainErrMsg dflags noSrcSpan $
+                    else return $ Left $ unitBag $ mkPlainErrMsg noSrcSpan $
                            text "can't find file:" <+> text file
         getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
            = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot
                                            (L rootLoc modl) obj_allowed
                                            maybe_buf excl_mods
                 case maybe_summary of
-                   Nothing -> return $ Left $ moduleNotFoundErr dflags modl
+                   Nothing -> return $ Left $ moduleNotFoundErr modl
                    Just s  -> return s
 
         rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
@@ -2301,7 +2302,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
         checkDuplicates root_map
            | allow_dup_roots = return ()
            | null dup_roots  = return ()
-           | otherwise       = liftIO $ multiRootsErr dflags (emsModSummary <$> head dup_roots)
+           | otherwise       = liftIO $ multiRootsErr (emsModSummary <$> head dup_roots)
            where
              dup_roots :: [[ExtendedModSummary]]        -- Each at least of length 2
              dup_roots = filterOut isSingleton $ map rights $ modNodeMapElems root_map
@@ -2320,7 +2321,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
           = if isSingleton summs then
                 loop ss done
             else
-                do { multiRootsErr dflags (emsModSummary <$> rights summs)
+                do { multiRootsErr (emsModSummary <$> rights summs)
                    ; return (ModNodeMap Map.empty)
                    }
           | otherwise
@@ -2696,7 +2697,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 dflags loc src_fn
+          Nothing -> return $ Left $ noHsFileErr loc src_fn
           Just t  -> new_summary location' mod src_fn t
 
     new_summary location mod src_fn src_timestamp
@@ -2717,7 +2718,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
               | otherwise = HsSrcFile
 
         when (pi_mod_name /= wanted_mod) $
-                throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $
+                throwE $ unitBag $ mkPlainErrMsg 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)
@@ -2729,7 +2730,7 @@ 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 $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $
+            in throwE $ unitBag $ mkPlainErrMsg 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)
@@ -2888,21 +2889,21 @@ withDeferredDiagnostics f = do
 noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> ErrMsg
 -- ToDo: we don't have a proper line number for this error
 noModError hsc_env loc wanted_mod err
-  = mkPlainErrMsg (hsc_dflags hsc_env) loc $ cannotFindModule hsc_env wanted_mod err
+  = mkPlainErrMsg loc $ cannotFindModule hsc_env wanted_mod err
 
-noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrorMessages
-noHsFileErr dflags loc path
-  = unitBag $ mkPlainErrMsg dflags loc $ text "Can't find" <+> text path
+noHsFileErr :: SrcSpan -> String -> ErrorMessages
+noHsFileErr loc path
+  = unitBag $ mkPlainErrMsg loc $ text "Can't find" <+> text path
 
-moduleNotFoundErr :: DynFlags -> ModuleName -> ErrorMessages
-moduleNotFoundErr dflags mod
-  = unitBag $ mkPlainErrMsg dflags noSrcSpan $
+moduleNotFoundErr :: ModuleName -> ErrorMessages
+moduleNotFoundErr mod
+  = unitBag $ mkPlainErrMsg noSrcSpan $
         text "module" <+> quotes (ppr mod) <+> text "cannot be found locally"
 
-multiRootsErr :: DynFlags -> [ModSummary] -> IO ()
-multiRootsErr _      [] = panic "multiRootsErr"
-multiRootsErr dflags summs@(summ1:_)
-  = throwOneError $ mkPlainErrMsg dflags noSrcSpan $
+multiRootsErr :: [ModSummary] -> IO ()
+multiRootsErr [] = panic "multiRootsErr"
+multiRootsErr summs@(summ1:_)
+  = throwOneError $ mkPlainErrMsg 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 b54bbbea3e..220e1bf5b2 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -288,9 +288,8 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
                 -> return Nothing
 
             fail ->
-                let dflags = hsc_dflags hsc_env
-                in throwOneError $ mkPlainErrMsg dflags srcloc $
-                        cannotFindModule hsc_env imp fail
+                throwOneError $ mkPlainErrMsg srcloc $
+                     cannotFindModule hsc_env imp fail
         }
 
 -----------------------------
diff --git a/compiler/GHC/Driver/Monad.hs b/compiler/GHC/Driver/Monad.hs
index d30f26999a..51329aead1 100644
--- a/compiler/GHC/Driver/Monad.hs
+++ b/compiler/GHC/Driver/Monad.hs
@@ -28,6 +28,7 @@ import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Driver.Env
+import GHC.Driver.Errors ( printOrThrowWarnings, printBagOfErrors )
 
 import GHC.Utils.Monad
 import GHC.Utils.Exception
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 717cd71369..5f79306e7e 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -46,6 +46,7 @@ import GHC.Tc.Types
 
 import GHC.Driver.Main
 import GHC.Driver.Env hiding ( Hsc )
+import GHC.Driver.Errors
 import GHC.Driver.Pipeline.Monad
 import GHC.Driver.Config
 import GHC.Driver.Phases
@@ -149,7 +150,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase =
   where
     srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1
     handler (ProgramError msg) = return $ Left $ unitBag $
-        mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg
+        mkPlainErrMsg srcspan $ text msg
     handler ex = throwGhcExceptionIO ex
 
 -- ---------------------------------------------------------------------------
@@ -1127,7 +1128,7 @@ runPhase (RealPhase (Cpp sf)) input_fn
        (dflags1, unhandled_flags, warns)
            <- liftIO $ parseDynamicFilePragma dflags0 src_opts
        setDynFlags dflags1
-       liftIO $ checkProcessArgsResult dflags1 unhandled_flags
+       liftIO $ checkProcessArgsResult unhandled_flags
 
        if not (xopt LangExt.Cpp dflags1) then do
            -- we have to be careful to emit warnings only once.
@@ -1148,7 +1149,7 @@ runPhase (RealPhase (Cpp sf)) input_fn
             src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn
             (dflags2, unhandled_flags, warns)
                 <- liftIO $ parseDynamicFilePragma dflags0 src_opts
-            liftIO $ checkProcessArgsResult dflags2 unhandled_flags
+            liftIO $ checkProcessArgsResult unhandled_flags
             unless (gopt Opt_Pp dflags2) $
                 liftIO $ handleFlagWarnings dflags2 warns
             -- the HsPp pass below will emit warnings
@@ -1182,7 +1183,7 @@ runPhase (RealPhase (HsPp sf)) input_fn = do
         (dflags1, unhandled_flags, warns)
             <- liftIO $ parseDynamicFilePragma dflags src_opts
         setDynFlags dflags1
-        liftIO $ checkProcessArgsResult dflags1 unhandled_flags
+        liftIO $ checkProcessArgsResult unhandled_flags
         liftIO $ handleFlagWarnings dflags1 warns
 
         return (RealPhase (Hsc sf), output_fn)
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index bdb275e5aa..7e52691124 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -453,9 +453,8 @@ warnDs :: WarnReason -> SDoc -> DsM ()
 warnDs reason warn
   = do { env <- getGblEnv
        ; loc <- getSrcSpanDs
-       ; dflags <- getDynFlags
        ; let msg = makeIntoWarning reason $
-                   mkWarnMsg dflags loc (ds_unqual env) warn
+                   mkWarnMsg loc (ds_unqual env) warn
        ; updMutVar (ds_msgs env) (\ (w,e) -> (w `snocBag` msg, e)) }
 
 -- | Emit a warning only if the correct WarnReason is set in the DynFlags
@@ -468,8 +467,7 @@ errDs :: SDoc -> DsM ()
 errDs err
   = do  { env <- getGblEnv
         ; loc <- getSrcSpanDs
-        ; dflags <- getDynFlags
-        ; let msg = mkErrMsg dflags loc (ds_unqual env) err
+        ; let msg = mkErrMsg loc (ds_unqual env) err
         ; updMutVar (ds_msgs env) (\ (w,e) -> (w, e `snocBag` msg)) }
 
 -- | Issue an error, but return the expression for (), so that we can continue
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index aba0c006ca..7374239092 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -18,7 +18,6 @@ module GHC.Iface.Rename (
 
 import GHC.Prelude
 
-import GHC.Driver.Session
 import GHC.Driver.Env
 
 import GHC.Tc.Utils.Monad
@@ -75,10 +74,9 @@ tcRnModExports x y = do
 failWithRn :: SDoc -> ShIfM a
 failWithRn doc = do
     errs_var <- fmap sh_if_errs getGblEnv
-    dflags <- getDynFlags
     errs <- readTcRef errs_var
     -- TODO: maybe associate this with a source location?
-    writeTcRef errs_var (errs `snocBag` mkPlainErrMsg dflags noSrcSpan doc)
+    writeTcRef errs_var (errs `snocBag` mkPlainErrMsg noSrcSpan doc)
     failM
 
 -- | What we have is a generalized ModIface, which corresponds to
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index edb9b04380..98b2341cf1 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -29,7 +29,6 @@ mkParserErr span doc = ErrMsg
    { errMsgSpan        = span
    , errMsgContext     = alwaysQualify
    , errMsgDoc         = ErrDoc [doc] [] []
-   , errMsgShortString = renderWithContext defaultSDocContext doc
    , errMsgSeverity    = SevError
    , errMsgReason      = NoReason
    }
@@ -39,7 +38,6 @@ mkParserWarn flag span doc = ErrMsg
    { errMsgSpan        = span
    , errMsgContext     = alwaysQualify
    , errMsgDoc         = ErrDoc [doc] [] []
-   , errMsgShortString = renderWithContext defaultSDocContext doc
    , errMsgSeverity    = SevWarning
    , errMsgReason      = Reason flag
    }
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 5abb0497d4..8c0a876c36 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -39,11 +39,11 @@ import GHC.Hs
 import GHC.Unit.Module
 import GHC.Builtin.Names
 
+import GHC.Types.Error
 import GHC.Types.SrcLoc
 import GHC.Types.SourceError
 import GHC.Types.SourceText
 
-import GHC.Utils.Error
 import GHC.Utils.Misc
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
@@ -259,7 +259,7 @@ getOptions' dflags toks
               | IToptions_prag str <- unLoc open
               , ITclose_prag       <- unLoc close
               = case toArgs str of
-                  Left _err -> optionsParseError str dflags $   -- #15053
+                  Left _err -> optionsParseError str $   -- #15053
                                  combineSrcSpans (getLoc open) (getLoc close)
                   Right args -> map (L (getLoc open)) args ++ parseToks xs
           parseToks (open:close:xs)
@@ -284,10 +284,10 @@ getOptions' dflags toks
                 case rest of
                   (L _loc ITcomma):more -> parseLanguage more
                   (L _loc ITclose_prag):more -> parseToks more
-                  (L loc _):_ -> languagePragParseError dflags loc
+                  (L loc _):_ -> languagePragParseError loc
                   [] -> panic "getOptions'.parseLanguage(1) went past eof token"
           parseLanguage (tok:_)
-              = languagePragParseError dflags (getLoc tok)
+              = languagePragParseError (getLoc tok)
           parseLanguage []
               = panic "getOptions'.parseLanguage(2) went past eof token"
 
@@ -308,12 +308,12 @@ getOptions' dflags toks
 --
 -- Throws a 'SourceError' if the input list is non-empty claiming that the
 -- input flags are unknown.
-checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()
-checkProcessArgsResult dflags flags
+checkProcessArgsResult :: MonadIO m => [Located String] -> m ()
+checkProcessArgsResult flags
   = when (notNull flags) $
       liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags
     where mkMsg (L loc flag)
-              = mkPlainErrMsg dflags loc $
+              = mkPlainErrMsg loc $
                   (text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+>
                    text flag)
 
@@ -330,9 +330,9 @@ checkExtension dflags (L l ext)
     ext' = unpackFS ext
     supported = supportedLanguagesAndExtensions $ platformArchOS $ targetPlatform dflags
 
-languagePragParseError :: DynFlags -> SrcSpan -> a
-languagePragParseError dflags loc =
-    throwErr dflags loc $
+languagePragParseError :: SrcSpan -> a
+languagePragParseError loc =
+    throwErr loc $
        vcat [ text "Cannot parse LANGUAGE pragma"
             , text "Expecting comma-separated list of language options,"
             , text "each starting with a capital letter"
@@ -340,7 +340,7 @@ languagePragParseError dflags loc =
 
 unsupportedExtnError :: DynFlags -> SrcSpan -> String -> a
 unsupportedExtnError dflags loc unsup =
-    throwErr dflags loc $
+    throwErr loc $
         text "Unsupported extension: " <> text unsup $$
         if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)
   where
@@ -348,8 +348,8 @@ unsupportedExtnError dflags loc unsup =
      suggestions = fuzzyMatch unsup supported
 
 
-optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages
-optionsErrorMsgs dflags unhandled_flags flags_lines _filename
+optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages
+optionsErrorMsgs unhandled_flags flags_lines _filename
   = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))
   where unhandled_flags_lines :: [Located String]
         unhandled_flags_lines = [ L l f
@@ -357,17 +357,17 @@ optionsErrorMsgs dflags unhandled_flags flags_lines _filename
                                 , L l f' <- flags_lines
                                 , f == f' ]
         mkMsg (L flagSpan flag) =
-            GHC.Utils.Error.mkPlainErrMsg dflags flagSpan $
+            mkPlainErrMsg flagSpan $
                     text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+> text flag
 
-optionsParseError :: String -> DynFlags -> SrcSpan -> a     -- #15053
-optionsParseError str dflags loc =
-  throwErr dflags loc $
+optionsParseError :: String -> SrcSpan -> a     -- #15053
+optionsParseError str loc =
+  throwErr loc $
       vcat [ text "Error while parsing OPTIONS_GHC pragma."
            , text "Expecting whitespace-separated list of GHC options."
            , text "  E.g. {-# OPTIONS_GHC -Wall -O2 #-}"
            , text ("Input was: " ++ show str) ]
 
-throwErr :: DynFlags -> SrcSpan -> SDoc -> a                -- #15053
-throwErr dflags loc doc =
-  throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc doc
+throwErr :: SrcSpan -> SDoc -> a                -- #15053
+throwErr loc doc =
+  throw $ mkSrcErr $ unitBag $ mkPlainErrMsg loc doc
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 174055bd01..819740c341 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -208,7 +208,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax
     hsc_src = ms_hsc_src mod_sum
     dflags = hsc_dflags hsc_env
     home_unit = hsc_home_unit hsc_env
-    err_msg = mkPlainErrMsg dflags loc $
+    err_msg = mkPlainErrMsg loc $
               text "Module does not have a RealSrcSpan:" <+> ppr this_mod
 
     pair :: (Module, SrcSpan)
@@ -3119,5 +3119,5 @@ mark_plugin_unsafe dflags = unless (gopt Opt_PluginTrustworthy dflags) $
   recordUnsafeInfer pluginUnsafe
   where
     unsafeText = "Use of plugins makes the module unsafe"
-    pluginUnsafe = unitBag ( mkPlainWarnMsg dflags noSrcSpan
+    pluginUnsafe = unitBag ( mkPlainWarnMsg noSrcSpan
                                    (Outputable.text unsafeText) )
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 7056ba898b..48348ce7d7 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -994,21 +994,19 @@ discardWarnings thing_inside
 
 mkLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ErrMsg
 mkLongErrAt loc msg extra
-  = do { dflags <- getDynFlags ;
-         printer <- getPrintUnqualified ;
+  = do { printer <- getPrintUnqualified ;
          unit_state <- hsc_units <$> getTopEnv ;
          let msg' = pprWithUnitState unit_state msg in
-         return $ mkLongErrMsg dflags loc printer msg' extra }
+         return $ mkLongErrMsg loc printer msg' extra }
 
 mkErrDocAt :: SrcSpan -> ErrDoc -> TcRn ErrMsg
 mkErrDocAt loc errDoc
-  = do { dflags <- getDynFlags ;
-         printer <- getPrintUnqualified ;
+  = do { printer <- getPrintUnqualified ;
          unit_state <- hsc_units <$> getTopEnv ;
          let f = pprWithUnitState unit_state
              errDoc' = mapErrDoc f errDoc
          in
-         return $ mkErrDoc dflags loc printer errDoc' }
+         return $ mkErrDoc loc printer errDoc' }
 
 addLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
 addLongErrAt loc msg extra = mkLongErrAt loc msg extra >>= reportError
@@ -1515,9 +1513,8 @@ add_warn reason msg extra_info
 -- | Display a warning, with an optional flag, for a given location.
 add_warn_at :: WarnReason -> SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
 add_warn_at reason loc msg extra_info
-  = do { dflags <- getDynFlags ;
-         printer <- getPrintUnqualified ;
-         let { warn = mkLongWarnMsg dflags loc printer
+  = do { printer <- getPrintUnqualified ;
+         let { warn = mkLongWarnMsg loc printer
                                     msg extra_info } ;
          reportWarning reason warn }
 
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index cb624c6c99..6737edcda4 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -18,6 +18,14 @@ module GHC.Types.Error
    , getSeverityColour
    , getCaretDiagnostic
    , makeIntoWarning
+   -- * Constructing individual errors
+   , mkErrMsg
+   , mkPlainErrMsg
+   , mkErrDoc
+   , mkLongErrMsg
+   , mkWarnMsg
+   , mkPlainWarnMsg
+   , mkLongWarnMsg
    )
 where
 
@@ -41,14 +49,12 @@ type ErrorMessages   = Bag ErrMsg
 type MsgDoc          = SDoc
 type WarnMsg         = ErrMsg
 
-
+-- | The main 'GHC' error type.
 data ErrMsg = ErrMsg
    { errMsgSpan        :: SrcSpan
       -- ^ The SrcSpan is used for sorting errors into line-number order
    , errMsgContext     :: PrintUnqualified
    , errMsgDoc         :: ErrDoc
-   , errMsgShortString :: String
-      -- ^ This has the same text as errDocImportant . errMsgDoc.
    , errMsgSeverity    :: Severity
    , errMsgReason      :: WarnReason
    }
@@ -102,7 +108,12 @@ instance ToJson Severity where
   json s = JSString (show s)
 
 instance Show ErrMsg where
-    show em = errMsgShortString em
+    show = showErrMsg
+
+-- | Shows an 'ErrMsg'.
+showErrMsg :: ErrMsg -> String
+showErrMsg err =
+  renderWithContext defaultSDocContext (vcat (errDocImportant $ errMsgDoc err))
 
 pprMessageBag :: Bag MsgDoc -> SDoc
 pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))
@@ -238,3 +249,31 @@ makeIntoWarning reason err = err
     { errMsgSeverity = SevWarning
     , errMsgReason = reason }
 
+--
+-- Creating ErrMsg(s)
+--
+
+mk_err_msg :: Severity -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
+mk_err_msg sev locn print_unqual err
+ = ErrMsg { errMsgSpan = locn
+          , errMsgContext = print_unqual
+          , errMsgDoc = err
+          , errMsgSeverity = sev
+          , errMsgReason = NoReason }
+
+mkErrDoc :: SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
+mkErrDoc = mk_err_msg SevError
+
+mkLongErrMsg, mkLongWarnMsg   :: SrcSpan -> PrintUnqualified -> MsgDoc -> MsgDoc -> ErrMsg
+-- ^ A long (multi-line) error message
+mkErrMsg, mkWarnMsg           :: SrcSpan -> PrintUnqualified -> MsgDoc            -> ErrMsg
+-- ^ A short (one-line) error message
+mkPlainErrMsg, mkPlainWarnMsg :: SrcSpan ->                     MsgDoc            -> ErrMsg
+-- ^ Variant that doesn't care about qualified/unqualified names
+
+mkLongErrMsg   locn unqual msg extra = mk_err_msg SevError   locn unqual        (ErrDoc [msg] [] [extra])
+mkErrMsg       locn unqual msg       = mk_err_msg SevError   locn unqual        (ErrDoc [msg] [] [])
+mkPlainErrMsg  locn        msg       = mk_err_msg SevError   locn alwaysQualify (ErrDoc [msg] [] [])
+mkLongWarnMsg  locn unqual msg extra = mk_err_msg SevWarning locn unqual        (ErrDoc [msg] [] [extra])
+mkWarnMsg      locn unqual msg       = mk_err_msg SevWarning locn unqual        (ErrDoc [msg] [] [])
+mkPlainWarnMsg locn        msg       = mk_err_msg SevWarning locn alwaysQualify (ErrDoc [msg] [] [])
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index 1051a731c5..2c7edd30e9 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -21,12 +21,10 @@ module GHC.Utils.Error (
         Messages, ErrorMessages, WarningMessages,
         unionMessages,
         errorsFound, isEmptyMessages,
-        isWarnMsgFatal,
-        warningsToMessages,
 
         -- ** Formatting
         pprMessageBag, pprErrMsgBagWithLoc,
-        pprLocErrMsg, printBagOfErrors,
+        pprLocErrMsg,
         formatErrDoc,
 
         -- ** Construction
@@ -59,8 +57,7 @@ module GHC.Utils.Error (
         prettyPrintGhcErrors,
         traceCmd,
 
-        -- * Compilation errors and warnings
-        printOrThrowWarnings, handleFlagWarnings, shouldPrintWarning
+        sortMsgBag
     ) where
 
 #include "HsVersions.h"
@@ -69,13 +66,11 @@ import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Driver.Ppr
-import qualified GHC.Driver.CmdLine as CmdLine
 
 import GHC.Data.Bag
 import GHC.Utils.Exception
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
-import GHC.Types.SourceError
 import GHC.Types.Error
 import GHC.Types.SrcLoc as SrcLoc
 
@@ -125,32 +120,6 @@ orValid _       v = v
 -- -----------------------------------------------------------------------------
 -- Collecting up messages for later ordering and printing.
 
-mk_err_msg :: DynFlags -> Severity -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
-mk_err_msg dflags sev locn print_unqual doc
- = ErrMsg { errMsgSpan = locn
-          , errMsgContext = print_unqual
-          , errMsgDoc = doc
-          , errMsgShortString = showSDoc dflags (vcat (errDocImportant doc))
-          , errMsgSeverity = sev
-          , errMsgReason = NoReason }
-
-mkErrDoc :: DynFlags -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
-mkErrDoc dflags = mk_err_msg dflags SevError
-
-mkLongErrMsg, mkLongWarnMsg   :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc -> MsgDoc -> ErrMsg
--- ^ A long (multi-line) error message
-mkErrMsg, mkWarnMsg           :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc            -> ErrMsg
--- ^ A short (one-line) error message
-mkPlainErrMsg, mkPlainWarnMsg :: DynFlags -> SrcSpan ->                     MsgDoc            -> ErrMsg
--- ^ Variant that doesn't care about qualified/unqualified names
-
-mkLongErrMsg   dflags locn unqual msg extra = mk_err_msg dflags SevError   locn unqual        (ErrDoc [msg] [] [extra])
-mkErrMsg       dflags locn unqual msg       = mk_err_msg dflags SevError   locn unqual        (ErrDoc [msg] [] [])
-mkPlainErrMsg  dflags locn        msg       = mk_err_msg dflags SevError   locn alwaysQualify (ErrDoc [msg] [] [])
-mkLongWarnMsg  dflags locn unqual msg extra = mk_err_msg dflags SevWarning locn unqual        (ErrDoc [msg] [] [extra])
-mkWarnMsg      dflags locn unqual msg       = mk_err_msg dflags SevWarning locn unqual        (ErrDoc [msg] [] [])
-mkPlainWarnMsg dflags locn        msg       = mk_err_msg dflags SevWarning locn alwaysQualify (ErrDoc [msg] [] [])
-
 ----------------
 emptyMessages :: Messages
 emptyMessages = (emptyBag, emptyBag)
@@ -161,27 +130,6 @@ isEmptyMessages (warns, errs) = isEmptyBag warns && isEmptyBag errs
 errorsFound :: DynFlags -> Messages -> Bool
 errorsFound _dflags (_warns, errs) = not (isEmptyBag errs)
 
-warningsToMessages :: DynFlags -> WarningMessages -> Messages
-warningsToMessages dflags =
-  partitionBagWith $ \warn ->
-    case isWarnMsgFatal dflags warn of
-      Nothing -> Left warn
-      Just err_reason ->
-        Right warn{ errMsgSeverity = SevError
-                  , errMsgReason = ErrReason err_reason }
-
-printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
-printBagOfErrors dflags bag_of_errors
-  = sequence_ [ let style = mkErrStyle unqual
-                    ctx   = initSDocContext dflags style
-                in putLogMsg dflags reason sev s $ withPprStyle style (formatErrDoc ctx doc)
-              | ErrMsg { errMsgSpan      = s,
-                         errMsgDoc       = doc,
-                         errMsgSeverity  = sev,
-                         errMsgReason    = reason,
-                         errMsgContext   = unqual } <- sortMsgBag (Just dflags)
-                                                                  bag_of_errors ]
-
 formatErrDoc :: SDocContext -> ErrDoc -> SDoc
 formatErrDoc ctx (ErrDoc important context supplementary)
   = case msgs of
@@ -629,17 +577,6 @@ prettyPrintGhcErrors dflags
       where
          ctx = initSDocContext dflags defaultUserStyle
 
--- | Checks if given 'WarnMsg' is a fatal warning.
-isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)
-isWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}
-  = if wopt_fatal wflag dflags
-      then Just (Just wflag)
-      else Nothing
-isWarnMsgFatal dflags _
-  = if gopt Opt_WarnIsError dflags
-      then Just Nothing
-      else Nothing
-
 traceCmd :: DynFlags -> String -> String -> IO a -> IO a
 -- trace the command (at two levels of verbosity)
 traceCmd dflags phase_name cmd_line action
@@ -795,44 +732,3 @@ dumpAction dflags = dump_action dflags dflags
 -- | Helper for `trace_action`
 traceAction :: TraceAction
 traceAction dflags = trace_action dflags dflags
-
-handleFlagWarnings :: DynFlags -> [CmdLine.Warn] -> IO ()
-handleFlagWarnings dflags warns = do
-  let warns' = filter (shouldPrintWarning dflags . CmdLine.warnReason)  warns
-
-      -- It would be nicer if warns :: [Located MsgDoc], but that
-      -- has circular import problems.
-      bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
-                      | CmdLine.Warn _ (L loc warn) <- warns' ]
-
-  printOrThrowWarnings dflags bag
-
--- Given a warn reason, check to see if it's associated -W opt is enabled
-shouldPrintWarning :: DynFlags -> CmdLine.WarnReason -> Bool
-shouldPrintWarning dflags CmdLine.ReasonDeprecatedFlag
-  = wopt Opt_WarnDeprecatedFlags dflags
-shouldPrintWarning dflags CmdLine.ReasonUnrecognisedFlag
-  = wopt Opt_WarnUnrecognisedWarningFlags dflags
-shouldPrintWarning _ _
-  = True
-
-
--- | Given a bag of warnings, turn them into an exception if
--- -Werror is enabled, or print them out otherwise.
-printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
-printOrThrowWarnings dflags warns = do
-  let (make_error, warns') =
-        mapAccumBagL
-          (\make_err warn ->
-            case isWarnMsgFatal dflags warn of
-              Nothing ->
-                (make_err, warn)
-              Just err_reason ->
-                (True, warn{ errMsgSeverity = SevError
-                           , errMsgReason = ErrReason err_reason
-                           }))
-          False warns
-  if make_error
-    then throwIO (mkSrcErr warns')
-    else printBagOfErrors dflags warns
-
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 323940d925..b7a68d8ba4 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -385,6 +385,7 @@ Library
         GHC.Driver.Config
         GHC.Driver.Env
         GHC.Driver.Env.Types
+        GHC.Driver.Errors
         GHC.Driver.Flags
         GHC.Driver.Hooks
         GHC.Driver.Main
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 5beca7882d..f78faae40d 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -45,6 +45,7 @@ import GHC.Runtime.Interpreter.Types
 import GHCi.RemoteTypes
 import GHCi.BreakArray
 import GHC.ByteCode.Types
+import GHC.Driver.Errors
 import GHC.Driver.Phases
 import GHC.Driver.Session as DynFlags
 import GHC.Driver.Ppr hiding (printForUser)
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 1f9e0bdf2a..12acd5a479 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -21,6 +21,7 @@ import GHC              (parseTargetFiles,  Ghc, GhcMonad(..), Backend (..),
 
 import GHC.Driver.CmdLine
 import GHC.Driver.Env
+import GHC.Driver.Errors
 import GHC.Driver.Phases
 import GHC.Driver.Session hiding (WarnReason(..))
 import GHC.Driver.Ppr
diff --git a/testsuite/tests/ghc-api/T18522-dbg-ppr.hs b/testsuite/tests/ghc-api/T18522-dbg-ppr.hs
index f669bfbd6d..39da5f1292 100644
--- a/testsuite/tests/ghc-api/T18522-dbg-ppr.hs
+++ b/testsuite/tests/ghc-api/T18522-dbg-ppr.hs
@@ -13,6 +13,7 @@ import GHC.Tc.Utils.Zonk
 import GHC.Utils.Error
 import GHC.Driver.Ppr
 import GHC.Driver.Env
+import GHC.Driver.Errors
 import GHC
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout
index 332c15123f..90b5a3c4ab 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout
@@ -1,4 +1,4 @@
-Found 237 parser module dependencies
+Found 238 parser module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -81,6 +81,7 @@ GHC.Driver.Backpack.Syntax
 GHC.Driver.CmdLine
 GHC.Driver.Env
 GHC.Driver.Env.Types
+GHC.Driver.Errors
 GHC.Driver.Flags
 GHC.Driver.Hooks
 GHC.Driver.Monad
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index d889b90bc7..fee1302b8e 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -42,6 +42,7 @@ import GHC.Driver.Monad
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
+import GHC.Driver.Errors
 import GHC.Utils.Error
 import GHC.Utils.Outputable
 import GHC.Types.Basic