diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index c49493a1ac5..cbd52b5a6e8 100644 --- a/Cabal/Cabal.cabal +++ b/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 diff --git a/Cabal/src/Distribution/Simple/Build/Inputs.hs b/Cabal/src/Distribution/Simple/Build/Inputs.hs new file mode 100644 index 00000000000..a2c4a66bff0 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Build/Inputs.hs @@ -0,0 +1,75 @@ +{-# 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 diff --git a/Cabal/src/Distribution/Simple/Build/Monad.hs b/Cabal/src/Distribution/Simple/Build/Monad.hs deleted file mode 100644 index c273f9e474d..00000000000 --- a/Cabal/src/Distribution/Simple/Build/Monad.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PatternSynonyms #-} - -module Distribution.Simple.Build.Monad - ( -- * A Monad for building components - BuildM (BuildM) - , runBuildM - , PreBuildComponentInputs (..) - - -- * Queries over the component being built - , buildVerbosity - , buildWhat - , buildComponent - , buildIsLib - , buildCLBI - , buildBI - , buildLBI - , buildCompiler - , buildTarget - - -- * Re-exports - , BuildingWhat (..) - , LocalBuildInfo (..) - , TargetInfo (..) - , buildingWhatVerbosity - , buildingWhatDistPref - ) -where - -import Control.Monad.Reader - -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 - } - --- | Computations carried out in the context of building a component (e.g. @'buildAllExtraSources'@) -newtype BuildM a = BuildM' (ReaderT PreBuildComponentInputs IO a) - deriving (Functor, Applicative, Monad, MonadReader PreBuildComponentInputs, MonadIO) - --- Ideally we'd use deriving via ReaderT PreBuildComponentInputs IO, but ghc 8.4 doesn't support it. - --- | Construct a t'BuildM' action from an IO function on 'PreBuildComponentInputs'. -pattern BuildM :: (PreBuildComponentInputs -> IO a) -> BuildM a -pattern BuildM f = BuildM' (ReaderT f) - -{-# COMPLETE BuildM #-} - --- | 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} -{-# INLINE runBuildM #-} - --- | Get the @'BuildingWhat'@ representing the kind of build we are doing with what flags (Normal vs Repl vs ...) -buildWhat :: BuildM BuildingWhat -buildWhat = asks buildingWhat -{-# INLINE buildWhat #-} - --- | Get the @'Verbosity'@ from the context the component being built is in. -buildVerbosity :: BuildM Verbosity -buildVerbosity = buildingWhatVerbosity <$> buildWhat -{-# INLINE buildVerbosity #-} - --- | Get the @'Component'@ being built. -buildComponent :: BuildM Component -buildComponent = asks (targetComponent . targetInfo) -{-# INLINE buildComponent #-} - --- | Is the @'Component'@ being built a @'Library'@? -buildIsLib :: BuildM 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 :: BuildM ComponentLocalBuildInfo -buildCLBI = asks (targetCLBI . targetInfo) -{-# INLINE buildCLBI #-} - --- | Get the @'BuildInfo'@ of the component being built. -buildBI :: BuildM BuildInfo -buildBI = componentBuildInfo <$> buildComponent -{-# INLINE buildBI #-} - --- | Get the @'LocalBuildInfo'@ of the component being built. -buildLBI :: BuildM LocalBuildInfo -buildLBI = asks localBuildInfo -{-# INLINE buildLBI #-} - --- | Get the @'Compiler'@ being used to build the component. -buildCompiler :: BuildM Compiler -buildCompiler = compiler <$> buildLBI -{-# INLINE buildCompiler #-} - --- | Get the @'TargetInfo'@ of the current component being built. -buildTarget :: BuildM TargetInfo -buildTarget = asks targetInfo -{-# INLINE buildTarget #-} diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 89df6980d88..449dc695a69 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/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. diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs index fa4c034fc1d..75e40de07b5 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build.hs +++ b/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 diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs index daa3fbca4c4..ba07ce274bb 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs +++ b/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 diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index 94c891161cf..261caa7869f 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -20,7 +20,7 @@ import Distribution.Package import Distribution.PackageDescription as PD import Distribution.PackageDescription.Utils (cabalBug) import Distribution.Pretty -import Distribution.Simple.Build.Monad +import Distribution.Simple.Build.Inputs import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.GHC.Build.Modules @@ -64,15 +64,18 @@ linkOrLoadComponent -- ^ The set of build ways wanted based on the user opts, and a function to -- convert a build way into the set of ghc options that were used to build -- that way. - -> BuildM () -linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (wantedWays, buildOpts) = do - verbosity <- buildVerbosity - target <- buildTarget - component <- buildComponent - what <- buildWhat - lbi <- buildLBI - bi <- buildBI - clbi <- buildCLBI + -> PreBuildComponentInputs + -- ^ The context and component being built in it. + -> IO () +linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (wantedWays, buildOpts) pbci = do + let + verbosity = buildVerbosity pbci + target = targetInfo pbci + component = buildComponent pbci + what = buildingWhat pbci + lbi = localBuildInfo pbci + bi = buildBI pbci + clbi = buildCLBI pbci -- ensure extra lib dirs exist before passing to ghc cleanedExtraLibDirs <- liftIO $ filterM doesDirectoryExist (extraLibDirs bi) @@ -163,7 +166,7 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) ( in when (not $ componentIsIndefinite clbi) $ do -- If not building dynamically, we don't pass any runtime paths. - rpaths <- if DynWay `Set.member` wantedWays then getRPaths else return (toNubListR []) + rpaths <- if DynWay `Set.member` wantedWays then getRPaths pbci else return (toNubListR []) liftIO $ do info verbosity "Linking..." let linkExeLike name = linkExecutable (linkerOpts rpaths) (wantedWays, buildOpts) targetDir name runGhcProg lbi @@ -484,13 +487,16 @@ linkFLib flib bi lbi linkerOpts (wantedWays, buildOpts) targetDir runGhcProg = d -- | Calculate the RPATHs for the component we are building. -- -- Calculates relative RPATHs when 'relocatable' is set. -getRPaths :: BuildM (NubListR FilePath) -getRPaths = do - lbi <- buildLBI - bi <- buildBI - clbi <- buildCLBI - +getRPaths + :: PreBuildComponentInputs + -- ^ The context and component being built in it. + -> IO (NubListR FilePath) +getRPaths pbci = do let + lbi = localBuildInfo pbci + bi = buildBI pbci + clbi = buildCLBI pbci + (Platform _ hostOS) = hostPlatform lbi compid = compilerId . compiler $ lbi diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs index 507ea1e2876..e2f07222157 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs @@ -14,7 +14,7 @@ import Distribution.CabalSpecVersion import Distribution.ModuleName (ModuleName) import qualified Distribution.PackageDescription as PD import Distribution.Pretty -import Distribution.Simple.Build.Monad +import Distribution.Simple.Build.Inputs import Distribution.Simple.Compiler import Distribution.Simple.GHC.Build.Utils import qualified Distribution.Simple.GHC.Internal as Internal @@ -101,22 +101,25 @@ buildHaskellModules -- has already been created. -> Set.Set BuildWay -- ^ The set of wanted build ways according to user options - -> BuildM (BuildWay -> GhcOptions) + -> PreBuildComponentInputs + -- ^ The context and component being built in it. + -> IO (BuildWay -> GhcOptions) -- ^ Returns a mapping from build ways to the 'GhcOptions' used in the -- invocation used to compile the component in that 'BuildWay'. -- This can be useful in, eg, a linker invocation, in which we want to use the -- same options and list the same inputs as those used for building. -buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do +buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = do -- See Note [Building Haskell Modules accounting for TH] - verbosity <- buildVerbosity - isLib <- buildIsLib - clbi <- buildCLBI - lbi <- buildLBI - bi <- buildBI - what <- buildWhat - comp <- buildCompiler let + verbosity = buildVerbosity pbci + isLib = buildIsLib pbci + clbi = buildCLBI pbci + lbi = localBuildInfo pbci + bi = buildBI pbci + what = buildingWhat pbci + comp = buildCompiler pbci + -- If this component will be loaded into a repl, we don't compile the modules at all. forRepl | BuildRepl{} <- what = True @@ -133,7 +136,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do | isCoverageEnabled = Flag $ Hpc.mixDir (buildTargetDir extraCompilationArtifacts) way | otherwise = mempty - (inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr + (inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr pbci let runGhcProg = runGHC verbosity ghcProg comp platform @@ -292,12 +295,15 @@ componentInputs :: FilePath -- ^ Target build dir -> PD.PackageDescription - -> BuildM ([FilePath], [ModuleName]) + -> PreBuildComponentInputs + -- ^ The context and component being built in it. + -> IO ([FilePath], [ModuleName]) -- ^ The Haskell input files, and the Haskell modules -componentInputs buildTargetDir pkg_descr = do - verbosity <- buildVerbosity - component <- buildComponent - clbi <- buildCLBI +componentInputs buildTargetDir pkg_descr pbci = do + let + verbosity = buildVerbosity pbci + component = buildComponent pbci + clbi = buildCLBI pbci case component of CLib lib ->