1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
module Rules.CabalReinstall where
import Context
import Expression
import Oracles.Flag
import Packages
import Settings
import Target
import Utilities
import qualified System.Directory.Extra as IO
import Data.Either
import Rules.BinaryDist
import Hadrian.Haskell.Cabal (pkgIdentifier)
{-
Note [Testing reinstallable GHC]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
To test the reinstallable GHC configuration, we install a GHC to <build root>/stage-cabal/bin
along with appropriate wrapper scripts.
The libdir of the reinstalled GHC points to the libdir of the stage 2 compiler (in <build root>/stage1)
-}
-- | We don't support reinstalling these
cabalExcludedPackages :: [Package]
cabalExcludedPackages = [array, base, deepseq, filepath, ghcBignum, ghcBootTh, ghcPrim, integerGmp, integerSimple, pretty, templateHaskell]
findCabalPackageDb :: String -> FilePath
findCabalPackageDb env = go $ map (\l -> (words l, l)) (lines env)
where
go [] = error $ "Couldn't find installed package db in " ++ show env
go (("package-db":_, l):_) = drop 11 l
go (_:xs) = go xs
cabalBuildRules :: Rules ()
cabalBuildRules = do
root <- buildRootRules
root -/- "stage-cabal" -/- "cabal-packages" %> \_ -> do
-- Always rerun to pass onto cabal's own recompilation logic
alwaysRerun
all_pkgs <- stagePackages Stage1
forM_ (filter (not . (`elem` cabalExcludedPackages)) all_pkgs) $ \pkg -> do
withVerbosity Diagnostic $
buildWithCmdOptions [] $
target (vanillaContext Stage2 pkg) (Cabal Install Stage2) [] []
phony "build-cabal" $ need [root -/- "stage-cabal" -/- "bin" -/- ".stamp"]
root -/- "stage-cabal" -/- "bin" -/- "*" %> \_ -> need [root -/- "stage-cabal" -/- "bin" -/- ".stamp"]
priority 2.0 $ root -/- "stage-cabal" -/- "bin" -/- ".stamp" %> \stamp -> do
-- We 'need' all binaries and libraries
all_pkgs <- stagePackages Stage1
(lib_targets, bin_targets) <- partitionEithers <$> mapM pkgTarget all_pkgs
cross <- flag CrossCompiling
iserv_targets <- if cross then pure [] else iservBins
need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets)))
distDir <- Context.distDir Stage1
rtsDir <- pkgIdentifier rts
let ghcBuildDir = root -/- stageString Stage1
rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
-/- "include"
libdir <- liftIO . IO.makeAbsolute =<< stageLibPath Stage1
work_dir <- liftIO $ IO.makeAbsolute $ root -/- "stage-cabal"
let outputDir = work_dir -/- "bin"
includeDir <- liftIO $ IO.makeAbsolute rtsIncludeDir
createDirectory outputDir
need [root -/- "stage-cabal" -/- "cabal-packages"]
env <- liftIO $ readFile $ root -/- "stage-cabal" -/- "cabal-packages"
let cabal_package_db = findCabalPackageDb env
forM_ (filter ((/= iserv) . fst) bin_targets) $ \(bin_pkg,_bin_path) -> do
let pgmName pkg
| pkg == ghc = "ghc"
| pkg == hpcBin = "hpc"
| otherwise = pkgName pkg
let cabal_bin_out = work_dir -/- "cabal-bin" -/- (pgmName bin_pkg)
needed_wrappers <- pkgToWrappers bin_pkg
forM_ needed_wrappers $ \wrapper_name -> do
let wrapper_prefix = unlines
["#!/usr/bin/env sh"
,"executablename="++show cabal_bin_out
,"libdir="++show libdir
,"bindir="++show outputDir
,"exedir="++show outputDir
,"includedir="++show includeDir
,"export GHC_PACKAGE_PATH="++show cabal_package_db++":"
]
output_file = outputDir -/- wrapper_name
wrapper_content <- wrapper wrapper_name
writeFile' output_file (wrapper_prefix ++ wrapper_content)
makeExecutable output_file
pure ()
-- Just symlink these for now
-- TODO: build these with cabal as well
forM_ iserv_targets $ \(_bin_pkg,bin_path') -> do
bin_path <- liftIO $ IO.makeAbsolute bin_path'
let orig_filename = takeFileName bin_path
output_file = outputDir -/- orig_filename
liftIO $ do
IO.removeFile output_file <|> pure ()
IO.createFileLink bin_path output_file
pure ()
writeFile' stamp "OK"
|
