From 32dddcb1f0495a633ab806e0bcd43816cac67b03 Mon Sep 17 00:00:00 2001 From: Duncan Coutts <duncan@community.haskell.org> Date: Mon, 2 Dec 2013 17:13:18 +0000 Subject: [PATCH] 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. --- 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 4142c2308a..7ad86a1029 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. @@ -525,25 +525,20 @@ renderPureArgs version comp 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) @@ -578,12 +573,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)) -- GitLab