diff --git a/Cabal/src/Distribution/Simple/Build/Monad.hs b/Cabal/src/Distribution/Simple/Build/Monad.hs index 7aab514dfdf..a1350afba95 100644 --- a/Cabal/src/Distribution/Simple/Build/Monad.hs +++ b/Cabal/src/Distribution/Simple/Build/Monad.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE PatternSynonyms #-} module Distribution.Simple.Build.Monad - ( BuildM (..) + ( BuildM (BuildM) , runBuildM , PreBuildComponentInputs (..) @@ -49,8 +50,16 @@ 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, MonadReader PreBuildComponentInputs, MonadIO) via ReaderT PreBuildComponentInputs IO +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 diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs index 2aee12791c0..28d4ed450b9 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE BlockArguments #-} - module Distribution.Simple.GHC.Build where import Distribution.Compat.Prelude @@ -83,7 +81,7 @@ build numJobs pkg_descr = do targetDir_absolute (targetDirName ++ "-tmp") | otherwise = error "GHC.build: targetDir is empty" - liftIO do + liftIO $ do createDirectoryIfMissingVerbose verbosity True targetDir_absolute createDirectoryIfMissingVerbose verbosity True buildTargetDir_absolute diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs index 518a07b3b12..d62037d907b 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -136,7 +135,7 @@ buildExtraSources -> BuildM [FilePath] -- ^ Returns the list of extra sources that were built buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg buildTargetDir = - BuildM \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} -> + BuildM $ \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} -> let bi = componentBuildInfo (targetComponent targetInfo) verbosity = buildingWhatVerbosity buildingWhat @@ -146,6 +145,8 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP comp = compiler lbi platform = hostPlatform lbi + -- ROMES:TODO: Instead of keeping this logic here, we really just want to + -- receive as an input the `neededWays` and build accordingly isGhcDynamic = isDynamic comp doingTH = usesTemplateHaskellOrQQ bi forceSharedLib = doingTH && isGhcDynamic diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index 09c74cfef61..f62ee20fa4b 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -88,11 +88,9 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) ( PD.ldOptions bi ++ [ "-static" | withFullyStaticExe lbi -- ROMES:TODO: wb withStaticLib?? - -- ROMES:TODO: wouldn't this be best handled by re-using the build opt for the way being linked? ] -- Pass extra `ld-options` given -- through to GHC's linker. - -- ROMES:TODO: Why not for the dyn linker opts too? ++ maybe [] programOverrideArgs @@ -247,7 +245,8 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li -- ROMES:TODO: I'm fairly certain that, just like the executable, we can keep just the -- module input list, and point to the right sources dir (as is already -- done), and GHC will pick up the right suffix (p_ for profile, dyn_ when - -- -shared...). That would mean linking the lib would be just like the executable, and we could more easily merge the two. + -- -shared...). + -- That would mean linking the lib would be just like the executable, and we could more easily merge the two. -- -- Right now, instead, we pass the path to each object file. ghcBaseLinkArgs = @@ -377,14 +376,12 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li -- ROMES: Why exactly branch on staticObjectFiles, rather than any other build -- kind that we might have wanted instead? + -- This would be simpler by not adding every object to the invocation, and + -- rather using module names. unless (null staticObjectFiles) $ do info verbosity (show (ghcOptPackages (Internal.componentGhcOptions verbosity lbi libBi clbi buildTargetDir))) traverse_ linkWay wantedWays --- ROMES:TODO: Have to be careful about target dir vs build dir here! They are --- not the same on exes, and we don't want to conflate them for now, even --- though we want to drop the distinction eventually. - -- | Link the executable resulting from building this component, be it an -- executable, test, or benchmark component. linkExecutable