From 0cf6fc670da338a58e103e1324f934139bca8aa3 Mon Sep 17 00:00:00 2001
From: Neil Mitchell <unknown>
Date: Mon, 15 Dec 2008 11:44:26 +0000
Subject: Make forall's in constructors explicit, i.e. data Foo = Foo {foo ::
 Eq a => a}

---
 src/Haddock/Backends/Hoogle.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

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

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 8b184a54..d46ca565 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -75,6 +75,12 @@ outHsType :: OutputableBndr a => HsType a -> String
 outHsType = out . dropHsDocTy
 
 
+makeExplicit (HsForAllTy _ a b c) = HsForAllTy Explicit a b c
+makeExplicit x = x
+
+makeExplicitL (L src x) = L src (makeExplicit x)
+
+
 dropComment (' ':'-':'-':' ':_) = []
 dropComment (x:xs) = x : dropComment xs
 dropComment [] = []
@@ -165,10 +171,10 @@ ppCtor dat con = ldoc (con_doc con) ++ f (con_details con)
                            [out (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]
                           | r <- recs]
 
-        funs = foldr1 (\x y -> reL $ HsFunTy x y)
+        funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y))
         apps = foldl1 (\x y -> reL $ HsAppTy x y)
 
-        typeSig name flds = operator name ++ " :: " ++ outHsType (unL $ funs flds)
+        typeSig name flds = operator name ++ " :: " ++ outHsType (makeExplicit $ unL $ funs flds)
         name = out $ unL $ con_name con
 
         resType = case con_res con of
-- 
cgit v1.2.3