Introduce SevIgnore Severity to suppress warnings

This commit introduces a new `Severity` type constructor called
`SevIgnore`, which can be used to classify diagnostic messages which are
not meant to be displayed to the user, for example suppressed warnings.

This extra constructor allows us to get rid of a bunch of redundant
checks when emitting diagnostics, typically in the form of the pattern:

```
when (optM Opt_XXX) $
  addDiagnosticTc (WarningWithFlag Opt_XXX) ...
```

Fair warning! Not all checks should be omitted/skipped, as evaluating some data
structures used to produce a diagnostic might still be expensive (e.g.
zonking, etc). Therefore, a case-by-case analysis must be conducted when
deciding if a check can be removed or not.

Last but not least, we remove the unnecessary `CmdLine.WarnReason` type, which is now
redundant with `DiagnosticReason`.

26 files changed, 178 insertions, 172 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 4ba5e9b68a..134580c653 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -899,7 +899,7 @@ checkNewDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags
 checkNewDynFlags logger dflags = do
   -- See Note [DynFlags consistency]
   let (dflags', warnings) = makeDynFlagsConsistent dflags
-  liftIO $ handleFlagWarnings logger dflags (map (Warn NoReason) warnings)
+  liftIO $ handleFlagWarnings logger dflags (map (Warn WarningWithoutFlag) warnings)
   return dflags'
 
 checkNewInteractiveDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags
@@ -1949,4 +1949,3 @@ instance Exception GhcApiError
 
 mkApiErr :: DynFlags -> SDoc -> GhcApiError
 mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
-
diff --git a/compiler/GHC/Driver/CmdLine.hs b/compiler/GHC/Driver/CmdLine.hs
index 50d8276278..568e83e795 100644
--- a/compiler/GHC/Driver/CmdLine.hs
+++ b/compiler/GHC/Driver/CmdLine.hs
@@ -20,8 +20,7 @@ module GHC.Driver.CmdLine
 
       Err(..), Warn(..), WarnReason(..),
 
-      EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM,
-      deprecate
+      EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM
     ) where
 
 #include "HsVersions.h"
@@ -35,6 +34,8 @@ import GHC.Data.Bag
 import GHC.Types.SrcLoc
 import GHC.Utils.Json
 
+import GHC.Types.Error ( DiagnosticReason(..) )
+
 import Data.Function
 import Data.List (sortBy, intercalate, stripPrefix)
 
@@ -107,7 +108,7 @@ newtype Err  = Err { errMsg :: Located String }
 
 -- | A command-line warning message and the reason it arose
 data Warn = Warn
-  {   warnReason :: WarnReason,
+  {   warnReason :: DiagnosticReason,
       warnMsg    :: Located String
   }
 
@@ -141,17 +142,12 @@ addErr :: Monad m => String -> EwM m ()
 addErr e = EwM (\(L loc _) es ws -> return (es `snocBag` Err (L loc e), ws, ()))
 
 addWarn :: Monad m => String -> EwM m ()
-addWarn = addFlagWarn NoReason
+addWarn = addFlagWarn WarningWithoutFlag
 
-addFlagWarn :: Monad m => WarnReason -> String -> EwM m ()
+addFlagWarn :: Monad m => DiagnosticReason -> String -> EwM m ()
 addFlagWarn reason msg = EwM $
   (\(L loc _) es ws -> return (es, ws `snocBag` Warn reason (L loc msg), ()))
 
-deprecate :: Monad m => String -> EwM m ()
-deprecate s = do
-    arg <- getArg
-    addFlagWarn ReasonDeprecatedFlag (arg ++ " is deprecated: " ++ s)
-
 getArg :: Monad m => EwM m String
 getArg = EwM (\(L _ arg) es ws -> return (es, ws, arg))
 
diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs
index b6fdee5c9b..eafcfe73f3 100644
--- a/compiler/GHC/Driver/Errors.hs
+++ b/compiler/GHC/Driver/Errors.hs
@@ -36,23 +36,22 @@ printBagOfErrors logger dflags bag_of_errors
 
 handleFlagWarnings :: Logger -> DynFlags -> [CmdLine.Warn] -> IO ()
 handleFlagWarnings logger dflags warns = do
-  let warns' = filter (shouldPrintWarning dflags . CmdLine.warnReason)  warns
-
+  let warns' = filter (should_print_warning dflags . CmdLine.warnReason)  warns
       -- It would be nicer if warns :: [Located SDoc], but that
       -- has circular import problems.
       bag = listToBag [ mkPlainMsgEnvelope dflags WarningWithoutFlag loc (text warn)
                       | CmdLine.Warn _ (L loc warn) <- warns' ]
 
   printOrThrowDiagnostics logger 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
+  where
+    -- Given a warn reason, check to see if it's associated -W opt is enabled
+    should_print_warning :: DynFlags -> DiagnosticReason -> Bool
+    should_print_warning dflags (WarningWithFlag Opt_WarnDeprecatedFlags)
+      = wopt Opt_WarnDeprecatedFlags dflags
+    should_print_warning dflags (WarningWithFlag Opt_WarnUnrecognisedWarningFlags)
+      = wopt Opt_WarnUnrecognisedWarningFlags dflags
+    should_print_warning _ _
+      = True
 
 -- | Given a bag of diagnostics, turn them into an exception if
 -- any has 'SevError', or print them out otherwise.
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index b677f63681..484353ae4d 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -270,7 +270,7 @@ instantiationNodes unit_state = InstantiationNode <$> iuids_to_check
 -- The warning in enabled by `-Wmissing-home-modules`. See #13129
 warnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m ()
 warnMissingHomeModules hsc_env mod_graph =
-    when (wopt Opt_WarnMissingHomeModules dflags && not (null missing)) $
+    when (not (null missing)) $
         logWarnings (listToBag [warn])
   where
     dflags = hsc_dflags hsc_env
@@ -391,7 +391,7 @@ warnUnusedPackages = do
                    , text "but were not needed for compilation:"
                    , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs)) ]
 
