diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 1bf02e3c8938457dc0f5e2e1a493137a2af801d0..405bf2045d1fd87da33caa231af927c728f2398f 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 fb1038f2bd23d40a872479f36c8570f338c98e6e..08810d6ec12aa2708f09c466f964ab8dad347276 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"