Print which warning-flag controls an emitted warning.wip/warning-origins

Both gcc and clang tell which warning flag a reported warning can be
controlled with, this patch makes ghc do the same. More generally, this
allows for annotated compiler output, where an optional annotation is
displayed in brackets after the severity.

Display which group enables a warning.

Add flag to show which group a warning belongs to

``-f(no-)show-warning-groups``, used to show/hide the group an emitted
warning belongs to. On by default.

Fix compilation error in ghc-api test

Reviewers: goldfire, hvr, quchen, austin, bgamari

Reviewed By: quchen, bgamari

Subscribers: goldfire, thomie

Differential Revision: https://phabricator.haskell.org/D1943

GHC Trac Issues: #10752

1 files changed, 27 insertions, 15 deletions

diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 4f655090c6..f3851ba770 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -500,10 +500,12 @@ checkCanonicalInstances cls poly_ty mbinds = do
               case mbind of
                   FunBind { fun_id = L _ name, fun_matches = mg }
                       | name == pureAName, isAliasMG mg == Just returnMName
-                      -> addWarnNonCanonicalMethod1 "pure" "return"
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonadInstances "pure" "return"
 
                       | name == thenAName, isAliasMG mg == Just thenMName
-                      -> addWarnNonCanonicalMethod1 "(*>)" "(>>)"
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)"
 
                   _ -> return ()
 
@@ -512,10 +514,12 @@ checkCanonicalInstances cls poly_ty mbinds = do
               case mbind of
                   FunBind { fun_id = L _ name, fun_matches = mg }
                       | name == returnMName, isAliasMG mg /= Just pureAName
-                      -> addWarnNonCanonicalMethod2 "return" "pure"
+                      -> addWarnNonCanonicalMethod2
+                            Opt_WarnNonCanonicalMonadInstances "return" "pure"
 
                       | name == thenMName, isAliasMG mg /= Just thenAName
-                      -> addWarnNonCanonicalMethod2 "(>>)" "(*>)"
+                      -> addWarnNonCanonicalMethod2
+                            Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)"
 
                   _ -> return ()
 
@@ -540,7 +544,9 @@ checkCanonicalInstances cls poly_ty mbinds = do
               case mbind of
                   FunBind { fun_id = L _ name, fun_matches = mg }
                       | name == failMName, isAliasMG mg == Just failMName_preMFP
-                      -> addWarnNonCanonicalMethod1 "fail" "Control.Monad.fail"
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonadFailInstances "fail"
+                            "Control.Monad.fail"
 
                   _ -> return ()
 
@@ -549,8 +555,9 @@ checkCanonicalInstances cls poly_ty mbinds = do
               case mbind of
                   FunBind { fun_id = L _ name, fun_matches = mg }
                       | name == failMName_preMFP, isAliasMG mg /= Just failMName
-                      -> addWarnNonCanonicalMethod2 "fail"
-                                                    "Control.Monad.Fail.fail"
+                      -> addWarnNonCanonicalMethod2
+                            Opt_WarnNonCanonicalMonadFailInstances "fail"
+                            "Control.Monad.Fail.fail"
                   _ -> return ()
 
       | otherwise = return ()
@@ -574,7 +581,8 @@ checkCanonicalInstances cls poly_ty mbinds = do
               case mbind of
                   FunBind { fun_id = L _ name, fun_matches = mg }
                       | name == sappendName, isAliasMG mg == Just mappendName
-                      -> addWarnNonCanonicalMethod1 "(<>)" "mappend"
+                      -> addWarnNonCanonicalMethod1
+                            Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend"
 
                   _ -> return ()
 
@@ -583,7 +591,8 @@ checkCanonicalInstances cls poly_ty mbinds = do
               case mbind of
                   FunBind { fun_id = L _ name, fun_matches = mg }
                       | name == mappendName, isAliasMG mg /= Just sappendName
-                      -> addWarnNonCanonicalMethod2NoDefault "mappend" "(<>)"
+                      -> addWarnNonCanonicalMethod2NoDefault
+                            Opt_WarnNonCanonicalMonoidInstances "mappend" "(<>)"
 
                   _ -> return ()
 
@@ -599,8 +608,9 @@ checkCanonicalInstances cls poly_ty mbinds = do
     isAliasMG _ = Nothing
 
     -- got "lhs = rhs" but expected something different
-    addWarnNonCanonicalMethod1 lhs rhs = do
-        addWarn $ vcat [ text "Noncanonical" <+>
+    addWarnNonCanonicalMethod1 flag lhs rhs = do
+        addWarn (Reason flag) $ vcat
+                       [ text "Noncanonical" <+>
                          quotes (text (lhs ++ " = " ++ rhs)) <+>
                          text "definition detected"
                        , instDeclCtxt1 poly_ty
@@ -610,8 +620,9 @@ checkCanonicalInstances cls poly_ty mbinds = do
                        ]
 
     -- expected "lhs = rhs" but got something else
-    addWarnNonCanonicalMethod2 lhs rhs = do
-        addWarn $ vcat [ text "Noncanonical" <+>
+    addWarnNonCanonicalMethod2 flag lhs rhs = do
+        addWarn (Reason flag) $ vcat
+                       [ text "Noncanonical" <+>
                          quotes (text lhs) <+>
                          text "definition detected"
                        , instDeclCtxt1 poly_ty
@@ -621,8 +632,9 @@ checkCanonicalInstances cls poly_ty mbinds = do
                        ]
 
     -- like above, but method has no default impl
-    addWarnNonCanonicalMethod2NoDefault lhs rhs = do
-        addWarn $ vcat [ text "Noncanonical" <+>
+    addWarnNonCanonicalMethod2NoDefault flag lhs rhs = do
+        addWarn (Reason flag) $ vcat
+                       [ text "Noncanonical" <+>
                          quotes (text lhs) <+>
                          text "definition detected"
                        , instDeclCtxt1 poly_ty