-    when (wopt Opt_WarnUnusedPackages dflags && not (null unusedArgs)) $
+    when (not (null unusedArgs)) $
       logWarnings (listToBag [warn])
 
     where
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b3052978af..c1142137cc 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -235,7 +235,6 @@ import GHC.Settings.Config
 import GHC.Utils.CliOption
 import {-# SOURCE #-} GHC.Core.Unfold
 import GHC.Driver.CmdLine
-import qualified GHC.Driver.CmdLine as Cmd
 import GHC.Settings.Constants
 import GHC.Utils.Panic
 import qualified GHC.Utils.Ppr.Colour as Col
@@ -1869,7 +1868,7 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
 
   liftIO $ setUnsafeGlobalDynFlags dflags4
 
-  let warns' = map (Warn Cmd.NoReason) (consistency_warnings ++ sh_warns)
+  let warns' = map (Warn WarningWithoutFlag) (consistency_warnings ++ sh_warns)
 
   return (dflags4, leftover, warns' ++ warns)
 
@@ -2889,7 +2888,7 @@ unrecognisedWarning prefix = defHiddenFlag prefix (Prefix action)
     action :: String -> EwM (CmdLineP DynFlags) ()
     action flag = do
       f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState
-      when f $ addFlagWarn Cmd.ReasonUnrecognisedFlag $
+      when f $ addFlagWarn (WarningWithFlag Opt_WarnUnrecognisedWarningFlags) $
         "unrecognised warning flag: -" ++ prefix ++ flag
 
 -- See Note [Supporting CLI completion]
@@ -3050,6 +3049,12 @@ mkFlag turn_on flagPrefix f (dep, (FlagSpec name flag extra_action mode))
     = (dep,
        Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) mode)
 
+-- here to avoid module cycle with GHC.Driver.CmdLine
+deprecate :: Monad m => String -> EwM m ()
+deprecate s = do
+    arg <- getArg
+    addFlagWarn (WarningWithFlag Opt_WarnDeprecatedFlags) (arg ++ " is deprecated: " ++ s)
+
 deprecatedForExtension :: String -> TurnOnFlag -> String
 deprecatedForExtension lang turn_on
     = "use -X" ++ flag ++
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index c9dacae70d..a4bbc290e2 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -90,7 +90,6 @@ import GHC.Unit.Module.ModIface
 
 import Data.List (partition)
 import Data.IORef
-import Control.Monad( when )
 import GHC.Driver.Plugins ( LoadedPlugin(..) )
 
 {-
@@ -438,8 +437,7 @@ dsRule (L loc (HsRule { rd_name = name
         ; rule <- dsMkUserRule this_mod is_local
                          rule_name rule_act fn_name final_bndrs args
                          final_rhs
-        ; when (wopt Opt_WarnInlineRuleShadowing dflags) $
-          warnRuleShadowing rule_name rule_act fn_id arg_ids
+        ; warnRuleShadowing rule_name rule_act fn_id arg_ids
 
         ; return (Just rule)
         } } }
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 928db49ddc..7af84d1d06 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -767,8 +767,7 @@ dsMkUserRule :: Module -> Bool -> RuleName -> Activation
        -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> DsM CoreRule
 dsMkUserRule this_mod is_local name act fn bndrs args rhs = do
     let rule = mkRule this_mod False is_local name act fn bndrs args rhs
-    dflags <- getDynFlags
-    when (isOrphan (ru_orphan rule) && wopt Opt_WarnOrphans dflags) $
+    when (isOrphan (ru_orphan rule)) $
         diagnosticDs (WarningWithFlag Opt_WarnOrphans) (ruleOrphWarn rule)
     return rule
 
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index da2794f805..67b3d0d8c0 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1047,8 +1047,7 @@ lookup_demoted rdr_name
                     ; case mb_demoted_name of
                         Nothing -> unboundNameX WL_Any rdr_name star_info
                         Just demoted_name ->
-                          do { whenWOptM Opt_WarnUntickedPromotedConstructors $
-                               addDiagnostic
+                          do { addDiagnostic
                                  (WarningWithFlag Opt_WarnUntickedPromotedConstructors)
                                  (untickedPromConstrWarn demoted_name)
                              ; return demoted_name } }
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 07cc79fd17..fbdcc15730 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1648,8 +1648,7 @@ dataKindsErr env thing
 warnUnusedForAll :: OutputableBndrFlag flag 'Renamed
                  => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM ()
 warnUnusedForAll doc (L loc tv) used_names
-  = whenWOptM Opt_WarnUnusedForalls $
-    unless (hsTyVarName tv `elemNameSet` used_names) $
+  = unless (hsTyVarName tv `elemNameSet` used_names) $
     addDiagnosticAt (WarningWithFlag Opt_WarnUnusedForalls) (locA loc) $
     vcat [ text "Unused quantified type variable" <+> quotes (ppr tv)
          , inHsDocContext doc ]
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index b5c91c8cc3..d5a787f9ab 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1945,16 +1945,15 @@ warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
                  -> RnM ()
 warnNoDerivStrat mds loc
   = do { dyn_flags <- getDynFlags
-       ; when (wopt Opt_WarnMissingDerivingStrategies dyn_flags) $
-           case mds of
-             Nothing -> addDiagnosticAt
-               (WarningWithFlag Opt_WarnMissingDerivingStrategies)
-               loc
-               (if xopt LangExt.DerivingStrategies dyn_flags
-                 then no_strat_warning
-                 else no_strat_warning $+$ deriv_strat_nenabled
-               )
-             _ -> pure ()
+       ; case mds of
+           Nothing -> addDiagnosticAt
+             (WarningWithFlag Opt_WarnMissingDerivingStrategies)
+             loc
+             (if xopt LangExt.DerivingStrategies dyn_flags
+               then no_strat_warning
+               else no_strat_warning $+$ deriv_strat_nenabled
+             )
+           _ -> pure ()
        }
   where
     no_strat_warning :: SDoc
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index aa5019895f..0502d8d962 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -394,12 +394,10 @@ rnImportDecl this_mod
         imports = calculateAvails home_unit iface mod_safe' want_boot (ImportedByUser imv)
 
     -- Complain if we import a deprecated module
-    whenWOptM Opt_WarnWarningsDeprecations (
-       case (mi_warns iface) of
-          WarnAll txt -> addDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations)
-                                       (moduleWarn imp_mod_name txt)
-          _           -> return ()
-     )
+    case mi_warns iface of
+       WarnAll txt -> addDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations)
+                                    (moduleWarn imp_mod_name txt)
+       _           -> return ()
 
     -- Complain about -Wcompat-unqualified-imports violations.
     warnUnqualifiedImport decl iface
