Hadrian: refactor stage<N>Packages
The title isn't great, but I couldn't find a better wording for the following problem.
Right now, we have the following code in Settings.Default:
-- | Packages that are built by default. You can change this in "UserSettings".
defaultPackages :: Stage -> Action [Package]
defaultPackages Stage0 = stage0Packages
defaultPackages Stage1 = stage1Packages
defaultPackages Stage2 = stage2Packages
defaultPackages Stage3 = return []
-- | Packages built in 'Stage0' by default. You can change this in "UserSettings".
stage0Packages :: Action [Package]
stage0Packages = do
cross <- flag CrossCompiling
return $ [ binary
, cabal
, compareSizes
, compiler
, deriveConstants
, genapply
, genprimopcode
, ghc
, ghcBoot
, ghcBootTh
, ghcHeap
, ghci
, ghcPkg
, haddock
, hsc2hs
, hpc
, mtl
, parsec
, templateHaskell
, text
, transformers
, unlit
]
++ [ terminfo | not windowsHost, not cross ]
++ [ timeout | windowsHost ]
++ [ touchy | windowsHost ]
-- | Packages built in 'Stage1' by default. You can change this in "UserSettings".
stage1Packages :: Action [Package]
stage1Packages = do
intLib <- integerLibrary =<< flavour
libraries0 <- filter isLibrary <$> stage0Packages
cross <- flag CrossCompiling
return $ libraries0 -- Build all Stage0 libraries in Stage1
++ [ array
, base
, bytestring
, containers
, deepseq
, directory
, exceptions
, filepath
, ghc
, ghcCompact
, ghcPkg
, ghcPrim
, haskeline
, hp2ps
, hsc2hs
, intLib
, pretty
, process
, rts
, stm
, time
, unlit
, xhtml
]
++ [ haddock | not cross ]
++ [ hpcBin | not cross ]
++ [ iserv | not cross ]
++ [ libiserv | not cross ]
++ [ runGhc | not cross ]
++ [ touchy | windowsHost ]
++ [ unix | not windowsHost ]
++ [ win32 | windowsHost ]
-- | Packages built in 'Stage2' by default. You can change this in "UserSettings".
stage2Packages :: Action [Package]
stage2Packages = stage1Packages
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = return [ timeout | windowsHost ]We have been tweaking this code ever since I started working on Hadrian, to remove/add packages in those lists to avoid/fix all sorts of issues. Especially for Windows, cross-compilers, making packages available for running tests/nofib, etc.
And this is used by the default flavour (and therefore by a huge majority if not all of the other flavours, which merely override some builder arguments and library/rts ways, in general):
defaultFlavour :: Flavour
defaultFlavour = Flavour
{ ...
, packages = defaultPackages
, ...
}And then made accessible in the Action monad for everyone to use by Settings:stagePackages:
stagePackages :: Stage -> Action [Package]
stagePackages stage = do
f <- flavour
packages f stageWe end up using this is many places:
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs:133: stagePkgs <- stagePackages stage
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs-134- -- We'll need those packages in our package database.
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs-135- deps <- sequence [ pkgConfFile (context { package = pkg })
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs-136- | pkg <- depPkgs, pkg `elem` stagePkgs ]
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs-137- need deps
hadrian/src/Rules.hs-42- forM_ [ Stage1 ..] $ \stage -> do
hadrian/src/Rules.hs-43- when (verbosity >= Loud) $ do
hadrian/src/Rules.hs:44: (libraries, programs) <- partition isLibrary <$> stagePackages stage
hadrian/src/Rules.hs-45- libNames <- mapM (name stage) libraries
hadrian/src/Rules.hs-46- pgmNames <- mapM (name stage) programs
hadrian/src/Rules.hs-47- let stageHeader t ps =
hadrian/src/Rules.hs-48- "| Building " ++ show stage ++ " "
hadrian/src/Rules.hs-49- ++ t ++ ": " ++ intercalate ", " ps
hadrian/src/Rules.hs-50- putNormal . unlines $
hadrian/src/Rules.hs-51- [ stageHeader "libraries" libNames
hadrian/src/Rules.hs-52- , stageHeader "programs" pgmNames ]
hadrian/src/Rules.hs-53- let buildStages = [ s | s <- [Stage0 ..], s < finalStage ]
hadrian/src/Rules.hs-54- targets <- concatForM buildStages $ \stage -> do
hadrian/src/Rules.hs:55: packages <- stagePackages stage
hadrian/src/Rules.hs-56- mapM (path stage) packages
hadrian/src/Rules.hs-83-packageTargets :: Bool -> Stage -> Package -> Action [FilePath]
hadrian/src/Rules.hs-84-packageTargets includeGhciLib stage pkg = do
hadrian/src/Rules.hs-85- let context = vanillaContext stage pkg
hadrian/src/Rules.hs:86: activePackages <- stagePackages stage
hadrian/src/Rules.hs-87- if pkg `notElem` activePackages
hadrian/src/Rules.hs-88- then return [] -- Skip inactive packages.
hadrian/src/Rules.hs-89- else if isLibrary pkg
hadrian/src/Rules/BinaryDist.hs-101- phony "binary-dist-dir" $ do
hadrian/src/Rules/BinaryDist.hs-102- -- We 'need' all binaries and libraries
hadrian/src/Rules/BinaryDist.hs:103: targets <- mapM pkgTarget =<< stagePackages Stage1
hadrian/src/Rules/BinaryDist.hs-104- need targets
hadrian/src/Rules/Documentation.hs-202-allHaddocks :: Action [FilePath]
hadrian/src/Rules/Documentation.hs-203-allHaddocks = do
hadrian/src/Rules/Documentation.hs:204: pkgs <- stagePackages Stage1
hadrian/src/Rules/Documentation.hs-205- sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
hadrian/src/Rules/Documentation.hs-206- | pkg <- pkgs, isLibrary pkg, pkgName pkg /= "rts" ]
hadrian/src/Rules/Program.hs-45-getProgramContexts :: Stage -> Action [(FilePath, Context)]
hadrian/src/Rules/Program.hs-46-getProgramContexts stage = do
hadrian/src/Rules/Program.hs-47- -- This is quite inefficient, but we can't access 'programName' from
hadrian/src/Rules/Program.hs-48- -- 'Rules', because it is an 'Action' depending on an oracle.
hadrian/src/Rules/Program.hs:49: sPackages <- filter isProgram <$> stagePackages stage
hadrian/src/Rules/Program.hs-50- tPackages <- testsuitePackages
hadrian/src/Rules/Program.hs-51- -- TODO: Shall we use Stage2 for testsuite packages instead?
hadrian/src/Rules/Program.hs-52- let allPackages = sPackages
hadrian/src/Rules/Program.hs-53- ++ if stage == Stage1 then tPackages else []
hadrian/src/Rules/Register.hs:103: isBoot <- (pkg `notElem`) <$> stagePackages Stage0
hadrian/src/Rules/Selftest.hs-101-testPackages :: Action ()
hadrian/src/Rules/Selftest.hs-102-testPackages = do
hadrian/src/Rules/Selftest.hs-103- putBuild "==== Check system configuration"
hadrian/src/Rules/Selftest.hs-104- putBuild "==== Packages, interpretInContext, configuration flags"
hadrian/src/Rules/Selftest.hs-105- forM_ [Stage0 ..] $ \stage -> do
hadrian/src/Rules/Selftest.hs:106: pkgs <- stagePackages stage
hadrian/src/Rules/Selftest.hs-107- when (win32 `elem` pkgs) . test $ windowsHost
hadrian/src/Rules/Selftest.hs-108- when (unix `elem` pkgs) . test $ not windowsHost
hadrian/src/Rules/Selftest.hs-109- test $ pkgs == nubOrd pkgs
hadrian/src/Settings/Builders/Cabal.hs-132-bootPackageConstraints :: Args
hadrian/src/Settings/Builders/Cabal.hs-133-bootPackageConstraints = stage0 ? do
hadrian/src/Settings/Builders/Cabal.hs:134: bootPkgs <- expr $ stagePackages Stage0
hadrian/src/Settings/Builders/Cabal.hs-135- let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
hadrian/src/Settings/Builders/Cabal.hs-136- constraints <- expr $ forM (sort pkgs) $ \pkg -> do
hadrian/src/Settings/Builders/Cabal.hs-137- version <- pkgVersion pkg
hadrian/src/Settings/Builders/Cabal.hs-138- return $ ((pkgName pkg ++ " == ") ++) version
hadrian/src/Settings/Builders/Cabal.hs-139- pure $ concat [ ["--constraint", c] | c <- constraints ]
hadrian/src/Settings/Builders/RunTest.hs-54-runTestBuilderArgs = builder RunTest ? do
hadrian/src/Settings/Builders/RunTest.hs:55: pkgs <- expr $ stagePackages Stage1
hadrian/src/Settings/Builders/RunTest.hs-56- libTests <- expr $ filterM doesDirectoryExist $ concat
hadrian/src/Settings/Builders/RunTest.hs-57- [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
hadrian/src/Settings/Builders/RunTest.hs-58- | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
hadrian/src/Utilities.hs-45- step pkg = do
hadrian/src/Utilities.hs-46- deps <- pkgDependencies pkg
hadrian/src/Utilities.hs:47: active <- sort <$> stagePackages stage
hadrian/src/Utilities.hs-48- return $ intersectOrd (compare . pkgName) active depsHowever, we also have Packages:ghcPackages and its cousinSettings:knownPackages`:
-- | These are all GHC packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows. @GHC.defaultPackages@ defines
-- default conditions for building each package. Users can add their own
-- packages and modify build default build conditions in "UserSettings".
ghcPackages :: [Package]
ghcPackages =
[ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations
, compareSizes, compiler, containers, deepseq, deriveConstants, directory
, exceptions, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh
, ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl
, parsec, pretty, process, rts, runGhc, stm, templateHaskell
, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml
, timeout ]knownPackages :: [Package]
knownPackages = sort $ ghcPackages ++ userPackagesIt feels like it should be enough to base our entire logic on 1/ the list of packages that Hadrian knows about (knownPackages), 2/ the dependencies between them as reported by Cabal (which requires proper configuration to turn on/off dependencies on packages through flags depending on what we want) 3/ the packages that we know we have to build to satisfy a given target. And that if something doesn't work as expected with this simpler logic, then we're quite likely doing something wrong somewhere in Hadrian.