[commit: packages/Cabal] ghc-head: Make absolute haddock paths proper URLs (544d737)

[git at git.haskell.org]

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

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=544d737a23ac4d6c030b0c45bbb76f650f15b46f

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

commit 544d737a23ac4d6c030b0c45bbb76f650f15b46f
Author: Roman Cheplyaka <roma at ro-che.info>
Date:   Thu Aug 1 08:57:53 2013 +0300

    Make absolute haddock paths proper URLs
    
    Fixes #1064, #1406


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

544d737a23ac4d6c030b0c45bbb76f650f15b46f
 Cabal/Distribution/Simple/Haddock.hs         |   11 +++++++++--
 cabal-install/Distribution/Client/Haddock.hs |    9 +++++++--
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs
index 46c7154..e43b572 100644
--- a/Cabal/Distribution/Simple/Haddock.hs
+++ b/Cabal/Distribution/Simple/Haddock.hs
@@ -113,7 +113,7 @@ import Data.Monoid
 import Data.Maybe    ( fromMaybe, listToMaybe )
 
 import System.FilePath((</>), (<.>), splitFileName, splitExtension,
-                       normalise, splitPath, joinPath )
+                       normalise, splitPath, joinPath, isAbsolute )
 import System.IO (hClose, hPutStrLn)
 import Distribution.Version
 
@@ -513,13 +513,20 @@ renderPureArgs version args = concat
      argTargets $ args
     ]
     where
-      renderInterfaces = map (\(i,mh) -> "--read-interface=" ++ maybe "" (++",") mh ++ i)
+      renderInterfaces =
+        map (\(i,mh) -> "--read-interface=" ++
+          maybe "" ((++",") . mkUrl) mh ++ i)
       bool a b c = if c then a else b
       isVersion2 = version >= Version [2,0] []
       isVersion2_5 = version >= Version [2,5] []
       verbosityFlag
        | isVersion2_5 = "--verbosity=1"
        | otherwise = "--verbose"
+      -- See https://github.com/haskell/cabal/issues/1064
+      mkUrl f =
+        if isAbsolute f
+          then "file://" ++ f
+          else f
 
 -----------------------------------------------------------------------------------------------------------
 
diff --git a/cabal-install/Distribution/Client/Haddock.hs b/cabal-install/Distribution/Client/Haddock.hs
index 97c3a72..802d533 100644
--- a/cabal-install/Distribution/Client/Haddock.hs
+++ b/cabal-install/Distribution/Client/Haddock.hs
@@ -21,7 +21,7 @@ import Data.List (maximumBy)
 import Control.Monad (guard)
 import System.Directory (createDirectoryIfMissing, doesFileExist,
                          renameFile)
-import System.FilePath ((</>), splitFileName)
+import System.FilePath ((</>), splitFileName, isAbsolute)
 import Distribution.Package
          ( Package(..), packageVersion )
 import Distribution.Simple.Program (haddockProgram, ProgramConfiguration
@@ -57,7 +57,7 @@ regenerateHaddockIndex verbosity pkgs conf index = do
                     , "--gen-index"
                     , "--odir=" ++ tempDir
                     , "--title=Haskell modules on this system" ]
-                 ++ [ "--read-interface=" ++ html ++ "," ++ interface
+                 ++ [ "--read-interface=" ++ mkUrl html ++ "," ++ interface
                     | (interface, html) <- paths ]
         rawSystemProgram verbosity confHaddock flags
         renameFile (tempDir </> "index.html") (tempDir </> destFile)
@@ -69,6 +69,11 @@ regenerateHaddockIndex verbosity pkgs conf index = do
             | (_pname, pkgvers) <- allPackagesByName pkgs
             , let pkgvers' = filter exposed pkgvers
             , not (null pkgvers') ]
+    -- See https://github.com/haskell/cabal/issues/1064
+    mkUrl f =
+      if isAbsolute f
+        then "file://" ++ f
+        else f
 
 haddockPackagePaths :: [InstalledPackageInfo]
                        -> IO ([(FilePath, FilePath)], Maybe String)