Commit f02af79e authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve the behaviour of warnIf

Now that warnIf takes a "reason", we can test the reason
in warnIf rather than in the caller.  Less code, and less
risk of getting the test and the reason out of sync.
parent 8c33cd4f
......@@ -1272,14 +1272,12 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
| let earlier_mods = [ mod
| (L _ (IEModuleContents (L _ mod))) <- ie_names ]
, mod `elem` earlier_mods -- Duplicate export of M
= do { warn_dup_exports <- woptM Opt_WarnDuplicateExports ;
warnIf (Reason Opt_WarnDuplicateExports) warn_dup_exports
= do { warnIf (Reason Opt_WarnDuplicateExports) True
(dupModuleExport mod) ;
return acc }
| otherwise
= do { warnDodgyExports <- woptM Opt_WarnDodgyExports
; let { exportValid = (mod `elem` imported_modules)
= do { let { exportValid = (mod `elem` imported_modules)
|| (moduleName this_mod == mod)
; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
; new_exports = map (availFromGRE . fst) gre_prs
......@@ -1289,7 +1287,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
; checkErr exportValid (moduleNotImported mod)
; warnIf (Reason Opt_WarnDodgyExports)
(warnDodgyExports && exportValid && null gre_prs)
(exportValid && null gre_prs)
(nullModuleExport mod)
; traceRn (text "efa" <+> (ppr mod $$ ppr all_gres))
......@@ -1429,11 +1427,10 @@ check_occs ie occs names -- 'names' are the entities specifed by 'ie'
| name == name' -- Duplicate export
-- But we don't want to warn if the same thing is exported
-- by two different module exports. See ticket #4478.
-> do unless (dupExport_ok name ie ie') $ do
warn_dup_exports <- woptM Opt_WarnDuplicateExports
warnIf (Reason Opt_WarnDuplicateExports) warn_dup_exports
(dupExportWarn name_occ ie ie')
return occs
-> do { warnIf (Reason Opt_WarnDuplicateExports)
(not (dupExport_ok name ie ie'))
(dupExportWarn name_occ ie ie')
; return occs }
| otherwise -- Same occ name but different names: an error
-> do { global_env <- getGlobalRdrEnv ;
......
......@@ -640,10 +640,9 @@ newClsInst overlap_mode dfun_name tvs theta clas tys
-- but it'll do fine
; oflag <- getOverlapFlag overlap_mode
; let inst = mkLocalInstance dfun oflag tvs' clas tys'
; dflags <- getDynFlags
; warnIf (Reason Opt_WarnOrphans)
(isOrphan (is_orphan inst) && wopt Opt_WarnOrphans dflags)
(instOrphWarn inst)
(isOrphan (is_orphan inst))
(instOrphWarn inst)
; return inst }
instOrphWarn :: ClsInst -> SDoc
......
......@@ -724,11 +724,6 @@ checkErr :: Bool -> MsgDoc -> TcRn ()
-- Add the error if the bool is False
checkErr ok msg = unless ok (addErr msg)
-- | Display a warning if a condition is met.
warnIf :: WarnReason -> Bool -> MsgDoc -> TcRn ()
warnIf reason True msg = addWarn reason msg
warnIf _ False _ = return ()
addMessages :: Messages -> TcRn ()
addMessages msgs1
= do { errs_var <- getErrsVar ;
......@@ -1087,6 +1082,16 @@ failIfTcM True err = failWithTcM err
-- Warnings have no 'M' variant, nor failure
-- | Display a warning if a condition is met.
-- and the warning is enabled
warnIf :: WarnReason -> Bool -> MsgDoc -> TcRn ()
warnIf reason is_bad msg
= do { warn_on <- case reason of
NoReason -> return True
Reason warn_flag -> woptM warn_flag
; when (warn_on && is_bad) $
addWarn reason msg }
-- | Display a warning if a condition is met.
warnTc :: WarnReason -> Bool -> MsgDoc -> TcM ()
warnTc reason warn_if_true warn_msg
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment