Skip to content

Commit

Permalink
Stop logging to file when build inplace
Browse files Browse the repository at this point in the history
In f70fc98, while refactoring
buildInplaceUnpackedPackage and buildAndInstallUnpackedPackage, we
started logging into a file on both cases, instead of logging to a file
only for buildAndInstallUnpackedPackage.

When building a package inplace, it is much more useful to be able to
see the GHC invocation directly outside of a log file.

This is especially relevant for Cabal developers working inplace.

Fixes haskell#9606
  • Loading branch information
alt-romes committed Jan 10, 2024
1 parent 4352c9b commit 46726a4
Show file tree
Hide file tree
Showing 2 changed files with 33 additions and 37 deletions.
8 changes: 0 additions & 8 deletions Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ import Distribution.Simple.GHC.Build
( replNoLoad
, runReplOrWriteFlags
)
import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import qualified Distribution.Simple.Hpc as Hpc
Expand Down Expand Up @@ -84,13 +83,6 @@ buildOrReplLib what numJobs pkg_descr lbi lib clbi = do
cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs libBi)
cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic libBi)

let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = usesTemplateHaskellOrQQ libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
-- TH always needs default libs, even when building for profiling

-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = libCoverage lbi
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -151,29 +151,27 @@ buildAndRegisterUnpackedPackage
-> ElaboratedReadyPackage
-> FilePath
-> FilePath
-> Maybe (FilePath)
-- ^ The path to an /initialized/ log file
-> (PackageBuildingPhase -> IO ())
-> IO (Maybe FilePath)
-- ^ Returns the path to the /initialized/ log file configured in
-- t'BuildTimeSettings' ('buildSettingLogFile'), if one exists.
-> IO ()
buildAndRegisterUnpackedPackage
verbosity
distDirLayout@DistDirLayout{distTempDirectory}
maybe_semaphore
BuildTimeSettings{buildSettingNumJobs, buildSettingLogFile}
BuildTimeSettings{buildSettingNumJobs}
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig
{ pkgConfigCompiler = compiler
, pkgConfigCompilerProgs = progdb
, pkgConfigPlatform = platform
}
plan
rpkg@(ReadyPackage pkg)
srcdir
builddir
mlogFile
delegate = do
initLogFile

-- Configure phase
delegate $
PBConfigurePhase $
Expand Down Expand Up @@ -238,10 +236,9 @@ buildAndRegisterUnpackedPackage
annotateFailure mlogFile ReplFailed $
setupInteractive replCommand replFlags replArgs

return mlogFile
return ()
where
uid = installedUnitId rpkg
pkgid = packageId rpkg

comp_par_strat = case maybe_semaphore of
Just sem_name -> Cabal.toFlag (getSemaphoreName sem_name)
Expand Down Expand Up @@ -386,21 +383,6 @@ buildAndRegisterUnpackedPackage
pkgConfDest
setup Cabal.registerCommand registerFlags (const [])

mlogFile :: Maybe FilePath
mlogFile =
case buildSettingLogFile of
Nothing -> Nothing
Just mkLogFile -> Just (mkLogFile compiler platform pkgid uid)

initLogFile :: IO ()
initLogFile =
case mlogFile of
Nothing -> return ()
Just logFile -> do
createDirectoryIfMissing True (takeDirectory logFile)
exists <- doesFileExist logFile
when exists $ removeFile logFile

withLogging :: (Maybe Handle -> IO r) -> IO r
withLogging action =
case mlogFile of
Expand Down Expand Up @@ -459,7 +441,7 @@ buildInplaceUnpackedPackage
buildResult :: BuildResultMisc
buildResult = (docsResult, testsResult)

mlogFile <- buildAndRegisterUnpackedPackage
buildAndRegisterUnpackedPackage
verbosity
distDirLayout
maybe_semaphore
Expand All @@ -471,6 +453,7 @@ buildInplaceUnpackedPackage
rpkg
srcdir
builddir
Nothing -- no log file for inplace builds!
$ \case
PBConfigurePhase{runConfigure} -> do
whenReConfigure $ do
Expand Down Expand Up @@ -572,7 +555,7 @@ buildInplaceUnpackedPackage
BuildResult
{ buildResultDocs = docsResult
, buildResultTests = testsResult
, buildResultLogFile = mlogFile
, buildResultLogFile = Nothing
}
where
dparams = elabDistDirParams pkgshared pkg
Expand Down Expand Up @@ -632,10 +615,13 @@ buildAndInstallUnpackedPackage
{ storePackageDBStack
}
maybe_semaphore
buildSettings@BuildTimeSettings{buildSettingNumJobs}
buildSettings@BuildTimeSettings{buildSettingNumJobs, buildSettingLogFile}
registerLock
cacheLock
pkgshared@ElaboratedSharedConfig{pkgConfigCompiler = compiler}
pkgshared@ElaboratedSharedConfig
{ pkgConfigCompiler = compiler
, pkgConfigPlatform = platform
}
plan
rpkg@(ReadyPackage pkg)
srcdir
Expand All @@ -653,7 +639,9 @@ buildAndInstallUnpackedPackage
-- TODO: [required feature] docs and tests
-- TODO: [required feature] sudo re-exec

mlogFile <- buildAndRegisterUnpackedPackage
initLogFile

buildAndRegisterUnpackedPackage
verbosity
distDirLayout
maybe_semaphore
Expand All @@ -665,6 +653,7 @@ buildAndInstallUnpackedPackage
rpkg
srcdir
builddir
mlogFile
$ \case
PBConfigurePhase{runConfigure} -> do
noticeProgress ProgressStarting
Expand Down Expand Up @@ -758,6 +747,21 @@ buildAndInstallUnpackedPackage
when (isParallelBuild buildSettingNumJobs) $
progressMessage verbosity phase dispname

mlogFile :: Maybe FilePath
mlogFile =
case buildSettingLogFile of
Nothing -> Nothing
Just mkLogFile -> Just (mkLogFile compiler platform pkgid uid)

initLogFile :: IO ()
initLogFile =
case mlogFile of
Nothing -> return ()
Just logFile -> do
createDirectoryIfMissing True (takeDirectory logFile)
exists <- doesFileExist logFile
when exists $ removeFile logFile

-- | The copy part of the installation phase when doing build-and-install
copyPkgFiles
:: Verbosity
Expand Down

0 comments on commit 46726a4

Please sign in to comment.