Use HsForAllTelescope (GHC#18235)

3 files changed, 32 insertions, 11 deletions

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 5e09fec6..108e9f66 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -476,7 +476,7 @@ subordinates instMap decl = case decl of
         extract_deriv_ty (L l ty) =
           case ty of
             -- deriving (forall a. C a {- ^ Doc comment -})
-            HsForAllTy{ hst_fvf = ForallInvis
+            HsForAllTy{ hst_tele = HsForAllInvis{}
                       , hst_body = L _ (HsDocTy _ _ doc) }
                             -> Just (l, doc)
             -- deriving (C a {- ^ Doc comment -})
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 848acb1f..a0c118f8 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -223,11 +223,11 @@ renameMaybeInjectivityAnn = traverse renameInjectivityAnn
 
 renameType :: HsType GhcRn -> RnM (HsType DocNameI)
 renameType t = case t of
-  HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars, hst_body = ltype } -> do
-    tyvars'   <- mapM renameLTyVarBndr tyvars
-    ltype'    <- renameLType ltype
-    return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
-                       , hst_bndrs = tyvars', hst_body = ltype' })
+  HsForAllTy { hst_tele = tele, hst_body = ltype } -> do
+    tele'  <- renameHsForAllTelescope tele
+    ltype' <- renameLType ltype
+    return (HsForAllTy { hst_xforall = noExtField
+                       , hst_tele = tele', hst_body = ltype' })
 
   HsQualTy { hst_ctxt = lcontext , hst_body = ltype } -> do
     lcontext' <- renameLContext lcontext
@@ -304,6 +304,13 @@ renameLHsQTyVars (HsQTvs { hsq_explicit = tvs })
        ; return (HsQTvs { hsq_ext = noExtField
                         , hsq_explicit = tvs' }) }
 
+renameHsForAllTelescope :: HsForAllTelescope GhcRn -> RnM (HsForAllTelescope DocNameI)
+renameHsForAllTelescope tele = case tele of
+  HsForAllVis   x bndrs -> do bndrs' <- mapM renameLTyVarBndr bndrs
+                              pure $ HsForAllVis x bndrs'
+  HsForAllInvis x bndrs -> do bndrs' <- mapM renameLTyVarBndr bndrs
+                              pure $ HsForAllInvis x bndrs'
+
 renameLTyVarBndr :: LHsTyVarBndr flag GhcRn -> RnM (LHsTyVarBndr flag DocNameI)
 renameLTyVarBndr (L loc (UserTyVar x fl (L l n)))
   = do { n' <- rename n
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index cbfea762..e137c258 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -206,12 +206,16 @@ freeVariables =
     everythingWithState Set.empty Set.union query
   where
     query term ctx = case cast term :: Maybe (HsType GhcRn) of
-        Just (HsForAllTy _ _ bndrs _) ->
-            (Set.empty, Set.union ctx (bndrsNames bndrs))
+        Just (HsForAllTy _ tele _) ->
+            (Set.empty, Set.union ctx (teleNames tele))
         Just (HsTyVar _ _ (L _ name))
             | getName name `Set.member` ctx -> (Set.empty, ctx)
             | otherwise -> (Set.singleton $ getName name, ctx)
         _ -> (Set.empty, ctx)
+
+    teleNames (HsForAllVis   _ bndrs) = bndrsNames bndrs
+    teleNames (HsForAllInvis _ bndrs) = bndrsNames bndrs
+
     bndrsNames = Set.fromList . map (getName . tyVarName . unLoc)
 
 
@@ -244,9 +248,9 @@ data RenameEnv name = RenameEnv
 
 
 renameType :: HsType GhcRn -> Rename (IdP GhcRn) (HsType GhcRn)
-renameType (HsForAllTy x fvf bndrs lt) =
-    HsForAllTy x fvf
-        <$> mapM (located renameBinder) bndrs
+renameType (HsForAllTy x tele lt) =
+    HsForAllTy x
+        <$> renameForAllTelescope tele
         <*> renameLType lt
 renameType (HsQualTy x lctxt lt) =
     HsQualTy x
@@ -291,11 +295,21 @@ renameLTypes = mapM renameLType
 renameContext :: HsContext GhcRn -> Rename (IdP GhcRn) (HsContext GhcRn)
 renameContext = renameLTypes
 
+renameForAllTelescope :: HsForAllTelescope GhcRn
+                      -> Rename (IdP GhcRn) (HsForAllTelescope GhcRn)
+renameForAllTelescope (HsForAllVis x bndrs) =
+  HsForAllVis x <$> mapM renameLBinder bndrs
+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 (KindedTyVar x fl lname lkind) =
   KindedTyVar x fl <$> located renameName lname <*> located renameType lkind
 
+renameLBinder :: LHsTyVarBndr flag GhcRn -> Rename (IdP GhcRn) (LHsTyVarBndr flag GhcRn)
+renameLBinder = located renameBinder
+
 -- | Core renaming logic.
 renameName :: (Eq name, SetName name) => name -> Rename name name
 renameName name = do