HsUniToken and HsToken for HsArrow (#19623)

Another step towards a simpler design for exact printing.

Updates the haddock submodule.

30 files changed, 360 insertions, 168 deletions

diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 1d59ae2308..4b543cb8ef 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -626,7 +626,7 @@ getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of
   InfixCon{}  -> Nothing
 getRecConArgs_maybe (ConDeclGADT{con_g_args = args}) = case args of
   PrefixConGADT{} -> Nothing
-  RecConGADT flds -> Just flds
+  RecConGADT flds _ -> Just flds
 
 hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)]
 hsConDeclTheta Nothing            = []
@@ -708,7 +708,7 @@ pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs
               ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])
   where
     get_args (PrefixConGADT args) = map ppr args
-    get_args (RecConGADT fields)  = [pprConDeclFields (unLoc fields)]
+    get_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields)]
 
     ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)
     ppr_arrow_chain []     = empty
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index 99b0bbc1ab..841604ecb9 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -240,3 +240,8 @@ type instance Anno (HsToken tok) = EpAnnCO
 
 noHsTok :: GenLocated (EpAnn a) (HsToken tok)
 noHsTok = L noAnn HsTok
+
+type instance Anno (HsUniToken tok utok) = EpAnnCO
+
+noHsUniTok :: GenLocated (EpAnn a) (HsUniToken tok utok)
+noHsUniTok = L noAnn HsNormalTok
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 363b890d59..4ec53aeaf0 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -475,6 +475,11 @@ deriving instance Data (HsType GhcPs)
 deriving instance Data (HsType GhcRn)
 deriving instance Data (HsType GhcTc)
 
+-- deriving instance Data (HsLinearArrowTokens p)
+deriving instance Data (HsLinearArrowTokens GhcPs)
+deriving instance Data (HsLinearArrowTokens GhcRn)
+deriving instance Data (HsLinearArrowTokens GhcTc)
+
 -- deriving instance (DataIdLR p p) => Data (HsArrow p)
 deriving instance Data (HsArrow GhcPs)
 deriving instance Data (HsArrow GhcRn)
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 0b5457c35e..3b67c8dd2e 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -24,6 +24,7 @@ module GHC.Hs.Type (
         Mult, HsScaled(..),
         hsMult, hsScaledThing,
         HsArrow(..), arrowToHsType,
+        HsLinearArrowTokens(..),
         hsLinear, hsUnrestricted, isUnrestricted,
 
         HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
@@ -285,7 +286,7 @@ type instance XForAllTy        (GhcPass _) = NoExtField
 type instance XQualTy          (GhcPass _) = NoExtField
 type instance XTyVar           (GhcPass _) = EpAnn [AddEpAnn]
 type instance XAppTy           (GhcPass _) = NoExtField
-type instance XFunTy           (GhcPass _) = EpAnn TrailingAnn -- For the AnnRarrow or AnnLolly
+type instance XFunTy           (GhcPass _) = EpAnnCO
 type instance XListTy          (GhcPass _) = EpAnn AnnParen
 type instance XTupleTy         (GhcPass _) = EpAnn AnnParen
 type instance XSumTy           (GhcPass _) = EpAnn AnnParen
@@ -329,6 +330,12 @@ oneDataConHsTy = HsTyVar noAnn NotPromoted (noLocA oneDataConName)
 manyDataConHsTy :: HsType GhcRn
 manyDataConHsTy = HsTyVar noAnn NotPromoted (noLocA manyDataConName)
 
+hsLinear :: a -> HsScaled (GhcPass p) a
+hsLinear = HsScaled (HsLinearArrow (HsPct1 noHsTok noHsUniTok))
+
+hsUnrestricted :: a -> HsScaled (GhcPass p) a
+hsUnrestricted = HsScaled (HsUnrestrictedArrow noHsUniTok)
+
 isUnrestricted :: HsArrow GhcRn -> Bool
 isUnrestricted (arrowToHsType -> L _ (HsTyVar _ _ (L _ n))) = n == manyDataConName
 isUnrestricted _ = False
@@ -338,8 +345,8 @@ isUnrestricted _ = False
 -- multiplicity or a shorthand.
 arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
 arrowToHsType (HsUnrestrictedArrow _) = noLocA manyDataConHsTy
-arrowToHsType (HsLinearArrow _ _) = noLocA oneDataConHsTy
-arrowToHsType (HsExplicitMult _ _ p) = p
+arrowToHsType (HsLinearArrow _) = noLocA oneDataConHsTy
+arrowToHsType (HsExplicitMult _ p _) = p
 
 instance
       (OutputableBndrId pass) =>
@@ -349,8 +356,8 @@ instance
 -- See #18846
 pprHsArrow :: (OutputableBndrId pass) => HsArrow (GhcPass pass) -> SDoc
 pprHsArrow (HsUnrestrictedArrow _) = arrow
-pprHsArrow (HsLinearArrow _ _) = lollipop
-pprHsArrow (HsExplicitMult _ _ p) = (mulArrow (ppr p))
+pprHsArrow (HsLinearArrow _) = lollipop
+pprHsArrow (HsExplicitMult _ p _) = mulArrow (ppr p)
 
 type instance XConDeclField  (GhcPass _) = EpAnn [AddEpAnn]
 type instance XXConDeclField (GhcPass _) = NoExtCon
@@ -484,13 +491,12 @@ splitHsFunType ty = go ty
           cs' = cs S.<> epAnnComments (ann l) S.<> epAnnComments an
         in (anns', cs', args, res)
 
-    go (L ll (HsFunTy (EpAnn _ an cs) mult x y))
+    go (L ll (HsFunTy (EpAnn _ _ cs) mult x y))
       | (anns, csy, args, res) <- splitHsFunType y
       = (anns, csy S.<> epAnnComments (ann ll), HsScaled mult x':args, res)
       where
-        (L (SrcSpanAnn a l) t) = x
-        an' = addTrailingAnnToA l an cs a
-        x' = L (SrcSpanAnn an' l) t
+        L l t = x
+        x' = L (addCommentsToSrcAnn l cs) t
 
     go other = ([], emptyComments, [], other)
 
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 5c6a53a8a7..42ea9f0ae7 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -609,7 +609,7 @@ nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
 nlHsAppTy f t = noLocA (HsAppTy noExtField f (parenthesizeHsType appPrec t))
 nlHsTyVar x   = noLocA (HsTyVar noAnn NotPromoted (noLocA x))
-nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) (parenthesizeHsType funPrec a) b)
+nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) (parenthesizeHsType funPrec a) b)
 nlHsParTy t   = noLocA (HsParTy noAnn t)
 
 nlHsTyConApp :: IsSrcSpanAnn p a
