| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnDeprecations
+ | Opt_WarnMisc
-- language opts
| Opt_AllowOverlappingInstances
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
- Opt_WarnDuplicateExports
+ Opt_WarnDuplicateExports,
+ Opt_WarnMisc
]
minusWOpts
-> FiniteMap ModuleName AvailEnv -- Minimal imports
-> RnMG ()
printMinimalImports this_mod unqual imps
- = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
- if not dump_minimal then returnRn () else
+ = ifOptRn Opt_D_dump_minimal_imports $
mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
ioToRnM (do { h <- openFile filename WriteMode ;
bndr_name_set = mkNameSet binder_names
in
renameSigsFVs (okBindSig bndr_name_set) sigs `thenRn` \ (siglist, sig_fvs) ->
- doptRn Opt_WarnMissingSigs `thenRn` \ warnMissing ->
- let
- type_sig_vars = [n | Sig n _ _ <- siglist]
- un_sigd_binders | warnMissing = nameSetToList (delListFromNameSet
- bndr_name_set type_sig_vars)
- | otherwise = []
- in
- mapRn_ missingSigWarn un_sigd_binders `thenRn_`
- rn_mono_binds siglist mbinds `thenRn` \ (final_binds, bind_fvs) ->
+ ifOptRn Opt_WarnMissingSigs (
+ let
+ type_sig_vars = [n | Sig n _ _ <- siglist]
+ un_sigd_binders = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars)
+ in
+ mapRn_ missingSigWarn un_sigd_binders
+ ) `thenRn_`
+
+ rn_mono_binds siglist mbinds `thenRn` \ (final_binds, bind_fvs) ->
returnRn (final_binds, bind_fvs `plusFV` sig_fvs)
where
binder_rdr_names = collectMonoBinders mbinds
-- Check for duplicate names
checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
- doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
-
-- Warn about shadowing, but only in source modules
(case mode of
- SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
- other -> returnRn ()
+ SourceMode -> ifOptRn Opt_WarnNameShadowing $
+ mapRn_ (check_shadow name_env) rdr_names_w_loc
+ other -> returnRn ()
) `thenRn_`
newLocalsRn rdr_names_w_loc `thenRn` \ names ->
\begin{code}
warnUnusedModules :: [ModuleName] -> RnM d ()
warnUnusedModules mods
- = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
- if warn then mapRn_ (addWarnRn . unused_mod) mods
- else returnRn ()
+ = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
where
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
text "is imported, but nothing from it is used",
warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
warnUnusedImports names
- = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
- if warn then warnUnusedBinds names else returnRn ()
+ = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
warnUnusedLocalBinds names
- = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
- if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
- else returnRn ()
+ = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
warnUnusedMatches names
- = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
- if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
- else returnRn ()
+ = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
-------------------------
warnDeprec :: Name -> DeprecTxt -> RnM d ()
warnDeprec name txt
- = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
- if not warn_drs then returnRn () else
+ = ifOptRn Opt_WarnDeprecations $
addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
quotes (ppr name) <+> text "is deprecated:",
nest 4 (ppr txt) ])
(\ err -> panic "ioToRnM_no_fail: the I/O operation failed!")
traceRn :: SDoc -> RnM d ()
-traceRn msg
- = doptRn Opt_D_dump_rn_trace `thenRn` \b ->
- if b then putDocRn msg else returnRn ()
+traceRn msg = ifOptRn Opt_D_dump_rn_trace (putDocRn msg)
traceHiDiffsRn :: SDoc -> RnM d ()
-traceHiDiffsRn msg
- = doptRn Opt_D_dump_hi_diffs `thenRn` \b ->
- if b then putDocRn msg else returnRn ()
+traceHiDiffsRn msg = ifOptRn Opt_D_dump_hi_diffs (putDocRn msg)
putDocRn :: SDoc -> RnM d ()
putDocRn msg = ioToRnM (printErrs alwaysQualify msg) `thenRn_`
doptRn dflag (RnDown { rn_dflags = dflags}) l_down
= return (dopt dflag dflags)
+ifOptRn :: DynFlag -> RnM d a -> RnM d ()
+ifOptRn dflag thing_inside down@(RnDown { rn_dflags = dflags}) l_down
+ | dopt dflag dflags = thing_inside down l_down >> return ()
+ | otherwise = return ()
+
getDOptsRn :: RnM d DynFlags
getDOptsRn (RnDown { rn_dflags = dflags}) l_down
= return dflags
else
-- Complain if we import a deprecated module
- (case deprecs of
- DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt)
- other -> returnRn ()
+ ifOptRn Opt_WarnDeprecations (
+ case deprecs of
+ DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt)
+ other -> returnRn ()
) `thenRn_`
-- Filter the imports according to the import list
Just avail@(AvailTC _ [n]) -> -- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
- addWarnRn (dodgyImportWarn mod item) `thenRn_`
+ ifOptRn opt_WarnMisc (addWarnRn (dodgyImportWarn mod item)) `thenRn_`
returnRn [(avail, [availName avail])]
Just avail -> returnRn [(avail, [availName avail])]
rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
rnContext doc ctxt
= mapRn rn_pred ctxt `thenRn` \ theta ->
- let
- (_, dups) = removeDupsEq theta
- -- We only have equality, not ordering
- in
+
-- Check for duplicate assertions
-- If this isn't an error, then it ought to be:
- mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
+ ifOptRn Opt_WarnMisc (
+ let
+ (_, dups) = removeDupsEq theta
+ -- We only have equality, not ordering
+ in
+ mapRn (addWarnRn . dupClassAssertWarn theta) dups
+ ) `thenRn_`
+
returnRn theta
where
--Someone discovered that @CCallable@ and @CReturnable@
= hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
forAllWarn doc ty tyvar
- = doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
- () | not warn_unused -> returnRn ()
- | otherwise
- -> getModeRn `thenRn` \ mode ->
- case mode of {
+ = ifOptRn Opt_WarnUnusedMatches $
+ getModeRn `thenRn` \ mode ->
+ case mode of {
#ifndef DEBUG
InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
-- unless DEBUG is on, in which case it is slightly