hadrian: Add --haddock-base-url option for specifying base-url when generating docs

The motiviation for this flag is to be able to produce documentation
which is suitable for uploading for hackage, ie, the cross-package links
work correctly.

There are basically three values you want to set this to:

* off - default, base_url = ../%pkg% which works for local browsing
* on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload
* on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation.

The `%pkg%` string is a template variable which is replaced with the
package identifier for the relevant package.

This is one step towards fixing #21749

8 files changed, 51 insertions, 13 deletions

diff --git a/hadrian/README.md b/hadrian/README.md
index 1a3335d535..d132ee0326 100644
--- a/hadrian/README.md
+++ b/hadrian/README.md
@@ -285,6 +285,10 @@ 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.
+
 #### Source distribution
 
 To build a GHC source distribution tarball, run `build source-dist`.
diff --git a/hadrian/bindist/Makefile b/hadrian/bindist/Makefile
index 63fb7d0551..c079755f1f 100644
--- a/hadrian/bindist/Makefile
+++ b/hadrian/bindist/Makefile
@@ -65,11 +65,12 @@ define patchpackageconf
 # $2 = path to .conf file
 # $3 = Docs Directory
 # $4 = (relative) path from $${pkgroot} to docs directory ($3)
+# $5 = package name and version (ex: bytestring-0.13)
 #
 # We fix the paths to haddock files by using the relative path from the pkgroot
 # to the doc files.
-	cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$1/$1.haddock"|' \
-	         | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$1"|' \
+	cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$5/$1.haddock"|' \
+	         | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$5"|' \
 		 | sed 's|    $${pkgroot}/../../docs/html/.*||' \
 	       > '$2.copy'
 # The rts package doesn't actually supply haddocks, so we stop advertising them
@@ -212,7 +213,7 @@ update_package_db: install_bin install_lib
 	cp mk/system-cxx-std-lib-1.0.conf "$(DESTDIR)$(ActualLibsDir)/"
 	@echo "Updating the package DB"
 	$(foreach p, $(PKG_CONFS),\
-		$(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:\0xxx\0:   :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)")))
+		$(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:\0xxx\0:   :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/.conf//g')))
 	'$(DESTDIR)$(ActualBinsDir)/$(CrossCompilePrefix)ghc-pkg' --global-package-db "$(DESTDIR)$(ActualLibsDir)/package.conf.d" recache
 
 install_mingw:
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 7ddacb4b9b..da0aa4daab 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -153,6 +153,7 @@ executable hadrian
                        , shake                >= 0.18.3  && < 0.20
                        , transformers         >= 0.4     && < 0.6
                        , unordered-containers >= 0.2.1   && < 0.3
+                       , text                 >= 1.2     && < 3
     ghc-options:       -Wall
                        -Wincomplete-record-updates
                        -Wredundant-constraints
diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
index e2316057e3..7d1edc8978 100644
--- a/hadrian/src/CommandLine.hs
+++ b/hadrian/src/CommandLine.hs
@@ -2,7 +2,7 @@ module CommandLine (
     optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, lookupFreeze2, lookupSkipDepends,
     cmdBignum, cmdBignumCheck, cmdProgressInfo, cmdCompleteSetting,
     cmdDocsArgs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs,
-    cmdPrefix
+    cmdPrefix, DocArgs(..), defaultDocArgs
     ) where
 
 import Data.Either
@@ -17,6 +17,7 @@ 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)
 
@@ -32,6 +33,7 @@ data CommandLineArgs = CommandLineArgs
     , progressInfo   :: ProgressInfo
     , buildRoot      :: BuildRoot
     , testArgs       :: TestArgs
+    , docsArgs       :: DocArgs
     , docTargets     :: DocTargets
     , prefix         :: Maybe FilePath
     , completeStg    :: Maybe String }
@@ -50,6 +52,7 @@ defaultCommandLineArgs = CommandLineArgs
     , progressInfo   = Brief
     , buildRoot      = BuildRoot "_build"
     , testArgs       = defaultTestArgs
+    , docsArgs       = defaultDocArgs
     , docTargets     = Set.fromList [minBound..maxBound]
     , prefix         = Nothing
     , completeStg    = Nothing }
@@ -104,6 +107,13 @@ defaultTestArgs = TestArgs
     , testHasInTreeFiles = False
     }
 
+data DocArgs = DocArgs
+  { docsBaseUrl :: String
+  } deriving (Eq, Show)
+
+defaultDocArgs :: DocArgs
+defaultDocArgs = DocArgs { docsBaseUrl = "../%pkg%" }
+
 readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
 readConfigure = Left "hadrian --configure has been deprecated (see #20167). Please run ./boot; ./configure manually"
 
@@ -191,6 +201,13 @@ 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' } }
+
+  where base_url' = fromMaybe "https://hackage.haskell.org/package/%pkg%/docs" base_url
+
+
 readTestRootDirs :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readTestRootDirs rootdirs = Right $ \flags ->
   flags { testArgs = (testArgs flags) { testRootDirs = rootdirs'' flags } }
