aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/Create.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs24
1 files changed, 17 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 6ff1223c..26ac0281 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -819,20 +819,30 @@ fullModuleContents :: DynFlags
-> [LHsDecl Name] -- ^ All the renamed declarations
-> ErrMsgGhc [ExportItem Name]
fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap splices decls =
- liftM catMaybes $ mapM mkExportItem (expandSig decls)
+ liftM catMaybes $ mapM mkExportItem (expandSigDecls decls)
where
-- A type signature can have multiple names, like:
-- foo, bar :: Types..
--
-- We go through the list of declarations and expand type signatures, so
-- that every type signature has exactly one name!
- expandSig :: [LHsDecl name] -> [LHsDecl name]
- expandSig = foldr f []
+ expandSigDecls :: [LHsDecl name] -> [LHsDecl name]
+ expandSigDecls = concatMap f
where
- f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
- f (L l (SigD (TypeSig names t))) xs = foldr (\n acc -> L l (SigD (TypeSig [n] t)) : acc) xs names
- f (L l (SigD (ClassOpSig b names t))) xs = foldr (\n acc -> L l (SigD (ClassOpSig b [n] t)) : acc) xs names
- f x xs = x : xs
+ f (L l (SigD sig)) = [ L l (SigD s) | s <- expandSig sig ]
+
+ -- also expand type signatures for class methods
+ f (L l (TyClD cls@ClassDecl{})) =
+ [ L l (TyClD cls { tcdSigs = concatMap expandLSig (tcdSigs cls) }) ]
+ f x = [x]
+
+ expandLSig :: LSig name -> [LSig name]
+ expandLSig (L l sig) = [ L l s | s <- expandSig sig ]
+
+ expandSig :: Sig name -> [Sig name]
+ expandSig (TypeSig names t) = [ TypeSig [n] t | n <- names ]
+ expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ]
+ expandSig x = [x]
mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
mkExportItem (L _ (DocD (DocGroup lev docStr))) = do