From a8d7e66da4dcc3b242103271875261604be42d6e Mon Sep 17 00:00:00 2001
From: Gert-Jan Bottu <gertjan.bottu@kuleuven.be>
Date: Sun, 5 Apr 2020 11:16:56 +0200
Subject: Explicit Specificity Support for Haddock

---
 haddock-api/src/Haddock/Interface/Rename.hs     | 12 ++++++------
 haddock-api/src/Haddock/Interface/Specialize.hs | 18 +++++++++---------
 2 files changed, 15 insertions(+), 15 deletions(-)

(limited to 'haddock-api/src/Haddock/Interface')

diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 59c2f818..848acb1f 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -304,14 +304,14 @@ renameLHsQTyVars (HsQTvs { hsq_explicit = tvs })
        ; return (HsQTvs { hsq_ext = noExtField
                         , hsq_explicit = tvs' }) }
 
-renameLTyVarBndr :: LHsTyVarBndr GhcRn -> RnM (LHsTyVarBndr DocNameI)
-renameLTyVarBndr (L loc (UserTyVar x (L l n)))
+renameLTyVarBndr :: LHsTyVarBndr flag GhcRn -> RnM (LHsTyVarBndr flag DocNameI)
+renameLTyVarBndr (L loc (UserTyVar x fl (L l n)))
   = do { n' <- rename n
-       ; return (L loc (UserTyVar x (L l n'))) }
-renameLTyVarBndr (L loc (KindedTyVar x (L lv n) kind))
+       ; return (L loc (UserTyVar x fl (L l n'))) }
+renameLTyVarBndr (L loc (KindedTyVar x fl (L lv n) kind))
   = do { n' <- rename n
        ; kind' <- renameLKind kind
-       ; return (L loc (KindedTyVar x (L lv n') kind')) }
+       ; return (L loc (KindedTyVar x fl (L lv n') kind')) }
 
 renameLContext :: Located [LHsType GhcRn] -> RnM (Located [LHsType DocNameI])
 renameLContext (L loc context) = do
@@ -475,7 +475,7 @@ renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars
                             , con_res_ty = res_ty
                             , con_doc = mbldoc }) = do
       lnames'   <- mapM renameL lnames
-      ltyvars'  <- renameLHsQTyVars ltyvars
+      ltyvars'  <- mapM renameLTyVarBndr ltyvars
       lcontext' <- traverse renameLContext lcontext
       details'  <- renameDetails details
       res_ty'   <- renameLType res_ty
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index a939dfbd..cbfea762 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -60,8 +60,8 @@ specializeTyVarBndrs bndrs typs =
     specialize $ zip bndrs' typs
   where
     bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs
-    bname (UserTyVar _ (L _ name)) = name
-    bname (KindedTyVar _ (L _ name) _) = name
+    bname (UserTyVar _ _ (L _ name)) = name
+    bname (KindedTyVar _ _ (L _ name) _) = name
     bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs"
 
 
@@ -291,10 +291,10 @@ renameLTypes = mapM renameLType
 renameContext :: HsContext GhcRn -> Rename (IdP GhcRn) (HsContext GhcRn)
 renameContext = renameLTypes
 
-renameBinder :: HsTyVarBndr GhcRn -> Rename (IdP GhcRn) (HsTyVarBndr GhcRn)
-renameBinder (UserTyVar x lname) = UserTyVar x <$> located renameName lname
-renameBinder (KindedTyVar x lname lkind) =
-  KindedTyVar x <$> located renameName lname <*> located renameType lkind
+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
 
 -- | Core renaming logic.
 renameName :: (Eq name, SetName name) => name -> Rename name name
@@ -348,7 +348,7 @@ located :: Functor f => (a -> f b) -> Located a -> f (Located b)
 located f (L loc e) = L loc <$> f e
 
 
-tyVarName :: HsTyVarBndr name -> IdP name
-tyVarName (UserTyVar _ name) = unLoc name
-tyVarName (KindedTyVar _ (L _ name) _) = name
+tyVarName :: HsTyVarBndr flag name -> IdP name
+tyVarName (UserTyVar _ _ name) = unLoc name
+tyVarName (KindedTyVar _ _ (L _ name) _) = name
 tyVarName (XTyVarBndr _ ) = error "haddock:tyVarName"
-- 
cgit v1.2.3