diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs
index f4afb68868a18e1f89b01f5cc158ab1a0337c885..0fe76ceacae88eb9de8a81311a6fb5624e628bfe 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall.hs
@@ -70,6 +70,7 @@ import Distribution.Client.ProjectConfig
, fetchAndReadSourcePackages
, projectConfigWithBuilderRepoContext
, resolveBuildTimeSettings
+ , withGlobalConfig
, withProjectOrGlobalConfig
)
import Distribution.Client.ProjectConfig.Types
@@ -105,6 +106,7 @@ import Distribution.Client.Types
, PackageSpecifier (..)
, SourcePackageDb (..)
, UnresolvedSourcePackage
+ , mkNamedPackage
, pkgSpecifierTarget
)
import Distribution.Client.Types.OverwritePolicy
@@ -344,153 +346,60 @@ installCommand =
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
installAction :: NixStyleFlags ClientInstallFlags -> [String] -> GlobalFlags -> IO ()
-installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetStrings globalFlags = do
+installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, projectFlags} targetStrings globalFlags = do
-- Ensure there were no invalid configuration options specified.
verifyPreconditionsOrDie verbosity configFlags'
-- We cannot use establishDummyProjectBaseContext to get these flags, since
-- it requires one of them as an argument. Normal establishProjectBaseContext
-- does not, and this is why this is done only for the install command
- clientInstallFlags <- getClientInstallFlags verbosity globalFlags clientInstallFlags'
-
+ clientInstallFlags <- getClientInstallFlags verbosity globalFlags extraFlags
let
installLibs = fromFlagOrDefault False (cinstInstallLibs clientInstallFlags)
- targetFilter = if installLibs then Just LibKind else Just ExeKind
- targetStrings' = if null targetStrings then ["."] else targetStrings
-
- -- Note the logic here is rather goofy. Target selectors of the form "foo:bar" also parse as uris.
- -- However, we want install to also take uri arguments. Hence, we only parse uri arguments in the case where
- -- no project file is present (including an implicit one derived from being in a package directory)
- -- or where the --ignore-project flag is passed explicitly. In such a case we only parse colon-free target selectors
- -- as selectors, and otherwise parse things as URIs.
-
- -- However, in the special case where --ignore-project is passed with no selectors, we want to act as though this is
- -- a "normal" ignore project that actually builds and installs the selected package.
-
- withProject :: IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)
- withProject = do
- let reducedVerbosity = lessVerbose verbosity
-
- -- First, we need to learn about what's available to be installed.
- localBaseCtx <-
- establishProjectBaseContext reducedVerbosity baseCliConfig InstallCommand
- let localDistDirLayout = distDirLayout localBaseCtx
- pkgDb <-
- projectConfigWithBuilderRepoContext
- reducedVerbosity
- (buildSettings localBaseCtx)
- (getSourcePackages verbosity)
-
- let
- (targetStrings'', packageIds) =
- partitionEithers
- . flip fmap targetStrings'
- $ \str -> case simpleParsec str of
- Just (pkgId :: PackageId)
- | pkgVersion pkgId /= nullVersion -> Right pkgId
- _ -> Left str
- packageSpecifiers =
- flip fmap packageIds $ \case
- PackageIdentifier{..}
- | pkgVersion == nullVersion -> NamedPackage pkgName []
- | otherwise ->
- NamedPackage
- pkgName
- [ PackagePropertyVersion
- (thisVersion pkgVersion)
- ]
- packageTargets =
- flip TargetPackageNamed targetFilter . pkgName <$> packageIds
-
- if null targetStrings'' -- if every selector is already resolved as a packageid, return without further parsing.
- then return (packageSpecifiers, [], packageTargets, projectConfig localBaseCtx)
- else do
- targetSelectors <-
- either (reportTargetSelectorProblems verbosity) return
- =<< readTargetSelectors
- (localPackages localBaseCtx)
- Nothing
- targetStrings''
-
- (specs, selectors) <-
- getSpecsAndTargetSelectors
- verbosity
- reducedVerbosity
- pkgDb
- targetSelectors
- localDistDirLayout
- localBaseCtx
- targetFilter
-
- return
- ( specs ++ packageSpecifiers
- , []
- , selectors ++ packageTargets
- , projectConfig localBaseCtx
- )
-
- withoutProject :: ProjectConfig -> IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)
- withoutProject _ | null targetStrings = withProject -- if there's no targets, we don't parse specially, but treat it as install in a standard cabal package dir
- withoutProject globalConfig = do
- tss <- traverse (parseWithoutProjectTargetSelector verbosity) targetStrings'
- let
- projectConfig = globalConfig <> baseCliConfig
-
- ProjectConfigBuildOnly
- { projectConfigLogsDir
- } = projectConfigBuildOnly projectConfig
-
- ProjectConfigShared
- { projectConfigStoreDir
- } = projectConfigShared projectConfig
- mlogsDir = flagToMaybe projectConfigLogsDir
- mstoreDir = flagToMaybe projectConfigStoreDir
- cabalDirLayout <- mkCabalDirLayout mstoreDir mlogsDir
+ normalisedTargetStrings = if null targetStrings then ["."] else targetStrings
- let
- buildSettings =
- resolveBuildTimeSettings
- verbosity
- cabalDirLayout
- projectConfig
+ -- Note the logic here is rather goofy. Target selectors of the form "foo:bar" also parse as uris.
+ -- However, we want install to also take uri arguments. Hence, we only parse uri arguments in the case where
+ -- no project file is present (including an implicit one derived from being in a package directory)
+ -- or where the --ignore-project flag is passed explicitly. In such a case we only parse colon-free target selectors
+ -- as selectors, and otherwise parse things as URIs.
- SourcePackageDb{packageIndex} <-
- projectConfigWithBuilderRepoContext
- verbosity
- buildSettings
- (getSourcePackages verbosity)
-
- for_ (concatMap woPackageNames tss) $ \name -> do
- when (null (lookupPackageName packageIndex name)) $ do
- let xs = searchByName packageIndex (unPackageName name)
- let emptyIf True _ = []
- emptyIf False zs = zs
- str2 =
- emptyIf
- (null xs)
- [ "Did you mean any of the following?\n"
- , unlines (("- " ++) . unPackageName . fst <$> xs)
- ]
- dieWithException verbosity $ WithoutProject (unPackageName name) str2
+ -- However, in the special case where --ignore-project is passed with no selectors, we want to act as though this is
+ -- a "normal" ignore project that actually builds and installs the selected package.
- let
- (uris, packageSpecifiers) = partitionEithers $ map woPackageSpecifiers tss
- packageTargets = map woPackageTargets tss
-
- return (packageSpecifiers, uris, packageTargets, projectConfig)
-
- (specs, uris, targetSelectors, baseConfig) <-
- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject withoutProject
-
- -- We compute the base context again to determine packages available in the
- -- project to be installed, so we can list the available package names when
- -- the "all:..." variants of the target selectors are used.
- localPkgs <- localPackages <$> establishProjectBaseContext verbosity baseConfig InstallCommand
+ (pkgSpecs, uris, targetSelectors, config) <-
+ let
+ with = do
+ (pkgSpecs, targetSelectors, baseConfig) <-
+ withProject verbosity cliConfig normalisedTargetStrings installLibs
+ -- No URIs in this case, see note above
+ return (pkgSpecs, [], targetSelectors, baseConfig)
+
+ without =
+ withGlobalConfig verbosity globalConfigFlag $ \globalConfig ->
+ withoutProject verbosity (globalConfig <> cliConfig) normalisedTargetStrings
+ in
+ -- If there's no targets it does not make sense to not be in a project.
+ if null targetStrings
+ then with
+ else withProjectOrGlobalConfig ignoreProject with without
+
+ -- NOTE: CmdInstall and project local packages.
+ --
+ -- CmdInstall always installs packages from a source distribution that, in case of unpackage
+ -- pacakges, is created automatically. This is implemented in getSpecsAndTargetSelectors.
+ --
+ -- This has the inconvenience that the planner will consider all packages as non-local
+ -- (see `ProjectPlanning.shouldBeLocal`) and that any project or cli configuration will
+ -- not apply to them.
+ --
+ -- We rectify this here. In the project configuration, we copy projectConfigLocalPackages to a
+ -- new projectConfigSpecificPackage entry for each package corresponding to a target selector.
+ --
+ -- See #8637 and later #7297, #8909, #7236.
let
- config = addLocalConfigToPkgs baseConfig (map pkgSpecifierTarget specs ++ concatMap (targetPkgNames localPkgs) targetSelectors)
-
ProjectConfig
{ projectConfigBuildOnly =
ProjectConfigBuildOnly
@@ -525,12 +434,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
$ configProgDb
-- progDb is a program database with compiler tools configured properly
- ( compiler@Compiler
- { compilerId = CompilerId compilerFlavor compilerVersion
- }
- , platform
- , progDb
- ) <-
+ (compiler@Compiler{compilerId = CompilerId compilerFlavor compilerVersion}, platform, progDb) <-
configCompilerEx hcFlavor hcPath hcPkg preProgDb verbosity
let
@@ -567,7 +471,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
let getPackageName :: PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName (NamedPackage pn _) = pn
getPackageName (SpecificSourcePackage (SourcePackage pkgId _ _ _)) = pkgName pkgId
- targetNames = S.fromList $ map getPackageName (specs ++ uriSpecs)
+ targetNames = S.fromList $ map getPackageName (pkgSpecs ++ uriSpecs)
envNames = S.fromList $ map getPackageName envSpecs
forceInstall = fromFlagOrDefault False $ installOverrideReinstall installFlags
nameIntersection = S.intersection targetNames envNames
@@ -584,7 +488,8 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
in pure (es, nge)
else dieWithException verbosity $ PackagesAlreadyExistInEnvfile envFile (map prettyShow $ S.toList nameIntersection)
- -- we construct an installed index of files in the cleaned target environment (absent overwrites) so that we can solve with regards to packages installed locally but not in the upstream repo
+ -- we construct an installed index of files in the cleaned target environment (absent overwrites) so that
+ -- we can solve with regards to packages installed locally but not in the upstream repo
let installedPacks = PI.allPackagesByName installedIndex
newEnvNames = S.fromList $ map getPackageName envSpecs'
installedIndex' = PI.fromList . concatMap snd . filter (\p -> fst p `S.member` newEnvNames) $ installedPacks
@@ -594,7 +499,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
verbosity
config
distDirLayout
- (envSpecs' ++ specs ++ uriSpecs)
+ (envSpecs' ++ pkgSpecs ++ uriSpecs)
InstallCommand
buildCtx <- constructProjectBuildContext verbosity (baseCtx{installedPackages = Just installedIndex'}) targetSelectors
@@ -635,12 +540,13 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
configFlags' = disableTestsBenchsByDefault configFlags
verbosity = fromFlagOrDefault normal (configVerbosity configFlags')
ignoreProject = flagIgnoreProject projectFlags
- baseCliConfig =
+ cliConfig =
commandLineFlagsToProjectConfig
globalFlags
flags{configFlags = configFlags'}
- clientInstallFlags'
- globalConfigFlag = projectConfigConfigFile (projectConfigShared baseCliConfig)
+ extraFlags
+
+ globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
-- Do the install action for each executable in the install configuration.
traverseInstall :: InstallAction -> InstallCfg -> IO ()
@@ -649,7 +555,143 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
actionOnExe <- action v overwritePolicy <$> prepareExeInstall cfg
traverse_ actionOnExe . Map.toList $ targetsMap buildCtx
--- | Treat all direct targets of install command as local packages: #8637 and later #7297, #8909, #7236.
+withProject
+ :: Verbosity
+ -> ProjectConfig
+ -> [String]
+ -> Bool
+ -> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector], ProjectConfig)
+withProject verbosity cliConfig targetStrings installLibs = do
+ -- First, we need to learn about what's available to be installed.
+ baseCtx <- establishProjectBaseContext reducedVerbosity cliConfig InstallCommand
+
+ (pkgSpecs, targetSelectors) <-
+ -- If every target is already resolved to a package id, we can return without any further parsing.
+ if null unresolvedTargetStrings
+ then return (parsedPkgSpecs, parsedTargets)
+ else do
+ -- Anything that could not be parsed as a packageId (e.g. a pacakge name with not version or
+ -- a target syntax using colons) must be resolved inside the project context.
+ (resolvedPkgSpecs, resolvedTargets) <-
+ resolveTargetSelectorsInProjectBaseContext verbosity baseCtx unresolvedTargetStrings targetFilter
+ return (resolvedPkgSpecs ++ parsedPkgSpecs, resolvedTargets ++ parsedTargets)
+
+ -- Apply the local configuration (e.g. cli flags) to all direct targets of install command, see note
+ -- in 'installAction'.
+ --
+ -- NOTE: If a target string had to be resolved inside the project conterxt, then pkgSpecs will include
+ -- the project packages turned into source distributions (getSpecsAndTargetSelectors does this).
+ -- We want to apply the local configuration only to the actual targets.
+ let config =
+ addLocalConfigToPkgs (projectConfig baseCtx) $
+ concatMap (targetPkgNames $ localPackages baseCtx) targetSelectors
+ return (pkgSpecs, targetSelectors, config)
+ where
+ reducedVerbosity = lessVerbose verbosity
+
+ -- We take the targets and try to parse them as package ids (with name and version).
+ -- The ones who don't parse will have to be resolved in the project context.
+ (unresolvedTargetStrings, parsedPackageIds) =
+ partitionEithers $
+ flip map targetStrings $ \s ->
+ case eitherParsec s of
+ Right pkgId@PackageIdentifier{pkgVersion}
+ | pkgVersion /= nullVersion ->
+ pure pkgId
+ _ -> Left s
+
+ -- For each packageId, we output a NamedPackage specifier (i.e. a package only known by
+ -- its name) and a target selector.
+ (parsedPkgSpecs, parsedTargets) =
+ unzip
+ [ (mkNamedPackage pkgId, TargetPackageNamed (pkgName pkgId) targetFilter)
+ | pkgId <- parsedPackageIds
+ ]
+
+ targetFilter = if installLibs then Just LibKind else Just ExeKind
+
+resolveTargetSelectorsInProjectBaseContext
+ :: Verbosity
+ -> ProjectBaseContext
+ -> [String]
+ -> Maybe ComponentKindFilter
+ -> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
+resolveTargetSelectorsInProjectBaseContext verbosity baseCtx targetStrings targetFilter = do
+ let reducedVerbosity = lessVerbose verbosity
+
+ sourcePkgDb <-
+ projectConfigWithBuilderRepoContext
+ reducedVerbosity
+ (buildSettings baseCtx)
+ (getSourcePackages verbosity)
+
+ targetSelectors <-
+ readTargetSelectors (localPackages baseCtx) Nothing targetStrings
+ >>= \case
+ Left problems -> reportTargetSelectorProblems verbosity problems
+ Right ts -> return ts
+
+ getSpecsAndTargetSelectors
+ verbosity
+ reducedVerbosity
+ sourcePkgDb
+ targetSelectors
+ (distDirLayout baseCtx)
+ baseCtx
+ targetFilter
+
+withoutProject
+ :: Verbosity
+ -> ProjectConfig
+ -> [String]
+ -> IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)
+withoutProject verbosity globalConfig targetStrings = do
+ tss <- traverse (parseWithoutProjectTargetSelector verbosity) targetStrings
+ let
+ ProjectConfigBuildOnly
+ { projectConfigLogsDir
+ } = projectConfigBuildOnly globalConfig
+
+ ProjectConfigShared
+ { projectConfigStoreDir
+ } = projectConfigShared globalConfig
+
+ mlogsDir = flagToMaybe projectConfigLogsDir
+ mstoreDir = flagToMaybe projectConfigStoreDir
+
+ cabalDirLayout <- mkCabalDirLayout mstoreDir mlogsDir
+
+ let buildSettings = resolveBuildTimeSettings verbosity cabalDirLayout globalConfig
+
+ SourcePackageDb{packageIndex} <-
+ projectConfigWithBuilderRepoContext
+ verbosity
+ buildSettings
+ (getSourcePackages verbosity)
+
+ for_ (concatMap woPackageNames tss) $ \name -> do
+ when (null (lookupPackageName packageIndex name)) $ do
+ let xs = searchByName packageIndex (unPackageName name)
+ let emptyIf True _ = []
+ emptyIf False zs = zs
+ str2 =
+ emptyIf
+ (null xs)
+ [ "Did you mean any of the following?\n"
+ , unlines (("- " ++) . unPackageName . fst <$> xs)
+ ]
+ dieWithException verbosity $ WithoutProject (unPackageName name) str2
+
+ let
+ packageSpecifiers :: [PackageSpecifier UnresolvedSourcePackage]
+ (uris, packageSpecifiers) = partitionEithers $ map woPackageSpecifiers tss
+ packageTargets = map woPackageTargets tss
+
+ -- Apply the local configuration (e.g. cli flags) to all direct targets of install command,
+ -- see note in 'installAction'
+ let config = addLocalConfigToPkgs globalConfig (concatMap woPackageNames tss)
+ return (packageSpecifiers, uris, packageTargets, config)
+
addLocalConfigToPkgs :: ProjectConfig -> [PackageName] -> ProjectConfig
addLocalConfigToPkgs config pkgs =
config
@@ -692,6 +734,7 @@ verifyPreconditionsOrDie verbosity configFlags = do
when (configBenchmarks configFlags == Flag True) $
dieWithException verbosity ConfigBenchmarks
+-- | Apply the given 'ClientInstallFlags' on top of one coming from the global configuration.
getClientInstallFlags :: Verbosity -> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags
getClientInstallFlags verbosity globalFlags existingClientInstallFlags = do
let configFileFlag = globalConfigFile globalFlags
@@ -707,28 +750,27 @@ getSpecsAndTargetSelectors
-> ProjectBaseContext
-> Maybe ComponentKindFilter
-> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
-getSpecsAndTargetSelectors verbosity reducedVerbosity pkgDb targetSelectors localDistDirLayout localBaseCtx targetFilter =
- withInstallPlan reducedVerbosity localBaseCtx $ \elaboratedPlan _ -> do
+getSpecsAndTargetSelectors verbosity reducedVerbosity sourcePkgDb targetSelectors distDirLayout baseCtx targetFilter =
+ withInstallPlan reducedVerbosity baseCtx $ \elaboratedPlan _ -> do
-- Split into known targets and hackage packages.
- (targets, hackageNames) <-
+ (targetsMap, hackageNames) <-
partitionToKnownTargetsAndHackagePackages
verbosity
- pkgDb
+ sourcePkgDb
elaboratedPlan
targetSelectors
let
planMap = InstallPlan.toMap elaboratedPlan
- targetIds = Map.keys targets
sdistize (SpecificSourcePackage spkg) =
SpecificSourcePackage spkg'
where
- sdistPath = distSdistFile localDistDirLayout (packageId spkg)
+ sdistPath = distSdistFile distDirLayout (packageId spkg)
spkg' = spkg{srcpkgSource = LocalTarballPackage sdistPath}
sdistize named = named
- local = sdistize <$> localPackages localBaseCtx
+ localPkgs = sdistize <$> localPackages baseCtx
gatherTargets :: UnitId -> TargetSelector
gatherTargets targetId = TargetPackageNamed pkgName targetFilter
@@ -736,30 +778,29 @@ getSpecsAndTargetSelectors verbosity reducedVerbosity pkgDb targetSelectors loca
targetUnit = Map.findWithDefault (error "cannot find target unit") targetId planMap
PackageIdentifier{..} = packageId targetUnit
- targets' = fmap gatherTargets targetIds
+ localTargets = map gatherTargets (Map.keys targetsMap)
hackagePkgs :: [PackageSpecifier UnresolvedSourcePackage]
- hackagePkgs = flip NamedPackage [] <$> hackageNames
+ hackagePkgs = [NamedPackage pn [] | pn <- hackageNames]
hackageTargets :: [TargetSelector]
- hackageTargets =
- flip TargetPackageNamed targetFilter <$> hackageNames
+ hackageTargets = [TargetPackageNamed pn targetFilter | pn <- hackageNames]
- createDirectoryIfMissing True (distSdistDirectory localDistDirLayout)
+ createDirectoryIfMissing True (distSdistDirectory distDirLayout)
- unless (Map.null targets) $ for_ (localPackages localBaseCtx) $ \lpkg -> case lpkg of
+ unless (Map.null targetsMap) $ for_ (localPackages baseCtx) $ \case
SpecificSourcePackage pkg ->
packageToSdist
verbosity
- (distProjectRootDirectory localDistDirLayout)
+ (distProjectRootDirectory distDirLayout)
TarGzArchive
- (distSdistFile localDistDirLayout (packageId pkg))
+ (distSdistFile distDirLayout (packageId pkg))
pkg
NamedPackage pkgName _ -> error $ "Got NamedPackage " ++ prettyShow pkgName
- if null targets
+ if null targetsMap
then return (hackagePkgs, hackageTargets)
- else return (local ++ hackagePkgs, targets' ++ hackageTargets)
+ else return (localPkgs ++ hackagePkgs, localTargets ++ hackageTargets)
-- | Partitions the target selectors into known local targets and hackage packages.
partitionToKnownTargetsAndHackagePackages
diff --git a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
index c6939729f61ffc7d3909b037127da36073f340b1..7879602a91398a6762ec67768e125669fc68e90e 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
@@ -18,8 +18,6 @@ import Distribution.Compat.CharParsing (char, optional)
import Distribution.Package
import Distribution.Simple.LocalBuildInfo (ComponentName (CExeName))
import Distribution.Simple.Utils (dieWithException)
-import Distribution.Solver.Types.PackageConstraint (PackageProperty (..))
-import Distribution.Version
data WithoutProjectTargetSelector
= WoPackageId PackageId
@@ -57,15 +55,6 @@ woPackageTargets (WoURI _) =
TargetAllPackages (Just ExeKind)
woPackageSpecifiers :: WithoutProjectTargetSelector -> Either URI (PackageSpecifier pkg)
-woPackageSpecifiers (WoPackageId pid) = Right (pidPackageSpecifiers pid)
-woPackageSpecifiers (WoPackageComponent pid _) = Right (pidPackageSpecifiers pid)
+woPackageSpecifiers (WoPackageId pid) = Right (mkNamedPackage pid)
+woPackageSpecifiers (WoPackageComponent pid _) = Right (mkNamedPackage pid)
woPackageSpecifiers (WoURI uri) = Left uri
-
-pidPackageSpecifiers :: PackageId -> PackageSpecifier pkg
-pidPackageSpecifiers pid
- | pkgVersion pid == nullVersion = NamedPackage (pkgName pid) []
- | otherwise =
- NamedPackage
- (pkgName pid)
- [ PackagePropertyVersion (thisVersion (pkgVersion pid))
- ]
diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs
index c77c1eae9105b2aad76326978c7c0ec19b58a82e..a1142b06a278e774c625f36c7f74c4985159c700 100644
--- a/cabal-install/src/Distribution/Client/CmdSdist.hs
+++ b/cabal-install/src/Distribution/Client/CmdSdist.hs
@@ -32,6 +32,7 @@ import Distribution.Client.ProjectConfig
, commandLineFlagsToProjectConfig
, projectConfigConfigFile
, projectConfigShared
+ , withGlobalConfig
, withProjectOrGlobalConfig
)
import Distribution.Client.ProjectFlags
@@ -219,7 +220,11 @@ sdistOptions showOrParseArgs =
sdistAction :: (ProjectFlags, SdistFlags) -> [String] -> GlobalFlags -> IO ()
sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
- (baseCtx, distDirLayout) <- withProjectOrGlobalConfig verbosity flagIgnoreProject globalConfigFlag withProject withoutProject
+ (baseCtx, distDirLayout) <-
+ withProjectOrGlobalConfig
+ flagIgnoreProject
+ withProject
+ (withGlobalConfig verbosity globalConfigFlag withoutProject)
let localPkgs = localPackages baseCtx
diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs
index c0f4e05a1376155474c1395507c0cb90c0e30eed..052c8d60edd7f05e3715f900ea18dca992407998 100644
--- a/cabal-install/src/Distribution/Client/CmdUpdate.hs
+++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs
@@ -48,6 +48,7 @@ import Distribution.Client.ProjectConfig
( ProjectConfig (..)
, ProjectConfigShared (projectConfigConfigFile)
, projectConfigWithSolverRepoContext
+ , withGlobalConfig
, withProjectOrGlobalConfig
)
import Distribution.Client.ProjectFlags
@@ -162,11 +163,9 @@ updateAction flags@NixStyleFlags{..} extraArgs globalFlags = do
projectConfig <-
withProjectOrGlobalConfig
- verbosity
ignoreProject
- globalConfigFlag
(projectConfig <$> establishProjectBaseContext verbosity cliConfig OtherCommand)
- (\globalConfig -> return $ globalConfig <> cliConfig)
+ (withGlobalConfig verbosity globalConfigFlag $ \globalConfig -> return $ globalConfig <> cliConfig)
projectConfigWithSolverRepoContext
verbosity
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
index cffc0912c93963a849882f320bae9ead419778bf..1a19eb3f62102ee6033c0aa18f908f76acc062ed 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -621,32 +621,25 @@ withGlobalConfig verbosity gcf with = do
with globalConfig
withProjectOrGlobalConfig
- :: Verbosity
- -- ^ verbosity
- -> Flag Bool
+ :: Flag Bool
-- ^ whether to ignore local project (--ignore-project flag)
- -> Flag FilePath
- -- ^ @--cabal-config@
-> IO a
- -- ^ with project
- -> (ProjectConfig -> IO a)
- -- ^ without project
+ -- ^ continuation with project
-> IO a
-withProjectOrGlobalConfig verbosity (Flag True) gcf _with without = do
- globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf
- without globalConfig
-withProjectOrGlobalConfig verbosity _ignorePrj gcf with without =
- withProjectOrGlobalConfig' verbosity gcf with without
+ -- ^ continuation without project
+ -> IO a
+withProjectOrGlobalConfig (Flag True) _with without = do
+ without
+withProjectOrGlobalConfig _ignorePrj with without =
+ withProjectOrGlobalConfig' with without
withProjectOrGlobalConfig'
- :: Verbosity
- -> Flag FilePath
+ :: IO a
+ -- ^ continuation with project
-> IO a
- -> (ProjectConfig -> IO a)
+ -- ^ continuation without project
-> IO a
-withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do
- globalConfig <- runRebuild "" $ readGlobalConfig verbosity globalConfigFlag
-
+withProjectOrGlobalConfig' with without = do
catch with $
\case
(BadPackageLocations prov locs)
@@ -654,8 +647,8 @@ withProjectOrGlobalConfig' verbosity globalConfigFlag with without = do
, let
isGlobErr (BadLocGlobEmptyMatch _) = True
isGlobErr _ = False
- , any isGlobErr locs ->
- without globalConfig
+ , any isGlobErr locs -> do
+ without
err -> throwIO err
-- | Read all the config relevant for a project. This includes the project
@@ -956,7 +949,7 @@ renderBadPackageLocationMatch bplm = case bplm of
++ "' contains multiple "
++ ".cabal files (which is not currently supported)."
--- | Given the project config,
+-- | Determines the location of all packages mentioned in the project configuration.
--
-- Throws 'BadPackageLocations'.
findProjectPackages
@@ -986,11 +979,7 @@ findProjectPackages
findPackageLocation
:: Bool
-> String
- -> Rebuild
- ( Either
- BadPackageLocation
- [ProjectPackageLocation]
- )
+ -> Rebuild (Either BadPackageLocation [ProjectPackageLocation])
findPackageLocation _required@True pkglocstr =
-- strategy: try first as a file:// or http(s):// URL.
-- then as a file glob (usually encompassing single file)
@@ -1011,13 +1000,7 @@ findProjectPackages
, checkIsFileGlobPackage
, checkIsSingleFilePackage
:: String
- -> Rebuild
- ( Maybe
- ( Either
- BadPackageLocation
- [ProjectPackageLocation]
- )
- )
+ -> Rebuild (Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsUriPackage pkglocstr =
case parseAbsoluteURI pkglocstr of
Just
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index db99b2576b92e29aa836dbec54a4ee57a881a2e4..b65f39526a0ffeb2821d51f36299f3881686cd3b 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -237,6 +237,9 @@ data ProjectBaseContext = ProjectBaseContext
, cabalDirLayout :: CabalDirLayout
, projectConfig :: ProjectConfig
, localPackages :: [PackageSpecifier UnresolvedSourcePackage]
+ -- ^ Note: these are all the packages mentioned in the project configuration.
+ -- Whether or not they will be considered local to the project will be decided
+ -- by `shouldBeLocal` in ProjectPlanning.
, buildSettings :: BuildTimeSettings
, currentCommand :: CurrentCommand
, installedPackages :: Maybe InstalledPackageIndex
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index ad9e507ae5c2bb03d55e7008f3ed9828ff9bb49a..3a4e6f96bf86cba1973655cd7545e77b3ce5706e 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -409,6 +409,8 @@ rebuildProjectConfig
-- Look for all the cabal packages in the project
-- some of which may be local src dirs, tarballs etc
--
+ -- NOTE: These are all packages mentioned in the project configuration.
+ -- Whether or not they will be considered local to the project will be decided by `shouldBeLocal`.
phaseReadLocalPackages
:: ProjectConfig
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs
index e66117414a812a3a0fee6c19b207603b8ad1dc4b..1793f6aa07ddc3d0a54e9d14143f7a175dbcd3d9 100644
--- a/cabal-install/src/Distribution/Client/ScriptUtils.hs
+++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs
@@ -292,7 +292,11 @@ withContextAndSelectors
-> IO b
withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act =
withTemporaryTempDirectory $ \mkTmpDir -> do
- (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject (withoutProject mkTmpDir)
+ (tc, ctx) <-
+ withProjectOrGlobalConfig
+ ignoreProject
+ withProject
+ (withGlobalConfig verbosity globalConfigFlag $ withoutProject mkTmpDir)
(tc', ctx', sels) <- case targetStrings of
-- Only script targets may contain spaces and or end with ':'.
diff --git a/cabal-install/src/Distribution/Client/Types/PackageSpecifier.hs b/cabal-install/src/Distribution/Client/Types/PackageSpecifier.hs
index 5f25be4aa77dfe0549b43133ec04f1f12f93c7aa..a803a85b4293385101c034adeb346a986456154b 100644
--- a/cabal-install/src/Distribution/Client/Types/PackageSpecifier.hs
+++ b/cabal-install/src/Distribution/Client/Types/PackageSpecifier.hs
@@ -5,14 +5,15 @@ module Distribution.Client.Types.PackageSpecifier
( PackageSpecifier (..)
, pkgSpecifierTarget
, pkgSpecifierConstraints
+ , mkNamedPackage
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
-import Distribution.Package (Package (..), packageName, packageVersion)
+import Distribution.Package (Package (..), PackageIdentifier (..), packageName, packageVersion)
import Distribution.Types.PackageName (PackageName)
-import Distribution.Version (thisVersion)
+import Distribution.Version (nullVersion, thisVersion)
import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.LabeledPackageConstraint
@@ -53,3 +54,12 @@ pkgSpecifierConstraints (SpecificSourcePackage pkg) =
PackageConstraint
(ScopeTarget $ packageName pkg)
(PackagePropertyVersion $ thisVersion (packageVersion pkg))
+
+mkNamedPackage :: PackageIdentifier -> PackageSpecifier pkg
+mkNamedPackage pkgId =
+ NamedPackage
+ (pkgName pkgId)
+ ( if pkgVersion pkgId == nullVersion
+ then []
+ else [PackagePropertyVersion (thisVersion (pkgVersion pkgId))]
+ )