diff options
Diffstat (limited to 'haddock-api/src')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 24 | 
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 | 
