HsToken in TypeArg (#19623)

Updates the haddock submodule.

18 files changed, 84 insertions, 61 deletions

diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 41dd33bee9..74d75fb7be 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -510,10 +510,10 @@ deriving instance Data thing => Data (HsScaled GhcPs thing)
 deriving instance Data thing => Data (HsScaled GhcRn thing)
 deriving instance Data thing => Data (HsScaled GhcTc thing)
 
-deriving instance (Data a, Data b) => Data (HsArg a b)
--- deriving instance Data (HsArg (Located (HsType GhcPs)) (Located (HsKind GhcPs)))
--- deriving instance Data (HsArg (Located (HsType GhcRn)) (Located (HsKind GhcRn)))
--- deriving instance Data (HsArg (Located (HsType GhcTc)) (Located (HsKind GhcTc)))
+-- deriving instance (Data a, Data b) => Data (HsArg p a b)
+deriving instance (Data a, Data b) => Data (HsArg GhcPs a b)
+deriving instance (Data a, Data b) => Data (HsArg GhcRn a b)
+deriving instance (Data a, Data b) => Data (HsArg GhcTc a b)
 
 -- deriving instance (DataIdLR p p) => Data (ConDeclField p)
 deriving instance Data (ConDeclField GhcPs)
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 9004f8dacb..053042d4a1 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -1,5 +1,6 @@
 
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveDataTypeable #-}
@@ -94,6 +95,7 @@ import Language.Haskell.Syntax.Type
 
 import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) )
 
+import Language.Haskell.Syntax.Concrete
 import Language.Haskell.Syntax.Extension
 import GHC.Core.DataCon( SrcStrictness(..), SrcUnpackedness(..), HsImplBang(..) )
 import GHC.Hs.Extension
@@ -312,7 +314,7 @@ type instance XIParamTy        (GhcPass _) = EpAnn [AddEpAnn]
 type instance XStarTy          (GhcPass _) = NoExtField
 type instance XKindSig         (GhcPass _) = EpAnn [AddEpAnn]
 
-type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives
+type instance XAppKindTy       (GhcPass _) = NoExtField
 
 type instance XSpliceTy        GhcPs = NoExtField
 type instance XSpliceTy        GhcRn = HsUntypedSpliceResult (LHsType GhcRn)
@@ -489,10 +491,10 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
            -> LHsType (GhcPass p)
 mkHsAppTys = foldl' mkHsAppTy
 
-mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+mkHsAppKindTy :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p)
               -> LHsType (GhcPass p)
-mkHsAppKindTy ext ty k
-  = addCLocAA ty k (HsAppKindTy ext ty k)
+mkHsAppKindTy ty at k
+  = addCLocAA ty k (HsAppKindTy noExtField ty at k)
 
 {-
 ************************************************************************
@@ -541,7 +543,7 @@ hsTyGetAppHead_maybe = go
   where
     go (L _ (HsTyVar _ _ ln))          = Just ln
     go (L _ (HsAppTy _ l _))           = go l
-    go (L _ (HsAppKindTy _ t _))       = go t
+    go (L _ (HsAppKindTy _ t _ _))     = go t
     go (L _ (HsOpTy _ _ _ ln _))       = Just ln
     go (L _ (HsParTy _ t))             = go t
     go (L _ (HsKindSig _ t _))         = go t
@@ -553,12 +555,12 @@ hsTyGetAppHead_maybe = go
 lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan
 lhsTypeArgSrcSpan arg = case arg of
   HsValArg  tm    -> getLocA tm
-  HsTypeArg at ty -> at `combineSrcSpans` getLocA ty
+  HsTypeArg at ty -> getTokenSrcSpan (getLoc at) `combineSrcSpans` getLocA ty
   HsArgPar  sp    -> sp
 
 --------------------------------
 
-numVisibleArgs :: [HsArg tm ty] -> Arity
+numVisibleArgs :: [HsArg p tm ty] -> Arity
 numVisibleArgs = count is_vis
   where is_vis (HsValArg _) = True
         is_vis _            = False
@@ -576,7 +578,7 @@ numVisibleArgs = count is_vis
 -- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering
 -- @
 pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty)