@@ -1473,7 +1473,7 @@ hsConDeclsBinders cons
 
     get_flds_gadt :: Seen p -> HsConDeclGADTDetails (GhcPass p)
                   -> (Seen p, [LFieldOcc (GhcPass p)])
-    get_flds_gadt remSeen (RecConGADT flds) = get_flds remSeen flds
+    get_flds_gadt remSeen (RecConGADT flds _) = get_flds remSeen flds
     get_flds_gadt remSeen _ = (remSeen, [])
 
     get_flds :: Seen p -> LocatedL [LConDeclField (GhcPass p)]
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index df2e334213..15771cd26e 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -250,7 +250,7 @@ h98ConArgDocs con_args = case con_args of
 gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap HsDocString
 gadtConArgDocs con_args res_ty = case con_args of
   PrefixConGADT args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args ++ [res_ty]
-  RecConGADT _       -> con_arg_docs 1 [res_ty]
+  RecConGADT _ _     -> con_arg_docs 1 [res_ty]
 
 con_arg_docs :: Int -> [HsType GhcRn] -> IntMap HsDocString
 con_arg_docs n = IM.fromList . catMaybes . zipWith f [n..]
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index cd7bee26ef..0860192e68 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -2681,7 +2681,7 @@ repGadtDataCons cons details res_ty
              arg_tys <- repPrefixConArgs ps
              res_ty' <- repLTy res_ty
              rep2 gadtCName [ unC (nonEmptyCoreList cons'), unC arg_tys, unC res_ty']
-           RecConGADT ips -> do
+           RecConGADT ips _ -> do
              arg_vtys <- repRecConArgs ips
              res_ty'  <- repLTy res_ty
              rep2 recGadtCName [unC (nonEmptyCoreList cons'), unC arg_vtys,
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 4920f1eac8..f198dc55c1 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1389,7 +1389,7 @@ instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg re
 
 instance ToHie (HsConDeclGADTDetails GhcRn) where
   toHie (PrefixConGADT args) = toHie args
-  toHie (RecConGADT rec) = toHie rec
+  toHie (RecConGADT rec _) = toHie rec
 
 instance HiePass p => ToHie (Located (HsCmdTop (GhcPass p))) where
   toHie (L span top) = concatM $ makeNode top span : case top of
@@ -1622,7 +1622,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
           ctxScope = maybe NoScope mkLScopeA ctx
           argsScope = case args of
             PrefixConGADT xs -> scaled_args_scope xs
-            RecConGADT x     -> mkLScopeA x
+            RecConGADT x _   -> mkLScopeA x
           tyScope = mkLScopeA typ
           resScope = ResolvedScopes [ctxScope, rhsScope]
       ConDeclH98 { con_name = name, con_ex_tvs = qvars
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index cc52d67469..15088081e1 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -12,6 +12,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -2147,20 +2148,20 @@ type :: { LHsType GhcPs }
         -- See Note [%shift: type -> btype]
         : btype %shift                 { $1 }
         | btype '->' ctype             {% acsA (\cs -> sLL (reLoc $1) (reLoc $>)
-                                            $ HsFunTy (EpAnn (glAR $1) (mau $2) cs) (HsUnrestrictedArrow (toUnicode $2)) $1 $3) }
+                                            $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) }
 
         | btype mult '->' ctype        {% hintLinear (getLoc $2)
-                                       >> let arr = (unLoc $2) (toUnicode $3)
+                                       >> let arr = (unLoc $2) (hsUniTok $3)
                                           in acsA (\cs -> sLL (reLoc $1) (reLoc $>)
-                                           $ HsFunTy (EpAnn (glAR $1) (mau $3) cs) arr $1 $4) }
+                                           $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) arr $1 $4) }
 
         | btype '->.' ctype            {% hintLinear (getLoc $2) >>
                                           acsA (\cs -> sLL (reLoc $1) (reLoc $>)
-                                            $ HsFunTy (EpAnn (glAR $1) (mlu $2) cs) (HsLinearArrow UnicodeSyntax Nothing) $1 $3) }
+                                            $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) }
                                               -- [mu AnnLollyU $2] }
 
-mult :: { Located (IsUnicodeSyntax -> HsArrow GhcPs) }
-        : PREFIX_PERCENT atype          { sLL $1 (reLoc $>) (\u -> mkMultTy u $1 $2) }
+mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) }
+        : PREFIX_PERCENT atype          { sLL $1 (reLoc $>) (mkMultTy (hsTok $1) $2) }
 
 btype :: { LHsType GhcPs }
         : infixtype                     {% runPV $1 }
