From 629ff801073bb90a968dbc882b0c443d13e4d92e Mon Sep 17 00:00:00 2001
From: "david.waern" <david.waern@gmail.com>
Date: Thu, 18 Mar 2010 22:22:27 +0000
Subject: Fix build with GHC 6.12.1

---
 src/Haddock/Backends/Hoogle.hs |  7 ++-----
 src/Haddock/Backends/Html.hs   | 14 +++++++++++++-
 src/Haddock/Convert.hs         |  8 ++++++++
 src/Haddock/GhcUtils.hs        | 16 ++++++++++++----
 4 files changed, 35 insertions(+), 10 deletions(-)

(limited to 'src/Haddock')

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index b1b08b95..25c5d91e 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -145,10 +145,7 @@ ppClass x = out x{tcdSigs=[]} :
         f t = HsForAllTy Implicit [] (reL [context]) (reL t)
 
         context = reL $ HsClassP (unL $ tcdLName x)
-            (map (reL . HsTyVar . tyVar . unL) (tcdTyVars x))
-
-        tyVar (UserTyVar v _) = v
-        tyVar (KindedTyVar v _) = v
+            (map (reL . HsTyVar . hsTyVarName . unL) (tcdTyVars x))
 
 
 ppInstance :: Instance -> [String]
@@ -191,7 +188,7 @@ ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con))
         name = out $ unL $ con_name con
 
         resType = case con_res con of
-            ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [x | UserTyVar x _ <- map unL $ tcdTyVars dat]
+            ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [hsTyVarName v | v@UserTyVar {} <- map unL $ tcdTyVars dat]
             ResTyGADT x -> x
 
 
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index b1290fd5..47930ed4 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -1368,7 +1368,11 @@ ppShortConstr summary con unicode = case con_res con of
     mkFunTy a b = noLoc (HsFunTy a b)
 
 -- ppConstrHdr is for (non-GADT) existentials constructors' syntax
+#if __GLASGOW_HASKELL__ == 612
+ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Bool -> Html
+#else
 ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool -> Html
+#endif
 ppConstrHdr forall tvs ctxt unicode
  = (if null tvs then noHtml else ppForall)
    +++
@@ -1580,7 +1584,11 @@ ppFunLhType  unicode ty = ppr_mono_ty pREC_FUN ty unicode
 -- Drop top-level for-all type variables in user style
 -- since they are implicit in Haskell
 
+#if __GLASGOW_HASKELL__ == 612
+ppForAll :: HsExplicitForAll -> [Located (HsTyVarBndr DocName)]
+#else
 ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)]
+#endif
          -> Located (HsContext DocName) -> Bool -> Html
 ppForAll expl tvs cxt unicode
   | show_forall = forall_part <+> ppLContext cxt unicode
@@ -1610,8 +1618,12 @@ ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP
 ppr_mono_ty _         (HsPredTy p)        u = parens (ppPred u p)
 ppr_mono_ty _         (HsNumTy n)         _ = toHtml (show n) -- generics only
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
+#if __GLASGOW_HASKELL__ == 612
+ppr_mono_ty _         (HsSpliceTyOut {})  _ = error "ppr_mono_ty HsQuasiQuoteTy"
+#else
 ppr_mono_ty _         (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy"
-ppr_mono_ty _         (HsRecTy _)         _ = error "ppr_mono_ty HsRecTy"
+#endif
+ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 
 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode 
   = maybeParen ctxt_prec pREC_CON $
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 5a47eb2e..54bce1c8 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -20,7 +20,11 @@ module Haddock.Convert where
 import HsSyn
 import TcType ( tcSplitSigmaTy )
 import TypeRep
+#if __GLASGOW_HASKELL__ == 612
+import Type ( splitKindFunTys )
+#else
 import Coercion ( splitKindFunTys )
+#endif
 import Name
 import Var
 import Class
@@ -226,7 +230,11 @@ synifyTyVars = map synifyTyVar
       kind = tyVarKind tv
       name = getName tv
      in if isLiftedTypeKind kind
+#if __GLASGOW_HASKELL__ == 612
+        then UserTyVar name
+#else
         then UserTyVar name placeHolderKind
+#endif
         else KindedTyVar name kind
 
 --states of what to do with foralls:
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index 5c481586..c0d6707c 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -90,10 +90,18 @@ isVarSym = isLexVarSym . occNameFS
 
 getMainDeclBinder :: HsDecl name -> Maybe name
 getMainDeclBinder (TyClD d) = Just (tcdName d)
-getMainDeclBinder (ValD d)
-   = case collectHsBindBinders d of
-        []       -> Nothing 
-        (name:_) -> Just name
+getMainDeclBinder (ValD d) =
+#if __GLASGOW_HASKELL__ == 612
+  case collectAcc d [] of
+    []       -> Nothing
+    (name:_) -> Just (unLoc name)
+#else
+  case collectHsBindBinders d of
+    []       -> Nothing
+    (name:_) -> Just name
+#endif
+
+
 getMainDeclBinder (SigD d) = sigNameNoLoc d
 getMainDeclBinder (ForD (ForeignImport name _ _)) = Just (unLoc name)
 getMainDeclBinder (ForD (ForeignExport _ _ _)) = Nothing
-- 
cgit v1.2.3