diff options
author | Duncan Coutts <duncan@well-typed.com> | 2014-08-27 13:49:31 +0100 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2014-12-12 06:26:11 +0000 |
commit | b455abf0132b109512f967af917cd516b69d1c01 (patch) | |
tree | 4e5b2534d6335b4d09ba5505b605c8ceec3af4d9 /haddock-api/src/Haddock.hs | |
parent | e1156b56e4711546956f5588b7b4258cb42caaac (diff) |
Changes due to ghc api changes in package representation
Also fix a bug with finding the package name and version given a
module. This had become wrong due to the package key changes (it was
very hacky in the first place). We now look up the package key in the
package db to get the package info properly.
Conflicts:
haddock-api/src/Haddock.hs
Diffstat (limited to 'haddock-api/src/Haddock.hs')
-rw-r--r-- | haddock-api/src/Haddock.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index ee6e3050..0bf94129 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -47,7 +47,6 @@ import Data.IORef import qualified Data.Map as Map import System.IO import System.Exit -import System.Directory #if defined(mingw32_HOST_OS) import Foreign @@ -68,6 +67,8 @@ import DynFlags hiding (verbosity) import StaticFlags (discardStaticFlags) import Panic (handleGhcException) import Module +import PackageConfig +import FastString -------------------------------------------------------------------------------- -- * Exception handling @@ -250,7 +251,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do pkgMod = ifaceMod (head ifaces) pkgKey = modulePackageKey pkgMod pkgStr = Just (packageKeyString pkgKey) - (pkgName,pkgVer) = modulePackageInfo pkgMod + (pkgName,pkgVer) = modulePackageInfo dflags pkgMod (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags srcMap' = maybe srcMap (\path -> Map.insert pkgKey path srcMap) srcEntity @@ -286,15 +287,17 @@ render dflags flags qual ifaces installedIfaces srcMap = do -- TODO: we throw away Meta for both Hoogle and LaTeX right now, -- might want to fix that if/when these two get some work on them when (Flag_Hoogle `elem` flags) $ do - let pkgName2 = if pkgName == "main" && title /= [] then title else pkgName - ppHoogle dflags pkgName2 pkgVer title (fmap _doc prologue) visibleIfaces + let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] + = title + | otherwise = unpackFS pkgNameFS + where PackageName pkgNameFS = pkgName + ppHoogle dflags pkgNameStr pkgVer title (fmap _doc prologue) visibleIfaces odir when (Flag_LaTeX `elem` flags) $ do ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style libDir - ------------------------------------------------------------------------------- -- * Reading and dumping interface files ------------------------------------------------------------------------------- |