Created
July 3, 2014 21:08
-
-
Save thoughtpolice/b78b8b483d80c90d165e to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs | |
index 1bf02e3..405bf20 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 fb1038f..08810d6 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" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment