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).

23 files changed, 1498 insertions, 63 deletions

diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs
index 7ea08c9216..9f1cc41f92 100644
--- a/testsuite/tests/ghc-api/T11579.hs
+++ b/testsuite/tests/ghc-api/T11579.hs
@@ -5,6 +5,7 @@ import GHC
 import GHC.Data.StringBuffer
 import GHC.Parser.Lexer
 import GHC.Types.SrcLoc
+import Data.Foldable (toList)
 
 main :: IO ()
 main = do
@@ -13,14 +14,14 @@ main = do
     let stringBuffer = stringToStringBuffer "-- $bar some\n-- named chunk"
         loc = mkRealSrcLoc (mkFastString "Foo.hs") 1 1
 
-    token <- runGhc (Just libdir) $ do
+    hdk_comments <- runGhc (Just libdir) $ do
         dflags <- getSessionDynFlags
         let pstate = mkPState (dflags `gopt_set` Opt_Haddock) stringBuffer loc
         case unP (lexer False return) pstate of
-            POk _ token -> return (unLoc token)
-            _           -> error "No token"
+            POk s (L _ ITeof) -> return (map unLoc (toList (hdk_comments s)))
+            _                 -> error "No token"
 
     -- #11579
     -- Expected:                    "ITdocCommentNamed "bar some\n named chunk"
     -- Actual (with ghc-8.0.1-rc2): "ITdocCommentNamed "bar some"
