aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs40
1 files changed, 24 insertions, 16 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index f905f494..7f0594e0 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -647,8 +647,9 @@ mkExportItems
instIfaceMap dflags =
case exportList of
Nothing ->
- fullModuleContents is_sig modMap thisMod semMod warnings exportedNames
- decls maps fixMap splices instIfaceMap dflags allExports
+ fullModuleContents is_sig modMap thisMod semMod warnings gre
+ exportedNames decls maps fixMap splices instIfaceMap dflags
+ allExports
Just exports -> liftM concat $ mapM lookupExport exports
where
lookupExport (IEGroup lev docStr, _) = liftErrMsg $ do
@@ -985,6 +986,7 @@ fullModuleContents :: Bool -- is it a signature
-> Module -- this module
-> Module -- semantic module
-> WarningMap
+ -> GlobalRdrEnv -- ^ The renaming environment
-> [Name] -- exported names (orig)
-> [LHsDecl GhcRn] -- renamed source declarations
-> Maps
@@ -994,23 +996,29 @@ fullModuleContents :: Bool -- is it a signature
-> DynFlags
-> Avails
-> ErrMsgGhc [ExportItem GhcRn]
-fullModuleContents is_sig modMap thisMod semMod warnings exportedNames
+fullModuleContents is_sig modMap thisMod semMod warnings gre exportedNames
decls maps@(_, _, declMap, _) fixMap splices instIfaceMap dflags avails = do
let availEnv = availsToNameEnv (nubAvails avails)
(concat . concat) `fmap` (for decls $ \decl -> do
- for (getMainDeclBinder (unLoc decl)) $ \nm -> do
- case lookupNameEnv availEnv nm of
- Just avail
- | L _ (ValD valDecl) <- decl
- , (name:_) <- collectHsBindBinders valDecl
- , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap
- -> pure []
-
- | otherwise
- -> availExportItem is_sig modMap thisMod
- semMod warnings exportedNames maps fixMap
- splices instIfaceMap dflags avail
- Nothing -> pure [])
+ case decl of
+ (L _ (DocD (DocGroup lev docStr))) -> do
+ doc <- liftErrMsg (processDocString dflags gre docStr)
+ return [[ExportGroup lev "" doc]]
+ (L _ (DocD (DocCommentNamed _ docStr))) -> do
+ doc <- liftErrMsg (processDocStringParas dflags gre docStr)
+ return [[ExportDoc doc]]
+ (L _ (ValD valDecl))
+ | name:_ <- collectHsBindBinders valDecl
+ , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap
+ -> return []
+ _ ->
+ for (getMainDeclBinder (unLoc decl)) $ \nm -> do
+ case lookupNameEnv availEnv nm of
+ Just avail ->
+ availExportItem is_sig modMap thisMod
+ semMod warnings exportedNames maps fixMap
+ splices instIfaceMap dflags avail
+ Nothing -> pure [])
where
isSigD (L _ SigD{}) = True
isSigD _ = False