diff options
| author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2016-08-10 23:43:55 -0700 |
|---|---|---|
| committer | alexbiehl <alex.biehl@gmail.com> | 2017-10-31 20:35:05 +0100 |
| commit | aec8868cb317afb827e890faba4c80f3e1a574d7 (patch) | |
| tree | df6ebfa37357f916de4d946a6fdfdbe25fd80e09 /haddock-api/src/Haddock.hs | |
| parent | b4982d87f41d9a4d3f6237bacfd819145723e35b (diff) | |
Supported reexported-modules via --reexport flag.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Diffstat (limited to 'haddock-api/src/Haddock.hs')
| -rw-r--r-- | haddock-api/src/Haddock.hs | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 7b4b8671..d9bc3ea6 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -67,6 +67,7 @@ import Paths_haddock_api (getDataDir) import System.Directory (doesDirectoryExist) #endif +import Text.ParserCombinators.ReadP (readP_to_S) import GHC hiding (verbosity) import Config import DynFlags hiding (projectVersion, verbosity) @@ -296,6 +297,23 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap') + -- TODO: This silently suppresses errors + installedMap :: Map Module InstalledInterface + installedMap = Map.fromList [ (unwire (instMod iface), iface) | iface <- installedIfaces ] + + -- The user gives use base-4.9.0.0, but the InstalledInterface + -- records the *wired in* identity base. So untranslate it + -- so that we can service the request. + unwire :: Module -> Module + unwire m = m { moduleUnitId = unwireUnitId dflags (moduleUnitId m) } + + reexportedIfaces = + [ iface + | mod_str <- reexportFlags flags + , (m, "") <- readP_to_S parseModuleId mod_str + , Just iface <- [Map.lookup m installedMap] + ] + libDir <- getHaddockLibDir flags prologue <- getPrologue dflags' flags themes <- getThemes libDir flags >>= either bye return @@ -316,7 +334,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do copyHtmlBits odir libDir themes withQuickjump when (Flag_Html `elem` flags) $ do - ppHtml dflags' title pkgStr visibleIfaces odir + ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir prologue themes opt_mathjax sourceUrls' opt_wiki_urls opt_contents_url opt_index_url unicode qual |