aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock.hs13
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs6
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs25
3 files changed, 17 insertions, 27 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
-------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index dd2e7387..3ea73db5 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -25,6 +25,7 @@ import Outputable
import Data.Char
import Data.List
import Data.Maybe
+import Data.Version
import System.FilePath
import System.IO
@@ -34,13 +35,14 @@ prefix = ["-- Hoogle documentation, generated by Haddock"
,""]
-ppHoogle :: DynFlags -> String -> String -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()
+ppHoogle :: DynFlags -> String -> Version -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()
ppHoogle dflags package version synopsis prologue ifaces odir = do
let filename = package ++ ".txt"
contents = prefix ++
docWith dflags (drop 2 $ dropWhile (/= ':') synopsis) prologue ++
["@package " ++ package] ++
- ["@version " ++ version | version /= ""] ++
+ ["@version " ++ showVersion version
+ | not (null (versionBranch version)) ] ++
concat [ppModule dflags i | i <- ifaces, OptHide `notElem` ifaceOptions i]
h <- openFile (odir </> filename) WriteMode
hSetEncoding h utf8
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 33d92131..2c7b79a1 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -22,8 +22,6 @@ import Control.Arrow
import Data.Foldable hiding (concatMap)
import Data.Function
import Data.Traversable
-import Distribution.Compat.ReadP
-import Distribution.Text
import Exception
import Outputable
@@ -43,24 +41,11 @@ moduleString = moduleNameString . moduleName
-- return the (name,version) of the package
-modulePackageInfo :: Module -> (String, [Char])
-modulePackageInfo modu = case unpackPackageKey pkg of
- Nothing -> (packageKeyString pkg, "")
- Just x -> (display $ pkgName x, showVersion (pkgVersion x))
- where pkg = modulePackageKey modu
-
-
--- This was removed from GHC 6.11
--- XXX we shouldn't be using it, probably
-
--- | Try and interpret a GHC 'PackageKey' as a cabal 'PackageIdentifer'. Returns @Nothing@ if
--- we could not parse it as such an object.
-unpackPackageKey :: PackageKey -> Maybe PackageIdentifier
-unpackPackageKey p
- = case [ pid | (pid,"") <- readP_to_S parse str ] of
- [] -> Nothing
- (pid:_) -> Just pid
- where str = packageKeyString p
+modulePackageInfo :: DynFlags -> Module -> (PackageName, Version)
+modulePackageInfo dflags modu =
+ (packageName pkg, packageVersion pkg)
+ where
+ pkg = getPackageDetails dflags (modulePackageKey modu)
lookupLoadedHomeModuleGRE :: GhcMonad m => ModuleName -> m (Maybe GlobalRdrEnv)