diff options
| author | Herbert Valerio Riedel <hvr@gnu.org> | 2016-02-27 13:50:10 +0100 |
|---|---|---|
| committer | Herbert Valerio Riedel <hvr@gnu.org> | 2016-02-27 16:35:45 +0100 |
| commit | b9c697eefd34fcba3ab9c1f831baf7f651ad7503 (patch) | |
| tree | 73dd59a223adc3f855da6613c0a99ed2e1fb6f77 /compiler/deSugar/DsExpr.hs | |
| parent | 3ee4fc04322dacb66c70262a220dce0f52c29d4f (diff) | |
| download | haskell-b9c697eefd34fcba3ab9c1f831baf7f651ad7503.tar.gz | |
Print which flag controls emitted desugaring warnings
This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover
warnings emitted during the desugaring phase.
This implements another part of #10752
Reviewed-by: quchen, bgamari
Differential Revision: https://phabricator.haskell.org/D1954
Diffstat (limited to 'compiler/deSugar/DsExpr.hs')
| -rw-r--r-- | compiler/deSugar/DsExpr.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 9219d7e9de..2320ab498a 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -1005,8 +1005,8 @@ warnDiscardedDoBindings rhs rhs_ty -- Warn about discarding non-() things in 'monadic' binding ; if warn_unused && not (isUnitTy norm_elt_ty) - then warnDs (badMonadBind rhs elt_ty - (text "-fno-warn-unused-do-bind")) + then warnDs (Reason Opt_WarnUnusedDoBind) + (badMonadBind rhs elt_ty) else -- Warn about discarding m a things in 'monadic' binding of the same type, @@ -1015,20 +1015,20 @@ warnDiscardedDoBindings rhs rhs_ty do { case tcSplitAppTy_maybe norm_elt_ty of Just (elt_m_ty, _) | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty - -> warnDs (badMonadBind rhs elt_ty - (text "-fno-warn-wrong-do-bind")) + -> warnDs (Reason Opt_WarnWrongDoBind) + (badMonadBind rhs elt_ty) _ -> return () } } } | otherwise -- RHS does have type of form (m ty), which is weird = return () -- but at lesat this warning is irrelevant -badMonadBind :: LHsExpr Id -> Type -> SDoc -> SDoc -badMonadBind rhs elt_ty flag_doc +badMonadBind :: LHsExpr Id -> Type -> SDoc +badMonadBind rhs elt_ty = vcat [ hang (text "A do-notation statement discarded a result of type") 2 (quotes (ppr elt_ty)) , hang (text "Suppress this warning by saying") 2 (quotes $ text "_ <-" <+> ppr rhs) - , text "or by using the flag" <+> flag_doc ] + ] {- ************************************************************************ |