@@ -316,6 +333,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)."
     ]
 
 -- | A type-indexed map containing Hadrian command line arguments to be passed
@@ -353,6 +372,7 @@ cmdLineArgsMap = do
     return $ insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities
            $ insertExtra (buildRoot      args) -- Accessed by Hadrian.Utilities
            $ insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest
+           $ insertExtra (docsArgs       args) -- Accessed by Rules.Documentation
            $ insertExtra allSettings           -- Accessed by Settings
            $ insertExtra args Map.empty
 
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index ae1f329973..81bff8a11f 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -88,8 +88,8 @@ pkgSetupConfigFile context = contextPath context <&> (-/- "setup-config")
 pkgHaddockFile :: Context -> Action FilePath
 pkgHaddockFile Context {..} = do
     root <- buildRoot
-    let name = pkgName package
-    return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"
+    version <- pkgIdentifier package
+    return $ root -/- "docs/html/libraries" -/- version -/- pkgName package <.> "haddock"
 
 -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
 -- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@
diff --git a/hadrian/src/Rules/Documentation.hs b/hadrian/src/Rules/Documentation.hs
index 6898fd12e5..0e72c064c3 100644
--- a/hadrian/src/Rules/Documentation.hs
+++ b/hadrian/src/Rules/Documentation.hs
@@ -276,11 +276,11 @@ parsePkgDocTarget root = do
   _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
   _ <- Parsec.string (htmlRoot ++ "/")
   _ <- Parsec.string "libraries/"
-  pkgname <- Parsec.manyTill Parsec.anyChar (Parsec.char '/')
+  (pkgname, _) <- parsePkgId <* Parsec.char '/'
   Parsec.choice
     [ Parsec.try (Parsec.string "haddock-prologue.txt")
         *> pure (HaddockPrologue pkgname)
-    , Parsec.string (pkgname <.> "haddock")
+    , Parsec.string (pkgname <.> "haddock") -- Same as before
         *> pure (DotHaddock pkgname)
     ]
 
diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs
index 4486ab002b..dfd322b28d 100644
--- a/hadrian/src/Settings/Builders/Cabal.hs
+++ b/hadrian/src/Settings/Builders/Cabal.hs
@@ -82,6 +82,7 @@ commonCabalArgs :: Stage -> Args
 commonCabalArgs stage = do
   verbosity <- expr getVerbosity
   pkg       <- getPackage
+  package_id <- expr $ pkgIdentifier pkg
   let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..")
   mconcat [ -- Don't strip libraries when cross compiling.
             -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,
@@ -109,7 +110,7 @@ commonCabalArgs stage = do
             --
             -- This doesn't hold if we move the @docs@ folder anywhere else.
             , arg "--htmldir"
-            , arg $ "${pkgroot}/../../docs/html/libraries/" ++ pkgName pkg
+            , arg $ "${pkgroot}/../../docs/html/libraries/" ++ package_id
 
             , withStaged $ Ghc CompileHs
             , withBuilderArgs (Ghc CompileHs stage)
diff --git a/hadrian/src/Settings/Builders/Haddock.hs b/hadrian/src/Settings/Builders/Haddock.hs
index 5d76b7ee1e..29032d0b78 100644
--- a/hadrian/src/Settings/Builders/Haddock.hs
+++ b/hadrian/src/Settings/Builders/Haddock.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Settings.Builders.Haddock (haddockBuilderArgs) where
 
 import Hadrian.Haskell.Cabal
@@ -8,6 +9,10 @@ import Packages
 import Rules.Documentation
 import Settings.Builders.Common
 import Settings.Builders.Ghc
+import Utilities
+import Context.Type as C
+import CommandLine
+import qualified Data.Text as T
 
 -- | Given a version string such as "2.16.2" produce an integer equivalent.
 versionToInt :: String -> Int
@@ -38,10 +43,13 @@ haddockBuilderArgs = mconcat
         context  <- getContext
         version  <- expr $ pkgVersion  pkg
         synopsis <- expr $ pkgSynopsis pkg
-        deps     <- getContextData depNames
+        trans_deps <- expr $ contextDependencies context
+        pkgs <- expr $ mapM (pkgIdentifier . C.package) $ trans_deps
         haddocks <- expr $ haddockDependencies context
         hVersion <- expr $ pkgVersion haddock
         statsDir <- expr $ haddockStatsFilesDir
+        baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)
+        let baseUrl p = substituteTemplate baseUrlTemplate p
         ghcOpts  <- haddockGhcArgs
         mconcat
             [ arg "--verbosity=0"
@@ -59,12 +67,15 @@ haddockBuilderArgs = mconcat
             , arg $ "--optghc=-D__HADDOCK_VERSION__="
                     ++ show (versionToInt hVersion)
             , map ("--hide=" ++) <$> getContextData otherModules
-            , pure [ "--read-interface=../" ++ dep
-                     ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME},"
-                     ++ haddock | (dep, haddock) <- zip deps haddocks ]
+            , pure [ "--read-interface=../" ++ p
+                     ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME},"
+                     ++ haddock | (p, haddock) <- zip pkgs haddocks ]
             , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ]
             , getInputs
             , 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