-    print token
+    mapM_ print hdk_comments
diff --git a/testsuite/tests/ghc-api/T11579.stdout b/testsuite/tests/ghc-api/T11579.stdout
index 7603e535e7..24f3bf52e5 100644
--- a/testsuite/tests/ghc-api/T11579.stdout
+++ b/testsuite/tests/ghc-api/T11579.stdout
@@ -1 +1 @@
-ITdocCommentNamed "bar some\n named chunk"
+HdkCommentNamed "bar" (HsDocString " some\n named chunk")
diff --git a/testsuite/tests/ghc-api/annotations/comments.stdout b/testsuite/tests/ghc-api/annotations/comments.stdout
index 06273ba1e6..e5ff216fb0 100644
--- a/testsuite/tests/ghc-api/annotations/comments.stdout
+++ b/testsuite/tests/ghc-api/annotations/comments.stdout
@@ -1,12 +1,11 @@
 [
-( CommentsTest.hs:11:1-33 =
-[(CommentsTest.hs:11:1-33,AnnDocCommentNext " The function @foo@ does blah")])
-
 ( CommentsTest.hs:(12,7)-(15,14) =
 [(CommentsTest.hs:14:15-24,AnnLineComment "-- value 2")])
 
 ( <no location info> =
-[(CommentsTest.hs:(3,1)-(7,2),AnnBlockComment "{-\nAn opening comment\n  {- with a nested one -}\n  {-# nested PRAGMA #-}\n-}"),
+[(CommentsTest.hs:11:1-33,AnnDocCommentNext " The function @foo@ does blah"),
+
+(CommentsTest.hs:(3,1)-(7,2),AnnBlockComment "{-\nAn opening comment\n  {- with a nested one -}\n  {-# nested PRAGMA #-}\n-}"),
 
 (CommentsTest.hs:1:1-31,AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}")])
 ]
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs
index 5e7369cdc0..52899930be 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -7,6 +8,11 @@ module T11768 where
 
 class C a b
 
+class D a
+
+newtype DWrapper a = DWrap a
+instance D (DWrapper a)
+
 data Foo = Foo
   deriving Eq -- ^ Documenting a single type
 
@@ -15,6 +21,7 @@ data Bar = Bar
            , Ord
            )
   deriving anyclass ( forall a. C a {- ^ Documenting forall type -} )
+  deriving D {- ^ Documenting deriving via -} via DWrapper Bar
 
 -- | Documenting a standalone deriving instance
 deriving instance Read Bar
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
index 6de1b2b851..5fe63362b1 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
@@ -2,6 +2,9 @@
 ==================== Parser ====================
 module T11768 where
 class C a b
+class D a
+newtype DWrapper a = DWrap a
+instance D (DWrapper a)
 data Foo
   = Foo
   deriving Eq " Documenting a single type"
@@ -9,6 +12,7 @@ data Bar
   = Bar
   deriving (Eq " Documenting one of multiple types", Ord)
   deriving anyclass (forall a. C a " Documenting forall type ")
+  deriving D " Documenting deriving via " via DWrapper Bar
 <document comment>
 deriving instance Read Bar
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.hs b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.hs
new file mode 100644
index 0000000000..884bb2f495
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE TypeFamilies, GADTSyntax #-}
+
+module T17544 where
+
+class C1 a where
+  f1 :: a -> Int
+    -- ^ comment on Int
+
+class C2 a where
+  f2 :: a -> Int
+  -- ^ comment on f2
+
+class C3 a where
+  f3 :: a -> Int
+-- ^ comment on C3
+
+class C4 a where
+  f4 :: a -> Int
+-- ^ comment
+  g4 :: a -> Int
+
+class C5 a where { data D5 a }
+instance C5 Int where
+  data D5 Int where
+    MkD5 :: D5 Int
+     -- ^ comment on D5 Int
+
+class C6 a where { data D6 a }
+instance C6 Int where
+  data D6 Int where
+    MkD6 :: D6 Int
+    -- ^ comment on MkD6
+
+class C7 a where { data D7 a }
+instance C7 Int where
+  data D7 Int where
+    MkD7 :: D7 Int
+   -- ^ comment on data instance D7 Int
+
+class C8 a where { data D8 a }
+instance C8 Int where
+  data D8 Int where
+    MkD8 :: D8 Int
+  -- ^ comment on data instance D8 Int
+
+class C9 a where { data D9 a }
+instance C9 Int where
+  data D9 Int where
+    MkD9 :: D9 Int
+ -- ^ comment on class instance C9 Int
+
+class C10 a where { data D10 a }
+instance C10 Int where
+  data D10 Int where
+    MkD10 :: D10 Int
+-- ^ comment on class instance C10 Int
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
new file mode 100644
index 0000000000..863015241f
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -0,0 +1,1090 @@
+
+==================== Parser AST ====================
+
+({ T17544.hs:1:1 }
+ (HsModule
+  (VirtualBraces
+   (1))
+  (Just
+   ({ T17544.hs:3:8-13 }
+    {ModuleName: T17544}))
+  (Nothing)
+  []
+  [({ T17544.hs:(5,1)-(6,16) }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (VirtualBraces
+       (3))
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:5:7-8 }
+       (Unqual
+        {OccName: C1}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:5:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:5:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      [({ T17544.hs:6:3-16 }
+        (ClassOpSig
+         (NoExtField)
+         (False)
+         [({ T17544.hs:6:3-4 }
+           (Unqual
+            {OccName: f1}))]
+         (HsIB
+          (NoExtField)
+          ({ T17544.hs:6:9-16 }
+           (HsFunTy
+            (NoExtField)
+            (HsUnrestrictedArrow)
+            ({ T17544.hs:6:9 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:6:9 }
+               (Unqual
+                {OccName: a}))))
+            ({ T17544.hs:6:14-16 }
+             (HsDocTy
+              (NoExtField)
+              ({ T17544.hs:6:14-16 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:6:14-16 }
+                 (Unqual
+                  {OccName: Int}))))
+              ({ T17544.hs:7:5-23 }
+               (HsDocString
+                " comment on Int")))))))))]
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      []
+      []
+      [])))
+  ,({ T17544.hs:(9,1)-(10,16) }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (VirtualBraces
+       (3))
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:9:7-8 }
+       (Unqual
+        {OccName: C2}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:9:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:9:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      [({ T17544.hs:10:3-16 }
+        (ClassOpSig
+         (NoExtField)
+         (False)
+         [({ T17544.hs:10:3-4 }
+           (Unqual
+            {OccName: f2}))]
+         (HsIB
+          (NoExtField)
+          ({ T17544.hs:10:9-16 }
+           (HsFunTy
+            (NoExtField)
+            (HsUnrestrictedArrow)
+            ({ T17544.hs:10:9 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:10:9 }
+               (Unqual
+                {OccName: a}))))
+            ({ T17544.hs:10:14-16 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:10:14-16 }
+               (Unqual
+                {OccName: Int})))))))))]
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      []
+      []
+      [({ T17544.hs:11:3-20 }
+        (DocCommentPrev
+         (HsDocString
+          " comment on f2")))])))
+  ,({ T17544.hs:(13,1)-(14,16) }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (VirtualBraces
+       (3))
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:13:7-8 }
+       (Unqual
+        {OccName: C3}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:13:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:13:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      [({ T17544.hs:14:3-16 }
+        (ClassOpSig
+         (NoExtField)
+         (False)
+         [({ T17544.hs:14:3-4 }
+           (Unqual
+            {OccName: f3}))]
+         (HsIB
+          (NoExtField)
+          ({ T17544.hs:14:9-16 }
+           (HsFunTy
+            (NoExtField)
+            (HsUnrestrictedArrow)
+            ({ T17544.hs:14:9 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:14:9 }
+               (Unqual
+                {OccName: a}))))
+            ({ T17544.hs:14:14-16 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:14:14-16 }
+               (Unqual
+                {OccName: Int})))))))))]
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      []
+      []
+      [])))
+  ,({ T17544.hs:15:1-18 }
+    (DocD
+     (NoExtField)
+     (DocCommentPrev
+      (HsDocString
+       " comment on C3"))))
+  ,({ T17544.hs:(17,1)-(20,16) }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (VirtualBraces
+       (3))
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:17:7-8 }
+       (Unqual
+        {OccName: C4}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:17:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:17:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      [({ T17544.hs:18:3-16 }
+        (ClassOpSig
+         (NoExtField)
+         (False)
+         [({ T17544.hs:18:3-4 }
+           (Unqual
+            {OccName: f4}))]
+         (HsIB
+          (NoExtField)
+          ({ T17544.hs:18:9-16 }
+           (HsFunTy
+            (NoExtField)
+            (HsUnrestrictedArrow)
+            ({ T17544.hs:18:9 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:18:9 }
+               (Unqual
+                {OccName: a}))))
+            ({ T17544.hs:18:14-16 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:18:14-16 }
+               (Unqual
+                {OccName: Int})))))))))
+      ,({ T17544.hs:20:3-16 }
+        (ClassOpSig
+         (NoExtField)
+         (False)
+         [({ T17544.hs:20:3-4 }
+           (Unqual
+            {OccName: g4}))]
+         (HsIB
+          (NoExtField)
+          ({ T17544.hs:20:9-16 }
+           (HsFunTy
+            (NoExtField)
+            (HsUnrestrictedArrow)
+            ({ T17544.hs:20:9 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:20:9 }
+               (Unqual
+                {OccName: a}))))
+            ({ T17544.hs:20:14-16 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544.hs:20:14-16 }
+               (Unqual
+                {OccName: Int})))))))))]
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      []
+      []
+      [])))
+  ,({ T17544.hs:22:1-30 }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (ExplicitBraces)
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:22:7-8 }
+       (Unqual
+        {OccName: C5}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:22:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:22:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      []
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      [({ T17544.hs:22:20-28 }
+        (FamilyDecl
+         (NoExtField)
+         (DataFamily)
+         ({ T17544.hs:22:25-26 }
+          (Unqual
+           {OccName: D5}))
+         (HsQTvs
+          (NoExtField)
+          [({ T17544.hs:22:28 }
+            (UserTyVar
+             (NoExtField)
+             (())
+             ({ T17544.hs:22:28 }
+              (Unqual
+               {OccName: a}))))])
+         (Prefix)
+         ({ <no location info> }
+          (NoSig
+           (NoExtField)))
+         (Nothing)))]
+      []
+      [])))
+  ,({ T17544.hs:(23,1)-(25,18) }
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       (NoExtField)
+       (HsIB
+        (NoExtField)
+        ({ T17544.hs:23:10-15 }
+         (HsAppTy
+          (NoExtField)
+          ({ T17544.hs:23:10-11 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:23:10-11 }
+             (Unqual
+              {OccName: C5}))))
+          ({ T17544.hs:23:13-15 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:23:13-15 }
+             (Unqual
+              {OccName: Int})))))))
+       {Bag(Located (HsBind GhcPs)):
+        []}
+       []
+       []
+       [({ T17544.hs:(24,3)-(25,18) }
+         (DataFamInstDecl
+          (HsIB
+           (NoExtField)
+           (FamEqn
+            (NoExtField)
+            ({ T17544.hs:24:8-9 }
+             (Unqual
+              {OccName: D5}))
+            (Nothing)
+            [(HsValArg
+              ({ T17544.hs:24:11-13 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:24:11-13 }
+                 (Unqual
+                  {OccName: Int})))))]
+            (Prefix)
+            (HsDataDefn
+             (NoExtField)
+             (DataType)
+             ({ <no location info> }
+              [])
+             (Nothing)
+             (Nothing)
+             [({ T17544.hs:25:5-18 }
+               (XConDecl
+                (ConDeclGADTPrefixPs
+                 [({ T17544.hs:25:5-8 }
+                   (Unqual
+                    {OccName: MkD5}))]
+                 (HsIB
+                  (NoExtField)
+                  ({ T17544.hs:25:13-18 }
+                   (HsAppTy
+                    (NoExtField)
+                    ({ T17544.hs:25:13-14 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:25:13-14 }
+                       (Unqual
+                        {OccName: D5}))))
+                    ({ T17544.hs:25:16-18 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:25:16-18 }
+                       (Unqual
+                        {OccName: Int})))))))
+                 (Nothing))))]
+             ({ <no location info> }
+              []))))))]
+       (Nothing)))))
+  ,({ T17544.hs:28:1-30 }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (ExplicitBraces)
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:28:7-8 }
+       (Unqual
+        {OccName: C6}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:28:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:28:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      []
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      [({ T17544.hs:28:20-28 }
+        (FamilyDecl
+         (NoExtField)
+         (DataFamily)
+         ({ T17544.hs:28:25-26 }
+          (Unqual
+           {OccName: D6}))
+         (HsQTvs
+          (NoExtField)
+          [({ T17544.hs:28:28 }
+            (UserTyVar
+             (NoExtField)
+             (())
+             ({ T17544.hs:28:28 }
+              (Unqual
+               {OccName: a}))))])
+         (Prefix)
+         ({ <no location info> }
+          (NoSig
+           (NoExtField)))
+         (Nothing)))]
+      []
+      [])))
+  ,({ T17544.hs:(29,1)-(31,18) }
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       (NoExtField)
+       (HsIB
+        (NoExtField)
+        ({ T17544.hs:29:10-15 }
+         (HsAppTy
+          (NoExtField)
+          ({ T17544.hs:29:10-11 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:29:10-11 }
+             (Unqual
+              {OccName: C6}))))
+          ({ T17544.hs:29:13-15 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:29:13-15 }
+             (Unqual
+              {OccName: Int})))))))
+       {Bag(Located (HsBind GhcPs)):
+        []}
+       []
+       []
+       [({ T17544.hs:(30,3)-(31,18) }
+         (DataFamInstDecl
+          (HsIB
+           (NoExtField)
+           (FamEqn
+            (NoExtField)
+            ({ T17544.hs:30:8-9 }
+             (Unqual
+              {OccName: D6}))
+            (Nothing)
+            [(HsValArg
+              ({ T17544.hs:30:11-13 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:30:11-13 }
+                 (Unqual
+                  {OccName: Int})))))]
+            (Prefix)
+            (HsDataDefn
+             (NoExtField)
+             (DataType)
+             ({ <no location info> }
+              [])
+             (Nothing)
+             (Nothing)
+             [({ T17544.hs:31:5-18 }
+               (XConDecl
+                (ConDeclGADTPrefixPs
+                 [({ T17544.hs:31:5-8 }
+                   (Unqual
+                    {OccName: MkD6}))]
+                 (HsIB
+                  (NoExtField)
+                  ({ T17544.hs:31:13-18 }
+                   (HsAppTy
+                    (NoExtField)
+                    ({ T17544.hs:31:13-14 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:31:13-14 }
+                       (Unqual
+                        {OccName: D6}))))
+                    ({ T17544.hs:31:16-18 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:31:16-18 }
+                       (Unqual
+                        {OccName: Int})))))))
+                 (Nothing))))]
+             ({ <no location info> }
+              []))))))]
+       (Nothing)))))
+  ,({ T17544.hs:34:1-30 }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (ExplicitBraces)
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:34:7-8 }
+       (Unqual
+        {OccName: C7}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:34:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:34:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      []
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      [({ T17544.hs:34:20-28 }
+        (FamilyDecl
+         (NoExtField)
+         (DataFamily)
+         ({ T17544.hs:34:25-26 }
+          (Unqual
+           {OccName: D7}))
+         (HsQTvs
+          (NoExtField)
+          [({ T17544.hs:34:28 }
+            (UserTyVar
+             (NoExtField)
+             (())
+             ({ T17544.hs:34:28 }
+              (Unqual
+               {OccName: a}))))])
+         (Prefix)
+         ({ <no location info> }
+          (NoSig
+           (NoExtField)))
+         (Nothing)))]
+      []
+      [])))
+  ,({ T17544.hs:(35,1)-(37,18) }
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       (NoExtField)
+       (HsIB
+        (NoExtField)
+        ({ T17544.hs:35:10-15 }
+         (HsAppTy
+          (NoExtField)
+          ({ T17544.hs:35:10-11 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:35:10-11 }
+             (Unqual
+              {OccName: C7}))))
+          ({ T17544.hs:35:13-15 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:35:13-15 }
+             (Unqual
+              {OccName: Int})))))))
+       {Bag(Located (HsBind GhcPs)):
+        []}
+       []
+       []
+       [({ T17544.hs:(36,3)-(37,18) }
+         (DataFamInstDecl
+          (HsIB
+           (NoExtField)
+           (FamEqn
+            (NoExtField)
+            ({ T17544.hs:36:8-9 }
+             (Unqual
+              {OccName: D7}))
+            (Nothing)
+            [(HsValArg
+              ({ T17544.hs:36:11-13 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:36:11-13 }
+                 (Unqual
+                  {OccName: Int})))))]
+            (Prefix)
+            (HsDataDefn
+             (NoExtField)
+             (DataType)
+             ({ <no location info> }
+              [])
+             (Nothing)
+             (Nothing)
+             [({ T17544.hs:37:5-18 }
+               (XConDecl
+                (ConDeclGADTPrefixPs
+                 [({ T17544.hs:37:5-8 }
+                   (Unqual
+                    {OccName: MkD7}))]
+                 (HsIB
+                  (NoExtField)
+                  ({ T17544.hs:37:13-18 }
+                   (HsAppTy
+                    (NoExtField)
+                    ({ T17544.hs:37:13-14 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:37:13-14 }
+                       (Unqual
+                        {OccName: D7}))))
+                    ({ T17544.hs:37:16-18 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:37:16-18 }
+                       (Unqual
+                        {OccName: Int})))))))
+                 (Nothing))))]
+             ({ <no location info> }
+              []))))))]
+       (Nothing)))))
+  ,({ T17544.hs:40:1-30 }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (ExplicitBraces)
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:40:7-8 }
+       (Unqual
+        {OccName: C8}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:40:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:40:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      []
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      [({ T17544.hs:40:20-28 }
+        (FamilyDecl
+         (NoExtField)
+         (DataFamily)
+         ({ T17544.hs:40:25-26 }
+          (Unqual
+           {OccName: D8}))
+         (HsQTvs
+          (NoExtField)
+          [({ T17544.hs:40:28 }
+            (UserTyVar
+             (NoExtField)
+             (())
+             ({ T17544.hs:40:28 }
+              (Unqual
+               {OccName: a}))))])
+         (Prefix)
+         ({ <no location info> }
+          (NoSig
+           (NoExtField)))
+         (Nothing)))]
+      []
+      [])))
+  ,({ T17544.hs:(41,1)-(43,18) }
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       (NoExtField)
+       (HsIB
+        (NoExtField)
+        ({ T17544.hs:41:10-15 }
+         (HsAppTy
+          (NoExtField)
+          ({ T17544.hs:41:10-11 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:41:10-11 }
+             (Unqual
+              {OccName: C8}))))
+          ({ T17544.hs:41:13-15 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:41:13-15 }
+             (Unqual
+              {OccName: Int})))))))
+       {Bag(Located (HsBind GhcPs)):
+        []}
+       []
+       []
+       [({ T17544.hs:(42,3)-(43,18) }
+         (DataFamInstDecl
+          (HsIB
+           (NoExtField)
+           (FamEqn
+            (NoExtField)
+            ({ T17544.hs:42:8-9 }
+             (Unqual
+              {OccName: D8}))
+            (Nothing)
+            [(HsValArg
+              ({ T17544.hs:42:11-13 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:42:11-13 }
+                 (Unqual
+                  {OccName: Int})))))]
+            (Prefix)
+            (HsDataDefn
+             (NoExtField)
+             (DataType)
+             ({ <no location info> }
+              [])
+             (Nothing)
+             (Nothing)
+             [({ T17544.hs:43:5-18 }
+               (XConDecl
+                (ConDeclGADTPrefixPs
+                 [({ T17544.hs:43:5-8 }
+                   (Unqual
+                    {OccName: MkD8}))]
+                 (HsIB
+                  (NoExtField)
+                  ({ T17544.hs:43:13-18 }
+                   (HsAppTy
+                    (NoExtField)
+                    ({ T17544.hs:43:13-14 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:43:13-14 }
+                       (Unqual
+                        {OccName: D8}))))
+                    ({ T17544.hs:43:16-18 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:43:16-18 }
+                       (Unqual
+                        {OccName: Int})))))))
+                 (Nothing))))]
+             ({ <no location info> }
+              []))))))]
+       (Nothing)))))
+  ,({ T17544.hs:46:1-30 }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (ExplicitBraces)
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:46:7-8 }
+       (Unqual
+        {OccName: C9}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:46:10 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:46:10 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      []
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      [({ T17544.hs:46:20-28 }
+        (FamilyDecl
+         (NoExtField)
+         (DataFamily)
+         ({ T17544.hs:46:25-26 }
+          (Unqual
+           {OccName: D9}))
+         (HsQTvs
+          (NoExtField)
+          [({ T17544.hs:46:28 }
+            (UserTyVar
+             (NoExtField)
+             (())
+             ({ T17544.hs:46:28 }
+              (Unqual
+               {OccName: a}))))])
+         (Prefix)
+         ({ <no location info> }
+          (NoSig
+           (NoExtField)))
+         (Nothing)))]
+      []
+      [])))
+  ,({ T17544.hs:(47,1)-(49,18) }
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       (NoExtField)
+       (HsIB
+        (NoExtField)
+        ({ T17544.hs:47:10-15 }
+         (HsAppTy
+          (NoExtField)
+          ({ T17544.hs:47:10-11 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:47:10-11 }
+             (Unqual
+              {OccName: C9}))))
+          ({ T17544.hs:47:13-15 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:47:13-15 }
+             (Unqual
+              {OccName: Int})))))))
+       {Bag(Located (HsBind GhcPs)):
+        []}
+       []
+       []
+       [({ T17544.hs:(48,3)-(49,18) }
+         (DataFamInstDecl
+          (HsIB
+           (NoExtField)
+           (FamEqn
+            (NoExtField)
+            ({ T17544.hs:48:8-9 }
+             (Unqual
+              {OccName: D9}))
+            (Nothing)
+            [(HsValArg
+              ({ T17544.hs:48:11-13 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:48:11-13 }
+                 (Unqual
+                  {OccName: Int})))))]
+            (Prefix)
+            (HsDataDefn
+             (NoExtField)
+             (DataType)
+             ({ <no location info> }
+              [])
+             (Nothing)
+             (Nothing)
+             [({ T17544.hs:49:5-18 }
+               (XConDecl
+                (ConDeclGADTPrefixPs
+                 [({ T17544.hs:49:5-8 }
+                   (Unqual
+                    {OccName: MkD9}))]
+                 (HsIB
+                  (NoExtField)
+                  ({ T17544.hs:49:13-18 }
+                   (HsAppTy
+                    (NoExtField)
+                    ({ T17544.hs:49:13-14 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:49:13-14 }
+                       (Unqual
+                        {OccName: D9}))))
+                    ({ T17544.hs:49:16-18 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:49:16-18 }
+                       (Unqual
+                        {OccName: Int})))))))
+                 (Nothing))))]
+             ({ <no location info> }
+              []))))))]
+       (Nothing)))))
+  ,({ T17544.hs:52:1-32 }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (ExplicitBraces)
+      ({ <no location info> }
+       [])
+      ({ T17544.hs:52:7-9 }
+       (Unqual
+        {OccName: C10}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544.hs:52:11 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544.hs:52:11 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      []
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      [({ T17544.hs:52:21-30 }
+        (FamilyDecl
+         (NoExtField)
+         (DataFamily)
+         ({ T17544.hs:52:26-28 }
+          (Unqual
+           {OccName: D10}))
+         (HsQTvs
+          (NoExtField)
+          [({ T17544.hs:52:30 }
+            (UserTyVar
+             (NoExtField)
+             (())
+             ({ T17544.hs:52:30 }
+              (Unqual
+               {OccName: a}))))])
+         (Prefix)
+         ({ <no location info> }
+          (NoSig
+           (NoExtField)))
+         (Nothing)))]
+      []
+      [])))
+  ,({ T17544.hs:(53,1)-(55,20) }
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       (NoExtField)
+       (HsIB
+        (NoExtField)
+        ({ T17544.hs:53:10-16 }
+         (HsAppTy
+          (NoExtField)
+          ({ T17544.hs:53:10-12 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:53:10-12 }
+             (Unqual
+              {OccName: C10}))))
+          ({ T17544.hs:53:14-16 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544.hs:53:14-16 }
+             (Unqual
+              {OccName: Int})))))))
+       {Bag(Located (HsBind GhcPs)):
+        []}
+       []
+       []
+       [({ T17544.hs:(54,3)-(55,20) }
+         (DataFamInstDecl
+          (HsIB
+           (NoExtField)
+           (FamEqn
+            (NoExtField)
+            ({ T17544.hs:54:8-10 }
+             (Unqual
+              {OccName: D10}))
+            (Nothing)
+            [(HsValArg
+              ({ T17544.hs:54:12-14 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544.hs:54:12-14 }
+                 (Unqual
+                  {OccName: Int})))))]
+            (Prefix)
+            (HsDataDefn
+             (NoExtField)
+             (DataType)
+             ({ <no location info> }
+              [])
+             (Nothing)
+             (Nothing)
+             [({ T17544.hs:55:5-20 }
+               (XConDecl
+                (ConDeclGADTPrefixPs
+                 [({ T17544.hs:55:5-9 }
+                   (Unqual
+                    {OccName: MkD10}))]
+                 (HsIB
+                  (NoExtField)
+                  ({ T17544.hs:55:14-20 }
+                   (HsAppTy
+                    (NoExtField)
+                    ({ T17544.hs:55:14-16 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:55:14-16 }
+                       (Unqual
+                        {OccName: D10}))))
+                    ({ T17544.hs:55:18-20 }
+                     (HsTyVar
+                      (NoExtField)
+                      (NotPromoted)
+                      ({ T17544.hs:55:18-20 }
+                       (Unqual
+                        {OccName: Int})))))))
+                 (Nothing))))]
+             ({ <no location info> }
+              []))))))]
+       (Nothing)))))
+  ,({ T17544.hs:56:1-38 }
+    (DocD
+     (NoExtField)
+     (DocCommentPrev
+      (HsDocString
+       " comment on class instance C10 Int"))))]
+  (Nothing)
+  (Nothing)))
+
+
+
+T17544.hs:19:1: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+T17544.hs:26:6: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+T17544.hs:32:5: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+T17544.hs:38:4: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+T17544.hs:44:3: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+T17544.hs:50:2: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs
new file mode 100644
index 0000000000..4acf2af68d
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS -haddock -ddump-parsed-ast #-}
+
+-- Haddock comments in this test case should all be rejected, but they are not.
+--
+-- This is a known issue. Users should avoid writing comments in such
+-- positions, as a future fix will disallow them.
+--
+-- See Note [Register keyword location] in GHC.Parser.PostProcess.Haddock
+
+module
+  -- | Bad comment for the module
+  T17544_kw where
+
+data Foo -- | Bad comment for MkFoo
+  where MkFoo :: Foo
+
+newtype Bar -- | Bad comment for MkBar
+  where MkBar :: () -> Bar
+
+class Cls a
+    -- | Bad comment for clsmethod
+  where
+    clsmethod :: a
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
new file mode 100644
index 0000000000..9d45b6a86d
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -0,0 +1,154 @@
+
+==================== Parser AST ====================
+
+({ T17544_kw.hs:1:1 }
+ (HsModule
+  (VirtualBraces
+   (1))
+  (Just
+   ({ T17544_kw.hs:13:3-11 }
+    {ModuleName: T17544_kw}))
+  (Nothing)
+  []
+  [({ T17544_kw.hs:(15,1)-(16,20) }
+    (TyClD
+     (NoExtField)
+     (DataDecl
+      (NoExtField)
+      ({ T17544_kw.hs:15:6-8 }
+       (Unqual
+        {OccName: Foo}))
+      (HsQTvs
+       (NoExtField)
+       [])
+      (Prefix)
+      (HsDataDefn
+       (NoExtField)
+       (DataType)
+       ({ <no location info> }
+        [])
+       (Nothing)
+       (Nothing)
+       [({ T17544_kw.hs:16:9-20 }
+         (XConDecl
+          (ConDeclGADTPrefixPs
+           [({ T17544_kw.hs:16:9-13 }
+             (Unqual
+              {OccName: MkFoo}))]
+           (HsIB
+            (NoExtField)
+            ({ T17544_kw.hs:16:18-20 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T17544_kw.hs:16:18-20 }
+               (Unqual
+                {OccName: Foo})))))
+           (Just
+            ({ T17544_kw.hs:15:10-35 }
+             (HsDocString
+              " Bad comment for MkFoo"))))))]
+       ({ <no location info> }
+        [])))))
+  ,({ T17544_kw.hs:(18,1)-(19,26) }
+    (TyClD
+     (NoExtField)
+     (DataDecl
+      (NoExtField)
+      ({ T17544_kw.hs:18:9-11 }
+       (Unqual
+        {OccName: Bar}))
+      (HsQTvs
+       (NoExtField)
+       [])
+      (Prefix)
+      (HsDataDefn
+       (NoExtField)
+       (NewType)
+       ({ <no location info> }
+        [])
+       (Nothing)
+       (Nothing)
+       [({ T17544_kw.hs:19:9-26 }
+         (XConDecl
+          (ConDeclGADTPrefixPs
+           [({ T17544_kw.hs:19:9-13 }
+             (Unqual
+              {OccName: MkBar}))]
+           (HsIB
+            (NoExtField)
+            ({ T17544_kw.hs:19:18-26 }
+             (HsFunTy
+              (NoExtField)
+              (HsUnrestrictedArrow)
+              ({ T17544_kw.hs:19:18-19 }
+               (HsTupleTy
+                (NoExtField)
+                (HsBoxedOrConstraintTuple)
+                []))
+              ({ T17544_kw.hs:19:24-26 }
+               (HsTyVar
+                (NoExtField)
+                (NotPromoted)
+                ({ T17544_kw.hs:19:24-26 }
+                 (Unqual
+                  {OccName: Bar})))))))
+           (Just
+            ({ T17544_kw.hs:18:13-38 }
+             (HsDocString
+              " Bad comment for MkBar"))))))]
+       ({ <no location info> }
+        [])))))
+  ,({ T17544_kw.hs:(21,1)-(24,18) }
+    (TyClD
+     (NoExtField)
+     (ClassDecl
+      (VirtualBraces
+       (5))
+      ({ <no location info> }
+       [])
+      ({ T17544_kw.hs:21:7-9 }
+       (Unqual
+        {OccName: Cls}))
+      (HsQTvs
+       (NoExtField)
+       [({ T17544_kw.hs:21:11 }
+         (UserTyVar
+          (NoExtField)
+          (())
+          ({ T17544_kw.hs:21:11 }
+           (Unqual
+            {OccName: a}))))])
+      (Prefix)
+      []
+      [({ T17544_kw.hs:24:5-18 }
+        (ClassOpSig
+         (NoExtField)
+         (False)
+         [({ T17544_kw.hs:24:5-13 }
+           (Unqual
+            {OccName: clsmethod}))]
+         (HsIB
+          (NoExtField)
+          ({ T17544_kw.hs:24:18 }
+           (HsTyVar
+            (NoExtField)
+            (NotPromoted)
+            ({ T17544_kw.hs:24:18 }
+             (Unqual
+              {OccName: a})))))))]
+      {Bag(Located (HsBind GhcPs)):
+       []}
+      []
+      []
+      [({ T17544_kw.hs:22:5-34 }
+        (DocCommentNext
+         (HsDocString
+          " Bad comment for clsmethod")))])))]
+  (Nothing)
+  (Just
+   ({ T17544_kw.hs:12:3-33 }
+    (HsDocString
+     " Bad comment for the module")))))
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T8944.hs b/testsuite/tests/haddock/should_compile_flag_haddock/T8944.hs
new file mode 100644
index 0000000000..93ce9de99b
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T8944.hs
@@ -0,0 +1,10 @@
+module T8944 where
+
+import Data.Maybe ()
+-- * whatever
+import Data.Functor ()
+
+data F = F () -- ^ Comment for the first argument
+           ()
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T8944.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T8944.stderr
new file mode 100644
index 0000000000..6a7e12e763
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T8944.stderr
@@ -0,0 +1,11 @@
+
+==================== Parser ====================
+module T8944 where
+import Data.Maybe ()
+import Data.Functor ()
+data F = F () " Comment for the first argument" ()
+
+
+
+T8944.hs:4:1: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/all.T b/testsuite/tests/haddock/should_compile_flag_haddock/all.T
index c7b9d91c25..b35af797ce 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/all.T
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/all.T
@@ -7,53 +7,58 @@
 # When adding a new test here, think about adding it to the
 # should_compile_noflag_haddock directory as well.
 