-             => id -> LexicalFixity -> [HsArg tm ty] -> SDoc
+             => id -> LexicalFixity -> [HsArg p tm ty] -> SDoc
 pprHsArgsApp thing fixity (argl:argr:args)
   | Infix <- fixity
   = let pp_op_app = hsep [ ppr_single_hs_arg argl
@@ -591,7 +593,7 @@ pprHsArgsApp thing _fixity args
 
 -- | Pretty-print a prefix identifier to a list of 'HsArg's.
 ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty)
-                        => SDoc -> [HsArg tm ty] -> SDoc
+                        => SDoc -> [HsArg p tm ty] -> SDoc
 ppr_hs_args_prefix_app acc []         = acc
 ppr_hs_args_prefix_app acc (arg:args) =
   case arg of
@@ -601,7 +603,7 @@ ppr_hs_args_prefix_app acc (arg:args) =
 
 -- | Pretty-print an 'HsArg' in isolation.
 ppr_single_hs_arg :: (Outputable tm, Outputable ty)
-                  => HsArg tm ty -> SDoc
+                  => HsArg p tm ty -> SDoc
 ppr_single_hs_arg (HsValArg tm)    = ppr tm
 ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty
 -- GHC shouldn't be constructing ASTs such that this case is ever reached.
@@ -611,9 +613,9 @@ ppr_single_hs_arg (HsArgPar{})     = empty
 
 -- | This instance is meant for debug-printing purposes. If you wish to
 -- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead.
-instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
+instance (Outputable tm, Outputable ty) => Outputable (HsArg (GhcPass p) tm ty) where
   ppr (HsValArg tm)     = text "HsValArg"  <+> ppr tm
-  ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr sp <+> ppr ty
+  ppr (HsTypeArg at ty) = text "HsTypeArg" <+> ppr at <+> ppr ty
   ppr (HsArgPar sp)     = text "HsArgPar"  <+> ppr sp
 
 --------------------------------
@@ -1180,7 +1182,7 @@ ppr_mono_ty (HsStarTy _ isUni)  = char (if isUni then '★' else '*')
 
 ppr_mono_ty (HsAppTy _ fun_ty arg_ty)
   = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]
-ppr_mono_ty (HsAppKindTy _ ty k)
+ppr_mono_ty (HsAppKindTy _ ty _ k)
   = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k
 ppr_mono_ty (HsOpTy _ prom ty1 (L _ op) ty2)
   = sep [ ppr_mono_lty ty1
@@ -1295,7 +1297,7 @@ lhsTypeHasLeadingPromotionQuote ty
     go (HsWildCardTy{})      = False
     go (HsStarTy{})          = False
     go (HsAppTy _ t _)       = goL t
-    go (HsAppKindTy _ t _)   = goL t
+    go (HsAppKindTy _ t _ _) = goL t
     go (HsParTy{})           = False
     go (HsDocTy _ t _)       = goL t
     go (XHsType{})           = False
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 8e934d7c29..486e4810d4 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -628,13 +628,13 @@ nlHsTyConApp prom fixity tycon tys
     mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg
       -- parenthesize things like `(A + B) C`
     mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun (parenthesizeHsType appPrec ty))
-    mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noSrcSpan fun (parenthesizeHsType appPrec ki))
+    mk_app fun (HsTypeArg at ki) = noLocA (HsAppKindTy noExtField fun at (parenthesizeHsType appPrec ki))
     mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun)
 
 nlHsAppKindTy ::
   LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
 nlHsAppKindTy f k
-  = noLocA (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))
+  = noLocA (HsAppKindTy noExtField f noHsTok (parenthesizeHsType appPrec k))
 
 {-
 Tuples.  All these functions are *pre-typechecker* because they lack
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 045de30ed6..f6cf36101b 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1389,7 +1389,7 @@ repTy (HsAppTy _ f a)       = do
                                 f1 <- repLTy f
                                 a1 <- repLTy a
                                 repTapp f1 a1
-repTy (HsAppKindTy _ ty ki) = do
+repTy (HsAppKindTy _ ty _ ki) = do
                                 ty1 <- repLTy ty
                                 ki1 <- repLTy ki
                                 repTappKind ty1 ki1
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 8f97f51833..bf9a38e279 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -570,7 +570,7 @@ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where
     HsOuterExplicit{hso_bndrs = tvs} ->
       foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c]
 
-instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
+instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg p tm ty) where
   loc (HsValArg tm) = loc tm
   loc (HsTypeArg _ ty) = loc ty
   loc (HsArgPar sp)  = sp
@@ -1773,7 +1773,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
         [ toHie a
         , toHie b
         ]
-      HsAppKindTy _ ty ki ->
+      HsAppKindTy _ ty _ ki ->
         [ toHie ty
         , toHie ki
         ]
@@ -1831,7 +1831,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
       HsStarTy _ _ -> []
       XHsType _ -> []
 
-instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where
+instance (ToHie tm, ToHie ty) => ToHie (HsArg p tm ty) where
   toHie (HsValArg tm) = toHie tm
   toHie (HsTypeArg _ ty) = toHie ty
   toHie (HsArgPar sp) = locOnly sp
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index c56fae7b29..1d081d1071 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2199,7 +2199,7 @@ ftype :: { forall b. DisambTD b => PV (LocatedA b) }
         | ftype tyarg                   { $1 >>= \ $1 ->
                                           mkHsAppTyPV $1 $2 }
         | ftype PREFIX_AT atype         { $1 >>= \ $1 ->
-                                          mkHsAppKindTyPV $1 (getLoc $2) $3 }
+                                          mkHsAppKindTyPV $1 (hsTok $2) $3 }
 
 tyarg :: { LHsType GhcPs }
         : atype                         { $1 }
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 7b7fccc862..f4e1a06198 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -15,6 +15,7 @@ module GHC.Parser.Annotation (
   AddEpAnn(..),
   EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn,
   TokenLocation(..),
+  getTokenSrcSpan,
   DeltaPos(..), deltaPos, getDeltaLine,
 
   EpAnn(..), Anchor(..), AnchorOperation(..),
@@ -412,6 +413,11 @@ data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan)
 data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
                deriving (Data,Eq)
 
+getTokenSrcSpan :: TokenLocation -> SrcSpan
+getTokenSrcSpan NoTokenLoc = noSrcSpan
+getTokenSrcSpan (TokenLoc EpaDelta{}) = noSrcSpan
+getTokenSrcSpan (TokenLoc (EpaSpan rspan mbufpos)) = RealSrcSpan rspan mbufpos
+
 instance Outputable a => Outputable (GenLocated TokenLocation a) where
   ppr (L _ x) = ppr x
 
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 309fe2b8a7..9c0a5df0aa 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1020,7 +1020,7 @@ checkTyClHdr is_cls ty
       where
         (o,c) = mkParensEpAnn (realSrcSpan l)
     go _ (HsAppTy _ t1 t2) acc ops cps fix = goL t1 (HsValArg t2:acc) ops cps fix
-    go _ (HsAppKindTy l ty ki) acc ops cps fix = goL ty (HsTypeArg l ki:acc) ops cps fix
+    go _ (HsAppKindTy _ ty at ki) acc ops cps fix = goL ty (HsTypeArg at ki:acc) ops cps fix
     go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix
       = return (L (noAnnSrcSpan l) (nameRdrName tup_name)
                , map HsValArg ts, fix, (reverse ops)++cps)
@@ -1957,7 +1957,7 @@ class DisambTD b where
   -- | Disambiguate @f x@ (function application or prefix data constructor).
   mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b)
   -- | Disambiguate @f \@t@ (visible kind application)
-  mkHsAppKindTyPV :: LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b)
+  mkHsAppKindTyPV :: LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b)
   -- | Disambiguate @f \# x@ (infix operator)
   mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
   -- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma)
@@ -1966,7 +1966,7 @@ class DisambTD b where
 instance DisambTD (HsType GhcPs) where
   mkHsAppTyHeadPV = return
   mkHsAppTyPV t1 t2 = return (mkHsAppTy t1 t2)
-  mkHsAppKindTyPV t l_at ki = return (mkHsAppKindTy l_at t ki)
+  mkHsAppKindTyPV t at ki = return (mkHsAppKindTy t at ki)
   mkHsOpTyPV prom t1 op t2 = return (mkLHsOpTy prom t1 op t2)
   mkUnpackednessPV = addUnpackednessP
 
