Skip to content

Instantly share code, notes, and snippets.

@thoughtpolice
Created July 3, 2014 21:08
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save thoughtpolice/b78b8b483d80c90d165e to your computer and use it in GitHub Desktop.
Save thoughtpolice/b78b8b483d80c90d165e to your computer and use it in GitHub Desktop.
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