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

8 files changed, 152 insertions, 59 deletions

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)