@@ -2002,8 +2002,8 @@ instance DisambTD DataConBuilder where
     -- the grammar in Parser.y is written (see infixtype/ftype).
     panic "mkHsAppTyPV: InfixDataConBuilder"
 
-  mkHsAppKindTyPV lhs l_at ki =
-    addFatalError $ mkPlainErrorMsgEnvelope l_at $
+  mkHsAppKindTyPV lhs at ki =
+    addFatalError $ mkPlainErrorMsgEnvelope (getTokenSrcSpan (getLoc at)) $
                       (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki))
 
   mkHsOpTyPV prom lhs tc rhs = do
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index df53523597..989a8bf3d8 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -693,12 +693,12 @@ rnHsTyKi env (HsAppTy _ ty1 ty2)
        ; (ty2', fvs2) <- rnLHsTyKi env ty2
        ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi env (HsAppKindTy l ty k)
+rnHsTyKi env (HsAppKindTy _ ty at 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 l ty' k', fvs1 `plusFV` fvs2) }
+       ; return (HsAppKindTy noExtField ty' at k', fvs1 `plusFV` fvs2) }
 
 rnHsTyKi env t@(HsIParamTy x n ty)
   = do { notInKinds env t
@@ -1929,7 +1929,7 @@ extract_lty (L _ ty) acc
                                            flds
       HsAppTy _ ty1 ty2           -> extract_lty ty1 $
                                      extract_lty ty2 acc
-      HsAppKindTy _ ty k          -> extract_lty ty $
+      HsAppKindTy _ ty _ k        -> extract_lty ty $
                                      extract_lty k acc
       HsListTy _ ty               -> extract_lty ty acc
       HsTupleTy _ _ tys           -> extract_ltys tys acc
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index a0a2a51cee..0ea0412339 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1517,11 +1517,11 @@ splitHsAppTys hs_ty
     is_app _                       = False
 
     go :: LHsType GhcRn
-       -> [HsArg (LHsType GhcRn) (LHsKind GhcRn)]
+       -> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]
        -> (LHsType GhcRn,
-           [HsArg (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp
+           [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp
     go (L _  (HsAppTy _ f a))      as = go f (HsValArg a : as)
-    go (L _  (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)
+    go (L _  (HsAppKindTy _ ty at k)) as = go ty (HsTypeArg at k : as)
     go (L sp (HsParTy _ f))        as = go f (HsArgPar (locA sp) : as)
     go (L _  (HsOpTy _ prom l op@(L sp _) r)) as
       = ( L (na2la sp) (HsTyVar noAnn prom op)
@@ -1698,7 +1698,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args
         substed_fun_ki = substTy subst fun_ki
         hs_ty          = appTypeToArg orig_hs_ty (take (n-1) orig_hs_args)
 
-    n_initial_val_args :: [HsArg tm ty] -> Arity
+    n_initial_val_args :: [HsArg p tm ty] -> Arity
     -- Count how many leading HsValArgs we have
     n_initial_val_args (HsValArg {} : args) = 1 + n_initial_val_args args
     n_initial_val_args (HsArgPar {} : args) = n_initial_val_args args
@@ -1890,10 +1890,10 @@ unsaturated arguments: see #11246.  Hence doing this in tcInferApps.
 
 appTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn
 appTypeToArg f []                       = f
-appTypeToArg f (HsValArg arg    : args) = appTypeToArg (mkHsAppTy f arg) args
-appTypeToArg f (HsArgPar _      : args) = appTypeToArg f                 args
-appTypeToArg f (HsTypeArg l arg : args)
-  = appTypeToArg (mkHsAppKindTy l f arg) args
+appTypeToArg f (HsValArg arg     : args) = appTypeToArg (mkHsAppTy f arg) args
+appTypeToArg f (HsArgPar _       : args) = appTypeToArg f                 args
+appTypeToArg f (HsTypeArg at arg : args)
+  = appTypeToArg (mkHsAppKindTy f at arg) args
 
 
 {- *********************************************************************
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 0c74bd54f6..77d61941fc 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -299,7 +299,7 @@ no_anon_wc_ty lty = go lty
     go (L _ ty) = case ty of
       HsWildCardTy _                 -> False
       HsAppTy _ ty1 ty2              -> go ty1 && go ty2
-      HsAppKindTy _ ty ki            -> go ty && go ki
+      HsAppKindTy _ ty _ ki          -> go ty && go ki
       HsFunTy _ w ty1 ty2            -> go ty1 && go ty2 && go (arrowToHsType w)
       HsListTy _ ty                  -> go ty
       HsTupleTy _ _ tys              -> gos tys
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 32c64b6c7f..19b19e36c7 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -3045,7 +3045,7 @@ tcTyFamInstEqn fam_tc mb_clsinfo
                               (map (const Nominal) qtvs)
                               (locA loc)) }
 
-checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg tm ty] -> TcM ()
+checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg p tm ty] -> TcM ()
 checkTyFamInstEqn tc_fam_tc eqn_tc_name hs_pats =
   do { -- Ensure that each equation's type constructor is for the right
        -- type family.  E.g. barf on
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index bc6cbe0da1..5223d2f7df 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1795,8 +1795,9 @@ mk_apps head_ty type_args = do
         case arg of
           HsValArg ty  -> do p_ty <- add_parens ty
                              mk_apps (HsAppTy noExtField phead_ty p_ty) args
-          HsTypeArg l ki -> do p_ki <- add_parens ki
-                               mk_apps (HsAppKindTy l phead_ty p_ki) args
+          HsTypeArg at ki ->
+                          do p_ki <- add_parens ki
+                             mk_apps (HsAppKindTy noExtField phead_ty at p_ki) args
           HsArgPar _   -> mk_apps (HsParTy noAnn phead_ty) args
 
   go type_args
@@ -1841,7 +1842,7 @@ 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 noSrcSpan ki':as') }
+                                 ; go ty (HsTypeArg noHsTok ki' : as') }
     go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') }
     go f as           = return (f,as)
 
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 69cf084421..8898d2400b 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -756,6 +756,7 @@ data HsType pass
 
   | HsAppKindTy         (XAppKindTy pass) -- type level type app
                         (LHsType pass)
+                       !(LHsToken "@" pass)
                         (LHsKind pass)
 
   | HsFunTy             (XFunTy pass)
@@ -1181,14 +1182,13 @@ if they correspond to a visible 'forall'.
 -}
 
 -- | Arguments in an expression/type after splitting
