Change how the Hoogle backend outputs classes, adding the context in

1 files changed, 12 insertions, 1 deletions

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]