From f932c5890ec358aa0cbba547eb6982168e13da37 Mon Sep 17 00:00:00 2001
From: Adam Gundry <adam@well-typed.com>
Date: Tue, 10 Jan 2023 21:03:48 +0000
Subject: Allow WARNING pragmas to be controlled with custom categories

Closes #17209. This implements GHC Proposal 541, allowing a WARNING
pragma to be annotated with a category like so:

    {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-}

The user can then enable, disable and set the severity of such warnings
using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on.  There
is a new warning group `-Wextended-warnings` containing all these warnings.
Warnings without a category are treated as if the category was `deprecations`,
and are (still) controlled by the flags `-Wdeprecations`
and `-Wwarnings-deprecations`.

Updates Haddock submodule.
---
 utils/check-exact/ExactPrint.hs | 8 ++++----
 utils/haddock                   | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

(limited to 'utils')

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index a569b803d4..d4f1961176 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1424,13 +1424,13 @@ instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
   getAnnotationEntry = entryFromLocatedA
   setAnnotationAnchor = setAnchorAn
 
-  exact (L (SrcSpanAnn an l) (WarningTxt (L la src) ws)) = do
+  exact (L (SrcSpanAnn an l) (WarningTxt mb_cat (L la src) ws)) = do
     an0 <- markAnnOpenP an src "{-# WARNING"
     an1 <- markEpAnnL an0 lapr_rest AnnOpenS
     ws' <- markAnnotated ws
     an2 <- markEpAnnL an1 lapr_rest AnnCloseS
     an3 <- markAnnCloseP an2
-    return (L (SrcSpanAnn an3 l) (WarningTxt (L la src) ws'))
+    return (L (SrcSpanAnn an3 l) (WarningTxt mb_cat (L la src) ws'))
 
   exact (L (SrcSpanAnn an l) (DeprecatedTxt (L ls src) ws)) = do
     an0 <- markAnnOpenP an src "{-# DEPRECATED"
@@ -1766,9 +1766,9 @@ instance ExactPrint (WarnDecl GhcPs) where
     an0 <- markEpAnnL an lidl AnnOpenS -- "["
     txt' <-
       case txt of
-        WarningTxt    src ls -> do
+        WarningTxt mb_cat src ls -> do
           ls' <- markAnnotated ls
-          return (WarningTxt    src ls')
+          return (WarningTxt mb_cat src ls')
         DeprecatedTxt src ls -> do
           ls' <- markAnnotated ls
           return (DeprecatedTxt src ls')
diff --git a/utils/haddock b/utils/haddock
index 1f22a95c1d..6f1b909339 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 1f22a95c1db942fce2623b9daa26f66d193a4e7f
+Subproject commit 6f1b9093395f4b12298b8b785b855a637206f5f3
-- 
cgit v1.2.1