aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEdward Z. Yang <ezyang@cs.stanford.edu>2014-09-18 13:38:11 -0700
committerEdward Z. Yang <ezyang@cs.stanford.edu>2014-09-18 13:38:11 -0700
commitee47a1ab37699db0573c9cf0aa6461e1f8865197 (patch)
tree9eb0ca0d12911663b01d1f1c7ac82752fe9011ed /src
parent4023817d7c0e46db012ba2eea28022626841ca9b (diff)
Properly render package ID (not package key) in index, fixes #329.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Diffstat (limited to 'src')
-rw-r--r--src/Haddock.hs4
-rw-r--r--src/Haddock/Backends/Xhtml.hs14
-rw-r--r--src/Haddock/ModuleTree.hs13
3 files changed, 18 insertions, 13 deletions
diff --git a/src/Haddock.hs b/src/Haddock.hs
index bed47625..980926cd 100644
--- a/src/Haddock.hs
+++ b/src/Haddock.hs
@@ -262,14 +262,14 @@ render dflags flags qual ifaces installedIfaces srcMap = do
copyHtmlBits odir libDir themes
when (Flag_GenContents `elem` flags) $ do
- ppHtmlContents odir title pkgStr
+ ppHtmlContents dflags odir title pkgStr
themes opt_index_url sourceUrls' opt_wiki_urls
allVisibleIfaces True prologue pretty
(makeContentsQual qual)
copyHtmlBits odir libDir themes
when (Flag_Html `elem` flags) $ do
- ppHtml title pkgStr visibleIfaces odir
+ ppHtml dflags title pkgStr visibleIfaces odir
prologue
themes sourceUrls' opt_wiki_urls
opt_contents_url opt_index_url unicode qual
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 192c708a..b6a1190d 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -60,7 +60,8 @@ import Module
--------------------------------------------------------------------------------
-ppHtml :: String
+ppHtml :: DynFlags
+ -> String -- ^ Title
-> Maybe String -- ^ Package
-> [Interface]
-> FilePath -- ^ Destination directory
@@ -75,7 +76,7 @@ ppHtml :: String
-> Bool -- ^ Output pretty html (newlines and indenting)
-> IO ()
-ppHtml doctitle maybe_package ifaces odir prologue
+ppHtml dflags doctitle maybe_package ifaces odir prologue
themes maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url unicode
qual debug = do
@@ -84,7 +85,7 @@ ppHtml doctitle maybe_package ifaces odir prologue
visible i = OptHide `notElem` ifaceOptions i
when (isNothing maybe_contents_url) $
- ppHtmlContents odir doctitle maybe_package
+ ppHtmlContents dflags odir doctitle maybe_package
themes maybe_index_url maybe_source_url maybe_wiki_url
(map toInstalledIface visible_ifaces)
False -- we don't want to display the packages in a single-package contents
@@ -239,7 +240,8 @@ moduleInfo iface =
ppHtmlContents
- :: FilePath
+ :: DynFlags
+ -> FilePath
-> String
-> Maybe String
-> Themes
@@ -250,10 +252,10 @@ ppHtmlContents
-> Bool
-> Qualification -- ^ How to qualify names
-> IO ()
-ppHtmlContents odir doctitle _maybe_package
+ppHtmlContents dflags odir doctitle _maybe_package
themes maybe_index_url
maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do
- let tree = mkModuleTree showPkgs
+ let tree = mkModuleTree dflags showPkgs
[(instMod iface, toInstalledDescription iface) | iface <- ifaces]
html =
headHtml doctitle Nothing themes +++
diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs
index 28c5c06d..cb926685 100644
--- a/src/Haddock/ModuleTree.hs
+++ b/src/Haddock/ModuleTree.hs
@@ -15,18 +15,21 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where
import Haddock.Types ( Doc )
import GHC ( Name )
-import Module ( Module, moduleNameString, moduleName, modulePackageKey,
- packageKeyString )
+import Module ( Module, moduleNameString, moduleName, modulePackageKey )
+import DynFlags ( DynFlags )
+import Packages ( lookupPackage )
+import PackageConfig ( sourcePackageIdString )
data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree]
-mkModuleTree :: Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree]
-mkModuleTree showPkgs mods =
+mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree]
+mkModuleTree dflags showPkgs mods =
foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ]
where
- modPkg mod_ | showPkgs = Just (packageKeyString (modulePackageKey mod_))
+ modPkg mod_ | showPkgs = fmap sourcePackageIdString
+ (lookupPackage dflags (modulePackageKey mod_))
| otherwise = Nothing
fn (mod_,pkg,short) = addToTrees mod_ pkg short