-data HsArg tm ty
+data HsArg p tm ty
   = HsValArg tm   -- Argument is an ordinary expression     (f arg)
-  | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty)
-                         -- SrcSpan is location of the `@`
+  | HsTypeArg !(LHsToken "@" p) ty -- Argument is a visible type application (f @ty)
   | HsArgPar SrcSpan -- See Note [HsArgPar]
 
 -- type level equivalent
-type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)
+type LHsTypeArg p = HsArg p (LHsType p) (LHsKind p)
 
 {-
 Note [HsArgPar]
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 1e48180185..677988f0df 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -656,7 +656,10 @@
             (HsOuterImplicit
              (NoExtField))
             [(HsTypeArg
-              { DumpParsedAst.hs:18:6 }
+              (L
+               (TokenLoc
+                (EpaSpan { DumpParsedAst.hs:18:6 }))
+               (HsTok))
               (L
                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:7-11 })
                (HsTyVar
@@ -716,7 +719,7 @@
                 (L
                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:19-26 })
                  (HsAppKindTy
-                  { DumpParsedAst.hs:18:21 }
+                  (NoExtField)
                   (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:19 })
                    (HsTyVar
@@ -733,6 +736,10 @@
                      (Unqual
                       {OccName: T}))))
                   (L
+                   (TokenLoc
+                    (EpaSpan { DumpParsedAst.hs:18:21 }))
+                   (HsTok))
+                  (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:22-26 })
                    (HsTyVar
                     (EpAnn
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index cd5c002a6a..e297ee8b84 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -868,7 +868,10 @@
                [{Name: a}
                ,{Name: f}])
               [(HsTypeArg
-                { DumpRenamedAst.hs:25:6 }
+                (L
+                 (TokenLoc
+                  (EpaSpan { DumpRenamedAst.hs:25:6 }))
+                 (HsTok))
                 (L
                  (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:7-11 })
                  (HsTyVar
@@ -907,7 +910,7 @@
                   (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:19-26 })
                    (HsAppKindTy
-                    { DumpRenamedAst.hs:25:21 }
+                    (NoExtField)
                     (L
                      (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:19 })
                      (HsTyVar
@@ -917,6 +920,10 @@
                        (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:19 })
                        {Name: DumpRenamedAst.T})))
                     (L
+                     (TokenLoc
+                      (EpaSpan { DumpRenamedAst.hs:25:21 }))
+                     (HsTok))
+                    (L
                      (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:22-26 })
                      (HsTyVar
                       (EpAnnNotUsed)
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index c3d10b1f56..30a3234ee0 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1998,12 +1998,12 @@ exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do
 -- ---------------------------------------------------------------------
 
 instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)
-     =>  ExactPrint (HsArg tm ty) where
+     =>  ExactPrint (HsArg GhcPs tm ty) where
   getAnnotationEntry = const NoEntryVal
   setAnnotationAnchor a _ _ = a
 
   exact a@(HsValArg tm)    = markAnnotated tm >> return a
-  exact a@(HsTypeArg ss ty) = printStringAtSs ss "@" >> markAnnotated ty >> return a
+  exact a@(HsTypeArg at ty) = markToken at >> markAnnotated ty >> return a
   exact x@(HsArgPar _sp)   = withPpr x -- Does not appear in original source
 
 -- ---------------------------------------------------------------------
@@ -3777,7 +3777,7 @@ instance ExactPrint (HsType GhcPs) where
   getAnnotationEntry (HsQualTy _ _ _)          = NoEntryVal
   getAnnotationEntry (HsTyVar an _ _)          = fromAnn an
   getAnnotationEntry (HsAppTy _ _ _)           = NoEntryVal
-  getAnnotationEntry (HsAppKindTy _ _ _)       = NoEntryVal
+  getAnnotationEntry (HsAppKindTy _ _ _ _)     = NoEntryVal
   getAnnotationEntry (HsFunTy an _ _ _)        = fromAnn an
   getAnnotationEntry (HsListTy an _)           = fromAnn an
   getAnnotationEntry (HsTupleTy an _ _)        = fromAnn an
@@ -3801,7 +3801,7 @@ instance ExactPrint (HsType GhcPs) where
   setAnnotationAnchor a@(HsQualTy _ _ _)          _ _s = a
   setAnnotationAnchor (HsTyVar an a b)          anc cs = (HsTyVar (setAnchorEpa an anc cs) a b)
   setAnnotationAnchor a@(HsAppTy _ _ _)           _ _s = a
-  setAnnotationAnchor a@(HsAppKindTy _ _ _)       _ _s = a
+  setAnnotationAnchor a@(HsAppKindTy _ _ _ _)     _ _s = a
   setAnnotationAnchor (HsFunTy an a b c)        anc cs = (HsFunTy (setAnchorEpa an anc cs) a b c)
   setAnnotationAnchor (HsListTy an a)           anc cs = (HsListTy (setAnchorEpa an anc cs) a)
   setAnnotationAnchor (HsTupleTy an a b)        anc cs = (HsTupleTy (setAnchorEpa an anc cs) a b)
@@ -3842,11 +3842,11 @@ instance ExactPrint (HsType GhcPs) where
     t1' <- markAnnotated t1
     t2' <- markAnnotated t2
     return (HsAppTy an t1' t2')
-  exact (HsAppKindTy ss ty ki) = do
+  exact (HsAppKindTy ss ty at ki) = do
     ty' <- markAnnotated ty
-    printStringAtSs ss "@"
+    at' <- markToken at
     ki' <- markAnnotated ki
-    return (HsAppKindTy ss ty' ki')
+    return (HsAppKindTy ss ty' at' ki')
   exact (HsFunTy an mult ty1 ty2) = do
     ty1' <- markAnnotated ty1
     mult' <- markArrow mult
diff --git a/utils/haddock b/utils/haddock
-Subproject 261a7c8ac5b5ff29e6e0380690cbb6ee9730f98
+Subproject 519a95998b09a2c9c7a42c3a0cf2ca0c4358bb4