@@ -4178,13 +4179,6 @@ msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (EpaSpan $ rs $ gl l
 mu :: AnnKeywordId -> Located Token -> AddEpAnn
 mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (EpaSpan $ rs l)
 
-mau :: Located Token -> TrailingAnn
-mau lt@(L l t) = if isUnicode lt then AddRarrowAnnU (EpaSpan $ rs l)
-                                 else AddRarrowAnn  (EpaSpan $ rs l)
-
-mlu :: Located Token -> TrailingAnn
-mlu lt@(L l t) = AddLollyAnnU (EpaSpan $ rs l)
-
 -- | If the 'Token' is using its unicode variant return the unicode variant of
 --   the annotation
 toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
@@ -4350,7 +4344,12 @@ listAsAnchor [] = spanAsAnchor noSrcSpan
 listAsAnchor (L l _:_) = spanAsAnchor (locA l)
 
 hsTok :: Located Token -> LHsToken tok GhcPs
-hsTok (L l _) = L (EpAnn (Anchor (realSrcSpan l) UnchangedAnchor) NoEpAnns emptyComments) HsTok
+hsTok (L l _) = L (EpAnn (spanAsAnchor l) NoEpAnns emptyComments) HsTok
+
+hsUniTok :: Located Token -> LHsUniToken tok utok GhcPs
+hsUniTok t@(L l _) =
+  L (EpAnn (spanAsAnchor l) NoEpAnns emptyComments)
+    (if isUnicode t then HsUnicodeTok else HsNormalTok)
 
 -- -------------------------------------
 
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index abece56898..19925b0678 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -621,18 +621,12 @@ data TrailingAnn
   = AddSemiAnn EpaLocation    -- ^ Trailing ';'
   | AddCommaAnn EpaLocation   -- ^ Trailing ','
   | AddVbarAnn EpaLocation    -- ^ Trailing '|'
-  | AddRarrowAnn EpaLocation  -- ^ Trailing '->'
-  | AddRarrowAnnU EpaLocation -- ^ Trailing '->', unicode variant
-  | AddLollyAnnU EpaLocation  -- ^ Trailing '⊸'
   deriving (Data,Show,Eq, Ord)
 
 instance Outputable TrailingAnn where
   ppr (AddSemiAnn ss)    = text "AddSemiAnn"    <+> ppr ss
   ppr (AddCommaAnn ss)   = text "AddCommaAnn"   <+> ppr ss
   ppr (AddVbarAnn ss)    = text "AddVbarAnn"    <+> ppr ss
-  ppr (AddRarrowAnn ss)  = text "AddRarrowAnn"  <+> ppr ss
-  ppr (AddRarrowAnnU ss) = text "AddRarrowAnnU" <+> ppr ss
-  ppr (AddLollyAnnU ss)  = text "AddLollyAnnU"  <+> ppr ss
 
 -- | Annotation for items appearing in a list. They can have one or
 -- more trailing punctuations items, such as commas or semicolons.
@@ -1016,7 +1010,6 @@ setPriorComments (EpaCommentsBalanced _ ts) cs = EpaCommentsBalanced cs ts
 -- Comment-only annotations
 -- ---------------------------------------------------------------------
 
--- TODO:AZ I think EpAnnCO is not needed
 type EpAnnCO = EpAnn NoEpAnns -- ^ Api Annotations for comments only
 
 data NoEpAnns = NoEpAnns
@@ -1127,6 +1120,9 @@ instance Semigroup EpAnnComments where
 instance (Monoid a) => Monoid (EpAnn a) where
   mempty = EpAnnNotUsed
 
+instance Semigroup NoEpAnns where
+  _ <> _ = NoEpAnns
+
 instance Semigroup AnnListItem where
   (AnnListItem l1) <> (AnnListItem l2) = AnnListItem (l1 <> l2)
 
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index ffe44227fd..946b9a87f3 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -719,13 +719,14 @@ mkGadtDecl loc names ty annsIn = do
   (args, res_ty, annsa, csa) <-
     case body_ty of
      L ll (HsFunTy af hsArr (L loc' (HsRecTy an rf)) res_ty) -> do
-       let an' = addTrailingAnnToL (locA loc') (anns af) (comments af) an
-       case hsArr of
-         HsUnrestrictedArrow _ -> return ()
-         _ -> addError $ mkPlainErrorMsgEnvelope (getLocA body_ty) $
+       let an' = addCommentsToEpAnn (locA loc') an (comments af)
+       arr <- case hsArr of
+         HsUnrestrictedArrow arr -> return arr
+         _ -> do addError $ mkPlainErrorMsgEnvelope (getLocA body_ty) $
                                  (PsErrIllegalGadtRecordMultiplicity hsArr)
+                 return noHsUniTok
 
-       return ( RecConGADT (L (SrcSpanAnn an' (locA loc')) rf), res_ty
+       return ( RecConGADT (L (SrcSpanAnn an' (locA loc')) rf) arr, res_ty
               , [], epAnnComments (ann ll))
      _ -> do
        let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
@@ -2980,11 +2981,15 @@ mkLHsOpTy x op y =
   let loc = getLoc x `combineSrcSpansA` (noAnnSrcSpan $ getLocA op) `combineSrcSpansA` getLoc y
   in L loc (mkHsOpTy x op y)
 
-mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> HsArrow GhcPs
-mkMultTy u tok t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1)))
+mkMultTy :: LHsToken "%" GhcPs -> LHsType GhcPs -> LHsUniToken "->" "→" GhcPs -> HsArrow GhcPs
+mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1))) arr
   -- See #18888 for the use of (SourceText "1") above
-  = HsLinearArrow u (Just $ AddEpAnn AnnPercentOne (EpaSpan $ realSrcSpan $ combineLocs tok (reLoc t)))
-mkMultTy u tok t = HsExplicitMult u (Just $ AddEpAnn AnnPercent (EpaSpan $ realSrcSpan $ getLoc tok)) t
+  = HsLinearArrow (HsPct1 (L (getLoc pct Semi.<> locOf1) HsTok) arr)
+  where
+    -- The location of "1" in "%1".
+    locOf1 :: EpAnn NoEpAnns
+    locOf1 = EpAnn (spanAsAnchor (locA (getLoc t))) NoEpAnns emptyComments
+mkMultTy pct t arr = HsExplicitMult pct t arr
 
 -----------------------------------------------------------------------------
 -- Token symbols
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 88988b2ea6..5cb81edcdb 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -695,10 +695,10 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
         con_g_args' <-
           case con_g_args of
             PrefixConGADT ts -> PrefixConGADT <$> addHaddock ts
