Fix API Annotations for GADT constructors

Summary:
This patch completes the work for #14529 by making sure that all API
Annotations end up attached to a SrcSpan that appears in the final
ParsedSource.

Updates Haddock submodule

Test Plan: ./validate

Reviewers: goldfire, bgamari

Subscribers: rwbarton, thomie, mpickering, carter

GHC Trac Issues: #14529

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

6 files changed, 42 insertions, 32 deletions

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 1e85ea133e..832473edd6 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -693,13 +693,13 @@ repAnnProv ModuleAnnProvenance
 
 repC :: LConDecl GhcRn -> DsM (Core TH.ConQ)
 repC (L _ (ConDeclH98 { con_name = con
-                      , con_forall = False
+                      , con_forall = L _ False
                       , con_mb_cxt = Nothing
                       , con_args = args }))
   = repDataCon con args
 
 repC (L _ (ConDeclH98 { con_name = con
-                      , con_forall = is_existential
+                      , con_forall = L _ is_existential
                       , con_ex_tvs = con_tvs
                       , con_mb_cxt = mcxt
                       , con_args = args }))
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 7b721ed1f2..3da163c71d 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -535,14 +535,14 @@ cvtConstr (ForallC tvs ctxt con)
     add_cxt (L loc cxt1) (Just (L _ cxt2)) = Just (L loc (cxt1 ++ cxt2))
 
     add_forall tvs' cxt' con@(ConDeclGADT { con_qvars = qvars, con_mb_cxt = cxt })
