From 34d2aa54b95e8d261dc325393893d06f6a085130 Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <eir@cis.upenn.edu>
Date: Fri, 2 Aug 2013 15:54:55 +0100
Subject: Changes to reflect changes in GHC's type HsTyVarBndr

---
 src/Haddock/Backends/Hoogle.hs     |  2 +-
 src/Haddock/Backends/LaTeX.hs      |  1 +
 src/Haddock/Backends/Xhtml/Decl.hs |  1 +
 src/Haddock/Convert.hs             |  9 +++++----
 src/Haddock/Interface/Rename.hs    | 11 +++++------
 5 files changed, 13 insertions(+), 11 deletions(-)

(limited to 'src')

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 64905a37..58c02534 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@UserTyVar {}) <- hsQTvBndrs $ tyClDeclTyVars dat]
+                        (tcdName dat) : [hsTyVarName v | L _ v@(HsTyVarBndr _ Nothing Nothing) <- hsQTvBndrs $ tyClDeclTyVars dat]
             ResTyGADT x -> x
 
 
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 5d0fabe9..b8635d03 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -847,6 +847,7 @@ 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 2ecc6464..54c202b8 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -676,6 +676,7 @@ 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 0f7e5b9c..04acbc9b 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -120,8 +120,9 @@ 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 $ KindedTyVar (getName fakeTyVar) 
-                                                      (synifyKindSig realKind)
+                                = noLoc $ HsTyVarBndr (getName fakeTyVar) 
+                                                      (Just $ synifyKindSig realKind)
+                                                      Nothing
                          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 *
@@ -275,8 +276,8 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs
   where
     (kvs, tvs) = partition isKindVar ktvs
     synifyTyVar tv 
-      | isLiftedTypeKind kind = noLoc (UserTyVar name)
-      | otherwise             = noLoc (KindedTyVar name (synifyKindSig kind))
+      | isLiftedTypeKind kind = noLoc (HsTyVarBndr name Nothing Nothing)
+      | otherwise             = noLoc (HsTyVarBndr name (Just $ synifyKindSig kind) Nothing)
       where
         kind = tyVarKind tv
         name = getName tv
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index f21088d8..a6f48520 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -263,6 +263,8 @@ 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
@@ -288,13 +290,10 @@ 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 (UserTyVar n))
-  = do { n' <- rename n
-       ; return (L loc (UserTyVar n')) }
-renameLTyVarBndr (L loc (KindedTyVar n k))
+renameLTyVarBndr (L loc (HsTyVarBndr n mkind mrole))
   = do { n' <- rename n
-       ; k' <- renameLKind k
-       ; return (L loc (KindedTyVar n' k')) }
+       ; mkind' <- mapM renameLKind mkind
+       ; return (L loc (HsTyVarBndr n' mkind' mrole)) }
 
 renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
 renameLContext (L loc context) = do
-- 
cgit v1.2.3