diff options
| -rw-r--r-- | src/HaddockHtml.hs | 4 | ||||
| -rw-r--r-- | src/HaddockTypes.hs | 8 | ||||
| -rw-r--r-- | src/Main.hs | 70 |
3 files changed, 22 insertions, 60 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index d43b8270..e01499dd 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 = OptHide `notElem` hmod_options i + visible i = DocOptHide `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 = OptHide `notElem` hmod_options i + visible i = DocOptHide `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 9c04c6e2..e08b0652 100644 --- a/src/HaddockTypes.hs +++ b/src/HaddockTypes.hs @@ -22,14 +22,6 @@ 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 05b32662..1ff2ca01 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'', OptHide `notElem` (hmod_options m) ] + visibleMods = [ m | m <- haddockMods'', DocOptHide `notElem` (hmod_options m) ] packageName = (Just . packageIdString . modulePackageId . hmod_mod . head) visibleMods @@ -482,7 +482,7 @@ type FullyCheckedMod = (ParsedSource, data ModuleDataGHC = ModuleDataGHC { ghcModule :: Module, ghcFilename :: FilePath, - ghcMbDocOpts :: Maybe String, + ghcDocOpts :: [DocOption], ghcHaddockModInfo :: HaddockModInfo Name, ghcMbDoc :: Maybe (HsDoc Name), ghcGroup :: HsGroup Name, @@ -497,7 +497,7 @@ moduleDataGHC :: CheckedMod -> ModuleDataGHC moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC { ghcModule = mod, ghcFilename = file, - ghcMbDocOpts = mbOpts, + ghcDocOpts = opts, ghcHaddockModInfo = info, ghcMbDoc = mbDoc, ghcGroup = group, @@ -507,8 +507,8 @@ moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC { ghcInstances = modInfoInstances modInfo } where - HsModule _ _ _ _ _ mbOpts _ _ = unLoc parsed - (group, _, mbExports, mbDoc, info) = renamed + HsModule _ _ _ _ _ opts _ _ = unLoc parsed + (group, _, mbExports, (mbDoc, info, nodocs)) = renamed (parsed, renamed, _, modInfo) = checkedMod -- | Massage the data in ModuleDataGHC to produce something closer to what @@ -518,11 +518,9 @@ moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC { pass1data :: ModuleDataGHC -> [Flag] -> ModuleMap -> ErrMsgM HaddockModule pass1data modData flags modMap = do - let mod = ghcModule modData - - opts <- mkDocOpts (ghcMbDocOpts modData) mod - - let group = ghcGroup modData + let mod = ghcModule modData + opts = docOpts (ghcDocOpts modData) mod + group = ghcGroup modData entities = (nubBy sameName . collectEntities) group exports = fmap (reverse . map unLoc) (ghcMbExports modData) entityNames_ = entityNames entities @@ -545,7 +543,7 @@ pass1data modData flags modMap = do -- documentation, if the 'prune' option is on. let prunedExportItems - | OptPrune `elem` opts = pruneExportItems exportItems + | DocOptPrune `elem` opts = pruneExportItems exportItems | otherwise = exportItems return HM { @@ -567,14 +565,10 @@ pass1data modData flags modMap = do hmod_instances = ghcInstances modData } where - 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' + docOpts opts mod = + if Flag_HideModule (moduleString mod) `elem` flags + then DocOptHide : opts + else opts -- | Produce a map of HaddockModules with information that is close to -- renderable. What is lacking after this pass are the renamed export items. @@ -822,7 +816,7 @@ renameModule renamingEnv mod = in do -- report things that we couldn't link to. Only do this for non-hidden -- modules. - when (OptHide `notElem` hmod_options mod && not (null strings)) $ + when (DocOptHide `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) ] @@ -852,7 +846,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 || OptIgnoreExports `elem` opts + | isNothing maybe_exps || ignore_all_exports || DocOptIgnoreExports `elem` opts = everything_local_exported | Just specs <- maybe_exps = do exps <- mapM lookupExport specs @@ -899,7 +893,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m | otherwise = case Map.lookup m mod_map of Just hmod - | OptHide `elem` hmod_options hmod + | DocOptHide `elem` hmod_options hmod -> return (hmod_export_items hmod) | otherwise -> return [ ExportModule m ] Nothing -> return [] -- already emitted a warning in visibleNames @@ -1004,7 +998,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) - | OptIgnoreExports `elem` opts = return localNames + | DocOptIgnoreExports `elem` opts = return localNames | Just expspecs <- maybeExps = do visibleNames <- mapM extract expspecs return $ filter isNotPackageName (concat visibleNames) @@ -1029,7 +1023,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 - | OptHide `elem` hmod_options mod -> + | DocOptHide `elem` hmod_options mod -> return (filter (`elem` scope) (hmod_exports mod)) | otherwise -> return [] Nothing @@ -1065,9 +1059,9 @@ buildGlobalDocEnv modules = foldl upd Map.empty (reverse modules) where upd old_env mod - | OptHide `elem` hmod_options mod + | DocOptHide `elem` hmod_options mod = old_env - | OptNotHome `elem` hmod_options mod + | DocOptNotHome `elem` hmod_options mod = foldl' keep_old old_env exported_names | otherwise = foldl' keep_new old_env exported_names @@ -1095,30 +1089,6 @@ 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) |