[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: Changes due to ghc api changes in package representation (b455abf)

[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/b455abf0132b109512f967af917cd516b69d1c01

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

commit b455abf0132b109512f967af917cd516b69d1c01
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Wed Aug 27 13:49:31 2014 +0100

    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


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

b455abf0132b109512f967af917cd516b69d1c01
 haddock-api/src/Haddock.hs                 | 13 ++++++++-----
 haddock-api/src/Haddock/Backends/Hoogle.hs |  6 ++++--
 haddock-api/src/Haddock/GhcUtils.hs        | 25 +++++--------------------
 3 files changed, 17 insertions(+), 27 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index ee6e305..0bf9412 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 dd2e738..3ea73db 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 33d9213..2c7b79a 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)