@@ -522,8 +520,7 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by =
 -- Currently not used for anything.
 warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
 warnUnqualifiedImport decl iface =
-    whenWOptM Opt_WarnCompatUnqualifiedImports
-    $ when bad_import
+    when bad_import
     $ addDiagnosticAt (WarningWithFlag Opt_WarnCompatUnqualifiedImports) loc warning
   where
     mod = mi_module iface
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index b41170014c..f3bab6c3fe 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -912,10 +912,9 @@ check_cross_stage_lifting top_lvl name ps_var
               pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
 
           -- Warning for implicit lift (#17804)
-        ; whenWOptM Opt_WarnImplicitLift $
-            addDiagnosticTc (WarningWithFlag Opt_WarnImplicitLift)
-                            (text "The variable" <+> quotes (ppr name) <+>
-                             text "is implicitly lifted in the TH quotation")
+        ; addDiagnosticTc (WarningWithFlag Opt_WarnImplicitLift)
+                          (text "The variable" <+> quotes (ppr name) <+>
+                           text "is implicitly lifted in the TH quotation")
 
           -- Update the pending splices
         ; ps <- readMutVar ps_var
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 198bfa2477..40761ed38c 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -738,10 +738,9 @@ tcStandaloneDerivInstType ctxt
 
 warnUselessTypeable :: TcM ()
 warnUselessTypeable
-  = do { warn <- woptM Opt_WarnDerivingTypeable
-       ; when warn $ addDiagnosticTc (WarningWithFlag Opt_WarnDerivingTypeable)
-                   $ text "Deriving" <+> quotes (ppr typeableClassName) <+>
-                     text "has no effect: all types now auto-derive Typeable" }
+  = do { addDiagnosticTc (WarningWithFlag Opt_WarnDerivingTypeable)
+       $ text "Deriving" <+> quotes (ppr typeableClassName) <+>
+         text "has no effect: all types now auto-derive Typeable" }
 
 ------------------------------------------------------------------
 deriveTyData :: TyCon -> [Type] -- LHS of data or data instance
@@ -1610,8 +1609,7 @@ mkNewTypeEqn newtype_strat dit@(DerivInstTys { dit_cls_tys     = cls_tys
                  -- DeriveAnyClass, but emitting a warning about the choice.
                  -- See Note [Deriving strategies]
                  when (newtype_deriving && deriveAnyClass) $
-                   lift $ whenWOptM Opt_WarnDerivingDefaults $
-                     addDiagnosticTc (WarningWithFlag Opt_WarnDerivingDefaults) $ sep
+                   lift $ addDiagnosticTc (WarningWithFlag Opt_WarnDerivingDefaults) $ sep
                      [ text "Both DeriveAnyClass and"
                        <+> text "GeneralizedNewtypeDeriving are enabled"
                      , text "Defaulting to the DeriveAnyClass strategy"
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index abb58cd58b..dda7c0eeac 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -50,7 +50,7 @@ import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Name.Set
 import GHC.Data.Bag
-import GHC.Utils.Error  ( pprLocMsgEnvelope )
+import GHC.Utils.Error  (diagReasonSeverity,  pprLocMsgEnvelope )
 import GHC.Types.Basic
 import GHC.Types.Error
 import GHC.Core.ConLike ( ConLike(..))
@@ -66,10 +66,9 @@ import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Utils.FV ( fvVarList, unionFV )
 
-import Control.Monad    ( unless,  when )
+import Control.Monad    ( unless,  when, forM_ )
 import Data.Foldable    ( toList )
 import Data.List        ( partition, mapAccumL, sortBy, unfoldr )
-import Data.Traversable ( for )
 
 import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )
 
@@ -132,34 +131,24 @@ reportUnsolved :: WantedConstraints -> TcM (Bag EvBind)
 reportUnsolved wanted
   = do { binds_var <- newTcEvBinds
        ; defer_errors <- goptM Opt_DeferTypeErrors
-       ; warn_errors <- woptM Opt_WarnDeferredTypeErrors -- implement #10283
-       ; let type_errors | not defer_errors = Just ErrorWithoutFlag
-                         | warn_errors      = Just (WarningWithFlag Opt_WarnDeferredTypeErrors)
-                         | otherwise        = Nothing
+       ; let type_errors | not defer_errors = ErrorWithoutFlag
+                         | otherwise        = WarningWithFlag Opt_WarnDeferredTypeErrors
 
        ; defer_holes <- goptM Opt_DeferTypedHoles
-       ; warn_holes  <- woptM Opt_WarnTypedHoles
-       ; let expr_holes | not defer_holes = Just ErrorWithoutFlag
-                        | warn_holes      = Just (WarningWithFlag Opt_WarnTypedHoles)
-                        | otherwise       = Nothing
+       ; let expr_holes | not defer_holes = ErrorWithoutFlag
+                        | otherwise       = WarningWithFlag Opt_WarnTypedHoles
 
        ; partial_sigs      <- xoptM LangExt.PartialTypeSignatures
-       ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures
        ; let type_holes | not partial_sigs
-                        = Just ErrorWithoutFlag
-                        | warn_partial_sigs
-                        = Just (WarningWithFlag Opt_WarnPartialTypeSignatures)
+                        = ErrorWithoutFlag
                         | otherwise
-                        = Nothing
+                        = WarningWithFlag Opt_WarnPartialTypeSignatures
 
        ; defer_out_of_scope <- goptM Opt_DeferOutOfScopeVariables
-       ; warn_out_of_scope <- woptM Opt_WarnDeferredOutOfScopeVariables
        ; let out_of_scope_holes | not defer_out_of_scope
-                                = Just ErrorWithoutFlag
-                                | warn_out_of_scope
-                                = Just (WarningWithFlag Opt_WarnDeferredOutOfScopeVariables)
+                                = ErrorWithoutFlag
                                 | otherwise
-                                = Nothing
+                                = WarningWithFlag Opt_WarnDeferredOutOfScopeVariables
 
        ; report_unsolved type_errors expr_holes
                          type_holes out_of_scope_holes
@@ -180,13 +169,11 @@ reportAllUnsolved wanted
   = do { ev_binds <- newNoTcEvBinds
 
        ; partial_sigs      <- xoptM LangExt.PartialTypeSignatures
-       ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures
-       ; let type_holes | not partial_sigs  = Just ErrorWithoutFlag
-                        | warn_partial_sigs = Just (WarningWithFlag Opt_WarnPartialTypeSignatures)
-                        | otherwise         = Nothing
+       ; let type_holes | not partial_sigs  = ErrorWithoutFlag
+                        | otherwise         = WarningWithFlag Opt_WarnPartialTypeSignatures
 
-       ; report_unsolved (Just ErrorWithoutFlag)
-                         (Just ErrorWithoutFlag) type_holes (Just ErrorWithoutFlag)
+       ; report_unsolved ErrorWithoutFlag
+                         ErrorWithoutFlag type_holes ErrorWithoutFlag
                          ev_binds wanted }
 
 -- | Report all unsolved goals as warnings (but without deferring any errors to
@@ -195,17 +182,17 @@ reportAllUnsolved wanted
 warnAllUnsolved :: WantedConstraints -> TcM ()
 warnAllUnsolved wanted
   = do { ev_binds <- newTcEvBinds
-       ; report_unsolved (Just WarningWithoutFlag)
-                         (Just WarningWithoutFlag)
-                         (Just WarningWithoutFlag)
-                         (Just WarningWithoutFlag)
+       ; report_unsolved WarningWithoutFlag
+                         WarningWithoutFlag
+                         WarningWithoutFlag
+                         WarningWithoutFlag
                          ev_binds wanted }
 
 -- | Report unsolved goals as errors or warnings.
-report_unsolved :: Maybe DiagnosticReason -- Deferred type errors
-                -> Maybe DiagnosticReason -- Expression holes
-                -> Maybe DiagnosticReason -- Type holes
-                -> Maybe DiagnosticReason -- Out of scope holes
+report_unsolved :: DiagnosticReason -- Deferred type errors
+                -> DiagnosticReason -- Expression holes
+                -> DiagnosticReason -- Type holes
+                -> DiagnosticReason -- Out of scope holes
                 -> EvBindsVar        -- cec_binds
                 -> WantedConstraints -> TcM ()
 report_unsolved type_errors expr_holes
@@ -320,15 +307,15 @@ data ReportErrCtxt
                                        -- into warnings, and emit evidence bindings
                                        -- into 'cec_binds' for unsolved constraints
 
-          , cec_defer_type_errors :: Maybe DiagnosticReason -- Nothing: Defer type errors until runtime
+          , cec_defer_type_errors :: DiagnosticReason -- Defer type errors until runtime
 
           -- cec_expr_holes is a union of:
           --   cec_type_holes - a set of typed holes: '_', '_a', '_foo'
           --   cec_out_of_scope_holes - a set of variables which are
           --                            out of scope: 'x', 'y', 'bar'
-          , cec_expr_holes :: Maybe DiagnosticReason -- Holes in expressions. Nothing: defer/suppress errors.
-          , cec_type_holes :: Maybe DiagnosticReason -- Holes in types. Nothing: defer/suppress errors.
-          , cec_out_of_scope_holes :: Maybe DiagnosticReason -- Out of scope holes. Nothing: defer/suppress errors.
+          , cec_expr_holes :: DiagnosticReason -- Holes in expressions.
+          , cec_type_holes :: DiagnosticReason -- Holes in types.
+          , cec_out_of_scope_holes :: DiagnosticReason -- Out of scope holes.
 
           , cec_warn_redundant :: Bool    -- True <=> -Wredundant-constraints
           , cec_expand_syns    :: Bool    -- True <=> -fprint-expanded-synonyms
@@ -361,19 +348,19 @@ instance Outputable ReportErrCtxt where
 -- | Returns True <=> the ReportErrCtxt indicates that something is deferred
 deferringAnyBindings :: ReportErrCtxt -> Bool
   -- Don't check cec_type_holes, as these don't cause bindings to be deferred
-deferringAnyBindings (CEC { cec_defer_type_errors  = Just ErrorWithoutFlag
-                          , cec_expr_holes         = Just ErrorWithoutFlag
-                          , cec_out_of_scope_holes = Just ErrorWithoutFlag }) = False
-deferringAnyBindings _                                                 = True
+deferringAnyBindings (CEC { cec_defer_type_errors  = ErrorWithoutFlag
+                          , cec_expr_holes         = ErrorWithoutFlag
+                          , cec_out_of_scope_holes = ErrorWithoutFlag }) = False
+deferringAnyBindings _                                                   = True
 
 maybeSwitchOffDefer :: EvBindsVar -> ReportErrCtxt -> ReportErrCtxt
 -- Switch off defer-type-errors inside CoEvBindsVar
 -- See Note [Failing equalities with no evidence bindings]
 maybeSwitchOffDefer evb ctxt
  | CoEvBindsVar{} <- evb
- = ctxt { cec_defer_type_errors  = Just ErrorWithoutFlag
-        , cec_expr_holes         = Just ErrorWithoutFlag
-        , cec_out_of_scope_holes = Just ErrorWithoutFlag }
+ = ctxt { cec_defer_type_errors  = ErrorWithoutFlag
+        , cec_expr_holes         = ErrorWithoutFlag
+        , cec_out_of_scope_holes = ErrorWithoutFlag }
  | otherwise
  = ctxt
 
@@ -727,22 +714,22 @@ mkSkolReporter ctxt cts
 
 reportHoles :: [Ct]  -- other (tidied) constraints
             -> ReportErrCtxt -> [Hole] -> TcM ()
-reportHoles tidy_cts ctxt
-  = mapM_ $ \hole -> unless (ignoreThisHole ctxt hole) $
-                     do { msg_mb <- mkHoleError tidy_cts ctxt hole
-                        ; whenIsJust msg_mb reportDiagnostic }
+reportHoles tidy_cts ctxt holes
+  = do df <- getDynFlags
+       forM_ holes $ \hole -> unless (ignoreThisHole df ctxt hole) $
+          mkHoleError tidy_cts ctxt hole >>= reportDiagnostic
 
-ignoreThisHole :: ReportErrCtxt -> Hole -> Bool
+ignoreThisHole :: DynFlags -> ReportErrCtxt -> Hole -> Bool
 -- See Note [Skip type holes rapidly]
-ignoreThisHole ctxt hole
+ignoreThisHole df ctxt hole
   = case hole_sort hole of
        ExprHole {}    -> False
        TypeHole       -> ignore_type_hole
        ConstraintHole -> ignore_type_hole
   where
-    ignore_type_hole = case cec_type_holes ctxt of
-                         Nothing -> True
-                         _       -> False
+    ignore_type_hole = case diagReasonSeverity df (cec_type_holes ctxt) of
+                         SevIgnore -> True
+                         _         -> False
 
 {- Note [Skip type holes rapidly]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -894,14 +881,11 @@ suppressGroup mk_err ctxt cts
 
 maybeReportError :: ReportErrCtxt -> Ct -> Report -> TcM ()
 maybeReportError ctxt ct report
-  | Just reason <- cec_defer_type_errors ctxt
   = unless (cec_suppress ctxt) $ -- Some worse error has occurred, so suppress this diagnostic
-    do msg <- mkErrorReport reason ctxt (ctLocEnv (ctLoc ct)) report
+    do let reason = cec_defer_type_errors ctxt
+       msg <- mkErrorReport reason ctxt (ctLocEnv (ctLoc ct)) report
        reportDiagnostic msg
 
-  | otherwise
-  = return ()  -- nothing to report
-
 addDeferredBinding :: ReportErrCtxt -> Report -> Ct -> TcM ()
 -- See Note [Deferring coercion errors to runtime]
 addDeferredBinding ctxt err ct
@@ -1164,7 +1148,7 @@ See also 'reportUnsolved'.
 
 ----------------
 -- | Constructs a new hole error, unless this is deferred. See Note [Constructing Hole Errors].
-mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (Maybe (MsgEnvelope DiagnosticMessage))
+mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope DiagnosticMessage)
 mkHoleError _tidy_simples ctxt hole@(Hole { hole_occ = occ
                                            , hole_ty = hole_ty
                                            , hole_loc = ct_loc })
@@ -1180,8 +1164,7 @@ mkHoleError _tidy_simples ctxt hole@(Hole { hole_occ = occ
                        (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ))
 
        ; maybeAddDeferredBindings ctxt hole err
-       ; for (cec_out_of_scope_holes ctxt) $ \ rea ->
-           mkErrorReportNC rea lcl_env err
+       ; mkErrorReportNC (cec_out_of_scope_holes ctxt) lcl_env err
            -- Use NC variant: the context is generally not helpful here
        }
   where
@@ -1223,7 +1206,7 @@ mkHoleError tidy_simples ctxt hole@(Hole { hole_occ = occ
 
        ; let holes | ExprHole _ <- sort = cec_expr_holes ctxt
                    | otherwise          = cec_type_holes ctxt
-       ; for holes $ \ rea -> mkErrorReport rea ctxt lcl_env err
+       ; mkErrorReport holes ctxt lcl_env err
        }
 
   where
@@ -1260,7 +1243,7 @@ mkHoleError tidy_simples ctxt hole@(Hole { hole_occ = occ
                       -- hole, via kind casts
 
     type_hole_hint
-         | Just ErrorWithoutFlag <- cec_type_holes ctxt
+         | ErrorWithoutFlag <- cec_type_holes ctxt
          = text "To use the inferred type, enable PartialTypeSignatures"
          | otherwise
          = empty
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 228c3d3644..10294998c0 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -801,9 +801,7 @@ mkExport prag_fn insoluble qtvs theta
                   else addErrCtxtM (mk_impedance_match_msg mono_info sel_poly_ty poly_ty) $
                        tcSubTypeSigma sig_ctxt sel_poly_ty poly_ty
 
-        ; warn_missing_sigs <- woptM Opt_WarnMissingLocalSignatures
-        ; when warn_missing_sigs $
-              localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig
+        ; localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig
 
         ; return (ABE { abe_ext = noExtField
                       , abe_wrap = wrap
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 552b010994..a874e04fd7 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -236,9 +236,8 @@ exports_from_avail Nothing rdr_env _imports _this_mod
    -- so that's how we handle it, except we also export the data family
    -- when a data instance is exported.
   = do {
-    ; warnMissingExportList <- woptM Opt_WarnMissingExportList
     ; warnIfFlag Opt_WarnMissingExportList
-        warnMissingExportList
+        True
         (missingModuleExportWarn $ moduleName _this_mod)
     ; let avails =
             map fix_faminst . gresToAvailInfo
@@ -393,12 +392,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
              let gres = findChildren kids_env name
                  (non_flds, flds) = classifyGREs gres
              addUsedKids (ieWrappedName rdr) gres
-             warnDodgyExports <- woptM Opt_WarnDodgyExports
              when (null gres) $
                   if isTyConName name
-                  then when warnDodgyExports $
-                           addDiagnostic (WarningWithFlag Opt_WarnDodgyExports)
-                                         (dodgyExportWarn name)
+                  then addDiagnostic (WarningWithFlag Opt_WarnDodgyExports)
+                                     (dodgyExportWarn name)
                   else -- This occurs when you export T(..), but
                        -- only import T abstractly, or T is a synonym.
                        addErr (exportItemErr ie)
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 662a418116..ecd07c6059 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -1409,8 +1409,7 @@ checkMissingFields con_like rbinds arg_tys
         -- Illegal if any arg is strict
         addErrTc (missingStrictFields con_like [])
     else do
-        warn <- woptM Opt_WarnMissingFields
-        when (warn && notNull field_strs && null field_labels)
+        when (notNull field_strs && null field_labels)
              (diagnosticTc (WarningWithFlag Opt_WarnMissingFields) True
                            (missingFields con_like []))
 
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index d823cdbafb..57b99e703a 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -324,7 +324,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       dflags <- getDynFlags
       checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
       checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
-      checkMissingAmpersand dflags (map scaledThing arg_tys) res_ty
+      checkMissingAmpersand (map scaledThing arg_tys) res_ty
       case target of
           StaticTarget _ _ _ False
            | not (null arg_tys) ->
@@ -343,10 +343,9 @@ checkCTarget (StaticTarget _ str _ _) = do
 checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
 
 
-checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()
-checkMissingAmpersand dflags arg_tys res_ty
-  | null arg_tys && isFunPtrTy res_ty &&
-    wopt Opt_WarnDodgyForeignImports dflags
+checkMissingAmpersand :: [Type] -> Type -> TcM ()
+checkMissingAmpersand arg_tys res_ty
+  | null arg_tys && isFunPtrTy res_ty
   = addDiagnosticTc (WarningWithFlag Opt_WarnDodgyForeignImports)
                     (text "possible missing & in foreign import of FunPtr")
   | otherwise
@@ -534,9 +533,8 @@ checkCConv StdCallConv  = do dflags <- getDynFlags
                              if platformArch platform == ArchX86
                                  then return StdCallConv
                                  else do -- This is a warning, not an error. see #3336
-                                         when (wopt Opt_WarnUnsupportedCallingConventions dflags) $
-                                             addDiagnosticTc (WarningWithFlag Opt_WarnUnsupportedCallingConventions)
-                                                 (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
+                                         addDiagnosticTc (WarningWithFlag Opt_WarnUnsupportedCallingConventions)
+                                           (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
                                          return CCallConv
 checkCConv PrimCallConv = do addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
                              return PrimCallConv
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 0f1859ab55..85fd9d51f4 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -1114,10 +1114,9 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q))
                                        [getRuntimeRep id_ty, id_ty]
 
                    -- Warning for implicit lift (#17804)
-        ; whenWOptM Opt_WarnImplicitLift $
-            addDiagnosticTc (WarningWithFlag Opt_WarnImplicitLift)
-                            (text "The variable" <+> quotes (ppr id) <+>
-                             text "is implicitly lifted in the TH quotation")
+        ; addDiagnosticTc (WarningWithFlag Opt_WarnImplicitLift)
+                          (text "The variable" <+> quotes (ppr id) <+>
+                           text "is implicitly lifted in the TH quotation")
 
                    -- Update the pending splices
         ; ps <- readMutVar ps_var
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 0883ba1c8b..e906dd267f 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -258,9 +258,8 @@ tcRnModuleTcRnM hsc_env mod_sum
         ; let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
                                implicit_prelude import_decls }
 
-        ; whenWOptM Opt_WarnImplicitPrelude $
-             when (notNull prel_imports) $
-                addDiagnostic (WarningWithFlag Opt_WarnImplicitPrelude) (implicitPreludeWarn)
+        ; when (notNull prel_imports) $
+            addDiagnostic (WarningWithFlag Opt_WarnImplicitPrelude) (implicitPreludeWarn)
 
         ; -- TODO This is a little skeevy; maybe handle a bit more directly
           let { simplifyImport (L _ idecl) =
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index b4efeaabdd..d4e9003b72 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -1344,8 +1344,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates
              mono_tvs = mono_tvs2 `unionVarSet` constrained_tvs
 
            -- Warn about the monomorphism restriction
-       ; warn_mono <- woptM Opt_WarnMonomorphism
-       ; when (case infer_mode of { ApplyMR -> warn_mono; _ -> False}) $
+       ; when (case infer_mode of { ApplyMR -> True; _ -> False}) $
          diagnosticTc (WarningWithFlag Opt_WarnMonomorphism)
                       (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus)
                       mr_msg
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index a8f6cbbc19..bddb585a51 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -1507,9 +1507,8 @@ failIfTcM True  err = failWithTcM err
 --   and the warning is enabled
 warnIfFlag :: WarningFlag -> Bool -> SDoc -> TcRn ()
 warnIfFlag warn_flag is_bad msg
-  = do { warn_on <- woptM warn_flag
-       ; when (warn_on && is_bad) $
-         addDiagnostic (WarningWithFlag warn_flag) msg }
+  = do { -- No need to check the flag here, it will be done in 'diagReasonSeverity'.
+       ; when is_bad $ addDiagnostic (WarningWithFlag warn_flag) msg }
 
 -- | Display a warning if a condition is met.
 warnIf :: Bool -> SDoc -> TcRn ()
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 610c31789c..173a8e68cf 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -1103,7 +1103,7 @@ check_valid_theta _ _ _ []
 check_valid_theta env ctxt expand theta
   = do { dflags <- getDynFlags
        ; diagnosticTcM (WarningWithFlag Opt_WarnDuplicateConstraints)
-                       (wopt Opt_WarnDuplicateConstraints dflags && notNull dups)
+                       (notNull dups)
                        (dupPredWarn env dups)
        ; traceTc "check_valid_theta" (ppr theta)
        ; mapM_ (check_pred_ty env dflags ctxt expand) theta }
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index 48cb9eaedd..bf5481cc2c 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -90,12 +90,30 @@ mkMessages = Messages
 isEmptyMessages :: Messages e -> Bool
 isEmptyMessages (Messages msgs) = isEmptyBag msgs
 
+{- Note [Discarding Messages]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Discarding a 'SevIgnore' message from 'addMessage' and 'unionMessages' is
+just an optimisation, as GHC would /also/ suppress any diagnostic which severity is
+'SevIgnore' before printing the message: See for example 'putLogMsg' and 'defaultLogAction'.
+
+-}
+
+-- | Adds a 'Message' to the input collection of messages.
+-- See Note [Discarding Messages].
 addMessage :: MsgEnvelope e -> Messages e -> Messages e
-addMessage x (Messages xs) = Messages (x `consBag` xs)
+addMessage x (Messages xs)
+  | SevIgnore <- errMsgSeverity x = Messages xs
+  | otherwise                     = Messages (x `consBag` xs)
 
 -- | Joins two collections of messages together.
+-- See Note [Discarding Messages].
 unionMessages :: Messages e -> Messages e -> Messages e
-unionMessages (Messages msgs1) (Messages msgs2) = Messages (msgs1 `unionBags` msgs2)
+unionMessages (Messages msgs1) (Messages msgs2) =
+  Messages (filterBag interesting $ msgs1 `unionBags` msgs2)
+  where
+    interesting :: MsgEnvelope e -> Bool
+    interesting = (/=) SevIgnore . errMsgSeverity
 
 type WarningMessages = Bag (MsgEnvelope DiagnosticMessage)
 type ErrorMessages   = Bag (MsgEnvelope DiagnosticMessage)
@@ -230,19 +248,45 @@ data MessageClass
     -- /especially/ when emitting compiler diagnostics, use the smart constructor.
   deriving (Eq, Show)
 
+{- Note [Suppressing Messages]
+
+The 'SevIgnore' constructor is used to generate messages for diagnostics which are
+meant to be suppressed and not reported to the user: the classic example are warnings
+for which the user didn't enable the corresponding 'WarningFlag', so GHC shouldn't print them.
+
+A different approach would be to extend the zoo of 'mkMsgEnvelope' functions to return
+a 'Maybe (MsgEnvelope e)', so that we won't need to even create the message to begin with.
+Both approaches have been evaluated, but we settled on the "SevIgnore one" for a number of reasons:
+
+* It's less invasive to deal with;
+* It plays slightly better with deferred diagnostics (see 'GHC.Tc.Errors') as for those we need
+  to be able to /always/ produce a message (so that is reported at runtime);
+* It gives us more freedom: we can still decide to drop a 'SevIgnore' message at leisure, or we can
+  decide to keep it around until the last moment. Maybe in the future we would need to
+  turn a 'SevIgnore' into something else, for example to "unsuppress" diagnostics if a flag is
+  set: with this approach, we have more leeway to accommodate new features.
+
+-}
+
 
 -- | Used to describe warnings and errors
 --   o The message has a file\/line\/column heading,
 --     plus "warning:" or "error:",
 --     added by mkLocMessage
+--   o With 'SevIgnore' the message is suppressed
 --   o Output is intended for end users
 data Severity
-  = SevWarning
+  = SevIgnore
+  -- ^ Ignore this message, for example in
+  -- case of suppression of warnings users
+  -- don't want to see. See Note [Suppressing Messages]
+  | SevWarning
   | SevError
   deriving (Eq, Show)
 
 instance Outputable Severity where
   ppr = \case
+    SevIgnore  -> text "SevIgnore"
     SevWarning -> text "SevWarning"
     SevError   -> text "SevError"
 
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index 2ee1763ebb..d18791d0c6 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -87,7 +87,8 @@ import System.CPUTime
 -- particular diagnostic message is built, otherwise the computed 'Severity' might
 -- not be correct, due to the mutable nature of the 'DynFlags' in GHC.
 diagReasonSeverity :: DynFlags -> DiagnosticReason -> Severity
-diagReasonSeverity dflags (WarningWithFlag wflag) | wopt_fatal wflag dflags     = SevError
+diagReasonSeverity dflags (WarningWithFlag wflag) | not (wopt wflag dflags)     = SevIgnore
+                                                  | wopt_fatal wflag dflags     = SevError
                                                   | otherwise                   = SevWarning
 diagReasonSeverity dflags WarningWithoutFlag      | gopt Opt_WarnIsError dflags = SevError
                                                   | otherwise                   = SevWarning
diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs
index fbbacb2b48..2e5a9b06a7 100644
--- a/compiler/GHC/Utils/Logger.hs
+++ b/compiler/GHC/Utils/Logger.hs
@@ -198,6 +198,7 @@ makeThreadSafe logger = do
 -- See Note [JSON Error Messages]
 --
 jsonLogAction :: LogAction
+jsonLogAction _ (MCDiagnostic SevIgnore _) _ _ = return () -- suppress the message
 jsonLogAction dflags msg_class srcSpan msg
   =
     defaultLogActionHPutStrDoc dflags True stdout
@@ -214,12 +215,13 @@ defaultLogAction :: LogAction
 defaultLogAction dflags msg_class srcSpan msg
   | dopt Opt_D_dump_json dflags = jsonLogAction dflags msg_class srcSpan msg
   | otherwise = case msg_class of
-      MCOutput             -> printOut msg
-      MCDump               -> printOut (msg $$ blankLine)
-      MCInteractive        -> putStrSDoc msg
-      MCInfo               -> printErrs msg
-      MCFatal              -> printErrs msg
-      MCDiagnostic sev rea -> printDiagnostics sev rea
+      MCOutput                 -> printOut msg
+      MCDump                   -> printOut (msg $$ blankLine)
+      MCInteractive            -> putStrSDoc msg
+      MCInfo                   -> printErrs msg
+      MCFatal                  -> printErrs msg
+      MCDiagnostic SevIgnore _ -> pure () -- suppress the message
+      MCDiagnostic sev rea     -> printDiagnostics sev rea
     where
       printOut   = defaultLogActionHPrintDoc  dflags False stdout
       printErrs  = defaultLogActionHPrintDoc  dflags False stderr
@@ -242,6 +244,7 @@ defaultLogAction dflags msg_class srcSpan msg
         -- each unicode char.
 
       flagMsg :: Severity -> DiagnosticReason -> Maybe String
+      flagMsg SevIgnore _                 =  panic "Called flagMsg with SevIgnore"
       flagMsg SevError WarningWithoutFlag =  Just "-Werror"
       flagMsg SevError (WarningWithFlag wflag) = do
         spec <- flagSpecOf wflag