-      = con { con_forall = not (null all_tvs)
+      = con { con_forall = noLoc $ not (null all_tvs)
             , con_qvars  = mkHsQTvs all_tvs
             , con_mb_cxt = add_cxt cxt' cxt }
       where
         all_tvs = hsQTvExplicit tvs' ++ hsQTvExplicit qvars
 
     add_forall tvs' cxt' con@(ConDeclH98 { con_ex_tvs = ex_tvs, con_mb_cxt = cxt })
-      = con { con_forall = not (null all_tvs)
+      = con { con_forall = noLoc $ not (null all_tvs)
             , con_ex_tvs = all_tvs
             , con_mb_cxt = add_cxt cxt' cxt }
       where
@@ -555,7 +555,7 @@ cvtConstr (GadtC c strtys ty)
         ; args    <- mapM cvt_arg strtys
         ; L _ ty' <- cvtType ty
         ; c_ty    <- mk_arr_apps args ty'
-        ; returnL $ mkGadtDecl c' c_ty}
+        ; returnL $ fst $ mkGadtDecl c' c_ty}
 
 cvtConstr (RecGadtC c varstrtys ty)
   = do  { c'       <- mapM cNameL c
@@ -563,7 +563,7 @@ cvtConstr (RecGadtC c varstrtys ty)
         ; rec_flds <- mapM cvt_id_arg varstrtys
         ; let rec_ty = noLoc (HsFunTy noExt
                                            (noLoc $ HsRecTy noExt rec_flds) ty')
-        ; returnL $ mkGadtDecl c' rec_ty }
+        ; returnL $ fst $ mkGadtDecl c' rec_ty }
 
 cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
 cvtSrcUnpackedness NoSourceUnpackedness = NoSrcUnpack
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index c7a0ea0716..7ac43543bb 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -1236,7 +1236,9 @@ data ConDecl pass
 
       -- The next four fields describe the type after the '::'
       -- See Note [GADT abstract syntax]
-      , con_forall  :: Bool              -- ^ True <=> explicit forall
+      -- The following field is Located to anchor API Annotations,
+      -- AnnForall and AnnDot.
+      , con_forall  :: Located Bool      -- ^ True <=> explicit forall
                                          --   False => hsq_explicit is empty
       , con_qvars   :: LHsQTyVars pass
                        -- Whether or not there is an /explicit/ forall, we still
@@ -1254,7 +1256,8 @@ data ConDecl pass
       { con_ext     :: XConDeclH98 pass
       , con_name    :: Located (IdP pass)
 
-      , con_forall  :: Bool   -- ^ True <=> explicit user-written forall
+      , con_forall  :: Located Bool
+                              -- ^ True <=> explicit user-written forall
                               --     e.g. data T a = forall b. MkT b (b->a)
                               --     con_ex_tvs = {b}
                               -- False => con_ex_tvs is empty
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index d4caf76338..066ee421fb 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2139,8 +2139,9 @@ gadt_constr :: { LConDecl GhcPs }
     -- see Note [Difference in parsing GADT and data constructors]
     -- Returns a list because of:   C,D :: ty
         : con_list '::' sigtypedoc
-                {% ams (sLL $1 $> (mkGadtDecl (unLoc $1) $3))
-                       [mu AnnDcolon $2] }
+                {% let (gadt,anns) = mkGadtDecl (unLoc $1) $3
+                   in ams (sLL $1 $> gadt)
+                       (mu AnnDcolon $2:anns) }
 
 {- Note [Difference in parsing GADT and data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 64b74d3317..22de5ac63f 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -629,7 +629,7 @@ mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs]
 mkConDeclH98 name mb_forall mb_cxt args
   = ConDeclH98 { con_ext    = noExt
                , con_name   = name
-               , con_forall = isJust mb_forall
+               , con_forall = noLoc $ isJust mb_forall
                , con_ex_tvs = mb_forall `orElse` []
                , con_mb_cxt = mb_cxt
                , con_args   = args'
@@ -639,33 +639,39 @@ mkConDeclH98 name mb_forall mb_cxt args
 
 mkGadtDecl :: [Located RdrName]
            -> LHsType GhcPs     -- Always a HsForAllTy
-           -> ConDecl GhcPs
+           -> (ConDecl GhcPs, [AddAnn])
 mkGadtDecl names ty
-  = ConDeclGADT { con_g_ext  = noExt
-                , con_names  = names
-                , con_forall = isLHsForAllTy ty
-                , con_qvars  = mkHsQTvs tvs
-                , con_mb_cxt = mcxt
-                , con_args   = args'
-                , con_res_ty = res_ty
-                , con_doc    = Nothing }
+  = (ConDeclGADT { con_g_ext  = noExt
+                 , con_names  = names
+                 , con_forall = L l $ isLHsForAllTy ty
+                 , con_qvars  = mkHsQTvs tvs
+                 , con_mb_cxt = mcxt
+                 , con_args   = args'
+                 , con_res_ty = res_ty
+                 , con_doc    = Nothing }
+    , anns1 ++ anns2 ++ anns3)
   where
-    (tvs, rho) = splitLHsForAllTy ty
-    (mcxt, tau) = split_rho rho
+    (ty'@(L l _),anns1) = peel_parens ty []
+    (tvs, rho) = splitLHsForAllTy ty'
+    (mcxt, tau, anns2) = split_rho rho []
 
-    split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau }))
-                                   = (Just cxt, tau)
-    split_rho (L _ (HsParTy _ ty)) = split_rho ty
-    split_rho tau                  = (Nothing, tau)
+    split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) ann
+                                       = (Just cxt, tau, ann)
+    split_rho (L l (HsParTy _ ty)) ann = split_rho ty (ann++mkParensApiAnn l)
+    split_rho tau                  ann = (Nothing, tau, ann)
 
-    (args, res_ty) = split_tau tau
+    (args, res_ty, anns3) = split_tau tau []
     args' = nudgeHsSrcBangs args
 
     -- See Note [GADT abstract syntax] in HsDecls
-    split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty))
-                                   = (RecCon (L loc rf), res_ty)
-    split_tau (L _ (HsParTy _ ty)) = split_tau ty
-    split_tau tau                  = (PrefixCon [], tau)
+    split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty)) ann
+                                       = (RecCon (L loc rf), res_ty, ann)
+    split_tau (L l (HsParTy _ ty)) ann = split_tau ty (ann++mkParensApiAnn l)
+    split_tau tau                  ann = (PrefixCon [], tau, ann)
+
+    peel_parens (L l (HsParTy _ ty)) ann = peel_parens ty
+                                                       (ann++mkParensApiAnn l)
+    peel_parens ty                   ann = (ty, ann)
 
 nudgeHsSrcBangs :: HsConDeclDetails GhcPs -> HsConDeclDetails GhcPs
 -- ^ This function ensures that fields with strictness or packedness
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 98f8005381..bff6694d87 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -2007,7 +2007,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
                   all_fvs) }}
 
 rnConDecl decl@(ConDeclGADT { con_names   = names
-                            , con_forall  = explicit_forall
+                            , con_forall  = L _ explicit_forall
                             , con_qvars   = qtvs
                             , con_mb_cxt  = mcxt
                             , con_args    = args