API Annotations: Parens not attached correctly for ClassDecl

The parens around the kinded tyvars should be attached to the class
declaration as a whole, they are attached to the tyvar instead,
outside the span.

An annotation must always be within or after the span it is contained
in.

Closes #16212

(cherry picked from commit 4bf35da4fccd2a21153a1c19bfa80006e99e02a1)

1 files changed, 22 insertions, 19 deletions

diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index c1777759da..45fc5a0972 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -151,10 +151,11 @@ mkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls
   = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls
        ; let cxt = fromMaybe (noLoc []) mcxt
        ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr
-       ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
-       ; tyvars <- checkTyVarsP (text "class") whereDots cls tparams
-       ; (at_defs, anns) <- fmap unzip $ mapM (eitherToP . mkATDefault) at_insts
-       ; sequence_ anns
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars,annst) <- checkTyVarsP (text "class") whereDots cls tparams
+       ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan
+       ; (at_defs, annsi) <- mapAndUnzipM (eitherToP . mkATDefault) at_insts
+       ; sequence_ annsi
        ; return (cL loc (ClassDecl { tcdCExt = noExt, tcdCtxt = cxt
                                    , tcdLName = cls, tcdTyVars = tyvars
                                    , tcdFixity = fixity
@@ -186,7 +187,7 @@ mkATDefault (dL->L loc (TyFamInstDecl { tfid_eqn = HsIB { hsib_body = e }}))
                                     , feqn_pats   = tvs
                                     , feqn_fixity = fixity
                                     , feqn_rhs    = rhs })
-           ; pure (f, anns) }
+           ; pure (f, addAnnsAt loc anns) }
 mkATDefault (dL->L _ (TyFamInstDecl (HsIB _ (XFamEqn _)))) = panic "mkATDefault"
 mkATDefault (dL->L _ (TyFamInstDecl (XHsImplicitBndrs _))) = panic "mkATDefault"
 mkATDefault _ = panic "mkATDefault: Impossible Match"
@@ -203,8 +204,9 @@ mkTyData :: SrcSpan
 mkTyData loc new_or_data cType (dL->L _ (mcxt, tycl_hdr))
          ksig data_cons maybe_deriv
   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
-       ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
-       ; tyvars <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars, anns) <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams
+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
        ; return (cL loc (DataDecl { tcdDExt = noExt,
                                     tcdLName = tc, tcdTyVars = tyvars,
@@ -235,8 +237,9 @@ mkTySynonym :: SrcSpan
             -> P (LTyClDecl GhcPs)
 mkTySynonym loc lhs rhs
   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
-       ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
-       ; tyvars <- checkTyVarsP (text "type") equalsDots tc tparams
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars, anns) <- checkTyVarsP (text "type") equalsDots tc tparams
+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
        ; return (cL loc (SynDecl { tcdSExt = noExt
                                  , tcdLName = tc, tcdTyVars = tyvars
                                  , tcdFixity = fixity
@@ -293,8 +296,9 @@ mkFamDecl :: SrcSpan
           -> P (LTyClDecl GhcPs)
 mkFamDecl loc info lhs ksig injAnn
   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
-       ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
-       ; tyvars <- checkTyVarsP (ppr info) equals_or_where tc tparams
+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
+       ; (tyvars, anns) <- checkTyVarsP (ppr info) equals_or_where tc tparams
+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
        ; return (cL loc (FamDecl noExt (FamilyDecl
                                            { fdExt       = noExt
                                            , fdInfo      = info, fdLName = tc
@@ -804,13 +808,11 @@ really doesn't matter!
 -}
 
 checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]
-             -> P (LHsQTyVars GhcPs)
+             -> P (LHsQTyVars GhcPs, [AddAnn])
 -- Same as checkTyVars, but in the P monad
 checkTyVarsP pp_what equals_or_where tc tparms
   = do { let checkedTvs = checkTyVars pp_what equals_or_where tc tparms
-       ; (tvs, anns) <- eitherToP checkedTvs
-       ; anns
-       ; pure tvs }
+       ; eitherToP checkedTvs }
 
 eitherToP :: Either (SrcSpan, SDoc) a -> P a
 -- Adapts the Either monad to the P monad
@@ -820,14 +822,14 @@ eitherToP (Right thing)     = return thing
 checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]
             -> Either (SrcSpan, SDoc)
                       ( LHsQTyVars GhcPs  -- the synthesized type variables
-                      , P () )            -- action which adds annotations
+                      , [AddAnn] )        -- action which adds annotations
 -- ^ Check whether the given list of type parameters are all type variables
 -- (possibly with a kind signature).
 -- We use the Either monad because it's also called (via 'mkATDefault') from
 -- "Convert".
 checkTyVars pp_what equals_or_where tc tparms
   = do { (tvs, anns) <- fmap unzip $ mapM check tparms
-       ; return (mkHsQTvs tvs, sequence_ anns) }
+       ; return (mkHsQTvs tvs, concat anns) }
   where
     check (HsTypeArg ki@(L loc _)) = Left (loc,
                                       vcat [ text "Unexpected type application" <+>
@@ -839,14 +841,15 @@ checkTyVars pp_what equals_or_where tc tparms
                            <+> text "declaration for" <+> quotes (ppr tc)])
         -- Keep around an action for adjusting the annotations of extra parens
     chkParens :: [AddAnn] -> LHsType GhcPs
-              -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs, P ())
+              -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs, [AddAnn])
     chkParens acc (dL->L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l
                                                         ++ acc) ty
     chkParens acc ty = case chk ty of
       Left err -> Left err
-      Right tv@(dL->L l _) -> Right (tv, addAnnsAt l (reverse acc))
+      Right tv -> Right (tv, reverse acc)
 
         -- Check that the name space is correct!
+    chk :: LHsType GhcPs -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs)
     chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))
         | isRdrTyVar tv    = return (cL l (KindedTyVar noExt (cL lv tv) k))
     chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))