[commit: haddock] T6018-injective-type-families, adamse-D1033, ghc-head, master, wip/10268, wip/10313, wip/D538, wip/D538-1, wip/D538-2, wip/D538-3, wip/D538-4, wip/D538-5, wip/D538-6, wip/D548-master, wip/D548-master-2, wip/T10483, wip/T9840, wip/api-annot-tweaks-7.10, wip/api-annots-ghc-7.10-3, wip/orf-reboot: Properly render package ID (not package key) in index, fixes #329. (6e95f42)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branches: T6018-injective-type-families,adamse-D1033,ghc-head,master,wip/10268,wip/10313,wip/D538,wip/D538-1,wip/D538-2,wip/D538-3,wip/D538-4,wip/D538-5,wip/D538-6,wip/D548-master,wip/D548-master-2,wip/T10483,wip/T9840,wip/api-annot-tweaks-7.10,wip/api-annots-ghc-7.10-3,wip/orf-reboot
Link       : http://git.haskell.org/haddock.git/commitdiff/6e95f42907970c9cbb9f6279509a4bf5542ffae4

>---------------------------------------------------------------

commit 6e95f42907970c9cbb9f6279509a4bf5542ffae4
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Thu Sep 18 13:38:11 2014 -0700

    Properly render package ID (not package key) in index, fixes #329.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
    
    Conflicts:
    	haddock-api/src/Haddock/ModuleTree.hs


>---------------------------------------------------------------

6e95f42907970c9cbb9f6279509a4bf5542ffae4
 haddock-api/src/Haddock.hs                |  4 ++--
 haddock-api/src/Haddock/Backends/Xhtml.hs | 14 ++++++++------
 haddock-api/src/Haddock/ModuleTree.hs     | 13 ++++++++-----
 3 files changed, 18 insertions(+), 13 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 0bf9412..ef03f8f 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -270,14 +270,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/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index d117652..f065104 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/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/haddock-api/src/Haddock/ModuleTree.hs b/haddock-api/src/Haddock/ModuleTree.hs
index 662d702..eec1342 100644
--- a/haddock-api/src/Haddock/ModuleTree.hs
+++ b/haddock-api/src/Haddock/ModuleTree.hs
@@ -15,18 +15,21 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where
 import Haddock.Types ( MDoc )
 
 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 (MDoc Name)) [ModuleTree]
 
 
-mkModuleTree :: Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
-mkModuleTree showPkgs mods =
+mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc 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