Skip to content

Commit

Permalink
Build Haskell modules accounting for TH
Browse files Browse the repository at this point in the history
Creates a new module Distribution.Simple.GHC.Build.Modules which, in the
same spirit as ...GHC.Build.ExtraModules, defines a 'BuildM' action
which builds all the Haskell modules of the component being built.

This function clarifies and re-implements the logic of building Haskell
modules in the different possible ways, while accounting for
Template Haskell special "way requirements", which was previously
duplicated in a non-obvious manner in gbuild and buildOrReplLib.

The Note [Building Haskell modules accounting for TH] in that module
explains the big picture, and the implementation is re-done in light of
it.

A standalone part of the refactor of gbuild vs buildOrReplLib (haskell#9389)
  • Loading branch information
alt-romes committed Jan 22, 2024
1 parent d8d54fc commit 480c19d
Show file tree
Hide file tree
Showing 10 changed files with 568 additions and 494 deletions.
7 changes: 5 additions & 2 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,6 @@ library
Distribution.Simple
Distribution.Simple.Bench
Distribution.Simple.Build
Distribution.Simple.Build.ExtraSources
Distribution.Simple.Build.Macros
Distribution.Simple.Build.Monad
Distribution.Simple.Build.PackageInfoModule
Expand Down Expand Up @@ -334,8 +333,12 @@ library
Distribution.Simple.Build.PackageInfoModule.Z
Distribution.Simple.Build.PathsModule.Z
Distribution.Simple.GHC.Build
Distribution.Simple.GHC.BuildOrRepl
Distribution.Simple.GHC.Build.ExtraSources
Distribution.Simple.GHC.Build.Link
Distribution.Simple.GHC.Build.Modules
Distribution.Simple.GHC.Build.Utils
Distribution.Simple.GHC.BuildGeneric
Distribution.Simple.GHC.BuildOrRepl
Distribution.Simple.GHC.EnvironmentParser
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.ImplInfo
Expand Down
58 changes: 56 additions & 2 deletions Cabal/src/Distribution/Simple/Build/Monad.hs
Original file line number Diff line number Diff line change
@@ -1,11 +1,20 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NamedFieldPuns #-}

module Distribution.Simple.Build.Monad
( BuildM (..)
, runBuildM
, PreBuildComponentInputs (..)

-- * A few queries on @'BuildM'@
, buildVerbosity
, buildWhat
, buildComponent
, buildCLBI
, buildBI
, buildLBI
, buildCompiler
, buildTarget

-- * Re-exports
, BuildingWhat (..)
, LocalBuildInfo (..)
Expand All @@ -20,6 +29,11 @@ import Control.Monad.Reader
import Distribution.Simple.Setup (BuildingWhat (..), buildingWhatDistPref, buildingWhatVerbosity)
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Verbosity
import Distribution.Types.Component
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.BuildInfo
import Distribution.Simple.Compiler

-- | The information required for a build computation (@'BuildM'@)
-- which is available right before building each component, i.e. the pre-build
Expand All @@ -35,9 +49,49 @@ data PreBuildComponentInputs = PreBuildComponentInputs

-- | 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
deriving (Functor, Applicative, Monad, MonadReader PreBuildComponentInputs, MonadIO) 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}
{-# 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 #-}

-- | 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 #-}

buildCompiler :: BuildM Compiler
buildCompiler = compiler <$> buildLBI
{-# INLINE buildCompiler #-}

-- | Get the @'TargetInfo'@ of the current component being built.
buildTarget :: BuildM TargetInfo
buildTarget = asks targetInfo

22 changes: 9 additions & 13 deletions Cabal/src/Distribution/Simple/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ module Distribution.Simple.GHC
, libAbiHash
, hcPkgInfo
, registerPackage
, componentGhcOptions
, Internal.componentGhcOptions
, Internal.componentCcGhcOptions
, getGhcAppDir
, getLibDir
Expand Down Expand Up @@ -95,12 +95,7 @@ import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag (Flag (..), toFlag)
import Distribution.Simple.GHC.Build
( componentGhcOptions
, exeTargetName
, flibTargetName
, isDynamic
)
import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
Expand All @@ -109,6 +104,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (runghcProgram)
import Distribution.Types.TargetInfo
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Strip as Strip
Expand Down Expand Up @@ -137,7 +133,7 @@ import System.FilePath
)
import qualified System.Info
#ifndef mingw32_HOST_OS
import Distribution.Simple.GHC.Build (flibBuildName)
import Distribution.Simple.GHC.Build.Utils (flibBuildName)
import System.Directory (renameFile)
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */
Expand Down Expand Up @@ -579,7 +575,7 @@ buildLib
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib = buildOrReplLib . Left
buildLib = buildOrReplLib . BuildNormal

replLib
:: ReplFlags
Expand All @@ -589,7 +585,7 @@ replLib
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib = buildOrReplLib . Right
replLib = buildOrReplLib . BuildRepl

-- | Start a REPL without loading any source files.
startInterpreter
Expand Down Expand Up @@ -632,7 +628,7 @@ replFLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib replFlags njobs pkg lbi =
gbuild (BuildRepl replFlags) njobs pkg lbi . GReplFLib (replReplOptions replFlags)
gbuild (BuildRepl replFlags) njobs pkg lbi . GReplFLib replFlags

-- | Build an executable with GHC.
buildExe
Expand All @@ -654,7 +650,7 @@ replExe
-> ComponentLocalBuildInfo
-> IO ()
replExe replFlags njobs pkg lbi =
gbuild (BuildRepl replFlags) njobs pkg lbi . GReplExe (replReplOptions replFlags)
gbuild (BuildRepl replFlags) njobs pkg lbi . GReplExe replFlags

-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
Expand All @@ -671,7 +667,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
comp = compiler lbi
platform = hostPlatform lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
(Internal.componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty
{ ghcOptMode = toFlag GhcModeAbiHash
, ghcOptInputModules = toNubListR $ exposedModules lib
Expand Down
Loading

0 comments on commit 480c19d

Please sign in to comment.