-            RecConGADT (L l_rec flds) -> do
+            RecConGADT (L l_rec flds) arr -> do
               -- discardHasInnerDocs is ok because we don't need this info for GADTs.
               flds' <- traverse (discardHasInnerDocs . addHaddockConDeclField) flds
-              pure $ RecConGADT (L l_rec flds')
+              pure $ RecConGADT (L l_rec flds') arr
         con_res_ty' <- addHaddock con_res_ty
         pure $ L l_con_decl $
           ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt,
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 92228b0003..ea4ac365b1 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -764,10 +764,11 @@ rnHsTyKi env (HsWildCardTy _)
        ; return (HsWildCardTy noExtField, emptyFVs) }
 
 rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
-rnHsArrow _env (HsUnrestrictedArrow u) = return (HsUnrestrictedArrow u, emptyFVs)
-rnHsArrow _env (HsLinearArrow u a) = return (HsLinearArrow u a, emptyFVs)
-rnHsArrow env (HsExplicitMult u a p)
-  = (\(mult, fvs) -> (HsExplicitMult u a mult, fvs)) <$> rnLHsTyKi env p
+rnHsArrow _env (HsUnrestrictedArrow arr) = return (HsUnrestrictedArrow arr, emptyFVs)
+rnHsArrow _env (HsLinearArrow (HsPct1 pct1 arr)) = return (HsLinearArrow (HsPct1 pct1 arr), emptyFVs)
+rnHsArrow _env (HsLinearArrow (HsLolly arr)) = return (HsLinearArrow (HsLolly arr), emptyFVs)
+rnHsArrow env (HsExplicitMult pct p arr)
+  = (\(mult, fvs) -> (HsExplicitMult pct mult arr, fvs)) <$> rnLHsTyKi env p
 
 {-
 Note [Renaming HsCoreTys]
@@ -1891,8 +1892,8 @@ extractRdrKindSigVars (L _ resultSig) = case resultSig of
 extractConDeclGADTDetailsTyVars ::
   HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
 extractConDeclGADTDetailsTyVars con_args = case con_args of
-  PrefixConGADT args    -> extract_scaled_ltys args
-  RecConGADT (L _ flds) -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
+  PrefixConGADT args      -> extract_scaled_ltys args
+  RecConGADT (L _ flds) _ -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
 
 -- | Get type/kind variables mentioned in the kind signature, preserving
 -- left-to-right order:
@@ -1966,7 +1967,7 @@ extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
 
 extract_hs_arrow :: HsArrow GhcPs -> FreeKiTyVars ->
                    FreeKiTyVars
-extract_hs_arrow (HsExplicitMult _ _ p) acc = extract_lty p acc
+extract_hs_arrow (HsExplicitMult _ p _) acc = extract_lty p acc
 extract_hs_arrow _ acc = acc
 
 extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 61aa6a54d2..55cc83456e 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2389,9 +2389,9 @@ rnConDeclGADTDetails ::
 rnConDeclGADTDetails _ doc (PrefixConGADT tys)
   = do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys
        ; return (PrefixConGADT new_tys, fvs) }
-rnConDeclGADTDetails con doc (RecConGADT flds)
+rnConDeclGADTDetails con doc (RecConGADT flds arr)
   = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds
-       ; return (RecConGADT new_flds, fvs) }
+       ; return (RecConGADT new_flds arr, fvs) }
 
 rnRecConDeclFields ::
      Name
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 6d4806fe47..05bbb71c6e 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -888,7 +888,7 @@ getLocalNonValBinders fixity_env
             = [( find_con_name rdr
                , concatMap find_con_decl_flds (unLoc cdflds) )]
         find_con_flds (L _ (ConDeclGADT { con_names = rdrs
-                                        , con_g_args = RecConGADT flds }))
+                                        , con_g_args = RecConGADT flds _ }))
             = [ ( find_con_name rdr
                  , concatMap find_con_decl_flds (unLoc flds))
               | L _ rdr <- rdrs ]
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 83cfad2a1e..8de1974627 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1163,7 +1163,7 @@ tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind
 
 tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind
   | op `hasKey` funTyConKey
-  = tc_fun_type mode (HsUnrestrictedArrow NormalSyntax) ty1 ty2 exp_kind
+  = tc_fun_type mode (HsUnrestrictedArrow noHsUniTok) ty1 ty2 exp_kind
 
 --------- Foralls
 tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 1af410fd7b..a025190003 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -1630,9 +1630,9 @@ kcConH98Args new_or_data res_kind con_args = case con_args of
 -- Kind-check the types of arguments to a GADT data constructor.
 kcConGADTArgs :: NewOrData -> Kind -> HsConDeclGADTDetails GhcRn -> TcM ()
 kcConGADTArgs new_or_data res_kind con_args = case con_args of
-  PrefixConGADT tys     -> kcConArgTys new_or_data res_kind tys
-  RecConGADT (L _ flds) -> kcConArgTys new_or_data res_kind $
-                           map (hsLinear . cd_fld_type . unLoc) flds
+  PrefixConGADT tys     ->   kcConArgTys new_or_data res_kind tys
+  RecConGADT (L _ flds) _ -> kcConArgTys new_or_data res_kind $
+                             map (hsLinear . cd_fld_type . unLoc) flds
 
 kcConDecls :: NewOrData
            -> Kind             -- The result kind signature