-test('haddockA001', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA002', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA003', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA004', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA005', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA006', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA007', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA008', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA009', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA010', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA011', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA012', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA013', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA014', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA015', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA016', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA017', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA018', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA019', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA020', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA021', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA022', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA023', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA024', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA025', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA026', normal, compile, ['-haddock -ddump-parsed -XRankNTypes'])
-test('haddockA027', normal, compile, ['-haddock -ddump-parsed -XRankNTypes'])
-test('haddockA028', normal, compile, ['-haddock -ddump-parsed -XTypeOperators'])
-test('haddockA029', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA030', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA031', normal, compile, ['-haddock -ddump-parsed -XExistentialQuantification'])
-test('haddockA032', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA035', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA036', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA037', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA038', normal, compile, ['-haddock -ddump-parsed'])
+test('haddockA001', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA002', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA003', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA004', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA005', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA006', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA007', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA008', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA009', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA010', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA011', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA012', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA013', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA014', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA015', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA016', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA017', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA018', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA019', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA020', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA021', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA022', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA023', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA024', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA025', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA026', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed -XRankNTypes'])
+test('haddockA027', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed -XRankNTypes'])
+test('haddockA028', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed -XTypeOperators'])
+test('haddockA029', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA030', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA031', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed -XExistentialQuantification'])
+test('haddockA032', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA035', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA036', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA037', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA038', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
 
 # The tests below this line are not duplicated in
 # should_compile_noflag_haddock.
 
-test('haddockA033', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA034', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA039', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA040', normal, compile, ['-haddock -ddump-parsed'])
-test('haddockA041', [extra_files(['IncludeMe.hs'])], compile, ['-haddock -ddump-parsed'])
-test('T10398', normal, compile, ['-haddock -ddump-parsed'])
-test('T11768', normal, compile, ['-haddock -ddump-parsed'])
-test('T15206', normal, compile, ['-haddock -ddump-parsed'])
-test('T16585', normal, compile, ['-haddock -ddump-parsed'])
-test('T17561', expect_broken(17561), compile, ['-haddock -ddump-parsed'])
+test('haddockA033', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA034', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA039', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA040', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('haddockA041', [extra_files(['IncludeMe.hs'])], compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T10398', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T11768', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T15206', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T16585', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T17561', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T17544', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed-ast'])
+test('T17544_kw', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed-ast'])
+test('haddockExtraDocs', normal, compile, ['-haddock -Winvalid-haddock'])
+test('haddockTySyn', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T8944', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA022.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA022.stderr
index 6e6c5c6730..010ec9c069 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA022.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA022.stderr
@@ -1,9 +1,19 @@
 
 ==================== Parser ====================
-main = print (test :: Int)
-     where
-	 test = 0
-	 test2 = 1
-	 test3 = 2
+main
+  = print (test :: Int)
+  where
+      test = 0
+      test2 = 1
+      test3 = 2
 
 
+
+haddockA022.hs:4:5: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+haddockA022.hs:6:5: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+haddockA022.hs:10:5: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
index e09cfa2187..81b172ed80 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
@@ -2,9 +2,13 @@
 ==================== Parser ====================
 module ShouldCompile where
 data A
-  = " comment for A " A |
+  = " A comment that documents the first constructor" A |
     " comment for B " B |
     " comment for C  " C |
     D
 
 
+
+haddockA030.hs:7:5: warning: [-Winvalid-haddock]
+    Multiple Haddock comments for a single entity are not allowed.
+    The extraneous comment will be ignored.
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA033.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA033.stderr
index c1760c11fe..e3df0ec16f 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA033.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA033.stderr
@@ -9,3 +9,9 @@ f 3 = 6
 <document comment>
 
 
+
+haddockA033.hs:5:1: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
+
+haddockA033.hs:7:1: warning: [-Winvalid-haddock]
+    A Haddock comment cannot appear in this position and will be ignored.
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA041.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA041.hs
index fe9f7a24c4..3ba2c48fd9 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA041.hs
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA041.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE CPP #-}
-
 -- | Module header documentation
 module Comments_and_CPP_include where
-
 #include "IncludeMe.hs"
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockExtraDocs.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockExtraDocs.hs
new file mode 100644
index 0000000000..dc91ab3126
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockExtraDocs.hs
@@ -0,0 +1,25 @@
+module HaddockExtraDocs where
+
+data SomeField = SomeField
+
+data T1 =
+  MkT1
+    -- | Comment on SomeField
+    SomeField
+    -- ^ Another comment on SomeField? (rejected)
+
+data T2 =
+  MkT2 {
+    -- | Comment on SomeField
+    someField :: SomeField
+  } -- ^ Another comment on SomeField? (rejected)
+
+data T3 =
+  -- | Comment on MkT3
+  MkT3
+  -- ^ Another comment on MkT3? (rejected)
+
+data T4 =
+  -- | Comment on MkT4
+  MkT4 {}
+  -- ^ Another comment on MkT4? (rejected)
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockExtraDocs.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockExtraDocs.stderr
new file mode 100644
index 0000000000..b1e6cb5565
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockExtraDocs.stderr
@@ -0,0 +1,16 @@
+
+haddockExtraDocs.hs:9:5: warning: [-Winvalid-haddock]
+    Multiple Haddock comments for a single entity are not allowed.
+    The extraneous comment will be ignored.
+
+haddockExtraDocs.hs:15:5: warning: [-Winvalid-haddock]
+    Multiple Haddock comments for a single entity are not allowed.
+    The extraneous comment will be ignored.
+
+haddockExtraDocs.hs:20:3: warning: [-Winvalid-haddock]
+    Multiple Haddock comments for a single entity are not allowed.
+    The extraneous comment will be ignored.
+
+haddockExtraDocs.hs:25:3: warning: [-Winvalid-haddock]
+    Multiple Haddock comments for a single entity are not allowed.
+    The extraneous comment will be ignored.
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockTySyn.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockTySyn.hs
new file mode 100644
index 0000000000..d8597e003a
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockTySyn.hs
@@ -0,0 +1,3 @@
+module HaddockTySyn where
+
+type T = Int -- ^ Comment on type synonym RHS
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockTySyn.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockTySyn.stderr
new file mode 100644
index 0000000000..cc675fe568
--- /dev/null
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockTySyn.stderr
@@ -0,0 +1,6 @@
+
+==================== Parser ====================
+module HaddockTySyn where
+type T = Int " Comment on type synonym RHS"
+
+
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index b14b69dc04..5a6c569ad3 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -3,6 +3,8 @@
 
 ({ DumpParsedAst.hs:1:1 }
  (HsModule
+  (VirtualBraces
+   (1))
   (Just
    ({ DumpParsedAst.hs:4:8-20 }
     {ModuleName: DumpParsedAst}))
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index 689cc4187f..c5976593d3 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -3,6 +3,8 @@
 
 ({ KindSigs.hs:1:1 }
  (HsModule
+  (VirtualBraces
+   (1))
   (Just
    ({ KindSigs.hs:6:8-15 }
     {ModuleName: KindSigs}))
diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr
index fd48dbf203..7b8436f2cb 100644
--- a/testsuite/tests/parser/should_compile/T15323.stderr
+++ b/testsuite/tests/parser/should_compile/T15323.stderr
@@ -3,6 +3,8 @@
 
 ({ T15323.hs:1:1 }
  (HsModule
+  (VirtualBraces
+   (1))
   (Just
    ({ T15323.hs:3:8-13 }
     {ModuleName: T15323}))