API Annotations: AnnAt disconnected for TYPEAPP

For the code

    type family F1 (a :: k) (f :: k -> Type) :: Type where
      F1 @Peano a f = T @Peano f a

the API annotation for the first @ is not attached to a SourceSpan in
the ParsedSource

Closes #16236

(cherry picked from commit cbfc9fcaa33c3b341830962906543dfca1dfedd7)

16 files changed, 200 insertions, 71 deletions

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 02b6cbc..a8a4fb6 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -596,9 +596,9 @@ repTyArgs f [] = f
 repTyArgs f (HsValArg ty : as) = do { f' <- f
                                     ; ty' <- repLTy ty
                                     ; repTyArgs (repTapp f' ty') as }
-repTyArgs f (HsTypeArg ki : as) = do { f' <- f
-                                     ; ki' <- repLTy ki
-                                     ; repTyArgs (repTappKind f' ki') as }
+repTyArgs f (HsTypeArg _ ki : as) = do { f' <- f
+                                       ; ki' <- repLTy ki
+                                       ; repTyArgs (repTappKind f' ki') as }
 repTyArgs f (HsArgPar _ : as) = repTyArgs f as
 
 repDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core TH.DecQ)
diff --git a/compiler/hieFile/HieAst.hs b/compiler/hieFile/HieAst.hs
index 8025447..5634c0c 100644
--- a/compiler/hieFile/HieAst.hs
+++ b/compiler/hieFile/HieAst.hs
@@ -339,7 +339,7 @@ instance (HasLoc a, HasLoc b) => HasLoc (FamEqn s a b) where
   loc _ = noSrcSpan
 instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
   loc (HsValArg tm) = loc tm
-  loc (HsTypeArg ty) = loc ty
+  loc (HsTypeArg _ ty) = loc ty
   loc (HsArgPar sp)  = sp
 
 instance HasLoc (HsDataDefn GhcRn) where
@@ -1464,7 +1464,7 @@ instance ToHie (TScoped (LHsType GhcRn)) where
 
 instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where
   toHie (HsValArg tm) = toHie tm
-  toHie (HsTypeArg ty) = toHie ty
+  toHie (HsTypeArg _ ty) = toHie ty
   toHie (HsArgPar sp) = pure $ locOnly sp
 
 instance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 8672a66..1a801bb 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1520,8 +1520,8 @@ mk_apps head_ty type_args = do
         case arg of
           HsValArg ty  -> do p_ty <- add_parens ty
                              mk_apps (HsAppTy noExt phead_ty p_ty) args
-          HsTypeArg ki -> do p_ki <- add_parens ki
-                             mk_apps (HsAppKindTy noExt phead_ty p_ki) args
+          HsTypeArg l ki -> do p_ki <- add_parens ki
+                               mk_apps (HsAppKindTy l phead_ty p_ki) args
           HsArgPar _   -> mk_apps (HsParTy noExt phead_ty) args
 
   go type_args
@@ -1533,7 +1533,7 @@ mk_apps head_ty type_args = do
 
 wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
 wrap_tyarg (HsValArg ty)    = HsValArg  $ parenthesizeHsType appPrec ty
-wrap_tyarg (HsTypeArg ki)   = HsTypeArg $ parenthesizeHsType appPrec ki
+wrap_tyarg (HsTypeArg l ki) = HsTypeArg l $ parenthesizeHsType appPrec ki
 wrap_tyarg ta@(HsArgPar {}) = ta -- Already parenthesized
 
 -- ---------------------------------------------------------------------
@@ -1570,7 +1570,8 @@ split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
 split_ty_app ty = go ty []
   where
     go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') }
-    go (AppKindT ty ki) as' = do { ki' <- cvtKind ki; go ty (HsTypeArg ki':as') }
+    go (AppKindT ty ki) as' = do { ki' <- cvtKind ki
+                                 ; go ty (HsTypeArg noSrcSpan ki':as') }
     go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') }
     go f as           = return (f,as)
 
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 7344358..5eeca6e 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -710,7 +710,7 @@ type instance XIParamTy        (GhcPass _) = NoExt
 type instance XStarTy          (GhcPass _) = NoExt
 type instance XKindSig         (GhcPass _) = NoExt
 
-type instance XAppKindTy       (GhcPass _) = NoExt
+type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives
 
 type instance XSpliceTy        GhcPs = NoExt
 type instance XSpliceTy        GhcRn = NoExt
@@ -1045,10 +1045,10 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
            -> LHsType (GhcPass p)
 mkHsAppTys = foldl' mkHsAppTy
 