@@ -3676,7 +3676,7 @@ tcConGADTArgs :: ContextKind  -- expected kind of arguments
               -> TcM [(Scaled TcType, HsSrcBang)]
 tcConGADTArgs exp_kind (PrefixConGADT btys)
   = mapM (tcConArg exp_kind) btys
-tcConGADTArgs exp_kind (RecConGADT fields)
+tcConGADTArgs exp_kind (RecConGADT fields _)
   = tcRecConDeclFields exp_kind fields
 
 tcConArg :: ContextKind  -- expected kind for args; always OpenKind for datatypes,
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 7aa9b73eb2..edd5301907 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -659,7 +659,7 @@ cvtConstr (RecGadtC c varstrtys ty)
   = do  { c'       <- mapM cNameN c
         ; ty'      <- cvtType ty
         ; rec_flds <- mapM cvt_id_arg varstrtys
-        ; returnLA $ mk_gadt_decl c' (RecConGADT $ noLocA rec_flds) ty' }
+        ; returnLA $ mk_gadt_decl c' (RecConGADT (noLocA rec_flds) noHsUniTok) ty' }
 
 mk_gadt_decl :: [LocatedN RdrName] -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs
              -> ConDecl GhcPs
@@ -1518,7 +1518,7 @@ cvtTypeKind ty_str ty
                           _            -> return $
                                           parenthesizeHsType sigPrec x'
                  let y'' = parenthesizeHsType sigPrec y'
-                 returnLA (HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) x'' y'')
+                 returnLA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) x'' y'')
              | otherwise
              -> mk_apps
                 (HsTyVar noAnn NotPromoted (noLocA (getRdrName unrestrictedFunTyCon)))
@@ -1675,9 +1675,9 @@ cvtTypeKind ty_str ty
 hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs
 hsTypeToArrow w = case unLoc w of
                      HsTyVar _ _ (L _ (isExact_maybe -> Just n))
-                        | n == oneDataConName -> HsLinearArrow NormalSyntax Nothing
-                        | n == manyDataConName -> HsUnrestrictedArrow NormalSyntax
-                     _ -> HsExplicitMult NormalSyntax Nothing w
+                        | n == oneDataConName -> HsLinearArrow (HsPct1 noHsTok noHsUniTok)
+                        | n == manyDataConName -> HsUnrestrictedArrow noHsUniTok
+                     _ -> HsExplicitMult noHsTok w noHsUniTok
 
 -- ConT/InfixT can contain both data constructor (i.e., promoted) names and
 -- other (i.e, unpromoted) names, as opposed to PromotedT, which can only
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index fcbb5856b1..df06635ab3 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -1,5 +1,6 @@
 
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -1215,7 +1216,7 @@ type HsConDeclH98Details pass
 -- GHC.Tc.TyCl—but that is an orthogonal concern.)
 data HsConDeclGADTDetails pass
    = PrefixConGADT [HsScaled pass (LBangType pass)]
-   | RecConGADT (XRec pass [LConDeclField pass])
+   | RecConGADT (XRec pass [LConDeclField pass]) (LHsUniToken "->" "→" pass)
 
 instance Outputable NewOrData where
   ppr NewType  = text "newtype"
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 278b8aa99e..8d8eadf135 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -706,3 +706,16 @@ type LHsToken tok p = XRec p (HsToken tok)
 data HsToken (tok :: Symbol) = HsTok
 
 deriving instance KnownSymbol tok => Data (HsToken tok)
