From 9728fda4c7001b2770d721307a142c92cbba23a8 Mon Sep 17 00:00:00 2001
From: Neil Mitchell <unknown>
Date: Thu, 26 Jun 2008 00:28:10 +0000
Subject: Change how the Hoogle backend outputs classes, adding the context in

---
 src/Haddock/Backends/Hoogle.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

(limited to 'src/Haddock/Backends/Hoogle.hs')

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 53d99846..bda246ac 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -61,6 +61,7 @@ ppModule iface = "" : doc (ifaceDoc iface) ++
 
 indent = (++) "    "
 unL (L _ x) = x
+reL = L undefined
 
 
 dropComment (' ':'-':'-':' ':_) = []
@@ -95,7 +96,17 @@ ppExport _ = []
 -- note: does not yet output documentation for class methods
 ppClass :: TyClDecl Name -> [String]
 ppClass x = out x{tcdSigs=[]} :
-            map (indent . out) (tcdSigs x)
+            map (out . addContext . unL) (tcdSigs x)
+    where
+        addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
+        f (HsForAllTy a b con d) = HsForAllTy a b (reL $ context : unL con) d
+        f x = HsForAllTy Implicit [] (reL [context]) (reL x)
+
+        context = reL $ HsClassP (unL $ tcdLName x)
+            (map (reL . HsTyVar . tyVar . unL) (tcdTyVars x))
+
+        tyVar (UserTyVar x) = x
+        tyVar (KindedTyVar x _) = x
 
 
 ppInstance :: Instance -> [String]
-- 
cgit v1.2.3