-mkHsAppKindTy :: LHsType (GhcPass p) -> LHsType (GhcPass p)
+mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
               -> LHsType (GhcPass p)
-mkHsAppKindTy ty k
-  = addCLoc ty k (HsAppKindTy noExt ty k)
+mkHsAppKindTy ext ty k
+  = addCLoc ty k (HsAppKindTy ext ty k)
 
 {-
 ************************************************************************
@@ -1107,7 +1107,8 @@ hsTyGetAppHead_maybe = go
 -- Arguments in an expression/type after splitting
 data HsArg tm ty
   = HsValArg tm   -- Argument is an ordinary expression     (f arg)
-  | HsTypeArg  ty -- Argument is a visible type application (f @ty)
+  | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty)
+                         -- SrcSpan is location of the `@`
   | HsArgPar SrcSpan -- See Note [HsArgPar]
 
 numVisibleArgs :: [HsArg tm ty] -> Arity
@@ -1119,9 +1120,9 @@ numVisibleArgs = count is_vis
 type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)
 
 instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
-  ppr (HsValArg tm)  = ppr tm
-  ppr (HsTypeArg ty) = char '@' <> ppr ty
-  ppr (HsArgPar sp)  = text "HsArgPar"  <+> ppr sp
+  ppr (HsValArg tm)    = ppr tm
+  ppr (HsTypeArg _ ty) = char '@' <> ppr ty
+  ppr (HsArgPar sp)    = text "HsArgPar"  <+> ppr sp
 {-
 Note [HsArgPar]
 A HsArgPar indicates that everything to the left of this in the argument list is
@@ -1142,7 +1143,7 @@ splitHsAppTys e = go (noLoc e) []
     go :: LHsType GhcRn -> [LHsTypeArg GhcRn]
        -> (LHsType GhcRn, [LHsTypeArg GhcRn])
     go (L _ (HsAppTy _ f a))      as = go f (HsValArg a : as)
-    go (L _ (HsAppKindTy _ ty k)) as = go ty (HsTypeArg k : as)
+    go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)
     go (L sp (HsParTy _ f))       as = go f (HsArgPar sp : as)
     go f                          as = (f,as)
 --------------------------------
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 0c2ab34..ff57212 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1989,7 +1989,7 @@ tyapps :: { [Located TyEl] } -- NB: This list is reversed
 
 tyapp :: { Located TyEl }
         : atype                         { sL1 $1 $ TyElOpd (unLoc $1) }
