[commit: packages/Cabal] ghc-head: Fix the haddock --html-location= for relative URLs (1eb2181)

[git at git.haskell.org]

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

On branch  : ghc-head
Link       : http://git.haskell.org/packages/Cabal.git/commitdiff/1eb2181fae2b706ee8024d3f8fef104b5089b1a9

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

commit 1eb2181fae2b706ee8024d3f8fef104b5089b1a9
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Mon Dec 2 17:13:18 2013 +0000

    Fix the haddock --html-location= for relative URLs
    
    The previous fix in isue #1407 turned out to be in the wrong place and
    so applied to both the haddock-html from the ghc-pkg output, and also to
    the location passed via the --html-location flag. For the
    --html-location flag it is important that we can use relative URLs like
    /package/$pkg-$version/docs because that is what we need for hackage.
    Note that that is a relative URL, it's relative to the server root.
    However that was being interpreted as a local file path and being given
    the file:// prefix. So now we move the file:// URL stuff to the right
    place so it only applies to the location given in the haddock-html field
    of the package registration.


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

1eb2181fae2b706ee8024d3f8fef104b5089b1a9
 Cabal/Distribution/Simple/Haddock.hs |   25 ++++++++++++++-----------
 1 file changed, 14 insertions(+), 11 deletions(-)

diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs
index f86e2ca..d8634a0 100644
--- a/Cabal/Distribution/Simple/Haddock.hs
+++ b/Cabal/Distribution/Simple/Haddock.hs
@@ -131,7 +131,7 @@ data HaddockArgs = HaddockArgs {
  argContents :: Flag String,                      -- ^ optional url to contents page
  argVerbose :: Any,
  argOutput :: Flag [Output],                      -- ^ Html or Hoogle doc or both?                                   required.
- argInterfaces :: [(FilePath, Maybe FilePath)],   -- ^ [(interface file, path to the html docs for links)]
+ argInterfaces :: [(FilePath, Maybe String)],     -- ^ [(interface file, URL to the html docs for links)]
  argOutputDir :: Directory,                       -- ^ where to generate the documentation.
  argTitle :: Flag String,                         -- ^ page's title,                                         required.
  argPrologue :: Flag String,                      -- ^ prologue text,                                        required.
@@ -516,25 +516,20 @@ renderPureArgs version args = concat
     where
       renderInterfaces =
         map (\(i,mh) -> "--read-interface=" ++
-          maybe "" ((++",") . mkUrl) mh ++ i)
+          maybe "" (++",") 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
 
 -----------------------------------------------------------------------------------------------------------
 
 haddockPackageFlags :: LocalBuildInfo
                     -> ComponentLocalBuildInfo
                     -> Maybe PathTemplate
-                    -> IO ([(FilePath,Maybe FilePath)], Maybe String)
+                    -> IO ([(FilePath,Maybe String)], Maybe String)
 haddockPackageFlags lbi clbi htmlTemplate = do
   let allPkgs = installedPkgs lbi
       directDeps = map fst (componentPackageDeps clbi)
@@ -569,12 +564,20 @@ haddockPackageFlags lbi clbi htmlTemplate = do
     interfaceAndHtmlPath pkg = do
       interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
       html <- case htmlTemplate of
-        Nothing -> listToMaybe (InstalledPackageInfo.haddockHTMLs pkg)
+        Nothing -> fmap fixFileUrl
+                        (listToMaybe (InstalledPackageInfo.haddockHTMLs pkg))
         Just htmlPathTemplate -> Just (expandTemplateVars htmlPathTemplate)
       return (interface, html)
 
-      where expandTemplateVars = fromPathTemplate . substPathTemplate env
-            env = haddockTemplateEnv lbi (packageId pkg)
+      where
+        expandTemplateVars = fromPathTemplate . substPathTemplate env
+        env = haddockTemplateEnv lbi (packageId pkg)
+
+        -- the 'haddock-html' field in the hc-pkg output is often set as a
+        -- native path, but we need it as a URL.
+        -- See https://github.com/haskell/cabal/issues/1064
+        fixFileUrl f | isAbsolute f = "file://" ++ f
+                     | otherwise    = f
 
 haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
 haddockTemplateEnv lbi pkg_id = (PrefixVar, prefix (installDirTemplates lbi))