diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2015-12-16 06:05:25 -0500 | 
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2015-12-16 09:23:09 -0500 | 
| commit | 66cf3d2714ef1cf851782fbe4378f8c2b1af3335 (patch) | |
| tree | ec4af86a47c754d7c6d256d5da45e368f5edd76b /haddock-api/src/Haddock/Interface/Create.hs | |
| parent | 91217a9642962476a736f6179d0803ddb787c2b9 (diff) | |
Fix fallout from wildcards refactoring
The wildcard refactoring was introduced a new type of signature,
`ClassOpSig`, which is carried by typeclasses. The original patch
adapting Haddock for this change missed a few places where this
constructor needed to be handled, resulting in no class methods
in documentation produced by Haddock.
Additionally, this moves and renames the `isVanillaLSig` helper from
GHC's HsBinds module into GhcUtils, since it is only used by Haddock.
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 6 | 
1 files changed, 3 insertions, 3 deletions
| diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 30b32963..7da965ac 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -396,7 +396,7 @@ ungroup group_ =    mkDecls (typesigs . hs_valds)  SigD   group_ ++    mkDecls (valbinds . hs_valds)  ValD   group_    where -    typesigs (ValBindsOut _ sigs) = filter isVanillaLSig sigs +    typesigs (ValBindsOut _ sigs) = filter isUserLSig sigs      typesigs _ = error "expected ValBindsOut"      valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds @@ -428,7 +428,7 @@ filterDecls = filter (isHandled . unL . fst)      isHandled (ForD (ForeignImport {})) = True      isHandled (TyClD {}) = True      isHandled (InstD {}) = True -    isHandled (SigD d) = isVanillaLSig (reL d) +    isHandled (SigD d) = isUserLSig (reL d)      isHandled (ValD _) = True      -- we keep doc declarations to be able to get at named docs      isHandled (DocD _) = True @@ -441,7 +441,7 @@ filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x                        | x@(L loc d, doc) <- decls ]    where      filterClass (TyClD c) = -      TyClD $ c { tcdSigs = filter (liftA2 (||) isVanillaLSig isMinimalLSig) $ tcdSigs c } +      TyClD $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }      filterClass _ = error "expected TyClD" | 
