From 60aa88ef69436c974212e9ffefe9edcc9ab731bf Mon Sep 17 00:00:00 2001
From: Austin Seipp <aseipp@pobox.com>
Date: Thu, 3 Jul 2014 17:22:23 -0500
Subject: [PATCH] GHC 7.8: follow changes in PatSyn and LHsBindsLR
Signed-off-by: Austin Seipp <aseipp@pobox.com>
---
src/Haddock/Convert.hs | 4 ++--
src/Haddock/Interface/Create.hs | 16 ++++++++--------
2 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 1bf02e3c..405bf204 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -94,10 +94,10 @@ tyThingToLHsDecl t = noLoc $ case t of
(synifyType ImplicitizeForAll (dataConUserType dc)))
AConLike (PatSynCon ps) ->
- let (_, _, (req_theta, prov_theta)) = patSynSig ps
+ let (_, _, req_theta, prov_theta, _, res_ty) = patSynSig ps
in SigD $ PatSynSig (synifyName ps)
(fmap (synifyType WithinType) (patSynTyDetails ps))
- (synifyType WithinType (patSynType ps))
+ (synifyType WithinType res_ty)
(synifyCtx req_theta)
(synifyCtx prov_theta)
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index fb1038f2..08810d6e 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -364,7 +364,7 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
where
decls = docs ++ defs ++ sigs ++ ats
docs = mkDecls tcdDocs DocD class_
- defs = mkDecls (map snd . bagToList . tcdMeths) ValD class_
+ defs = mkDecls (bagToList . tcdMeths) ValD class_
sigs = mkDecls tcdSigs SigD class_
ats = mkDecls tcdATs (TyClD . FamDecl) class_
@@ -384,13 +384,13 @@ mkFixMap group_ = M.fromList [ (n,f)
ungroup :: HsGroup Name -> [LHsDecl Name]
ungroup group_ =
mkDecls (tyClGroupConcat . hs_tyclds) TyClD group_ ++
- mkDecls hs_derivds DerivD group_ ++
- mkDecls hs_defds DefD group_ ++
- mkDecls hs_fords ForD group_ ++
- mkDecls hs_docs DocD group_ ++
- mkDecls hs_instds InstD group_ ++
- mkDecls (typesigs . hs_valds) SigD group_ ++
- mkDecls (map snd . valbinds . hs_valds) ValD group_
+ mkDecls hs_derivds DerivD group_ ++
+ mkDecls hs_defds DefD group_ ++
+ mkDecls hs_fords ForD group_ ++
+ mkDecls hs_docs DocD group_ ++
+ mkDecls hs_instds InstD group_ ++
+ mkDecls (typesigs . hs_valds) SigD group_ ++
+ mkDecls (valbinds . hs_valds) ValD group_
where
typesigs (ValBindsOut _ sigs) = filter isVanillaLSig sigs
typesigs _ = error "expected ValBindsOut"
--
GitLab