diff options
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 14 | ||||
| -rw-r--r-- | src/Haddock/ModuleTree.hs | 13 | 
2 files changed, 16 insertions, 11 deletions
| 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 | 
