Revision to reflect new role annotation syntax in GHC.

6 files changed, 12 insertions, 14 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 58c02534..6afc7939 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -195,7 +195,7 @@ ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con)
 
         resType = case con_res con of
             ResTyH98 -> apps $ map (reL . HsTyVar) $ 
-                        (tcdName dat) : [hsTyVarName v | L _ v@(HsTyVarBndr _ Nothing Nothing) <- hsQTvBndrs $ tyClDeclTyVars dat]
+                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
             ResTyGADT x -> x
 
 
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 4f947249..c69f1e18 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -851,7 +851,6 @@ ppr_mono_ty _         (HsTyVar name)      _ = ppDocName name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u
 ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
-ppr_mono_ty _         (HsRoleAnnot {})    _ = error "ppr_mono_ty HsRoleAnnot"
 ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsIParamTy n ty)   u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 54c202b8..2ecc6464 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -676,7 +676,6 @@ ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
 ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u q =
     parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
-ppr_mono_ty _         (HsRoleAnnot {})    _ _ = error "ppr_mono_ty HsRoleAnnot"
 ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsIParamTy n ty)   u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 04acbc9b..0f7e5b9c 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -120,9 +120,8 @@ synifyTyCon tc
   = DataDecl { tcdLName = synifyName tc
              , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:
                          let mk_hs_tv realKind fakeTyVar 
-                                = noLoc $ HsTyVarBndr (getName fakeTyVar) 
-                                                      (Just $ synifyKindSig realKind)
-                                                      Nothing
+                                = noLoc $ KindedTyVar (getName fakeTyVar) 
+                                                      (synifyKindSig realKind)
                          in HsQTvs { hsq_kvs = []   -- No kind polymorphism
                                    , hsq_tvs = zipWith mk_hs_tv (fst (splitKindFunTys (tyConKind tc)))
                                                                 alphaTyVars --a, b, c... which are unfortunately all kind *
@@ -276,8 +275,8 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs
   where
     (kvs, tvs) = partition isKindVar ktvs
     synifyTyVar tv 
-      | isLiftedTypeKind kind = noLoc (HsTyVarBndr name Nothing Nothing)
-      | otherwise             = noLoc (HsTyVarBndr name (Just $ synifyKindSig kind) Nothing)
+      | isLiftedTypeKind kind = noLoc (UserTyVar name)
+      | otherwise             = noLoc (KindedTyVar name (synifyKindSig kind))
       where
         kind = tyVarKind tv
         name = getName tv
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index d4adbe1c..825e9624 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -354,7 +354,7 @@ topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
 -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
 ungroup :: HsGroup Name -> [LHsDecl Name]
 ungroup group_ =
-  mkDecls (concat   . hs_tyclds) TyClD  group_ ++
+  mkDecls (tyClGroupConcat . hs_tyclds) TyClD  group_ ++
   mkDecls hs_derivds             DerivD group_ ++
   mkDecls hs_defds               DefD   group_ ++
   mkDecls hs_fords               ForD   group_ ++
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a6f48520..a5ed47e6 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -263,8 +263,6 @@ renameType t = case t of
     k' <- renameLKind k
     return (HsKindSig ty' k')
 
-  HsRoleAnnot _ _ -> error "renameType: HsRoleAnnot"
-
   HsDocTy ty doc -> do
     ty' <- renameLType ty
     doc' <- renameLDocHsSyn doc
@@ -290,10 +288,13 @@ renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })
                 -- This is rather bogus, but I'm not sure what else to do
 
 renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
-renameLTyVarBndr (L loc (HsTyVarBndr n mkind mrole))
+renameLTyVarBndr (L loc (UserTyVar n))
+  = do { n' <- rename n
+       ; return (L loc (UserTyVar n')) }
+renameLTyVarBndr (L loc (KindedTyVar n kind))
   = do { n' <- rename n
-       ; mkind' <- mapM renameLKind mkind
-       ; return (L loc (HsTyVarBndr n' mkind' mrole)) }
+       ; kind' <- renameLKind kind
+       ; return (L loc (KindedTyVar n' kind')) }
 
 renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
 renameLContext (L loc context) = do