From 23f2a478b7dc6b61cab86cf7d0db7fec8a6d9a1f Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Fri, 1 Mar 2024 10:52:25 +0000
Subject: [PATCH] Fix haddock source links and hyperlinked source
There were a few issues with the hackage links:
1. We were using the package id rather than the package name for the
package links. This is fixed by now allowing the template to mention
%pkg% or %pkgid% and substituing both appropiatly.
2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage`
as the new base link works on a local or remote hackage server.
3. The "src" path including too much stuff, so cross-package source
links were broken as the template was getting double expanded.
Fixes #24086
---
.gitlab/generate-ci/gen_ci.hs | 2 +-
.gitlab/jobs.yaml | 4 ++--
hadrian/README.md | 6 +++---
hadrian/src/CommandLine.hs | 15 +++++++--------
hadrian/src/Settings/Builders/Haddock.hs | 21 ++++++++++++++-------
5 files changed, 27 insertions(+), 21 deletions(-)
diff --git a/.gitlab/generate-ci/gen_ci.hs b/.gitlab/generate-ci/gen_ci.hs
index b352ace63e05..db7f3af9cd0b 100644
--- a/.gitlab/generate-ci/gen_ci.hs
+++ b/.gitlab/generate-ci/gen_ci.hs
@@ -1031,7 +1031,7 @@ job_groups =
-- (see Note [Object unloading]).
fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 linker_unload_native")
- hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url")
+ hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
tsan_jobs =
modifyJobs
diff --git a/.gitlab/jobs.yaml b/.gitlab/jobs.yaml
index 2c3ac84c4015..63d340aec0c0 100644
--- a/.gitlab/jobs.yaml
+++ b/.gitlab/jobs.yaml
@@ -2330,7 +2330,7 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-base-url",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"LLC": "/bin/false",
"OPT": "/bin/false",
"RUNTEST_ARGS": "",
@@ -4007,7 +4007,7 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-base-url --hash-unit-ids",
+ "HADRIAN_ARGS": "--haddock-for-hackage --hash-unit-ids",
"IGNORE_PERF_FAILURES": "all",
"LLC": "/bin/false",
"OPT": "/bin/false",
diff --git a/hadrian/README.md b/hadrian/README.md
index 19fe12c10e9a..3d4db97f31e0 100644
--- a/hadrian/README.md
+++ b/hadrian/README.md
@@ -306,9 +306,9 @@ all of the documentation targets:
You can pass several `--docs=...` flags, Hadrian will combine
their effects.
-To build haddock documentation for upload to hackage you need to pass the `--haddock-base-url` flag,
-by default this will choose a url suitable for uploading to hackage but you might also want to pass something like
-`http://127.0.0.1:8080/package/%pkg%/docs` for testing upload locally on a local hackage server.
+To build haddock documentation for upload to hackage you need to pass the `--haddock-for-hackage` flag,
+This will generate URLs which are appropiate for either uploading to a local hackage
+server or the global hackage server.
#### Source distribution
diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
index 9de13ef89eac..98ee5a3b28ba 100644
--- a/hadrian/src/CommandLine.hs
+++ b/hadrian/src/CommandLine.hs
@@ -17,7 +17,6 @@ import System.Environment
import qualified System.Directory as Directory
import qualified Data.Set as Set
-import Data.Maybe
data TestSpeed = TestSlow | TestNormal | TestFast deriving (Show, Eq)
@@ -114,7 +113,7 @@ data DocArgs = DocArgs
} deriving (Eq, Show)
defaultDocArgs :: DocArgs
-defaultDocArgs = DocArgs { docsBaseUrl = "../%pkg%" }
+defaultDocArgs = DocArgs { docsBaseUrl = "../%pkgid%" }
readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Left "hadrian --configure has been deprecated (see #20167). Please run ./boot; ./configure manually"
@@ -192,11 +191,11 @@ readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testO
readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }
-readHaddockBaseUrl :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readHaddockBaseUrl base_url = Right $ \flags ->
- flags { docsArgs = (docsArgs flags) { docsBaseUrl = base_url' } }
+readHaddockBaseUrl :: Either String (CommandLineArgs -> CommandLineArgs)
+readHaddockBaseUrl = Right $ \flags ->
+ flags { docsArgs = (docsArgs flags) { docsBaseUrl = base_url } }
- where base_url' = fromMaybe "https://hackage.haskell.org/package/%pkg%/docs" base_url
+ where base_url = "/package/%pkg%/docs"
readTestRootDirs :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
@@ -320,8 +319,8 @@ optDescrs =
"Destination path for the bindist 'install' rule"
, Option [] ["complete-setting"] (OptArg readCompleteStg "SETTING")
"Setting key to autocomplete, for the 'autocomplete' target."
- , Option [] ["haddock-base-url"] (OptArg readHaddockBaseUrl "BASE_URL")
- "Generate documentation suitable for upload to hackage or for another base URL (for example a local hackage server)."
+ , Option [] ["haddock-for-hackage"] (NoArg readHaddockBaseUrl)
+ "Generate documentation suitable for upload to a hackage server."
]
-- | A type-indexed map containing Hadrian command line arguments to be passed
diff --git a/hadrian/src/Settings/Builders/Haddock.hs b/hadrian/src/Settings/Builders/Haddock.hs
index 400e697da052..0a1893c65dd7 100644
--- a/hadrian/src/Settings/Builders/Haddock.hs
+++ b/hadrian/src/Settings/Builders/Haddock.hs
@@ -43,12 +43,15 @@ haddockBuilderArgs = mconcat
version <- expr $ pkgVersion pkg
synopsis <- expr $ pkgSynopsis pkg
haddocks <- expr $ haddockDependencies context
- haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId stage p | (p, h) <- haddocks]
+ haddocks_with_versions <- expr $ sequence $ [(,,h) <$> pkgSimpleIdentifier p <*> pkgUnitId stage p | (p, h) <- haddocks]
hVersion <- expr $ pkgVersion haddock
statsDir <- expr $ haddockStatsFilesDir
baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)
- let baseUrl p = substituteTemplate baseUrlTemplate p
+ -- The path to where the docs for a package are
+ let docpath p = substituteTemplate baseUrlTemplate p
+ -- The path to where the src folder is for a package (typically docs ++ "/src/")
+ let srcpath p = docpath p ++ "/src/"
ghcOpts <- haddockGhcArgs
-- These are the options which are necessary to perform the build. Additional
-- options such as `--hyperlinked-source`, `--hoogle`, `--quickjump` are
@@ -67,14 +70,18 @@ haddockBuilderArgs = mconcat
, arg $ "--optghc=-D__HADDOCK_VERSION__="
++ show (versionToInt hVersion)
, map ("--hide=" ++) <$> getContextData otherModules
- , pure [ "--read-interface=../" ++ p
- ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME},"
- ++ haddock | (p, haddock) <- haddocks_with_versions ]
+ , pure [ "--read-interface=" ++ docpath (p, pid)
+ ++ "," ++ srcpath (p, pid) ++ ","
+ ++ haddock | (p, pid, haddock) <- haddocks_with_versions ]
, pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ]
, arg "+RTS"
, arg $ "-t" ++ (statsDir -/- pkgName pkg ++ ".t")
, arg "--machine-readable"
, arg "-RTS" ] ]
-substituteTemplate :: String -> String -> String
-substituteTemplate baseTemplate pkgId = T.unpack . T.replace "%pkg%" (T.pack pkgId) . T.pack $ baseTemplate
+substituteTemplate :: String -> (String, String) -> String
+substituteTemplate baseTemplate (pkg, pkgId) =
+ T.unpack
+ . T.replace "%pkg%" (T.pack pkg)
+ . T.replace "%pkgid%" (T.pack pkgId)
+ . T.pack $ baseTemplate
--
GitLab