Print which warning-flag controls an emitted warning

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.

This also adds a new flag `-f(no-)show-warning-groups` to control
whether to show which warning-group (such as `-Wall` or `-Wcompat`)
a warning belongs to. This flag is on by default.

This implements #10752

Reviewed By: quchen, bgamari, hvr

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

1 files changed, 6 insertions, 6 deletions

diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 7bbe4be495..1729a5bfdc 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -678,7 +678,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 -- | Each module is given a unique 'LogQueue' to redirect compilation messages
 -- to. A 'Nothing' value contains the result of compilation, and denotes the
 -- end of the message queue.
-data LogQueue = LogQueue !(IORef [Maybe (Severity, SrcSpan, PprStyle, MsgDoc)])
+data LogQueue = LogQueue !(IORef [Maybe (WarnReason, Severity, SrcSpan, PprStyle, MsgDoc)])
                          !(MVar ())
 
 -- | The graph of modules to compile and their corresponding result 'MVar' and
@@ -879,7 +879,7 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
             return (success_flag,ok_results)
 
   where
-    writeLogQueue :: LogQueue -> Maybe (Severity,SrcSpan,PprStyle,MsgDoc) -> IO ()
+    writeLogQueue :: LogQueue -> Maybe (WarnReason,Severity,SrcSpan,PprStyle,MsgDoc) -> IO ()
     writeLogQueue (LogQueue ref sem) msg = do
         atomicModifyIORef' ref $ \msgs -> (msg:msgs,())
         _ <- tryPutMVar sem ()
@@ -888,8 +888,8 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
     -- The log_action callback that is used to synchronize messages from a
     -- worker thread.
     parLogAction :: LogQueue -> LogAction
-    parLogAction log_queue _dflags !severity !srcSpan !style !msg = do
-        writeLogQueue log_queue (Just (severity,srcSpan,style,msg))
+    parLogAction log_queue _dflags !reason !severity !srcSpan !style !msg = do
+        writeLogQueue log_queue (Just (reason,severity,srcSpan,style,msg))
 
     -- Print each message from the log_queue using the log_action from the
     -- session's DynFlags.
@@ -902,8 +902,8 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
 
             print_loop [] = read_msgs
             print_loop (x:xs) = case x of
-                Just (severity,srcSpan,style,msg) -> do
-                    log_action dflags dflags severity srcSpan style msg
+                Just (reason,severity,srcSpan,style,msg) -> do
+                    log_action dflags dflags reason severity srcSpan style msg
                     print_loop xs
                 -- Exit the loop once we encounter the end marker.
                 Nothing -> return ()