+
+type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
+
+-- With UnicodeSyntax, there might be multiple ways to write the same token.
+-- For example an arrow could be either "->" or "→". This choice must be
+-- recorded in order to exactprint such tokens,
+-- so instead of HsToken "->" we introduce HsUniToken "->" "→".
+--
+-- See also IsUnicodeSyntax in GHC.Parser.Annotation; we do not use here to
+-- avoid a dependency.
+data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
+
+deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 1b311716d0..74f8f98432 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                       -- in module Language.Haskell.Syntax.Extension
 {-
@@ -22,7 +23,7 @@ module Language.Haskell.Syntax.Type (
         Mult, HsScaled(..),
         hsMult, hsScaledThing,
         HsArrow(..),
-        hsLinear, hsUnrestricted,
+        HsLinearArrowTokens(..),
 
         HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
         HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr,
@@ -913,16 +914,20 @@ data HsTyLit
 
 -- | Denotes the type of arrows in the surface language
 data HsArrow pass
-  = HsUnrestrictedArrow IsUnicodeSyntax
+  = HsUnrestrictedArrow !(LHsUniToken "->" "→" pass)
     -- ^ a -> b or a → b
-  | HsLinearArrow IsUnicodeSyntax (Maybe AddEpAnn)
+  | HsLinearArrow !(HsLinearArrowTokens pass)
     -- ^ a %1 -> b or a %1 → b, or a ⊸ b
-  | HsExplicitMult IsUnicodeSyntax (Maybe AddEpAnn) (LHsType pass)
+  | HsExplicitMult !(LHsToken "%" pass) !(LHsType pass) !(LHsUniToken "->" "→" pass)
     -- ^ a %m -> b or a %m → b (very much including `a %Many -> b`!
     -- This is how the programmer wrote it). It is stored as an
     -- `HsType` so as to preserve the syntax as written in the
     -- program.
 
+data HsLinearArrowTokens pass
+  = HsPct1 !(LHsToken "%1" pass) !(LHsUniToken "->" "→" pass)
+  | HsLolly !(LHsToken "⊸" pass)
+
 -- | This is used in the syntax. In constructor declaration. It must keep the
 -- arrow representation.
 data HsScaled pass a = HsScaled (HsArrow pass) a
@@ -933,12 +938,6 @@ hsMult (HsScaled m _) = m
 hsScaledThing :: HsScaled pass a -> a
 hsScaledThing (HsScaled _ t) = t
 
--- | When creating syntax we use the shorthands. It's better for printing, also,
--- the shorthands work trivially at each pass.
-hsUnrestricted, hsLinear :: a -> HsScaled pass a
-hsUnrestricted = HsScaled (HsUnrestrictedArrow NormalSyntax)
-hsLinear = HsScaled (HsLinearArrow NormalSyntax Nothing)
-
 instance Outputable a => Outputable (HsScaled pass a) where
    ppr (HsScaled _cnt t) = -- ppr cnt <> ppr t
                             ppr t
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
index 622ba39adf..8054c405c8 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -112,12 +112,19 @@
               (Anchor
                { T17544.hs:6:9 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { T17544.hs:6:11-12 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T17544.hs:6:11-12 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:6:9 })
               (HsTyVar
@@ -239,12 +246,19 @@
               (Anchor
                { T17544.hs:10:9 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { T17544.hs:10:11-12 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T17544.hs:10:11-12 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:10:9 })
               (HsTyVar
@@ -362,12 +376,19 @@
               (Anchor
                { T17544.hs:14:9 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { T17544.hs:14:11-12 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T17544.hs:14:11-12 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:14:9 })
               (HsTyVar
@@ -488,12 +509,19 @@
               (Anchor
                { T17544.hs:18:9 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { T17544.hs:18:11-12 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T17544.hs:18:11-12 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:18:9 })
               (HsTyVar
@@ -554,12 +582,19 @@
               (Anchor
                { T17544.hs:20:9 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { T17544.hs:20:11-12 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T17544.hs:20:11-12 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:20:9 })
               (HsTyVar
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
index 82d2122d3e..6831df7140 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -166,15 +166,22 @@
           (PrefixConGADT
            [(HsScaled
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T17544_kw.hs:19:21-22 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnn
                            (Anchor
                             { T17544_kw.hs:19:18-19 }
                             (UnchangedAnchor))
                            (AnnListItem
-                            [(AddRarrowAnn
-                              (EpaSpan { T17544_kw.hs:19:21-22 }))])
+                            [])
                            (EpaComments
                             [])) { T17544_kw.hs:19:18-19 })
               (HsTupleTy
@@ -312,3 +319,5 @@
     { T17544_kw.hs:12:3-33 }
     (HsDocString
      " Bad comment for the module")))))
+
+
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 025df2068b..de37b069d1 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -144,8 +144,13 @@
            []
            [(HsScaled
              (HsLinearArrow
-              (NormalSyntax)
-              (Nothing))
+              (HsPct1
+               (L
+                (EpAnnNotUsed)
+                (HsTok))
+               (L
+                (EpAnnNotUsed)
+                (HsNormalTok))))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:26-30 })
               (HsTyVar
@@ -549,8 +554,13 @@
            []
            [(HsScaled
              (HsLinearArrow
-              (NormalSyntax)
-              (Nothing))
+              (HsPct1
+               (L
+                (EpAnnNotUsed)
+                (HsTok))
+               (L
+                (EpAnnNotUsed)
+                (HsNormalTok))))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:25-29 })
               (HsParTy
@@ -831,12 +841,19 @@
               (Anchor
                { DumpParsedAst.hs:17:31 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { DumpParsedAst.hs:17:33-34 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { DumpParsedAst.hs:17:33-34 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:17:31 })
               (HsTyVar
@@ -978,4 +995,6 @@
        (FromSource))
       [])))]
   (Nothing)
-  (Nothing)))
\ No newline at end of file
+  (Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index a205c8af53..b595315435 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -148,8 +148,13 @@
              []
              [(HsScaled
                (HsLinearArrow
-                (NormalSyntax)
-                (Nothing))
+                (HsPct1
+                 (L
+                  (EpAnnNotUsed)
+                  (HsTok))
+                 (L
+                  (EpAnnNotUsed)
+                  (HsNormalTok))))
                (L
                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:26-30 })
                 (HsTyVar
@@ -375,12 +380,19 @@
               (Anchor
                { DumpRenamedAst.hs:16:20 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { DumpRenamedAst.hs:16:22-23 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { DumpRenamedAst.hs:16:22-23 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:16:20 })
               (HsTyVar
@@ -396,12 +408,19 @@
                 (Anchor
                  { DumpRenamedAst.hs:16:25 }
                  (UnchangedAnchor))
-                (AddRarrowAnn
-                 (EpaSpan { DumpRenamedAst.hs:16:27-28 }))
+                (NoEpAnns)
                 (EpaComments
                  []))
                (HsUnrestrictedArrow
-                (NormalSyntax))
+                (L
+                 (EpAnn
+                  (Anchor
+                   { DumpRenamedAst.hs:16:27-28 }
+                   (UnchangedAnchor))
+                  (NoEpAnns)
+                  (EpaComments
+                   []))
+                 (HsNormalTok)))
                (L
                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:16:25 })
                 (HsTyVar
@@ -471,12 +490,19 @@
                    (Anchor
                     { DumpRenamedAst.hs:19:28 }
                     (UnchangedAnchor))
-                   (AddRarrowAnn
-                    (EpaSpan { DumpRenamedAst.hs:19:30-31 }))
+                   (NoEpAnns)
                    (EpaComments
                     []))
                   (HsUnrestrictedArrow
-                   (NormalSyntax))
+                   (L
+                    (EpAnn
+                     (Anchor
+                      { DumpRenamedAst.hs:19:30-31 }
+                      (UnchangedAnchor))
+                     (NoEpAnns)
+                     (EpaComments
+                      []))
+                    (HsNormalTok)))
                   (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:19:28 })
                    (HsTyVar
@@ -507,12 +533,19 @@
                (Anchor
                 { DumpRenamedAst.hs:19:42-52 }
                 (UnchangedAnchor))
-               (AddRarrowAnn
-                (EpaSpan { DumpRenamedAst.hs:19:54-55 }))
+               (NoEpAnns)
                (EpaComments
                 []))
               (HsUnrestrictedArrow
-               (NormalSyntax))
+               (L
+                (EpAnn
+                 (Anchor
+                  { DumpRenamedAst.hs:19:54-55 }
+                  (UnchangedAnchor))
+                 (NoEpAnns)
+                 (EpaComments
+                  []))
+                (HsNormalTok)))
               (L
                (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:19:42-52 })
                (HsParTy
@@ -524,12 +557,19 @@
                    (Anchor
                     { DumpRenamedAst.hs:19:43 }
                     (UnchangedAnchor))
-                   (AddRarrowAnn
-                    (EpaSpan { DumpRenamedAst.hs:19:45-46 }))
+                   (NoEpAnns)
                    (EpaComments
                     []))
                   (HsUnrestrictedArrow
-                   (NormalSyntax))
+                   (L
+                    (EpAnn
+                     (Anchor
+                      { DumpRenamedAst.hs:19:45-46 }
+                      (UnchangedAnchor))
+                     (NoEpAnns)
+                     (EpaComments
+                      []))
+                    (HsNormalTok)))
                   (L
                    (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:19:43 })
                    (HsTyVar
@@ -570,15 +610,22 @@
               (PrefixConGADT
                [(HsScaled
                  (HsUnrestrictedArrow
-                  (NormalSyntax))
+                  (L
+                   (EpAnn
+                    (Anchor
+                     { DumpRenamedAst.hs:20:36-37 }
+                     (UnchangedAnchor))
+                    (NoEpAnns)
+                    (EpaComments
+                     []))
+                   (HsNormalTok)))
                  (L
                   (SrcSpanAnn (EpAnn
                                (Anchor
                                 { DumpRenamedAst.hs:20:10-34 }
                                 (UnchangedAnchor))
                                (AnnListItem
-                                [(AddRarrowAnn
-                                  (EpaSpan { DumpRenamedAst.hs:20:36-37 }))])
+                                [])
                                (EpaComments
                                 [])) { DumpRenamedAst.hs:20:10-34 })
                   (HsParTy
@@ -610,12 +657,19 @@
                         (Anchor
                          { DumpRenamedAst.hs:20:22-25 }
                          (UnchangedAnchor))
-                        (AddRarrowAnn
-                         (EpaSpan { DumpRenamedAst.hs:20:27-28 }))
+                        (NoEpAnns)
                         (EpaComments
                          []))
                        (HsUnrestrictedArrow
-                        (NormalSyntax))
+                        (L
+                         (EpAnn
+                          (Anchor
+                           { DumpRenamedAst.hs:20:27-28 }
+                           (UnchangedAnchor))
+                          (NoEpAnns)
+                          (EpaComments
+                           []))
+                         (HsNormalTok)))
                        (L
                         (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:22-25 })
                         (HsAppTy
@@ -771,8 +825,13 @@
              []
              [(HsScaled
                (HsLinearArrow
-                (NormalSyntax)
-                (Nothing))
+                (HsPct1
+                 (L
+                  (EpAnnNotUsed)
+                  (HsTok))
+                 (L
+                  (EpAnnNotUsed)
+                  (HsNormalTok))))
                (L
                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:25-29 })
                 (HsParTy
@@ -955,12 +1014,19 @@
                 (Anchor
                  { DumpRenamedAst.hs:24:31 }
                  (UnchangedAnchor))
-                (AddRarrowAnn
-                 (EpaSpan { DumpRenamedAst.hs:24:33-34 }))
+                (NoEpAnns)
                 (EpaComments
                  []))
                (HsUnrestrictedArrow
-                (NormalSyntax))
+                (L
+                 (EpAnn
+                  (Anchor
+                   { DumpRenamedAst.hs:24:33-34 }
+                   (UnchangedAnchor))
+                  (NoEpAnns)
+                  (EpaComments
+                   []))
+                 (HsNormalTok)))
                (L
                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:24:31 })
                 (HsTyVar
@@ -1302,3 +1368,5 @@
               {Name: GHC.Types.Type})))))])))))]
   (Nothing)
   (Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index 570a9d6650..ad5009011b 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -679,12 +679,19 @@
             (Anchor
              { KindSigs.hs:22:8-20 }
              (UnchangedAnchor))
-            (AddRarrowAnn
-             (EpaSpan { KindSigs.hs:22:22-23 }))
+            (NoEpAnns)
             (EpaComments
              []))
            (HsUnrestrictedArrow
-            (NormalSyntax))
+            (L
+             (EpAnn
+              (Anchor
+               { KindSigs.hs:22:22-23 }
+               (UnchangedAnchor))
+              (NoEpAnns)
+              (EpaComments
+               []))
+             (HsNormalTok)))
            (L
             (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:22:8-20 })
             (HsParTy
@@ -745,12 +752,19 @@
               (Anchor
                { KindSigs.hs:22:25-28 }
                (UnchangedAnchor))
-              (AddRarrowAnn
-               (EpaSpan { KindSigs.hs:22:30-31 }))
+              (NoEpAnns)
               (EpaComments
                []))
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { KindSigs.hs:22:30-31 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:22:25-28 })
               (HsTyVar
@@ -1505,3 +1519,5 @@
       [])))]
   (Nothing)
   (Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index f5cd2ecb36..ecfcae56c8 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -61,8 +61,13 @@
              []
              [(HsScaled
                (HsLinearArrow
-                (NormalSyntax)
-                (Nothing))
+                (HsPct1
+                 (L
+                  (EpAnnNotUsed)
+                  (HsTok))
+                 (L
+                  (EpAnnNotUsed)
+                  (HsNormalTok))))
                (L
                 (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:18-20 })
                 (HsTyVar
@@ -211,3 +216,4 @@
           {Name: T14189.f}))])])])
   (Nothing)))
 
