Accumulate Haddock comments in P (#17544, #17561, #8944)

Haddock comments are, first and foremost, comments. It's very annoying
to incorporate them into the grammar. We can take advantage of an
important property: adding a Haddock comment does not change the parse
tree in any way other than wrapping some nodes in HsDocTy and the like
(and if it does, that's a bug).

This patch implements the following:

* Accumulate Haddock comments with their locations in the P monad.
  This is handled in the lexer.

* After parsing, do a pass over the AST to associate Haddock comments
  with AST nodes using location info.

* Report the leftover comments to the user as a warning (-Winvalid-haddock).

1 files changed, 26 insertions, 2 deletions

diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index b222b726fb..9bc776d4d5 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -1,6 +1,10 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import Data.List
+import Data.Data
 import GHC.Types.SrcLoc
 import GHC hiding (moduleName)
 import GHC.Hs.Dump
@@ -30,7 +34,8 @@ testOneFile libdir fileName = do
        p <- parseOneFile libdir fileName
        let
          origAst = showSDoc unsafeGlobalDynFlags
-                     $ showAstData BlankSrcSpan (pm_parsed_source p)
+                     $ showAstData BlankSrcSpan
+                     $ eraseLayoutInfo (pm_parsed_source p)
          pped    = pragmas ++ "\n" ++ pp (pm_parsed_source p)
          anns    = pm_annotations p
          pragmas = getPragmas anns
@@ -46,7 +51,8 @@ testOneFile libdir fileName = do
 
        let newAstStr :: String
            newAstStr = showSDoc unsafeGlobalDynFlags
-                         $ showAstData BlankSrcSpan (pm_parsed_source p')
+                         $ showAstData BlankSrcSpan
+                         $ eraseLayoutInfo (pm_parsed_source p')
        writeFile newAstFile newAstStr
 
        if origAst == newAstStr
@@ -98,4 +104,22 @@ getPragmas anns = pragmaStr
 pp :: (Outputable a) => a -> String
 pp a = showPpr unsafeGlobalDynFlags a
 
+eraseLayoutInfo :: ParsedSource -> ParsedSource
+eraseLayoutInfo = everywhere go
+  where
+    go :: forall a. Typeable a => a -> a
+    go x =
+      case eqT @a @LayoutInfo of
+        Nothing -> x
+        Just Refl -> NoLayoutInfo
+
+-- ---------------------------------------------------------------------
 
+-- Copied from syb for the test
+
+everywhere :: (forall a. Data a => a -> a)
+           -> (forall a. Data a => a -> a)
+everywhere f = go
+  where
+    go :: forall a. Data a => a -> a
+    go = f . gmapT go