Commit 82ad2207 authored by Oleg Grenrus's avatar Oleg Grenrus

Implement cabal install -z

Resolve #5919
Resolve #6410

Add `withProjectOrGlobalConfigIgn` to unify the behaviour with `-z` in `cabal
repl`
parent 9a2425a9
......@@ -73,7 +73,7 @@ import Distribution.Client.IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.ProjectConfig
( readGlobalConfig, projectConfigWithBuilderRepoContext
, resolveBuildTimeSettings, withProjectOrGlobalConfig )
, resolveBuildTimeSettings, withProjectOrGlobalConfigIgn )
import Distribution.Client.ProjectPlanning
( storePackageInstallDirs' )
import qualified Distribution.Simple.InstallDirs as InstallDirs
......@@ -261,6 +261,7 @@ installAction ( configFlags, configExFlags, installFlags
targetFilter = if installLibs then Just LibKind else Just ExeKind
targetStrings' = if null targetStrings then ["."] else targetStrings
withProject :: IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector], ProjectConfig)
withProject = do
let verbosity' = lessVerbose verbosity
......@@ -399,6 +400,7 @@ installAction ( configFlags, configExFlags, installFlags
, selectors ++ packageTargets
, projectConfig localBaseCtx )
withoutProject :: ProjectConfig -> IO ([PackageSpecifier pkg], [TargetSelector], ProjectConfig)
withoutProject globalConfig = do
let
parsePkg pkgName
......@@ -451,9 +453,11 @@ installAction ( configFlags, configExFlags, installFlags
packageTargets = flip TargetPackageNamed Nothing . pkgName <$> packageIds
return (packageSpecifiers, packageTargets, projectConfig)
let
ignoreProject = fromFlagOrDefault False (cinstIgnoreProject clientInstallFlags)
(specs, selectors, config) <-
withProjectOrGlobalConfig verbosity globalConfigFlag
withProject withoutProject
withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag withProject withoutProject
home <- getHomeDirectory
let
......@@ -548,6 +552,13 @@ installAction ( configFlags, configExFlags, installFlags
-- installables correctly. For that, we need a place to put a
-- temporary dist directory.
globalTmp <- getTemporaryDirectory
-- if we are installing executables, we shouldn't take into account
-- environment specifiers.
let envSpecs' :: [PackageSpecifier a]
envSpecs' | installLibs = envSpecs
| otherwise = []
withTempDirectory
verbosity
globalTmp
......@@ -557,7 +568,7 @@ installAction ( configFlags, configExFlags, installFlags
verbosity
config
tmpDir
(envSpecs ++ specs)
(envSpecs' ++ specs)
InstallCommand
buildCtx <-
......
......@@ -29,6 +29,7 @@ instance Structured InstallMethod
data ClientInstallFlags = ClientInstallFlags
{ cinstInstallLibs :: Flag Bool
, cinstIgnoreProject :: Flag Bool
, cinstEnvironmentPath :: Flag FilePath
, cinstOverwritePolicy :: Flag OverwritePolicy
, cinstInstallMethod :: Flag InstallMethod
......@@ -48,6 +49,7 @@ instance Structured ClientInstallFlags
defaultClientInstallFlags :: ClientInstallFlags
defaultClientInstallFlags = ClientInstallFlags
{ cinstInstallLibs = toFlag False
, cinstIgnoreProject = toFlag False
, cinstEnvironmentPath = mempty
, cinstOverwritePolicy = mempty
, cinstInstallMethod = mempty
......@@ -60,6 +62,10 @@ clientInstallOptions _ =
"Install libraries rather than executables from the target package."
cinstInstallLibs (\v flags -> flags { cinstInstallLibs = v })
trueArg
, option "z" ["ignore-project"]
"Ignore local project configuration"
cinstIgnoreProject (\v flags -> flags { cinstIgnoreProject = v })
trueArg
, option [] ["package-env", "env"]
"Set the environment file that may be modified."
cinstEnvironmentPath (\pf flags -> flags { cinstEnvironmentPath = pf })
......
......@@ -30,15 +30,13 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.ProjectBuilding
( rebuildTargetsDryRun, improveInstallPlanWithUpToDatePackages )
import Distribution.Client.ProjectConfig
( ProjectConfig(..), withProjectOrGlobalConfig
, projectConfigConfigFile, readGlobalConfig )
( ProjectConfig(..), withProjectOrGlobalConfigIgn
, projectConfigConfigFile )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
( ElaboratedSharedConfig(..), ElaboratedInstallPlan )
import Distribution.Client.ProjectPlanning.Types
( elabOrderExeDependencies )
import Distribution.Client.RebuildMonad
( runRebuild )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
......@@ -237,11 +235,8 @@ replAction ( configFlags, configExFlags, installFlags
with = withProject cliConfig verbosity targetStrings
without config = withoutProject (config <> cliConfig) verbosity targetStrings
(baseCtx, targetSelectors, finalizer, replType) <- if ignoreProject
then do
globalConfig <- runRebuild "" $ readGlobalConfig verbosity globalConfigFlag
without globalConfig
else withProjectOrGlobalConfig verbosity globalConfigFlag with without
(baseCtx, targetSelectors, finalizer, replType) <-
withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without
when (buildSettingOnlyDeps (buildSettings baseCtx)) $
die' verbosity $ "The repl command does not support '--only-dependencies'. "
......
......@@ -341,12 +341,13 @@ instance Semigroup SavedConfig where
combine = combine' savedInstallFlags
lastNonEmptyNL = lastNonEmptyNL' savedInstallFlags
combinedSavedClientInstallFlags = ClientInstallFlags {
cinstInstallLibs = combine cinstInstallLibs,
cinstEnvironmentPath = combine cinstEnvironmentPath,
cinstOverwritePolicy = combine cinstOverwritePolicy,
cinstInstallMethod = combine cinstInstallMethod,
cinstInstalldir = combine cinstInstalldir
combinedSavedClientInstallFlags = ClientInstallFlags
{ cinstInstallLibs = combine cinstInstallLibs
, cinstIgnoreProject = combine cinstIgnoreProject
, cinstEnvironmentPath = combine cinstEnvironmentPath
, cinstOverwritePolicy = combine cinstOverwritePolicy
, cinstInstallMethod = combine cinstInstallMethod
, cinstInstalldir = combine cinstInstalldir
}
where
combine = combine' savedClientInstallFlags
......
......@@ -29,6 +29,7 @@ module Distribution.Client.ProjectConfig (
readGlobalConfig,
readProjectLocalFreezeConfig,
withProjectOrGlobalConfig,
withProjectOrGlobalConfigIgn,
writeProjectLocalExtraConfig,
writeProjectLocalFreezeConfig,
writeProjectConfigFile,
......@@ -454,6 +455,24 @@ renderBadProjectRoot :: BadProjectRoot -> String
renderBadProjectRoot (BadProjectRootExplicitFile projectFile) =
"The given project file '" ++ projectFile ++ "' does not exist."
-- | Like 'withProjectOrGlobalConfig', with an additional boolean
-- which tells to ignore local project.
--
-- Used to implement -z / --ignore-project behaviour
--
withProjectOrGlobalConfigIgn
:: Bool -- ^ whether to ignore local project
-> Verbosity
-> Flag FilePath
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfigIgn True verbosity gcf _with without = do
globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf
without globalConfig
withProjectOrGlobalConfigIgn False verbosity gcf with without =
withProjectOrGlobalConfig verbosity gcf with without
withProjectOrGlobalConfig :: Verbosity
-> Flag FilePath
-> IO a
......
......@@ -366,6 +366,7 @@ instance Arbitrary ClientInstallFlags where
arbitrary =
ClientInstallFlags
<$> arbitrary
<*> arbitrary
<*> arbitraryFlag arbitraryShortToken
<*> arbitrary
<*> arbitrary
......
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