Introduce computations in the context of building a component

Introduces 'BuildM', a monad for actions defined in the context of
building a component. Actions in the 'BuildM' monad have access to
'PreBuildComponentInputs', which is the information necessary and
available to a build right before building a component (hence the name).

Introduces as well 'BuildingWhat', a type that distinguishes the kind of
build we are doing (Normal vs Repl vs Haddock vs Hscolour) and the
different flags available for each kind of build.

Cabal/Cabal.cabal

@@ -89,6 +89,7 @@ library
     Distribution.Simple.Bench
     Distribution.Simple.Build
     Distribution.Simple.Build.Macros
+    Distribution.Simple.Build.Monad
     Distribution.Simple.Build.PackageInfoModule
     Distribution.Simple.Build.PathsModule
     Distribution.Simple.BuildPaths

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

@@ -0,0 +1,37 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Distribution.Simple.Build.Monad
+  ( BuildM(..), runBuildM, PreBuildComponentInputs(..)
+    -- * Re-exports
+  , BuildingWhat(..), LocalBuildInfo(..), TargetInfo(..)
+  , buildingWhatVerbosity, buildingWhatDistPref
+  )
+  where
+
+import Control.Monad.Reader
+
+import Distribution.Simple.Setup (BuildingWhat(..), buildingWhatVerbosity, buildingWhatDistPref)
+import Distribution.Types.LocalBuildInfo
+import Distribution.Types.TargetInfo
+
+-- | 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
+  }
+
+-- | Computations carried out in the context of building a component (e.g. @'buildAllExtraSources'@)
+newtype BuildM a = BuildM (PreBuildComponentInputs -> IO a)
+  deriving (Functor, Applicative, Monad) via ReaderT PreBuildComponentInputs IO
+
+-- | Run a 'BuildM' action, i.e. a computation in the context of building a component.
+runBuildM :: BuildingWhat -> LocalBuildInfo -> TargetInfo -> BuildM a -> IO a
+runBuildM buildingWhat localBuildInfo targetInfo (BuildM f)
+  = f PreBuildComponentInputs{buildingWhat, localBuildInfo, targetInfo}
+

Cabal/src/Distribution/Simple/Setup.hs

@@ -131,9 +131,13 @@ module Distribution.Simple.Setup
   , trueArg
   , falseArg
   , optionVerbosity
+  , BuildingWhat(..)
+  , buildingWhatVerbosity
+  , buildingWhatDistPref
   ) where
 
-import Prelude ()
+import GHC.Generics (Generic)
+import Prelude (Show, FilePath, ($))
 
 import Distribution.Simple.Flag
 import Distribution.Simple.InstallDirs
@@ -154,6 +158,37 @@ import Distribution.Simple.Setup.Repl
 import Distribution.Simple.Setup.SDist
 import Distribution.Simple.Setup.Test
 
+import Distribution.Verbosity (Verbosity)
+
+-- | What kind of build are we doing?
+--
+-- Is this a normal build, or is it perhaps for running an interactive
+-- session or Haddock?
+data BuildingWhat
+  = -- | A normal build.
+    BuildNormal BuildFlags
+  | -- | Build steps for an interactive session.
+    BuildRepl ReplFlags
+  | -- | Build steps for generating documentation.
+    BuildHaddock HaddockFlags
+  | -- | Build steps for Hscolour.
+    BuildHscolour HscolourFlags
+  deriving (Generic, Show)
+
+buildingWhatVerbosity :: BuildingWhat -> Verbosity
+buildingWhatVerbosity = \case
+  BuildNormal flags -> fromFlag $ buildVerbosity flags
+  BuildRepl flags -> fromFlag $ replVerbosity flags
+  BuildHaddock flags -> fromFlag $ haddockVerbosity flags
+  BuildHscolour flags -> fromFlag $ hscolourVerbosity flags
+
+buildingWhatDistPref :: BuildingWhat -> FilePath
+buildingWhatDistPref = \case
+  BuildNormal flags -> fromFlag $ buildDistPref flags
+  BuildRepl flags -> fromFlag $ replDistPref flags
+  BuildHaddock flags -> fromFlag $ haddockDistPref flags
+  BuildHscolour flags -> fromFlag $ hscolourDistPref flags
+
 -- The test cases kinda have to be rewritten from the ground up... :/
 -- hunitTests :: [Test]
 -- hunitTests =