aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/Create.hs
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2018-02-06 09:20:51 +0100
committeralexbiehl <alex.biehl@gmail.com>2018-02-06 09:20:51 +0100
commitffee7f80736f91f0f18c787f093b4ca1ae315afa (patch)
tree64a8b41fc45c14ebb7811e8bf95c86f88e95082f /haddock-api/src/Haddock/Interface/Create.hs
parentd73af20636a7f7f9f3022ca19fa5a97e871ddabf (diff)
fullModuleContents: support named docs
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
-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