+
diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr
index ac100b217e..abde8320b1 100644
--- a/testsuite/tests/printer/T18791.stderr
+++ b/testsuite/tests/printer/T18791.stderr
@@ -90,15 +90,22 @@
           (PrefixConGADT
            [(HsScaled
              (HsUnrestrictedArrow
-              (NormalSyntax))
+              (L
+               (EpAnn
+                (Anchor
+                 { T18791.hs:5:14-15 }
+                 (UnchangedAnchor))
+                (NoEpAnns)
+                (EpaComments
+                 []))
+               (HsNormalTok)))
              (L
               (SrcSpanAnn (EpAnn
                            (Anchor
                             { T18791.hs:5:10-12 }
                             (UnchangedAnchor))
                            (AnnListItem
-                            [(AddRarrowAnn
-                              (EpaSpan { T18791.hs:5:14-15 }))])
+                            [])
                            (EpaComments
                             [])) { T18791.hs:5:10-12 })
               (HsTyVar
@@ -133,3 +140,5 @@
        []))))]
   (Nothing)
   (Nothing)))
+
+
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 274b6aa464..fc45e8f9e4 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -492,20 +492,18 @@ markLocatedAALS (EpAnn _ a _) f kw (Just str) = go (f a)
 
 -- ---------------------------------------------------------------------
 
