Match changes in GHC AST for in-tree API Annotations

As landed via https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2418

1 files changed, 14 insertions, 12 deletions

diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 5ef5d92d..16f00fda 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -19,7 +19,6 @@ import GHC
 import GHC.Types.Name
 import GHC.Data.FastString
 import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName )
-import GHC.Parser.Annotation (IsUnicodeSyntax(..))
 
 import Control.Monad
 import Control.Monad.Trans.State
@@ -75,7 +74,7 @@ specializeSig :: LHsQTyVars GhcRn -> [HsType GhcRn]
               -> Sig GhcRn
               -> Sig GhcRn
 specializeSig bndrs typs (TypeSig _ lnames typ) =
-  TypeSig noExtField lnames (typ {hswc_body = noLoc typ'})
+  TypeSig noAnn lnames (typ {hswc_body = noLocA typ'})
   where
     true_type :: HsSigType GhcRn
     true_type = unLoc (dropWildCards typ)
@@ -111,7 +110,7 @@ sugar = sugarOperators . sugarTuples . sugarLists
 
 sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
 sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp)
-    | getName name == listTyConName = HsListTy noExtField ltyp
+    | getName name == listTyConName = HsListTy noAnn ltyp
 sugarLists typ = typ
 
 
@@ -122,7 +121,7 @@ sugarTuples typ =
     aux apps (HsAppTy _ (L _ ftyp) atyp) = aux (atyp:apps) ftyp
     aux apps (HsParTy _ (L _ typ')) = aux apps typ'
     aux apps (HsTyVar _ _ (L _ name))
-        | isBuiltInSyntax name' && suitable = HsTupleTy noExtField HsBoxedOrConstraintTuple apps
+        | isBuiltInSyntax name' && suitable = HsTupleTy noAnn HsBoxedOrConstraintTuple apps
       where
         name' = getName name
         strName = getOccString name
@@ -132,10 +131,10 @@ sugarTuples typ =
     aux _ _ = typ
 
 
-sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p)
+sugarOperators :: HsType GhcRn -> HsType GhcRn
 sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb)
     | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb
-    | unrestrictedFunTyConName == name' = HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) la lb
+    | unrestrictedFunTyConName == name' = HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) la lb
   where
     name' = getName name
 sugarOperators typ = typ
@@ -286,7 +285,7 @@ renameType (HsQualTy x lctxt lt) =
     HsQualTy x
         <$> renameMContext lctxt
         <*> renameLType lt
-renameType (HsTyVar x ip name) = HsTyVar x ip <$> located renameName name
+renameType (HsTyVar x ip name) = HsTyVar x ip <$> locatedN renameName name
 renameType t@(HsStarTy _ _) = pure t
 renameType (HsAppTy x lf la) = HsAppTy x <$> renameLType lf <*> renameLType la
 renameType (HsAppKindTy x lt lk) = HsAppKindTy x <$> renameLType lt <*> renameLKind lk
@@ -295,7 +294,7 @@ renameType (HsListTy x lt) = HsListTy x <$> renameLType lt
 renameType (HsTupleTy x srt lt) = HsTupleTy x srt <$> mapM renameLType lt
 renameType (HsSumTy x lt) = HsSumTy x <$> mapM renameLType lt
 renameType (HsOpTy x la lop lb) =
-    HsOpTy x <$> renameLType la <*> located renameName lop <*> renameLType lb
+    HsOpTy x <$> renameLType la <*> locatedN renameName lop <*> renameLType lb
 renameType (HsParTy x lt) = HsParTy x <$> renameLType lt
 renameType (HsIParamTy x ip lt) = HsIParamTy x ip <$> renameLType lt
 renameType (HsKindSig x lt lk) = HsKindSig x <$> renameLType lt <*> pure lk
@@ -312,7 +311,7 @@ renameType t@(HsTyLit _ _) = pure t
 renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
 
 renameHsArrow :: HsArrow GhcRn -> Rename (IdP GhcRn) (HsArrow GhcRn)
-renameHsArrow (HsExplicitMult u p) = HsExplicitMult u <$> renameLType p
+renameHsArrow (HsExplicitMult u a p) = HsExplicitMult u a <$> renameLType p
 renameHsArrow mult = pure mult
 
 
@@ -342,9 +341,9 @@ renameForAllTelescope (HsForAllInvis x bndrs) =
   HsForAllInvis x <$> mapM renameLBinder bndrs
 
 renameBinder :: HsTyVarBndr flag GhcRn -> Rename (IdP GhcRn) (HsTyVarBndr flag GhcRn)
-renameBinder (UserTyVar x fl lname) = UserTyVar x fl <$> located renameName lname
+renameBinder (UserTyVar x fl lname) = UserTyVar x fl <$> locatedN renameName lname
 renameBinder (KindedTyVar x fl lname lkind) =
-  KindedTyVar x fl <$> located renameName lname <*> located renameType lkind
+  KindedTyVar x fl <$> locatedN renameName lname <*> located renameType lkind
 
 renameLBinder :: LHsTyVarBndr flag GhcRn -> Rename (IdP GhcRn) (LHsTyVarBndr flag GhcRn)
 renameLBinder = located renameBinder
@@ -397,9 +396,12 @@ alternativeNames name =
     str = nameRepString name
 
 
-located :: Functor f => (a -> f b) -> Located a -> f (Located b)
+located :: Functor f => (a -> f b) -> GenLocated l a -> f (GenLocated l b)
 located f (L loc e) = L loc <$> f e
 
+locatedN :: Functor f => (a -> f b) -> LocatedN a -> f (LocatedN b)
+locatedN f (L loc e) = L loc <$> f e
+
 
 tyVarName :: HsTyVarBndr flag GhcRn -> IdP GhcRn
 tyVarName (UserTyVar _ _ name) = unLoc name