Commit f0cc4cb5 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

'build/run/test/bench -j': read the # of jobs from the config file.

parent f7fef871
......@@ -482,9 +482,7 @@ loadConfigOrSandboxConfig verbosity globalFlags userInstallFlag = do
sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
pkgEnvDir <- getPkgEnvDir globalFlags
pkgEnvType <- case sandboxConfigFileFlag of
NoFlag -> classifyPackageEnvironment pkgEnvDir
Flag _ -> return SandboxPackageEnvironment
pkgEnvType <- classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag
case pkgEnvType of
-- A @cabal.sandbox.config@ file (and possibly @cabal.config@) is present.
......@@ -651,19 +649,16 @@ maybeReinstallAddSourceDeps :: Verbosity
-> ConfigFlags -- ^ Saved configure flags
-- (from dist/setup-config)
-> GlobalFlags
-> IO (UseSandbox, WereDepsReinstalled)
-> IO (UseSandbox, SavedConfig
,WereDepsReinstalled)
maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
currentDir <- getCurrentDirectory
pkgEnvType <- classifyPackageEnvironment currentDir
case pkgEnvType of
AmbientPackageEnvironment -> return (NoSandbox, NoDepsReinstalled)
UserPackageEnvironment -> return (NoSandbox, NoDepsReinstalled)
SandboxPackageEnvironment -> do
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags'
-- Actually reinstall the modified add-source deps.
let config = pkgEnvSavedConfig pkgEnv
configFlags = savedConfigureFlags config
(useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags'
(configUserInstall configFlags')
case useSandbox of
NoSandbox -> return (NoSandbox, config, NoDepsReinstalled)
UseSandbox sandboxDir -> do
-- Reinstall the modified add-source deps.
let configFlags = savedConfigureFlags config
`mappendSomeSavedFlags`
configFlags'
configExFlags = defaultConfigExFlags
......@@ -682,7 +677,7 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
depsReinstalled <- reinstallAddSourceDeps verbosity
configFlags configExFlags installFlags globalFlags
sandboxDir
return (UseSandbox sandboxDir, depsReinstalled)
return (UseSandbox sandboxDir, config, depsReinstalled)
where
......
......@@ -110,16 +110,22 @@ data PackageEnvironmentType =
-- | Is there a 'cabal.sandbox.config' or 'cabal.config' in this
-- directory?
classifyPackageEnvironment :: FilePath -> IO PackageEnvironmentType
classifyPackageEnvironment pkgEnvDir = do
isSandbox <- configExists sandboxPackageEnvironmentFile
isUser <- configExists userPackageEnvironmentFile
case (isSandbox, isUser) of
(True, _) -> return SandboxPackageEnvironment
(False, True) -> return UserPackageEnvironment
(False, False) -> return AmbientPackageEnvironment
classifyPackageEnvironment :: FilePath -> (Flag FilePath)
-> IO PackageEnvironmentType
classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag =
case sandboxConfigFileFlag of
NoFlag -> doClassify
Flag _ -> return SandboxPackageEnvironment
where
configExists fname = doesFileExist (pkgEnvDir </> fname)
doClassify = do
isSandbox <- configExists sandboxPackageEnvironmentFile
isUser <- configExists userPackageEnvironmentFile
case (isSandbox, isUser) of
(True, _) -> return SandboxPackageEnvironment
(False, True) -> return UserPackageEnvironment
(False, False) -> return AmbientPackageEnvironment
where
configExists fname = doesFileExist (pkgEnvDir </> fname)
-- | Defaults common to 'initialPackageEnvironment' and
-- 'commentPackageEnvironment'.
......
......@@ -265,13 +265,21 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do
(globalRepos globalFlags')
comp platform conf configFlags'' configExFlags' extraArgs
buildAction :: (BuildFlags, BuildExFlags) -> [String] -> GlobalFlags -> IO ()
buildAction (buildFlags', buildExFlags) extraArgs globalFlags = do
let buildFlags = buildFlags' {
buildNumJobs = Flag . Just . determineNumJobs . buildNumJobs $
buildFlags'
-- | Set the 'buildNumJobs' field to 'determineNumJobs (configFileValue
-- `mappend` commandLineValue)'.
setNumJobsFlag :: SavedConfig -> BuildFlags -> BuildFlags
setNumJobsFlag config buildFlags =
let numJobsConfigFlag = installNumJobs . savedInstallFlags $ config
numJobsCmdLineFlag = buildNumJobs buildFlags
buildFlags' = buildFlags {
buildNumJobs = Flag . Just . determineNumJobs $
(numJobsConfigFlag `mappend` numJobsCmdLineFlag)
}
distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
in buildFlags'
buildAction :: (BuildFlags, BuildExFlags) -> [String] -> GlobalFlags -> IO ()
buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do
let distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
(buildDistPref buildFlags)
verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck
......@@ -279,12 +287,13 @@ buildAction (buildFlags', buildExFlags) extraArgs globalFlags = do
-- Calls 'configureAction' to do the real work, so nothing special has to be
-- done to support sandboxes.
useSandbox <- reconfigure verbosity distPref
mempty [] globalFlags noAddSource (buildNumJobs buildFlags)
(const Nothing)
(useSandbox, config) <- reconfigure verbosity distPref
mempty [] globalFlags noAddSource
(buildNumJobs buildFlags) (const Nothing)
let buildFlags' = setNumJobsFlag config buildFlags
maybeWithSandboxDirOnSearchPath useSandbox $
build verbosity distPref buildFlags extraArgs
build verbosity distPref buildFlags' extraArgs
-- | Actually do the work of building the package. This is separate from
......@@ -313,9 +322,9 @@ replAction replFlags extraArgs globalFlags = do
-- Calls 'configureAction' to do the real work, so nothing special has to be
-- done to support sandboxes.
useSandbox <- reconfigure verbosity distPref
mempty [] globalFlags noAddSource NoFlag
(const Nothing)
(useSandbox, _config) <- reconfigure verbosity distPref
mempty [] globalFlags noAddSource NoFlag
(const Nothing)
maybeWithSandboxDirOnSearchPath useSandbox $
let progConf = defaultProgramConfiguration
......@@ -388,7 +397,7 @@ reconfigure :: Verbosity -- ^ Verbosity setting
-- prefix setting is always required, it is checked
-- automatically; this function need not check
-- for it.
-> IO UseSandbox
-> IO (UseSandbox, SavedConfig)
reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
skipAddSourceDepsCheck numJobsFlag checkFlags = do
eLbi <- tryGetPersistBuildConfig distPref
......@@ -402,7 +411,8 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
--
-- If we're in a sandbox: add-source deps don't have to be reinstalled
-- (since we don't know the compiler & platform).
onNoBuildConfig :: String -> ConfigStateFileErrorType -> IO UseSandbox
onNoBuildConfig :: String -> ConfigStateFileErrorType
-> IO (UseSandbox, SavedConfig)
onNoBuildConfig err errCode = do
let msg = case errCode of
ConfigStateFileMissing -> "Package has never been configured."
......@@ -416,15 +426,14 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
$ msg ++ " Configuring with default flags." ++ configureManually
configureAction (defaultFlags, defaultConfigExFlags)
extraArgs globalFlags
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
return useSandbox
loadConfigOrSandboxConfig verbosity globalFlags mempty
-- Package has been configured, but the configuration may be out of
-- date or required flags may not be set.
--
-- If we're in a sandbox: reinstall the modified add-source deps and
-- force reconfigure if we did.
onBuildConfig :: LBI.LocalBuildInfo -> IO UseSandbox
onBuildConfig :: LBI.LocalBuildInfo -> IO (UseSandbox, SavedConfig)
onBuildConfig lbi = do
let configFlags = LBI.configFlags lbi
flags = mconcat [configFlags, addConfigFlags, distVerbFlags]
......@@ -444,14 +453,14 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
when (skipAddSourceDepsCheck' == SkipAddSourceDepsCheck) $
info verbosity "Skipping add-source deps check..."
(useSandbox, depsReinstalled) <-
(useSandbox, config, depsReinstalled) <-
case skipAddSourceDepsCheck' of
DontSkipAddSourceDepsCheck ->
maybeReinstallAddSourceDeps verbosity numJobsFlag flags globalFlags
SkipAddSourceDepsCheck -> do
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity
globalFlags mempty
return (useSandbox, NoDepsReinstalled)
(useSandbox, config) <- loadConfigOrSandboxConfig verbosity
globalFlags (configUserInstall flags)
return (useSandbox, config, NoDepsReinstalled)
-- Is the @cabal.config@ file newer than @dist/setup.config@? Then we need
-- to force reconfigure. Note that it's possible to use @cabal.config@
......@@ -468,14 +477,14 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
-- No message for the user indicates that reconfiguration
-- is not required.
Nothing -> return useSandbox
Nothing -> return (useSandbox, config)
-- Show the message and reconfigure.
Just msg -> do
notice verbosity msg
configureAction (flags, defaultConfigExFlags)
extraArgs globalFlags
return useSandbox
return (useSandbox, config)
-- True if the first file exists and is more recent than the second file.
existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
......@@ -628,12 +637,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
testAction :: (TestFlags, BuildFlags, BuildExFlags) -> [String] -> GlobalFlags
-> IO ()
testAction (testFlags, buildFlags', buildExFlags) extraArgs globalFlags = do
let buildFlags = buildFlags' {
buildNumJobs = Flag . Just . determineNumJobs . buildNumJobs $
buildFlags'
}
verbosity = fromFlagOrDefault normal (testVerbosity testFlags)
testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do
let verbosity = fromFlagOrDefault normal (testVerbosity testFlags)
distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
(testDistPref testFlags)
setupOptions = defaultSetupScriptOptions { useDistPref = distPref }
......@@ -646,11 +651,13 @@ testAction (testFlags, buildFlags', buildExFlags) extraArgs globalFlags = do
-- reconfigure also checks if we're in a sandbox and reinstalls add-source
-- deps if needed.
useSandbox <- reconfigure verbosity distPref addConfigFlags []
globalFlags noAddSource (buildNumJobs buildFlags) checkFlags
(useSandbox, config) <- reconfigure verbosity distPref addConfigFlags []
globalFlags noAddSource
(buildNumJobs buildFlags) checkFlags
let buildFlags' = setNumJobsFlag config buildFlags
maybeWithSandboxDirOnSearchPath useSandbox $
build verbosity distPref buildFlags extraArgs
build verbosity distPref buildFlags' extraArgs
maybeWithSandboxDirOnSearchPath useSandbox $
setupWrapper verbosity setupOptions Nothing
......@@ -659,13 +666,9 @@ testAction (testFlags, buildFlags', buildExFlags) extraArgs globalFlags = do
benchmarkAction :: (BenchmarkFlags, BuildFlags, BuildExFlags)
-> [String] -> GlobalFlags
-> IO ()
benchmarkAction (benchmarkFlags, buildFlags', buildExFlags)
benchmarkAction (benchmarkFlags, buildFlags, buildExFlags)
extraArgs globalFlags = do
let buildFlags = buildFlags' {
buildNumJobs = Flag . Just . determineNumJobs . buildNumJobs $
buildFlags'
}
verbosity = fromFlagOrDefault normal
let verbosity = fromFlagOrDefault normal
(benchmarkVerbosity benchmarkFlags)
distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
(benchmarkDistPref benchmarkFlags)
......@@ -679,12 +682,13 @@ benchmarkAction (benchmarkFlags, buildFlags', buildExFlags)
-- reconfigure also checks if we're in a sandbox and reinstalls add-source
-- deps if needed.
useSandbox <- reconfigure verbosity distPref addConfigFlags []
globalFlags noAddSource (buildNumJobs buildFlags)
checkFlags
(useSandbox, config) <- reconfigure verbosity distPref addConfigFlags []
globalFlags noAddSource (buildNumJobs buildFlags)
checkFlags
let buildFlags' = setNumJobsFlag config buildFlags
maybeWithSandboxDirOnSearchPath useSandbox $
build verbosity distPref buildFlags extraArgs
build verbosity distPref buildFlags' extraArgs
maybeWithSandboxDirOnSearchPath useSandbox $
setupWrapper verbosity setupOptions Nothing
......@@ -821,12 +825,8 @@ reportAction reportFlags extraArgs globalFlags = do
(flagToMaybe $ reportPassword reportFlags')
runAction :: (BuildFlags, BuildExFlags) -> [String] -> GlobalFlags -> IO ()
runAction (buildFlags', buildExFlags) extraArgs globalFlags = do
let buildFlags = buildFlags' {
buildNumJobs = Flag . Just . determineNumJobs . buildNumJobs $
buildFlags'
}
verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
runAction (buildFlags, buildExFlags) extraArgs globalFlags = do
let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags)
distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
(buildDistPref buildFlags)
noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck
......@@ -834,15 +834,16 @@ runAction (buildFlags', buildExFlags) extraArgs globalFlags = do
-- reconfigure also checks if we're in a sandbox and reinstalls add-source
-- deps if needed.
useSandbox <- reconfigure verbosity distPref mempty []
globalFlags noAddSource (buildNumJobs buildFlags)
(const Nothing)
(useSandbox, config) <- reconfigure verbosity distPref mempty []
globalFlags noAddSource (buildNumJobs buildFlags)
(const Nothing)
let buildFlags' = setNumJobsFlag config buildFlags
lbi <- getPersistBuildConfig distPref
(exe, exeArgs) <- splitRunArgs lbi extraArgs
maybeWithSandboxDirOnSearchPath useSandbox $
build verbosity distPref mempty ["exe:" ++ exeName exe]
build verbosity distPref buildFlags' ["exe:" ++ exeName exe]
maybeWithSandboxDirOnSearchPath useSandbox $
run verbosity lbi exe exeArgs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment