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 stage

We 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 deps

However, 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 ++ userPackages

It 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.

To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information

Admin message

Hadrian: refactor stage<N>Packages