packaging: Be more precise about which executables to copy and wrappers to create

Exes
----
Before: The whole bin/ folder was copied which could contain random old/stale/testsuite executables
After: Be precise

Wrappers
--------
Before: Wrappers were created for everything in the bin folder,
including internal executables such as "unlit"
After: Only create wrappers for the specific things which we want to
include in the user's path.

This makes the hadrian bindists match up more closely with the make
bindists.

(cherry picked from commit 888eadb9eb8350ffac348f34ae805e11061cc980)

1 files changed, 43 insertions, 14 deletions

diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 24c5482a59..50654f423d 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 module Rules.BinaryDist where
 
 import Hadrian.Haskell.Cabal
@@ -10,6 +11,9 @@ import Settings
 import Settings.Program (programContext)
 import Target
 import Utilities
+import Data.Either
+import Hadrian.Oracles.Cabal
+import Hadrian.Haskell.Cabal.Type
 
 {-
 Note [Binary distributions]
@@ -100,9 +104,10 @@ bindistRules = do
     root <- buildRootRules
     phony "binary-dist-dir" $ do
         -- We 'need' all binaries and libraries
-        targets <- mapM pkgTarget =<< stagePackages Stage1
-        need targets
-        needIservBins
+        all_pkgs <- stagePackages Stage1
+        (lib_targets, bin_targets) <- partitionEithers <$> mapM pkgTarget all_pkgs
+        iserv_targets <- iservBins
+        need (lib_targets ++ (map fst (bin_targets ++ iserv_targets)))
 
         version        <- setting ProjectVersion
         targetPlatform <- setting TargetPlatformFull
@@ -118,7 +123,12 @@ bindistRules = do
         -- We create the bindist directory at <root>/bindist/ghc-X.Y.Z-platform/
         -- and populate it with Stage2 build results
         createDirectory bindistFilesDir
-        copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir
+        createDirectory (bindistFilesDir -/- "bin")
+        createDirectory (bindistFilesDir -/- "lib")
+        -- Also create symlinks with version suffixes (#20074)
+        forM_ (bin_targets ++ iserv_targets) $ \(prog_path, _ver) -> do
+            let install_path = bindistFilesDir -/- "bin" -/- takeFileName prog_path
+            copyFile prog_path install_path
         copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir
         copyDirectory (rtsIncludeDir)         bindistFilesDir
         need ["docs"]
@@ -147,10 +157,12 @@ bindistRules = do
         -- other machine.
         need $ map (bindistFilesDir -/-)
                    (["configure", "Makefile"] ++ bindistInstallFiles)
-        need $ map ((bindistFilesDir -/- "wrappers") -/-) ["check-api-annotations"
-                   , "check-ppr", "ghc", "ghc-iserv", "ghc-pkg"
-                   , "ghci-script", "haddock", "hpc", "hp2ps", "hsc2hs"
-                   , "runghc"]
+        wrappers <- fmap concat (sequence [ pkgToWrappers p | p <- all_pkgs, isProgram p])
+        need $ map ((bindistFilesDir -/- "wrappers") -/-) wrappers
+
+
+--            IO.removeFile link_path <|> return ()
+--            IO.createFileLink versioned_exe_name link_path
 
 
     let buildBinDist :: Compressor -> Action ()
@@ -237,10 +249,26 @@ bindistInstallFiles =
 -- for all libraries and programs that are needed for a complete build.
 -- For libraries, it returns the path to the @.conf@ file in the package
 -- database. For programs, it returns the path to the compiled executable.
-pkgTarget :: Package -> Action FilePath
+pkgTarget :: Package -> Action (Either FilePath (FilePath, String))
 pkgTarget pkg
-    | isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg)
-    | otherwise     = programPath =<< programContext Stage1 pkg
+    | isLibrary pkg = Left <$> pkgConfFile (vanillaContext Stage1 pkg)
+    | otherwise     = do
+        path <- programPath =<< programContext Stage1 pkg
+        version <- version <$> readPackageData pkg
+        return (Right (path, version))
+
+
+-- | Which wrappers point to a specific package
+pkgToWrappers :: Package -> Action [String]
+pkgToWrappers pkg
+  -- ghc also has the ghci script wrapper
+  | pkg == ghc = pure ["ghc", "ghci-script"]
+  -- These are the packages which we want to expose to the user and hence
+  -- there are wrappers installed in the bindist.
+  | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, runGhc, ghc, ghcPkg]
+    = (:[]) <$> (programName =<< programContext Stage1 pkg)
+  | otherwise = pure []
+
 
 wrapper :: FilePath -> String
 wrapper "ghc"         = ghcWrapper
@@ -305,10 +333,11 @@ ghciScriptWrapper = unlines
 --   the package to be built, since here we're generating 3 different
 --   executables out of just one package, so we need to specify all 3 contexts
 --   explicitly and 'need' the result of building them.
-needIservBins :: Action ()
-needIservBins = do
+iservBins :: Action [(FilePath, String)]
+iservBins = do
   rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
-  need =<< traverse programPath
+  ver <- version <$> readPackageData iserv
+  traverse (fmap (,ver) . programPath)
       [ Context Stage1 iserv w
       | w <- [vanilla, profiling, dynamic]
       , w `elem` rtsways