Delete the BuildM monad in favour of just PreBuildComponentInputs

Cabal/Cabal.cabal

@@ -88,8 +88,8 @@ library
     Distribution.Simple
     Distribution.Simple.Bench
     Distribution.Simple.Build
+    Distribution.Simple.Build.Inputs
     Distribution.Simple.Build.Macros
-    Distribution.Simple.Build.Monad
     Distribution.Simple.Build.PackageInfoModule
     Distribution.Simple.Build.PathsModule
     Distribution.Simple.BuildPaths

Cabal/src/Distribution/Simple/Build/Inputs.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Distribution.Simple.Build.Inputs
+  ( -- * Inputs of actions for building components
+    PreBuildComponentInputs (..)
+
+    -- * Queries over the component being built
+  , buildVerbosity
+  , buildComponent
+  , buildIsLib
+  , buildCLBI
+  , buildBI
+  , buildCompiler
+
+    -- * Re-exports
+  , BuildingWhat (..)
+  , LocalBuildInfo (..)
+  , TargetInfo (..)
+  , buildingWhatVerbosity
+  , buildingWhatDistPref
+  )
+where
+
+import Distribution.Simple.Compiler
+import Distribution.Simple.Setup (BuildingWhat (..), buildingWhatDistPref, buildingWhatVerbosity)
+import Distribution.Types.BuildInfo
+import Distribution.Types.Component
+import Distribution.Types.ComponentLocalBuildInfo
+import Distribution.Types.LocalBuildInfo
+import Distribution.Types.TargetInfo
+import Distribution.Verbosity
+
+-- | The information required for a build computation (@'BuildM'@)
+-- which is available right before building each component, i.e. the pre-build
+-- component inputs.
+data PreBuildComponentInputs = PreBuildComponentInputs
+  { buildingWhat :: BuildingWhat
+  -- ^ What kind of build are we doing?
+  , localBuildInfo :: LocalBuildInfo
+  -- ^ Information about the package
+  , targetInfo :: TargetInfo
+  -- ^ Information about an individual component
+  }
+
+-- | Get the @'Verbosity'@ from the context the component being built is in.
+buildVerbosity :: PreBuildComponentInputs -> Verbosity
+buildVerbosity = buildingWhatVerbosity . buildingWhat
+
+-- | Get the @'Component'@ being built.
+buildComponent :: PreBuildComponentInputs -> Component
+buildComponent = targetComponent . targetInfo
+
+-- | Is the @'Component'@ being built a @'Library'@?
+buildIsLib :: PreBuildComponentInputs -> Bool
+buildIsLib = do
+  component <- buildComponent
+  let isLib
+        | CLib{} <- component = True
+        | otherwise = False
+  return isLib
+{-# INLINE buildIsLib #-}
+
+-- | Get the @'ComponentLocalBuildInfo'@ for the component being built.
+buildCLBI :: PreBuildComponentInputs -> ComponentLocalBuildInfo
+buildCLBI = targetCLBI . targetInfo
+
+-- | Get the @'BuildInfo'@ of the component being built.
+buildBI :: PreBuildComponentInputs -> BuildInfo
+buildBI = componentBuildInfo . buildComponent
+
+-- | Get the @'Compiler'@ being used to build the component.
+buildCompiler :: PreBuildComponentInputs -> Compiler
+buildCompiler = compiler . localBuildInfo
+

Cabal/src/Distribution/Simple/GHC.hs

@@ -91,7 +91,7 @@ import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
 import Distribution.Package
 import Distribution.PackageDescription as PD
 import Distribution.Pretty
-import Distribution.Simple.Build.Monad (runBuildM)
+import Distribution.Simple.Build.Inputs (PreBuildComponentInputs(..))
 import Distribution.Simple.BuildPaths
 import Distribution.Simple.Compiler
 import Distribution.Simple.Errors
@@ -575,7 +575,8 @@ buildLib
   -> ComponentLocalBuildInfo
   -> IO ()
 buildLib flags numJobs pkg lbi lib clbi =
-  runBuildM (BuildNormal flags) lbi (TargetInfo clbi (CLib lib)) (GHC.build numJobs pkg)
+  GHC.build numJobs pkg $
+    PreBuildComponentInputs (BuildNormal flags) lbi (TargetInfo clbi (CLib lib))
 
 replLib
   :: ReplFlags
@@ -586,7 +587,8 @@ replLib
   -> ComponentLocalBuildInfo
   -> IO ()
 replLib flags numJobs pkg lbi lib clbi =
-  runBuildM (BuildRepl flags) lbi (TargetInfo clbi (CLib lib)) (GHC.build numJobs pkg)
+  GHC.build numJobs pkg $
+    PreBuildComponentInputs (BuildRepl flags) lbi (TargetInfo clbi (CLib lib))
 
 -- | Start a REPL without loading any source files.
 startInterpreter
@@ -618,8 +620,9 @@ buildFLib
   -> ForeignLib
   -> ComponentLocalBuildInfo
   -> IO ()
-buildFLib v njobs pkg lbi flib clbi =
-  runBuildM (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib)) (GHC.build njobs pkg)
+buildFLib v numJobs pkg lbi flib clbi =
+  GHC.build numJobs pkg $
+    PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib))
 
 replFLib
   :: ReplFlags
@@ -630,7 +633,8 @@ replFLib
   -> ComponentLocalBuildInfo
   -> IO ()
 replFLib replFlags njobs pkg lbi flib clbi =
-  runBuildM (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib)) (GHC.build njobs pkg)
+  GHC.build njobs pkg $
+    PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib))
 
 -- | Build an executable with GHC.
 buildExe
