From 1a9dcfef033dd66514015d4a942ba67d21f95482 Mon Sep 17 00:00:00 2001
From: Thomas Winant <thomas.winant@cs.kuleuven.be>
Date: Wed, 6 Aug 2014 10:26:54 +0200
Subject: Support for PartialTypeSignatures

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

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

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index cdd4d56e..1df6d9b1 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -64,7 +64,7 @@ dropHsDocTy :: HsType a -> HsType a
 dropHsDocTy = f
     where
         g (L src x) = L src (f x)
-        f (HsForAllTy a b c d) = HsForAllTy a b c (g d)
+        f (HsForAllTy a b c d e) = HsForAllTy a b c d (g e)
         f (HsBangTy a b) = HsBangTy a (g b)
         f (HsAppTy a b) = HsAppTy (g a) (g b)
         f (HsFunTy a b) = HsFunTy (g a) (g b)
@@ -82,7 +82,7 @@ outHsType dflags = out dflags . dropHsDocTy
 
 
 makeExplicit :: HsType a -> HsType a
-makeExplicit (HsForAllTy _ a b c) = HsForAllTy Explicit a b c
+makeExplicit (HsForAllTy _ a b c d) = HsForAllTy Explicit a b c d
 makeExplicit x = x
 
 makeExplicitL :: LHsType a -> LHsType a
@@ -120,21 +120,21 @@ ppExport dflags ExportDecl { expItemDecl    = L _ decl
         f (TyClD d@DataDecl{})  = ppData dflags d subdocs
         f (TyClD d@SynDecl{})   = ppSynonym dflags d
         f (TyClD d@ClassDecl{}) = ppClass dflags d
-        f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
-        f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ
+        f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ []
+        f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ []
         f (SigD sig) = ppSig dflags sig
         f _ = []
 ppExport _ _ = []
 
 
 ppSig :: DynFlags -> Sig Name -> [String]
-ppSig dflags (TypeSig names sig)
+ppSig dflags (TypeSig names sig _)
     = [operator prettyNames ++ " :: " ++ outHsType dflags typ]
     where
         prettyNames = intercalate ", " $ map (out dflags) names
         typ = case unL sig of
-                   HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c
-                   HsForAllTy Qualified a b c -> HsForAllTy Implicit a b c
+                   HsForAllTy Explicit a b c d  -> HsForAllTy Implicit a b c d
+                   HsForAllTy Qualified a b c d -> HsForAllTy Implicit a b c d
                    x -> x
 ppSig _ _ = []
 
@@ -144,12 +144,12 @@ ppClass :: DynFlags -> TyClDecl Name -> [String]
 ppClass dflags x = out dflags x{tcdSigs=[]} :
             concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
     where
-        addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
+        addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs
         addContext (MinimalSig sig) = MinimalSig sig
         addContext _ = error "expected TypeSig"
 
-        f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d
-        f t = HsForAllTy Implicit emptyHsQTvs (reL [context]) (reL t)
+        f (HsForAllTy a b c con d) = HsForAllTy a b c (reL (context : unLoc con)) d
+        f t = HsForAllTy Implicit Nothing emptyHsQTvs (reL [context]) (reL t)
 
         context = nlHsTyConApp (tcdName x)
             (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tyClDeclTyVars x)))
-- 
cgit v1.2.3