-markArrow :: EpAnn TrailingAnn -> HsArrow GhcPs -> EPP ()
-markArrow an arr = do
-  case arr of
-    HsUnrestrictedArrow _u ->
-      return ()
-    HsLinearArrow _u ma -> do
-      mapM_ markAddEpAnn ma
-    HsExplicitMult _u ma t  -> do
-      mapM_ markAddEpAnn ma
-      markAnnotated t
-
-  case an of
-    EpAnnNotUsed -> pure ()
-    _ -> markKwT (anns an)
+markArrow :: HsArrow GhcPs -> EPP ()
+markArrow (HsUnrestrictedArrow arr) = do
+  markUniToken arr
+markArrow (HsLinearArrow (HsPct1 pct1 arr)) = do
+  markToken pct1
+  markUniToken arr
+markArrow (HsLinearArrow (HsLolly arr)) = do
+  markToken arr
+markArrow (HsExplicitMult pct t arr) = do
+  markToken pct
+  markAnnotated t
+  markUniToken arr
 
 -- ---------------------------------------------------------------------
 
@@ -584,10 +582,6 @@ markKwT :: TrailingAnn -> EPP ()
 markKwT (AddSemiAnn ss)    = markKwA AnnSemi ss
 markKwT (AddCommaAnn ss)   = markKwA AnnComma ss
 markKwT (AddVbarAnn ss)    = markKwA AnnVbar ss
-markKwT (AddRarrowAnn ss)  = markKwA AnnRarrow ss
-markKwT (AddRarrowAnnU ss) = markKwA AnnRarrowU ss
--- markKwT (AddLollyAnn ss)   = markKwA AnnLolly ss
-markKwT (AddLollyAnnU ss)  = markKwA AnnLollyU ss
 
 markKw :: AddEpAnn -> EPP ()
 markKw (AddEpAnn kw ss) = markKwA kw ss
@@ -603,6 +597,10 @@ markToken (L (EpAnn (Anchor a a_op) _ _) _) = printStringAtAA aa (symbolVal (Pro
                UnchangedAnchor -> EpaSpan a
                MovedAnchor dp  -> EpaDelta dp
 
+markUniToken :: forall tok utok. (KnownSymbol tok, KnownSymbol utok) => LHsUniToken tok utok GhcPs -> EPP ()
+markUniToken (L l HsNormalTok)  = markToken (L l (HsTok @tok))
+markUniToken (L l HsUnicodeTok) = markToken (L l (HsTok @utok))
+
 -- ---------------------------------------------------------------------
 
 markAnnList :: Bool -> EpAnn AnnList -> EPP () -> EPP ()
@@ -3015,9 +3013,9 @@ instance ExactPrint (HsType GhcPs) where
     markAnnotated ty
     printStringAtSs ss "@"
     markAnnotated ki
-  exact (HsFunTy an mult ty1 ty2) = do
+  exact (HsFunTy _an mult ty1 ty2) = do
     markAnnotated ty1
-    markArrow an mult
+    markArrow mult
     markAnnotated ty2
   exact (HsListTy an tys) = do
     markOpeningParen an
@@ -3328,8 +3326,10 @@ instance ExactPrint (ConDecl GhcPs) where
     when (isJust mcxt) $ markEpAnn an AnnDarrow
     -- mapM_ markAnnotated args
     case args of
-        (PrefixConGADT args') -> mapM_ markAnnotated args'
-        (RecConGADT fields)   -> markAnnotated fields
+        PrefixConGADT args' -> mapM_ markAnnotated args'
+        RecConGADT fields arr -> do
+          markAnnotated fields
+          markUniToken arr
           -- mapM_ markAnnotated (unLoc fields)
     markAnnotated res_ty
   -- markAST _ (GHC.ConDeclGADT _ lns (GHC.L l forall) qvars mbCxt args typ _) = do
@@ -3427,7 +3427,7 @@ instance (ExactPrint a) => ExactPrint (HsScaled GhcPs a) where
   getAnnotationEntry = const NoEntryVal
   exact (HsScaled arr t) = do
     markAnnotated t
-    markArrow EpAnnNotUsed arr
+    markArrow arr
 
 -- ---------------------------------------------------------------------
 
diff --git a/utils/haddock b/utils/haddock
-Subproject 126beaef07cdcbe8aeea248cc555e8a3057de82
+Subproject 0029f289bec7427032785f13cf3bcdebddf7b91