@@ -642,7 +646,8 @@ buildExe
   -> ComponentLocalBuildInfo
   -> IO ()
 buildExe v njobs pkg lbi exe clbi =
-  runBuildM (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe)) (GHC.build njobs pkg)
+  GHC.build njobs pkg $
+    PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe))
 
 replExe
   :: ReplFlags
@@ -653,7 +658,8 @@ replExe
   -> ComponentLocalBuildInfo
   -> IO ()
 replExe replFlags njobs pkg lbi exe clbi =
-  runBuildM (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe)) (GHC.build njobs pkg)
+  GHC.build njobs pkg $
+    PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe))
 
 -- | Extracts a String representing a hash of the ABI of a built
 -- library.  It can fail if the library has not yet been built.

Cabal/src/Distribution/Simple/GHC/Build.hs

@@ -6,7 +6,7 @@ import Prelude ()
 import Control.Monad.IO.Class
 import qualified Data.Set as Set
 import Distribution.PackageDescription as PD hiding (buildInfo)
-import Distribution.Simple.Build.Monad
+import Distribution.Simple.Build.Inputs
 import Distribution.Simple.Flag (Flag)
 import Distribution.Simple.GHC.Build.ExtraSources
 import Distribution.Simple.GHC.Build.Link
@@ -61,13 +61,16 @@ for linking libraries too (2024-01) (TODO)
 build
   :: Flag ParStrat
   -> PackageDescription
-  -> BuildM ()
-build numJobs pkg_descr = do
-  verbosity <- buildVerbosity
-  component <- buildComponent
-  isLib <- buildIsLib
-  lbi <- buildLBI
-  clbi <- buildCLBI
+  -> PreBuildComponentInputs
+  -- ^ The context and component being built in it.
+  -> IO ()
+build numJobs pkg_descr pbci = do
+  let
+    verbosity = buildVerbosity pbci
+    component = buildComponent pbci
+    isLib = buildIsLib pbci
+    lbi = localBuildInfo pbci
+    clbi = buildCLBI pbci
 
   -- Create a few directories for building the component
   -- See Note [Build Target Dir vs Target Dir]
@@ -131,6 +134,6 @@ build numJobs pkg_descr = do
   -- We need a separate build and link phase, and C sources must be compiled
   -- after Haskell modules, because C sources may depend on stub headers
   -- generated from compiling Haskell modules (#842, #3294).
-  buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays
-  extraSources <- buildAllExtraSources ghcProg buildTargetDir
-  linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts)
+  buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays pbci
+  extraSources <- buildAllExtraSources ghcProg buildTargetDir pbci
+  linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts) pbci

Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs

@@ -23,7 +23,7 @@ import Distribution.Types.ComponentLocalBuildInfo
 import Distribution.Types.Executable
 import Distribution.Verbosity (Verbosity)
 
-import Distribution.Simple.Build.Monad
+import Distribution.Simple.Build.Inputs
 
 -- | An action that builds all the extra build sources of a component, i.e. C,
 -- C++, Js, Asm, C-- sources.
@@ -32,17 +32,18 @@ buildAllExtraSources
   -- ^ The GHC configured program
   -> FilePath
   -- ^ The build directory for this target
-  -> BuildM [FilePath]
+  -> PreBuildComponentInputs
+  -- ^ The context and component being built in it.
+  -> IO [FilePath]
   -- ^ Returns the list of extra sources that were built
-buildAllExtraSources ghcProg buildTargetDir =
+buildAllExtraSources ghcProg buildTargetDir pbci =
   concat
-    <$> traverse
-      (($ buildTargetDir) . ($ ghcProg))
-      [ buildCSources
-      , buildCxxSources
-      , buildJsSources
-      , buildAsmSources
-      , buildCmmSources
+    <$> sequence
+      [ buildCSources ghcProg buildTargetDir pbci
+      , buildCxxSources ghcProg buildTargetDir pbci
+      , buildJsSources ghcProg buildTargetDir pbci
+      , buildAsmSources ghcProg buildTargetDir pbci
+      , buildCmmSources ghcProg buildTargetDir pbci
       ]
 
 buildCSources
@@ -54,7 +55,9 @@ buildCSources
     -- ^ The GHC configured program
     -> FilePath
     -- ^ The build directory for this target
-    -> BuildM [FilePath]
+    -> PreBuildComponentInputs
+    -- ^ The context and component being built in it.
+    -> IO [FilePath]
     -- ^ Returns the list of extra sources that were built
 buildCSources =
   buildExtraSources
@@ -79,7 +82,7 @@ buildCxxSources =
             _otherwise -> []
     )
 buildJsSources ghcProg buildTargetDir = do
-  Platform hostArch _ <- hostPlatform <$> buildLBI
+  Platform hostArch _ <- hostPlatform <$> localBuildInfo
   let hasJsSupport = hostArch == JavaScript
   buildExtraSources
     "JS Sources"
@@ -132,10 +135,12 @@ buildExtraSources
   -- ^ The GHC configured program
   -> FilePath
   -- ^ The build directory for this target
-  -> BuildM [FilePath]
+  -> PreBuildComponentInputs
+  -- ^ The context and component being built in it.
+  -> IO [FilePath]
   -- ^ Returns the list of extra sources that were built
 buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg buildTargetDir =
-  BuildM $ \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} ->
+  \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} ->
     let
       bi = componentBuildInfo (targetComponent targetInfo)
       verbosity = buildingWhatVerbosity buildingWhat