Remove a bunch of when (wopt ...)

This commit capitalises on the previous one by removing a bunch or
redundant `when (wopt ..)` calls.

17 files changed, 45 insertions, 68 deletions

diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index a433c2ab36..fe269e0f85 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -269,7 +269,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)) $
         whenIsJust warn $ logWarnings . unitBag
   where
     dflags = hsc_dflags hsc_env
@@ -390,7 +390,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)) $
       whenIsJust warn $ logWarnings . unitBag
 
     where
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 8600b52635..2906b52b60 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1049,8 +1049,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 467fec2f23..610bfa869e 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -393,12 +393,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
@@ -519,8 +517,7 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by =
 -- `Data.List.singleton` proposal. See #17244.
 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/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 53e3c4d19f..42bd81eabb 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/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 }