summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r--compiler/GHC/Rename/Bind.hs4
-rw-r--r--compiler/GHC/Rename/Env.hs8
-rw-r--r--compiler/GHC/Rename/HsType.hs2
-rw-r--r--compiler/GHC/Rename/Module.hs8
-rw-r--r--compiler/GHC/Rename/Names.hs26
-rw-r--r--compiler/GHC/Rename/Splice.hs6
-rw-r--r--compiler/GHC/Rename/Utils.hs12
7 files changed, 33 insertions, 33 deletions
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 23f201f120..a37f88bc83 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -489,7 +489,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat
-- See Note [Pattern bindings that bind no variables]
; whenWOptM Opt_WarnUnusedPatternBinds $
when (null bndrs && not ok_nobind_pat) $
- addWarn (Reason Opt_WarnUnusedPatternBinds) $
+ addDiagnostic (WarningWithFlag Opt_WarnUnusedPatternBinds) $
unusedPatBindWarn bind'
; fvs' `seq` -- See Note [Free-variable space leak]
@@ -1249,7 +1249,7 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs)
rnBody rhs
; unless (pattern_guards_allowed || is_standard_guard guards')
- (addWarn NoReason (nonStdGuardErr guards'))
+ (addDiagnostic WarningWithoutFlag (nonStdGuardErr guards'))
; return (GRHS noAnn guards' rhs', fvs) }
where
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 893e4ed60b..da2794f805 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1048,8 +1048,8 @@ lookup_demoted rdr_name
Nothing -> unboundNameX WL_Any rdr_name star_info
Just demoted_name ->
do { whenWOptM Opt_WarnUntickedPromotedConstructors $
- addWarn
- (Reason Opt_WarnUntickedPromotedConstructors)
+ addDiagnostic
+ (WarningWithFlag Opt_WarnUntickedPromotedConstructors)
(untickedPromConstrWarn demoted_name)
; return demoted_name } }
else do { -- We need to check if a data constructor of this name is
@@ -1523,8 +1523,8 @@ warnIfDeprecated gre@(GRE { gre_imp = iss })
-- See Note [Handling of deprecations]
do { iface <- loadInterfaceForName doc name
; case lookupImpDeprec iface gre of
- Just txt -> addWarn (Reason Opt_WarnWarningsDeprecations)
- (mk_msg imp_spec txt)
+ Just txt -> addDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations)
+ (mk_msg imp_spec txt)
Nothing -> return () } }
| otherwise
= return ()
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index a7f28b69cc..07cc79fd17 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1650,7 +1650,7 @@ warnUnusedForAll :: OutputableBndrFlag flag 'Renamed
warnUnusedForAll doc (L loc tv) used_names
= whenWOptM Opt_WarnUnusedForalls $
unless (hsTyVarName tv `elemNameSet` used_names) $
- addWarnAt (Reason Opt_WarnUnusedForalls) (locA loc) $
+ 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 00482b7c93..b5c91c8cc3 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -538,7 +538,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
-- got "lhs = rhs" but expected something different
addWarnNonCanonicalMethod1 refURL flag lhs rhs =
- addWarn (Reason flag) $ vcat
+ addDiagnostic (WarningWithFlag flag) $ vcat
[ text "Noncanonical" <+>
quotes (text (lhs ++ " = " ++ rhs)) <+>
text "definition detected"
@@ -552,7 +552,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
-- expected "lhs = rhs" but got something else
addWarnNonCanonicalMethod2 refURL flag lhs rhs =
- addWarn (Reason flag) $ vcat
+ addDiagnostic (WarningWithFlag flag) $ vcat
[ text "Noncanonical" <+>
quotes (text lhs) <+>
text "definition detected"
@@ -1947,8 +1947,8 @@ warnNoDerivStrat mds loc
= do { dyn_flags <- getDynFlags
; when (wopt Opt_WarnMissingDerivingStrategies dyn_flags) $
case mds of
- Nothing -> addWarnAt
- (Reason Opt_WarnMissingDerivingStrategies)
+ Nothing -> addDiagnosticAt
+ (WarningWithFlag Opt_WarnMissingDerivingStrategies)
loc
(if xopt LangExt.DerivingStrategies dyn_flags
then no_strat_warning
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 835e39a246..2781f9df91 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -334,8 +334,8 @@ rnImportDecl this_mod
_ | implicit -> return () -- Do not bleat for implicit imports
| qual_only -> return ()
| otherwise -> whenWOptM Opt_WarnMissingImportList $
- addWarn (Reason Opt_WarnMissingImportList)
- (missingImportListWarn imp_mod_name)
+ addDiagnostic (WarningWithFlag Opt_WarnMissingImportList)
+ (missingImportListWarn imp_mod_name)
iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)
@@ -396,8 +396,8 @@ rnImportDecl this_mod
-- Complain if we import a deprecated module
whenWOptM Opt_WarnWarningsDeprecations (
case (mi_warns iface) of
- WarnAll txt -> addWarn (Reason Opt_WarnWarningsDeprecations)
- (moduleWarn imp_mod_name txt)
+ WarnAll txt -> addDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations)
+ (moduleWarn imp_mod_name txt)
_ -> return ()
)
@@ -522,7 +522,7 @@ warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
warnUnqualifiedImport decl iface =
whenWOptM Opt_WarnCompatUnqualifiedImports
$ when bad_import
- $ addWarnAt (Reason Opt_WarnCompatUnqualifiedImports) loc warning
+ $ addDiagnosticAt (WarningWithFlag Opt_WarnCompatUnqualifiedImports) loc warning
where
mod = mi_module iface
loc = getLoc $ ideclName decl
@@ -1165,11 +1165,11 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
where
-- Warn when importing T(..) if T was exported abstractly
emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $
- addWarn (Reason Opt_WarnDodgyImports) (dodgyImportWarn n)
+ addDiagnostic (WarningWithFlag Opt_WarnDodgyImports) (dodgyImportWarn n)
emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
- addWarn (Reason Opt_WarnMissingImportList) (missingImportListItem ieRdr)
+ addDiagnostic (WarningWithFlag Opt_WarnMissingImportList) (missingImportListItem ieRdr)
emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $
- addWarn (Reason Opt_WarnDodgyImports) (lookup_err_msg (BadImport ie))
+ addDiagnostic (WarningWithFlag Opt_WarnDodgyImports) (lookup_err_msg (BadImport ie))
run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup m = case m of
@@ -1514,7 +1514,7 @@ warnMissingSignatures gbl_env
add_warn name msg
= when (name `elemNameSet` sig_ns && export_check name)
- (addWarnAt (Reason flag) (getSrcSpan name) msg)
+ (addDiagnosticAt (WarningWithFlag flag) (getSrcSpan name) msg)
export_check name
= warn_missing_sigs || not warn_only_exported || name `elemNameSet` exports
@@ -1536,7 +1536,7 @@ warnMissingKindSignatures gbl_env
add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
add_ty_warn cusks_enabled tyCon = when (name `elemNameSet` ksig_ns) $
- addWarnAt (Reason Opt_WarnMissingKindSignatures) (getSrcSpan name) $
+ addDiagnosticAt (WarningWithFlag Opt_WarnMissingKindSignatures) (getSrcSpan name) $
hang msg 2 (text "type" <+> pprPrefixName name <+> dcolon <+> ki_msg)
where
msg | cusks_enabled = text "Top-level type constructor with no standalone kind signature or CUSK:"
@@ -1703,7 +1703,7 @@ warnUnusedImport flag fld_env (L loc decl, used, unused)
-- Nothing used; drop entire declaration
| null used
- = addWarnAt (Reason flag) (locA loc) msg1
+ = addDiagnosticAt (WarningWithFlag flag) (locA loc) msg1
-- Everything imported is used; nop
| null unused
@@ -1714,11 +1714,11 @@ warnUnusedImport flag fld_env (L loc decl, used, unused)
| Just (_, L _ imports) <- ideclHiding decl
, length unused == 1
, Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports
- = addWarnAt (Reason flag) (locA loc) msg2
+ = addDiagnosticAt (WarningWithFlag flag) (locA loc) msg2
-- Some imports are unused
| otherwise
- = addWarnAt (Reason flag) (locA loc) msg2
+ = addDiagnosticAt (WarningWithFlag flag) (locA loc) msg2
where
msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index d22cabf69e..b41170014c 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -913,9 +913,9 @@ check_cross_stage_lifting top_lvl name ps_var
-- Warning for implicit lift (#17804)
; whenWOptM Opt_WarnImplicitLift $
- addWarnTc (Reason 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/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 3db88858e0..e5d27fa234 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -169,9 +169,9 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns
-- we don't find any GREs that are in scope qualified-only
complain [] = return ()
- complain pp_locs = addWarnAt (Reason Opt_WarnNameShadowing)
- loc
- (shadowedNameWarn occ pp_locs)
+ complain pp_locs = addDiagnosticAt (WarningWithFlag Opt_WarnNameShadowing)
+ loc
+ (shadowedNameWarn occ pp_locs)
is_shadowed_gre :: GlobalRdrElt -> RnM Bool
-- Returns False for record selectors that are shadowed, when
@@ -386,8 +386,8 @@ checkUnusedRecordWildcard loc fvs (Just dotdot_names) =
warnRedundantRecordWildcard :: RnM ()
warnRedundantRecordWildcard =
whenWOptM Opt_WarnRedundantRecordWildcards
- (addWarn (Reason Opt_WarnRedundantRecordWildcards)
- redundantWildcardWarning)
+ (addDiagnostic (WarningWithFlag Opt_WarnRedundantRecordWildcards)
+ redundantWildcardWarning)
-- | Produce a warning when no variables bound by a `..` pattern are used.
@@ -475,7 +475,7 @@ reportable child
addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM ()
addUnusedWarning flag occ span msg
- = addWarnAt (Reason flag) span $
+ = addDiagnosticAt (WarningWithFlag flag) span $
sep [msg <> colon,
nest 2 $ pprNonVarNameSpace (occNameSpace occ)
<+> quotes (ppr occ)]
View Lorry Controller Status