-        | TYPEAPP atype                 { sLL $1 $> $ (TyElKindApp (getLoc $1) $2) }
+        | TYPEAPP atype                 { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
         | qtyconop                      { sL1 $1 $ TyElOpr (unLoc $1) }
         | tyvarop                       { sL1 $1 $ TyElOpr (unLoc $1) }
         | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index bfc63e5..00212c7 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -831,7 +831,8 @@ checkTyVars pp_what equals_or_where tc tparms
   = do { (tvs, anns) <- fmap unzip $ mapM check tparms
        ; return (mkHsQTvs tvs, concat anns) }
   where
-    check (HsTypeArg ki@(L loc _)) = Left (loc,
+    check (HsTypeArg _ ki@(L loc _))
+                              = Left (loc,
                                       vcat [ text "Unexpected type application" <+>
                                             text "@" <> ppr ki
                                           , text "In the" <+> pp_what <+>
@@ -970,7 +971,7 @@ checkTyClHdr is_cls ty
       | isRdrTc tc               = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann)
     go l (HsParTy _ ty)    acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix
     go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (HsValArg t2:acc) ann fix
-    go _ (HsAppKindTy _ ty ki) acc ann fix = goL ty (HsTypeArg ki:acc) ann fix
+    go _ (HsAppKindTy l ty ki) acc ann fix = goL ty (HsTypeArg l ki:acc) ann fix
     go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix
       = return (cL l (nameRdrName tup_name), map HsValArg ts, fix, ann)
       where
@@ -1377,10 +1378,26 @@ isFunLhs e = go e [] []
 -- | Either an operator or an operand.
 data TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs)
           | TyElKindApp SrcSpan (LHsType GhcPs)
+          -- See Note [TyElKindApp SrcSpan interpretation]
           | TyElTilde | TyElBang
           | TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness)
           | TyElDocPrev HsDocString
 
+
+{- Note [TyElKindApp SrcSpan interpretation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A TyElKindApp captures type application written in haskell as
+
+    @ Foo
+
+where Foo is some type.
+
+The SrcSpan reflects both elements, and there are AnnAt and AnnVal API
+Annotations attached to this SrcSpan for the specific locations of
+each within it.
+-}
+
 instance Outputable TyEl where
   ppr (TyElOpr name) = ppr name
   ppr (TyElOpd ty) = ppr ty
@@ -1461,12 +1478,11 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
     -- handle (NO)UNPACK pragmas
     go k acc ops_acc ((dL->L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) =
       if not (null acc) && null xs
-      then do { (addAccAnns, acc') <- eitherToP $ mergeOpsAcc acc
+      then do { acc' <- eitherToP $ mergeOpsAcc acc
               ; let a = ops_acc acc'
                     strictMark = HsSrcBang unpkSrc unpk NoSrcStrict
                     bl = combineSrcSpans l (getLoc a)
                     bt = HsBangTy noExt strictMark a
-              ; addAccAnns
               ; addAnnsAt bl anns
               ; return (cL bl bt) }
       else parseErrorSDoc l unpkError
@@ -1502,8 +1518,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
                       -- due to #15884
         in guess xs
       = if not (null acc) && (k > 1 || length acc > 1)
-        then do { (_, a) <- eitherToP (mergeOpsAcc acc)
-               -- no need to add annotations since it fails anyways!
+        then do { a <- eitherToP (mergeOpsAcc acc)
                 ; failOpStrictnessCompound (cL l str) (ops_acc a) }
         else failOpStrictnessPosition (cL l str)
 
@@ -1514,8 +1529,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
     go k acc ops_acc ((dL->L l (TyElOpr op)):xs) =
       if null acc || null (filter isTyElOpd xs)
         then failOpFewArgs (cL l op)
-        else do { (addAccAnns, acc') <- eitherToP (mergeOpsAcc acc)
-                ; addAccAnns
+        else do { acc' <- eitherToP (mergeOpsAcc acc)
                 ; go (k + 1) [] (\c -> mkLHsOpTy c (cL l op) (ops_acc acc')) xs }
       where
         isTyElOpd (dL->L _ (TyElOpd _)) = True
@@ -1537,33 +1551,32 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
 
     -- clause [tyapp]:
     -- whenever a type application is encountered, it is added to the accumulator
-    go k acc ops_acc ((dL->L _ (TyElKindApp l a)):xs) = go k (HsTypeArg (l, a):acc) ops_acc xs
+    go k acc ops_acc ((dL->L _ (TyElKindApp l a)):xs) = go k (HsTypeArg l a:acc) ops_acc xs
 
     -- clause [end]
     -- See Note [Non-empty 'acc' in mergeOps clause [end]]
-    go _ acc ops_acc [] = do { (addAccAnns, acc') <- eitherToP (mergeOpsAcc acc)
-                             ; addAccAnns
+    go _ acc ops_acc [] = do { acc' <- eitherToP (mergeOpsAcc acc)
                              ; return (ops_acc acc') }
 
     go _ _ _ _ = panic "mergeOps.go: Impossible Match"
                         -- due to #15884
 
-mergeOpsAcc :: [HsArg (LHsType GhcPs) (SrcSpan, LHsKind GhcPs)]
-         -> Either (SrcSpan, SDoc) (P (), LHsType GhcPs)
+mergeOpsAcc :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
+         -> Either (SrcSpan, SDoc) (LHsType GhcPs)
 mergeOpsAcc [] = panic "mergeOpsAcc: empty input"
-mergeOpsAcc (HsTypeArg (_, L loc ki):_)
+mergeOpsAcc (HsTypeArg _ (L loc ki):_)
   = Left (loc, text "Unexpected type application:" <+> ppr ki)
-mergeOpsAcc (HsValArg ty : xs) = go1 (pure ()) ty xs
+mergeOpsAcc (HsValArg ty : xs) = go1 ty xs
   where
-    go1 :: P () -> LHsType GhcPs
-        -> [HsArg (LHsType GhcPs) (SrcSpan, LHsKind GhcPs)]
-        -> Either (SrcSpan, SDoc) (P (), LHsType GhcPs)
-    go1 anns lhs []     = Right (anns, lhs)
-    go1 anns lhs (x:xs) = case x of
-        HsValArg ty -> go1 anns (mkHsAppTy lhs ty) xs
-        HsTypeArg (loc, ki) -> let ty = mkHsAppKindTy lhs ki
-                               in go1 (addAnnotation (getLoc ty) AnnAt loc >> anns) ty xs
-        HsArgPar _ -> go1 anns lhs xs
+    go1 :: LHsType GhcPs
+        -> [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
+        -> Either (SrcSpan, SDoc) (LHsType GhcPs)
+    go1 lhs []     = Right lhs
+    go1 lhs (x:xs) = case x of
+        HsValArg ty -> go1 (mkHsAppTy lhs ty) xs
+        HsTypeArg loc ki -> let ty = mkHsAppKindTy loc lhs ki
+                            in go1 ty xs
+        HsArgPar _ -> go1 lhs xs
 mergeOpsAcc (HsArgPar _: xs) = mergeOpsAcc xs
 
 {- Note [Impossible case in mergeOps clause [unpk]]
@@ -1626,19 +1639,19 @@ pInfixSide (el:xs1)
   | Just t1 <- pLHsTypeArg el
   = go [t1] xs1
    where
-     go :: [HsArg (LHsType GhcPs) (SrcSpan, LHsKind GhcPs)]
+     go :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]
         -> [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])
      go acc (el:xs)
        | Just t <- pLHsTypeArg el
        = go (t:acc) xs
      go acc xs = case mergeOpsAcc acc of
        Left _ -> Nothing
-       Right (addAnns, acc') -> Just (acc', addAnns, xs)
+       Right acc' -> Just (acc', pure (), xs)
 pInfixSide _ = Nothing
 
-pLHsTypeArg :: Located TyEl -> Maybe (HsArg (LHsType GhcPs) (SrcSpan, LHsKind GhcPs))
+pLHsTypeArg :: Located TyEl -> Maybe (HsArg (LHsType GhcPs) (LHsKind GhcPs))
 pLHsTypeArg (dL->L l (TyElOpd a)) = Just (HsValArg (L l a))
-pLHsTypeArg (dL->L _ (TyElKindApp l a)) = Just (HsTypeArg (l,a))
+pLHsTypeArg (dL->L _ (TyElKindApp l a)) = Just (HsTypeArg l a)
 pLHsTypeArg _ = Nothing
 
 pDocPrev :: [Located TyEl] -> (Maybe LHsDocString, [Located TyEl])
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 3703f1a..1eaf89a 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -486,9 +486,9 @@ rnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs
 rnLHsTypeArg ctxt (HsValArg ty)
    = do { (tys_rn, fvs) <- rnLHsType ctxt ty
         ; return (HsValArg tys_rn, fvs) }
-rnLHsTypeArg ctxt (HsTypeArg ki)
+rnLHsTypeArg ctxt (HsTypeArg l ki)
    = do { (kis_rn, fvs) <- rnLHsKind ctxt ki
-        ; return (HsTypeArg kis_rn, fvs) }
+        ; return (HsTypeArg l kis_rn, fvs) }
 rnLHsTypeArg _ (HsArgPar sp)
    = return (HsArgPar sp, emptyFVs)
 
@@ -636,12 +636,12 @@ rnHsTyKi env (HsAppTy _ ty1 ty2)
        ; (ty2', fvs2) <- rnLHsTyKi env ty2
        ; return (HsAppTy noExt ty1' ty2', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi env (HsAppKindTy _ ty k)
+rnHsTyKi env (HsAppKindTy l ty k)
   = do { kind_app <- xoptM LangExt.TypeApplications
        ; unless kind_app (addErr (typeAppErr "kind" k))
        ; (ty', fvs1) <- rnLHsTyKi env ty
        ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
-       ; return (HsAppKindTy noExt ty' k', fvs1 `plusFV` fvs2) }
+       ; return (HsAppKindTy l ty' k', fvs1 `plusFV` fvs2) }
 
 rnHsTyKi env t@(HsIParamTy _ n ty)
   = do { notInKinds env t
@@ -1632,7 +1632,7 @@ inScope rdr_env rdr = rdr `elemLocalRdrEnv` rdr_env
 
 extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
 extract_tyarg (HsValArg ty) acc = extract_lty TypeLevel ty acc
-extract_tyarg (HsTypeArg ki) acc = extract_lty KindLevel ki acc
+extract_tyarg (HsTypeArg _ ki) acc = extract_lty KindLevel ki acc
 extract_tyarg (HsArgPar _) acc = acc
 
 extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 63cb351..0e09008 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -1099,10 +1099,10 @@ wrapHsArgs :: (NoGhcTc (GhcPass id) ~ GhcRn)
            => LHsExpr (GhcPass id)
            -> [HsArg (LHsExpr (GhcPass id)) (LHsWcType GhcRn)]
            -> LHsExpr (GhcPass id)
-wrapHsArgs f []                   = f
-wrapHsArgs f (HsValArg  a : args) = wrapHsArgs (mkHsApp f a)     args
-wrapHsArgs f (HsTypeArg t : args) = wrapHsArgs (mkHsAppType f t) args
-wrapHsArgs f (HsArgPar sp : args) = wrapHsArgs (L sp $ HsPar noExt f) args
+wrapHsArgs f []                     = f
+wrapHsArgs f (HsValArg  a : args)   = wrapHsArgs (mkHsApp f a)          args
+wrapHsArgs f (HsTypeArg _ t : args) = wrapHsArgs (mkHsAppType f t)      args
+wrapHsArgs f (HsArgPar sp : args)   = wrapHsArgs (L sp $ HsPar noExt f) args
 
 isHsValArg :: HsArg tm ty -> Bool
 isHsValArg (HsValArg {})  = True
@@ -1143,7 +1143,7 @@ tcApp m_herald (L _ (HsApp _ fun arg1)) args res_ty
   = tcApp m_herald fun (HsValArg arg1 : args) res_ty
 
 tcApp m_herald (L _ (HsAppType _ fun ty1)) args res_ty
-  = tcApp m_herald fun (HsTypeArg ty1 : args) res_ty
+  = tcApp m_herald fun (HsTypeArg noSrcSpan ty1 : args) res_ty
 
 tcApp m_herald fun@(L loc (HsRecFld _ fld_lbl)) args res_ty
   | Ambiguous _ lbl        <- fld_lbl  -- Still ambiguous
@@ -1177,7 +1177,7 @@ tcApp m_herald fun@(L loc (HsVar _ (L _ fun_id))) args res_ty
   where
     n_val_args = count isHsValArg args
 
-tcApp _ (L loc (ExplicitList _ Nothing [])) [HsTypeArg ty_arg] res_ty
+tcApp _ (L loc (ExplicitList _ Nothing [])) [HsTypeArg _ ty_arg] res_ty
   -- See Note [Visible type application for the empty list constructor]
   = do { ty_arg' <- tcHsTypeApp ty_arg liftedTypeKind
        ; let list_ty = TyConApp listTyCon [ty_arg']
@@ -1233,7 +1233,7 @@ mk_app_msg fun args = sep [ text "The" <+> text what <+> quotes (ppr expr)
     -- Include visible type arguments (but not other arguments) in the herald.
     -- See Note [Herald for matchExpectedFunTys] in TcUnify.
     expr = mkHsAppTypes fun type_app_args
-    type_app_args = [hs_ty | HsTypeArg hs_ty <- args]
+    type_app_args = [hs_ty | HsTypeArg _ hs_ty <- args]
 
 mk_op_msg :: LHsExpr GhcRn -> SDoc
 mk_op_msg op = text "The operator" <+> quotes (ppr op) <+> text "takes"
@@ -1303,7 +1303,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
            ; return (inner_wrap, HsArgPar sp : args', res_ty)
            }
 
-    go acc_args n fun_ty (HsTypeArg hs_ty_arg : args)
+    go acc_args n fun_ty (HsTypeArg l hs_ty_arg : args)
       = do { (wrap1, upsilon_ty) <- topInstantiateInferred fun_orig fun_ty
                -- wrap1 :: fun_ty "->" upsilon_ty
            ; case tcSplitForAllTy_maybe upsilon_ty of
@@ -1334,7 +1334,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
                    -- inner_wrap :: insted_ty "->" (map typeOf args') -> res_ty
                     ; let inst_wrap = mkWpTyApps [ty_arg]
                     ; return ( inner_wrap <.> inst_wrap <.> wrap1
-                             , HsTypeArg hs_ty_arg : args'
+                             , HsTypeArg l hs_ty_arg : args'
                              , res_ty ) }
                _ -> ty_app_err upsilon_ty hs_ty_arg }
 
@@ -1915,7 +1915,7 @@ tcTagToEnum loc fun_name args res_ty
              (before, _:after) = break isHsValArg args
 
        ; arg <- case filterOut isArgPar args of
-           [HsTypeArg hs_ty_arg, HsValArg term_arg]
+           [HsTypeArg _ hs_ty_arg, HsValArg term_arg]
              -> do { ty_arg <- tcHsTypeApp hs_ty_arg liftedTypeKind
                    ; _ <- tcSubTypeDS (OccurrenceOf fun_name) GenSigCtxt ty_arg res_ty
                      -- other than influencing res_ty, we just
@@ -1973,8 +1973,8 @@ too_many_args fun args
        2 (sep (map pp args))
   where
     pp (HsValArg e)                             = ppr e
-    pp (HsTypeArg (HsWC { hswc_body = L _ t })) = pprHsType t
-    pp (HsTypeArg (XHsWildCardBndrs _)) = panic "too_many_args"
+    pp (HsTypeArg _ (HsWC { hswc_body = L _ t })) = pprHsType t
+    pp (HsTypeArg _ (XHsWildCardBndrs _)) = panic "too_many_args"
     pp (HsArgPar _) = empty
 
 
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 006a97b..6ff9729 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -996,7 +996,7 @@ tcInferApps mode orig_hs_ty fun_ty fun_ki orig_hs_args
     go n subst fun all_kindbinder@(ki_binder:ki_binders) inner_ki
        all_args@(arg:args)
       | Specified <- tyCoBinderArgFlag ki_binder
-      , HsTypeArg ki <- arg
+      , HsTypeArg _ ki <- arg
          -- Invisible and specified binder with visible kind argument
          = do { traceTc "tcInferApps (vis kind app)" (vcat [ ppr ki_binder, ppr ki
                                                      , ppr (tyBinderType ki_binder)
@@ -1039,13 +1039,13 @@ tcInferApps mode orig_hs_ty fun_ty fun_ki orig_hs_args
                           (mkNakedAppTy fun arg')
                           ki_binders inner_ki args }
             -- error if the argument is a kind application
-             HsTypeArg ki -> do { traceTc "tcInferApps (error)"
+             HsTypeArg _ ki -> do { traceTc "tcInferApps (error)"
                                     (vcat [ ppr ki_binder
                                           , ppr ki
                                           , ppr (tyBinderType ki_binder)
                                           , ppr subst
                                           , ppr (isInvisibleBinder ki_binder) ])
-                                ; ty_app_err ki $ nakedSubstTy subst $
+                                  ; ty_app_err ki $ nakedSubstTy subst $
                                                   mkPiTys all_kindbinder inner_ki }
 
              HsArgPar _ -> panic "tcInferApps"  -- handled in separate clause of "go"
@@ -1068,7 +1068,7 @@ tcInferApps mode orig_hs_ty fun_ty fun_ki orig_hs_args
                     (fun `mkNakedCastTy` co)  -- See Note [The well-kinded type invariant]
                     [mkAnonBinder arg_k]
                     res_k all_args }
-        (HsTypeArg ki) -> ty_app_err ki substed_inner_ki
+        (HsTypeArg _ ki) -> ty_app_err ki substed_inner_ki
         (HsArgPar _) -> go n subst fun [] inner_ki args
       where
         substed_inner_ki               = substTy subst inner_ki
@@ -1082,7 +1082,8 @@ tcInferApps mode orig_hs_ty fun_ty fun_ki orig_hs_args
 appTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn
 appTypeToArg f [] = f
 appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args
-appTypeToArg f (HsTypeArg arg : args) = appTypeToArg (mkHsAppKindTy f arg) args
+appTypeToArg f (HsTypeArg l arg : args)
+  = appTypeToArg (mkHsAppKindTy l f arg) args
 appTypeToArg f (HsArgPar _ : arg) = appTypeToArg f arg
 
 -- | Applies a type to a list of arguments.
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 1c0fd2c..33eabde 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -157,3 +157,7 @@ T16279:
 .PHONY: T16230
 T16230:
 	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16230.hs
+
+.PHONY: T16236
+T16236:
+	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16236.hs
diff --git a/testsuite/tests/ghc-api/annotations/T16236.stdout b/testsuite/tests/ghc-api/annotations/T16236.stdout
new file mode 100644
index 0000000..986b9a4
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T16236.stdout
@@ -0,0 +1,85 @@
+---Unattached Annotation Problems (should be empty list)---
+[]
+---Ann before enclosing span problem (should be empty list)---
+[
+
+]
+
+---Annotations-----------------------
+-- SrcSpan the annotation is attached to, AnnKeywordId,
+--    list of locations the keyword item appears in
+[
+((Test16236.hs:1:1,AnnModule), [Test16236.hs:4:1-6]),
+((Test16236.hs:1:1,AnnWhere), [Test16236.hs:4:22-26]),
+((Test16236.hs:5:1-16,AnnImport), [Test16236.hs:5:1-6]),
+((Test16236.hs:5:1-16,AnnSemi), [Test16236.hs:7:1]),
+((Test16236.hs:7:1-30,AnnData), [Test16236.hs:7:1-4]),
+((Test16236.hs:7:1-30,AnnEqual), [Test16236.hs:7:12]),
+((Test16236.hs:7:1-30,AnnSemi), [Test16236.hs:9:1]),
+((Test16236.hs:7:14-17,AnnVbar), [Test16236.hs:7:19]),
+((Test16236.hs:9:1-39,AnnCloseP), [Test16236.hs:9:30]),
+((Test16236.hs:9:1-39,AnnDcolon), [Test16236.hs:9:32-33]),
+((Test16236.hs:9:1-39,AnnFamily), [Test16236.hs:9:6-11]),
+((Test16236.hs:9:1-39,AnnOpenP), [Test16236.hs:9:20]),
+((Test16236.hs:9:1-39,AnnSemi), [Test16236.hs:14:1]),
+((Test16236.hs:9:1-39,AnnType), [Test16236.hs:9:1-4]),
+((Test16236.hs:9:1-39,AnnWhere), [Test16236.hs:9:41-45]),
+((Test16236.hs:9:20-30,AnnCloseP), [Test16236.hs:9:30]),
+((Test16236.hs:9:20-30,AnnOpenP), [Test16236.hs:9:20]),
+((Test16236.hs:9:21-29,AnnDcolon), [Test16236.hs:9:24-25]),
+((Test16236.hs:9:27-29,AnnCloseS), [Test16236.hs:9:29]),
+((Test16236.hs:9:27-29,AnnOpenS), [Test16236.hs:9:27]),
+((Test16236.hs:10:3-36,AnnEqual), [Test16236.hs:10:19]),
+((Test16236.hs:10:3-36,AnnSemi), [Test16236.hs:11:3]),
+((Test16236.hs:10:10-17,AnnCloseP), [Test16236.hs:10:17]),
+((Test16236.hs:10:10-17,AnnOpenP), [Test16236.hs:10:10]),
+((Test16236.hs:10:26-36,AnnCloseP), [Test16236.hs:10:36]),
+((Test16236.hs:10:26-36,AnnOpenP), [Test16236.hs:10:26]),
+((Test16236.hs:11:3-24,AnnEqual), [Test16236.hs:11:19]),
+((Test16236.hs:11:10-12,AnnCloseS), [Test16236.hs:11:12]),
+((Test16236.hs:11:10-12,AnnOpenS), [Test16236.hs:11:11]),
+((Test16236.hs:11:10-12,AnnSimpleQuote), [Test16236.hs:11:10]),
+((Test16236.hs:14:1-29,AnnCloseP), [Test16236.hs:14:17]),
+((Test16236.hs:14:1-29,AnnData), [Test16236.hs:14:1-4]),
+((Test16236.hs:14:1-29,AnnEqual), [Test16236.hs:14:19]),
+((Test16236.hs:14:1-29,AnnOpenP), [Test16236.hs:14:10]),
+((Test16236.hs:14:1-29,AnnSemi), [Test16236.hs:16:1]),
+((Test16236.hs:14:10-17,AnnCloseP), [Test16236.hs:14:17]),
+((Test16236.hs:14:10-17,AnnOpenP), [Test16236.hs:14:10]),
+((Test16236.hs:14:11-16,AnnDcolon), [Test16236.hs:14:13-14]),
+((Test16236.hs:14:25-29,AnnCloseP), [Test16236.hs:14:29]),
+((Test16236.hs:14:25-29,AnnOpenP), [Test16236.hs:14:25]),
+((Test16236.hs:16:1-48,AnnCloseP), [Test16236.hs:16:23, Test16236.hs:16:40]),
+((Test16236.hs:16:1-48,AnnDcolon), [Test16236.hs:16:42-43]),
+((Test16236.hs:16:1-48,AnnFamily), [Test16236.hs:16:6-11]),
+((Test16236.hs:16:1-48,AnnOpenP), [Test16236.hs:16:16, Test16236.hs:16:25]),
+((Test16236.hs:16:1-48,AnnSemi), [Test16236.hs:19:1]),
+((Test16236.hs:16:1-48,AnnType), [Test16236.hs:16:1-4]),
+((Test16236.hs:16:1-48,AnnWhere), [Test16236.hs:16:50-54]),
+((Test16236.hs:16:16-23,AnnCloseP), [Test16236.hs:16:23]),
+((Test16236.hs:16:16-23,AnnOpenP), [Test16236.hs:16:16]),
+((Test16236.hs:16:17-22,AnnDcolon), [Test16236.hs:16:19-20]),
+((Test16236.hs:16:25-40,AnnCloseP), [Test16236.hs:16:40]),
+((Test16236.hs:16:25-40,AnnOpenP), [Test16236.hs:16:25]),
+((Test16236.hs:16:26-39,AnnDcolon), [Test16236.hs:16:28-29]),
+((Test16236.hs:16:31,AnnRarrow), [Test16236.hs:16:33-34]),
+((Test16236.hs:16:31-39,AnnRarrow), [Test16236.hs:16:33-34]),
+((Test16236.hs:17:3-30,AnnEqual), [Test16236.hs:17:17]),
+((Test16236.hs:19:1-11,AnnCloseP), [Test16236.hs:19:24]),
+((Test16236.hs:19:1-11,AnnData), [Test16236.hs:19:1-4]),
+((Test16236.hs:19:1-11,AnnFamily), [Test16236.hs:19:6-11]),
+((Test16236.hs:19:1-11,AnnOpenP), [Test16236.hs:19:17]),
+((Test16236.hs:19:1-11,AnnSemi), [Test16236.hs:20:1]),
+((Test16236.hs:19:17-24,AnnCloseP), [Test16236.hs:19:24]),
+((Test16236.hs:19:17-24,AnnOpenP), [Test16236.hs:19:17]),
+((Test16236.hs:19:18-23,AnnDcolon), [Test16236.hs:19:20-21]),
+((Test16236.hs:20:1-49,AnnData), [Test16236.hs:20:1-4]),
+((Test16236.hs:20:1-49,AnnEqual), [Test16236.hs:20:41]),
+((Test16236.hs:20:1-49,AnnInstance), [Test16236.hs:20:6-13]),
+((Test16236.hs:20:1-49,AnnSemi), [Test16236.hs:21:1]),
+((Test16236.hs:20:20-37,AnnCloseP), [Test16236.hs:20:37]),
+((Test16236.hs:20:20-37,AnnOpenP), [Test16236.hs:20:20]),
+((Test16236.hs:20:21-26,AnnRarrow), [Test16236.hs:20:28-29]),
+((Test16236.hs:20:21-36,AnnRarrow), [Test16236.hs:20:28-29]),
+((<no location info>,AnnEofPos), [Test16236.hs:21:1])
+]
diff --git a/testsuite/tests/ghc-api/annotations/Test16236.hs b/testsuite/tests/ghc-api/annotations/Test16236.hs
new file mode 100644
index 0000000..e19a0ee
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test16236.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies
+             , TypeApplications, TypeInType #-}
+
+module DumpParsedAst where
+import Data.Kind
+
+data Peano = Zero | Succ Peano
+
+type family Length (as :: [k]) :: Peano where
+  Length (a : as) = Succ (Length as)
+  Length '[]      = Zero
+
+-- vis kind app
+data T f (a :: k) = MkT (f a)
+
+type family F1 (a :: k) (f :: k -> Type) :: Type where
+  F1 @Peano a f = T @Peano f a
+
+data family DF3 (a :: k)
+data instance DF3 @(K.Type -> K.Type) b = DF3Char
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index c80e3aa..8cad6fc 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -65,3 +65,5 @@ test('T16212',      [extra_files(['Test16212.hs']),
                      ignore_stderr], run_command, ['$MAKE -s --no-print-directory T16212'])
 test('T16230',      [extra_files(['Test16230.hs']),
                      ignore_stderr], run_command, ['$MAKE -s --no-print-directory T16230'])
+test('T16236',      [extra_files(['Test16236.hs']),
+                     ignore_stderr], run_command, ['$MAKE -s --no-print-directory T16236'])
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 81607d7..5c8bb34 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -292,6 +292,7 @@
                {OccName: F1}))
              (Nothing)
              [(HsTypeArg
+               { DumpParsedAst.hs:17:6-11 }
                ({ DumpParsedAst.hs:17:7-11 }
                 (HsTyVar
                  (NoExt)
@@ -324,7 +325,7 @@
                  (NoExt)
                  ({ DumpParsedAst.hs:17:19-26 }
                   (HsAppKindTy
-                   (NoExt)
+                   { DumpParsedAst.hs:17:21-26 }
                    ({ DumpParsedAst.hs:17:19 }
                     (HsTyVar
                      (NoExt)
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 8df66c8..d6cfe26 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -536,6 +536,7 @@
                 {Name: DumpRenamedAst.F1})
                (Nothing)
                [(HsTypeArg
+                 { DumpRenamedAst.hs:24:6-11 }
                  ({ DumpRenamedAst.hs:24:7-11 }
                   (HsTyVar
                    (NoExt)
@@ -565,7 +566,7 @@
                    (NoExt)
                    ({ DumpRenamedAst.hs:24:19-26 }
                     (HsAppKindTy
-                     (NoExt)
+                     { DumpRenamedAst.hs:24:21-26 }
                      ({ DumpRenamedAst.hs:24:19 }
                       (HsTyVar
                        (NoExt)
diff --git a/utils/haddock b/utils/haddock
-Subproject 21e4f3fa6f73a9b25f3deed80da0e56024238ea
+Subproject 02589fd1eeb2dd0b65747672ed95a2cd040c6ad