aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/HaddockHtml.hs4
-rw-r--r--src/HaddockTypes.hs8
-rw-r--r--src/Main.hs70
3 files changed, 60 insertions, 22 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index fafbe3f5..b42cfe6b 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -68,7 +68,7 @@ ppHtml doctitle maybe_package hmods odir prologue maybe_html_help_format
maybe_contents_url maybe_index_url = do
let
visible_hmods = filter visible hmods
- visible i = DocOptHide `notElem` hmod_options i
+ visible i = OptHide `notElem` hmod_options i
when (not (isJust maybe_contents_url)) $
ppHtmlContents odir doctitle maybe_package
@@ -99,7 +99,7 @@ ppHtmlHelpFiles
ppHtmlHelpFiles doctitle maybe_package hmods odir maybe_html_help_format pkg_paths = do
let
visible_hmods = filter visible hmods
- visible i = DocOptHide `notElem` hmod_options i
+ visible i = OptHide `notElem` hmod_options i
-- Generate index and contents page for Html Help if requested
case maybe_html_help_format of
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index e08b0652..9c04c6e2 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -22,6 +22,14 @@ import Outputable
import Data.Map
+data DocOption
+ = OptHide -- ^ This module should not appear in the docs
+ | OptPrune
+ | OptIgnoreExports -- ^ Pretend everything is exported
+ | OptNotHome -- ^ Not the best place to get docs for things
+ -- exported by this module.
+ deriving (Eq, Show)
+
data ExportItem name
= ExportDecl
Name -- ^ The original name
diff --git a/src/Main.hs b/src/Main.hs
index 03b202e0..b7ecab36 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -427,7 +427,7 @@ run flags modules extEnv = do
mapM_ putStrLn messages'
let
- visibleMods = [ m | m <- haddockMods'', DocOptHide `notElem` (hmod_options m) ]
+ visibleMods = [ m | m <- haddockMods'', OptHide `notElem` (hmod_options m) ]
packageName = (Just . packageIdString . modulePackageId .
hmod_mod . head) visibleMods
@@ -486,7 +486,7 @@ type FullyCheckedMod = (ParsedSource,
data ModuleDataGHC = ModuleDataGHC {
ghcModule :: Module,
ghcFilename :: FilePath,
- ghcDocOpts :: [DocOption],
+ ghcMbDocOpts :: Maybe String,
ghcHaddockModInfo :: HaddockModInfo Name,
ghcMbDoc :: Maybe (HsDoc Name),
ghcGroup :: HsGroup Name,
@@ -501,7 +501,7 @@ moduleDataGHC :: CheckedMod -> ModuleDataGHC
moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC {
ghcModule = mod,
ghcFilename = file,
- ghcDocOpts = opts,
+ ghcMbDocOpts = mbOpts,
ghcHaddockModInfo = info,
ghcMbDoc = mbDoc,
ghcGroup = group,
@@ -511,8 +511,8 @@ moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC {
ghcInstances = modInfoInstances modInfo
}
where
- HsModule _ _ _ _ _ opts _ _ = unLoc parsed
- (group, _, mbExports, (mbDoc, info, nodocs)) = renamed
+ HsModule _ _ _ _ _ mbOpts _ _ = unLoc parsed
+ (group, _, mbExports, mbDoc, info) = renamed
(parsed, renamed, _, modInfo) = checkedMod
-- | Massage the data in ModuleDataGHC to produce something closer to what
@@ -522,9 +522,11 @@ moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC {
pass1data :: ModuleDataGHC -> [Flag] -> ModuleMap -> ErrMsgM HaddockModule
pass1data modData flags modMap = do
- let mod = ghcModule modData
- opts = docOpts (ghcDocOpts modData) mod
- group = ghcGroup modData
+ let mod = ghcModule modData
+
+ opts <- mkDocOpts (ghcMbDocOpts modData) mod
+
+ let group = ghcGroup modData
entities = (nubBy sameName . collectEntities) group
exports = fmap (reverse . map unLoc) (ghcMbExports modData)
entityNames_ = entityNames entities
@@ -547,7 +549,7 @@ pass1data modData flags modMap = do
-- documentation, if the 'prune' option is on.
let
prunedExportItems
- | DocOptPrune `elem` opts = pruneExportItems exportItems
+ | OptPrune `elem` opts = pruneExportItems exportItems
| otherwise = exportItems
return HM {
@@ -569,10 +571,14 @@ pass1data modData flags modMap = do
hmod_instances = ghcInstances modData
}
where
- docOpts opts mod =
- if Flag_HideModule (moduleString mod) `elem` flags
- then DocOptHide : opts
- else opts
+ mkDocOpts mbOpts mod = do
+ opts <- case mbOpts of
+ Just opts -> processOptions opts
+ Nothing -> return []
+ let opts' = if Flag_HideModule (moduleString mod) `elem` flags
+ then OptHide : opts
+ else opts
+ return opts'
-- | Produce a map of HaddockModules with information that is close to
-- renderable. What is lacking after this pass are the renamed export items.
@@ -820,7 +826,7 @@ renameModule renamingEnv mod =
in do
-- report things that we couldn't link to. Only do this for non-hidden
-- modules.
- when (DocOptHide `notElem` hmod_options mod && not (null strings)) $
+ when (OptHide `notElem` hmod_options mod && not (null strings)) $
tell ["Warning: " ++ show (ppr (hmod_mod mod) defaultUserStyle) ++
": could not find link destinations for:\n"++
" " ++ concat (map (' ':) strings) ]
@@ -850,7 +856,7 @@ mkExportItems
mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_map entities
opts maybe_exps ignore_all_exports docMap
- | isNothing maybe_exps || ignore_all_exports || DocOptIgnoreExports `elem` opts
+ | isNothing maybe_exps || ignore_all_exports || OptIgnoreExports `elem` opts
= everything_local_exported
| Just specs <- maybe_exps = do
exps <- mapM lookupExport specs
@@ -891,7 +897,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m
| otherwise =
case Map.lookup m mod_map of
Just hmod
- | DocOptHide `elem` hmod_options hmod
+ | OptHide `elem` hmod_options hmod
-> return (hmod_export_items hmod)
| otherwise -> return [ ExportModule m ]
Nothing -> return [] -- already emitted a warning in visibleNames
@@ -996,7 +1002,7 @@ mkVisibleNames :: Module
mkVisibleNames mdl modMap localNames scope subMap maybeExps opts declMap
-- if no export list, just return all local names
| Nothing <- maybeExps = return (filter hasDecl localNames)
- | DocOptIgnoreExports `elem` opts = return localNames
+ | OptIgnoreExports `elem` opts = return localNames
| Just expspecs <- maybeExps = do
visibleNames <- mapM extract expspecs
return $ filter isNotPackageName (concat visibleNames)
@@ -1021,7 +1027,7 @@ mkVisibleNames mdl modMap localNames scope subMap maybeExps opts declMap
| otherwise -> let m' = mkModule (modulePackageId mdl) m in
case Map.lookup m' modMap of
Just mod
- | DocOptHide `elem` hmod_options mod ->
+ | OptHide `elem` hmod_options mod ->
return (filter (`elem` scope) (hmod_exports mod))
| otherwise -> return []
Nothing
@@ -1057,9 +1063,9 @@ buildGlobalDocEnv modules
= foldl upd Map.empty (reverse modules)
where
upd old_env mod
- | DocOptHide `elem` hmod_options mod
+ | OptHide `elem` hmod_options mod
= old_env
- | DocOptNotHome `elem` hmod_options mod
+ | OptNotHome `elem` hmod_options mod
= foldl' keep_old old_env exported_names
| otherwise
= foldl' keep_new old_env exported_names
@@ -1087,6 +1093,30 @@ findNamedDoc name entities = search entities
| otherwise = search rest
search (_other_decl : rest) = search rest
+-- -----------------------------------------------------------------------------
+-- Haddock options embedded in the source file
+
+processOptions_ str = let (opts, msg) = runWriter (processOptions str)
+ in print msg >> return opts
+
+processOptions :: String -> ErrMsgM [DocOption]
+processOptions str = do
+ case break (== ',') str of
+ (this, ',':rest) -> do
+ opt <- parseOption this
+ opts <- processOptions rest
+ return (maybeToList opt ++ opts)
+ (this, _)
+ | all isSpace this -> return []
+ | otherwise -> do opt <- parseOption this; return (maybeToList opt)
+
+parseOption :: String -> ErrMsgM (Maybe DocOption)
+parseOption "hide" = return (Just OptHide)
+parseOption "prune" = return (Just OptPrune)
+parseOption "ignore-exports" = return (Just OptIgnoreExports)
+parseOption "not-home" = return (Just OptNotHome)
+parseOption other = do tell ["Unrecognised option: " ++ other]; return Nothing
+
-- simplified type for sorting types, ignoring qualification (not visible
-- in Haddock output) and unifying special tycons with normal ones.
data SimpleType = SimpleType Name [SimpleType] deriving (Eq,Ord)
generated by cgit v1.2.3 (git 2.39.1) at 2025-11-04 08:17:25 +0000