Skip to content

no global packages auto written to env files #8607

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 6 commits into from
Dec 27, 2022
Merged

no global packages auto written to env files #8607

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
91f5819
no global packages auto written to env files
gbaz Nov 19, 2022
2de5f0b
handle --force-reinstalls and exising in index packages
gbaz Nov 21, 2022
00cded9
fix warning
gbaz Nov 21, 2022
8098b40
fix test
gbaz Nov 21, 2022
b344502
changelog
gbaz Dec 24, 2022
fd0f03b
Merge branch 'master' into gb/no-global-packages-in-env
mergify[bot] Dec 26, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion cabal-install/src/Distribution/Client/CmdFreeze.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -115,6 +115,7 @@ freezeAction flags@NixStyleFlags {..} extraArgs globalFlags = do
distDirLayout cabalDirLayout
projectConfig
localPackages
Nothing

let freezeConfig = projectFreezeConfig elaboratedPlan totalIndexState activeRepos
dryRun = buildSettingDryRun buildSettings
Expand Down Expand Up @@ -233,4 +234,3 @@ projectFreezeConstraints plan =
| InstallPlan.Configured elab <- InstallPlan.toList plan
, elabLocalToProject elab
]

72 changes: 36 additions & 36 deletions cabal-install/src/Distribution/Client/CmdInstall.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,13 +33,13 @@ import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.CmdInstall.ClientInstallTargetSelector

import Distribution.Client.Setup
( GlobalFlags(..), ConfigFlags(..) )
( GlobalFlags(..), ConfigFlags(..), InstallFlags(..) )
import Distribution.Client.Types
( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage
, SourcePackageDb(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Package
( Package(..), PackageName, mkPackageName, unPackageName )
( Package(..), PackageName, unPackageName )
import Distribution.Types.PackageId
( PackageIdentifier(..) )
import Distribution.Client.ProjectConfig
Expand All @@ -58,7 +58,7 @@ import Distribution.Client.ProjectConfig.Types
, projectConfigConfigFile )
import Distribution.Simple.Program.Db
( userSpecifyPaths, userSpecifyArgss, defaultProgramDb
, modifyProgramSearchPath, ProgramDb )
, modifyProgramSearchPath )
import Distribution.Simple.BuildPaths
( exeExtension )
import Distribution.Simple.Program.Find
Expand Down Expand Up @@ -124,12 +124,11 @@ import Distribution.Simple.Utils
, withTempDirectory, createDirectoryIfMissingVerbose
, ordNub )
import Distribution.Utils.Generic
( safeHead, writeFileAtomic )
( writeFileAtomic )

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Ord
( Down(..) )
import qualified Data.Map as Map
import qualified Data.Set as S
import qualified Data.List.NonEmpty as NE
import Distribution.Utils.NubList
( fromNubList )
Expand Down Expand Up @@ -363,14 +362,37 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe
(projectConfigBuildOnly config)
[ ProjectPackageRemoteTarball uri | uri <- uris ]

-- check for targets already in env
let getPackageName :: PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName (NamedPackage pn _) = pn
getPackageName (SpecificSourcePackage (SourcePackage pkgId _ _ _)) = pkgName pkgId
targetNames = S.fromList $ map getPackageName (specs ++ uriSpecs)
envNames = S.fromList $ map getPackageName envSpecs
forceInstall = fromFlagOrDefault False $ installOverrideReinstall installFlags
nameIntersection = S.intersection targetNames envNames

-- we check for intersections in targets with the existing env
(envSpecs', nonGlobalEnvEntries') <- if null nameIntersection
then pure (envSpecs, map snd nonGlobalEnvEntries)
else if forceInstall
then let es = filter (\e -> not $ getPackageName e `S.member` nameIntersection) envSpecs
nge = map snd . filter (\e -> not $ fst e `S.member` nameIntersection) $ nonGlobalEnvEntries
in pure (es, nge)
else die' verbosity $ "Packages requested to install already exist in environment file at " ++ envFile ++ ". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " ++ intercalate ", " (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
let installedPacks = PI.allPackagesByName installedIndex
newEnvNames = S.fromList $ map getPackageName envSpecs'
installedIndex' = PI.fromList . concatMap snd . filter (\p -> fst p `S.member` newEnvNames) $ installedPacks

baseCtx <- establishDummyProjectBaseContext
verbosity
config
distDirLayout
(envSpecs ++ specs ++ uriSpecs)
(envSpecs' ++ specs ++ uriSpecs)
InstallCommand

buildCtx <- constructProjectBuildContext verbosity baseCtx targetSelectors
buildCtx <- constructProjectBuildContext verbosity (baseCtx {installedPackages = Just installedIndex'}) targetSelectors

printPlan verbosity baseCtx buildCtx

Expand All @@ -387,7 +409,7 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe
unless dryRun $
if installLibs
then installLibraries verbosity
buildCtx compiler packageDbs progDb envFile nonGlobalEnvEntries
buildCtx compiler packageDbs envFile nonGlobalEnvEntries'
else installExes verbosity
baseCtx buildCtx platform compiler configFlags clientInstallFlags
where
Expand Down Expand Up @@ -640,29 +662,18 @@ installLibraries
-> ProjectBuildContext
-> Compiler
-> PackageDBStack
-> ProgramDb
-> FilePath -- ^ Environment file
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries verbosity buildCtx compiler
packageDbs programDb envFile envEntries = do
-- Why do we get it again? If we updated a globalPackage then we need
-- the new version.
installedIndex <- getInstalledPackages verbosity compiler packageDbs programDb
packageDbs envFile envEntries = do
if supportsPkgEnvFiles $ getImplInfo compiler
then do
let
getLatest :: PackageName -> [InstalledPackageInfo]
getLatest = (=<<) (maybeToList . safeHead . snd) . take 1 . sortBy (comparing (Down . fst))
. PI.lookupPackageName installedIndex
globalLatest = concat (getLatest <$> globalPackages)

baseEntries =
GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs
globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest
pkgEntries = ordNub $
globalEntries
++ envEntries
envEntries
++ entriesForLibraryComponents (targetsMap buildCtx)
contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries)
createDirectoryIfMissing True (takeDirectory envFile)
Expand Down Expand Up @@ -700,21 +711,12 @@ warnIfNoExes verbosity buildCtx =
exeMaybe (ComponentTarget (CExeName exe) _) = Just exe
exeMaybe _ = Nothing

globalPackages :: [PackageName]
globalPackages = mkPackageName <$>
[ "ghc", "hoopl", "bytestring", "unix", "base", "time", "hpc", "filepath"
, "process", "array", "integer-gmp", "containers", "ghc-boot", "binary"
, "ghc-prim", "ghci", "rts", "terminfo", "transformers", "deepseq"
, "ghc-boot-th", "pretty", "template-haskell", "directory", "text"
, "bin-package-db"
]

-- | Return the package specifiers and non-global environment file entries.
getEnvSpecsAndNonGlobalEntries
:: PI.InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
getEnvSpecsAndNonGlobalEntries installedIndex entries installLibs =
if installLibs
then (envSpecs, envEntries')
Expand All @@ -724,17 +726,15 @@ getEnvSpecsAndNonGlobalEntries installedIndex entries installLibs =

environmentFileToSpecifiers
:: PI.InstalledPackageIndex -> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
environmentFileToSpecifiers ipi = foldMap $ \case
(GhcEnvFilePackageId unitId)
| Just InstalledPackageInfo
{ sourcePackageId = PackageIdentifier{..}, installedUnitId }
<- PI.lookupUnitId ipi unitId
, let pkgSpec = NamedPackage pkgName
[PackagePropertyVersion (thisVersion pkgVersion)]
-> if pkgName `elem` globalPackages
then ([pkgSpec], [])
else ([pkgSpec], [GhcEnvFilePackageId installedUnitId])
-> ([pkgSpec], [(pkgName, GhcEnvFilePackageId installedUnitId)])
_ -> ([], [])


Expand Down
21 changes: 15 additions & 6 deletions cabal-install/src/Distribution/Client/ProjectOrchestration.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -161,7 +161,7 @@ import Distribution.Simple.Flag
import qualified Distribution.Simple.Setup as Setup
import Distribution.Simple.Command (commandShowOptions)
import Distribution.Simple.Configure (computeEffectiveProfiling)

import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Utils
( die', warn, notice, noticeNoWrap, debugNoWrap, createDirectoryIfMissingVerbose, ordNub )
import Distribution.Verbosity
Expand Down Expand Up @@ -198,7 +198,8 @@ data ProjectBaseContext = ProjectBaseContext {
projectConfig :: ProjectConfig,
localPackages :: [PackageSpecifier UnresolvedSourcePackage],
buildSettings :: BuildTimeSettings,
currentCommand :: CurrentCommand
currentCommand :: CurrentCommand,
installedPackages :: Maybe InstalledPackageIndex
}

establishProjectBaseContext
Expand Down Expand Up @@ -260,11 +261,13 @@ establishProjectBaseContextWithRoot verbosity cliConfig projectRoot currentComma
projectConfig,
localPackages,
buildSettings,
currentCommand
currentCommand,
installedPackages
}
where
mdistDirectory = Setup.flagToMaybe projectConfigDistDir
ProjectConfigShared { projectConfigDistDir } = projectConfigShared cliConfig
installedPackages = Nothing


-- | This holds the context between the pre-build, build and post-build phases.
Expand Down Expand Up @@ -309,7 +312,8 @@ withInstallPlan
distDirLayout,
cabalDirLayout,
projectConfig,
localPackages
localPackages,
installedPackages
}
action = do
-- Take the project configuration and make a plan for how to build
Expand All @@ -321,6 +325,7 @@ withInstallPlan
distDirLayout cabalDirLayout
projectConfig
localPackages
installedPackages
action elaboratedPlan elaboratedShared

runProjectPreBuildPhase
Expand All @@ -334,7 +339,8 @@ runProjectPreBuildPhase
distDirLayout,
cabalDirLayout,
projectConfig,
localPackages
localPackages,
installedPackages
}
selectPlanSubset = do
-- Take the project configuration and make a plan for how to build
Expand All @@ -346,6 +352,7 @@ runProjectPreBuildPhase
distDirLayout cabalDirLayout
projectConfig
localPackages
installedPackages

-- The plan for what to do is represented by an 'ElaboratedInstallPlan'

Expand Down Expand Up @@ -1333,14 +1340,16 @@ establishDummyProjectBaseContext verbosity projectConfig distDirLayout localPack
buildSettings = resolveBuildTimeSettings
verbosity cabalDirLayout
projectConfig
installedPackages = Nothing

return ProjectBaseContext {
distDirLayout,
cabalDirLayout,
projectConfig,
localPackages,
buildSettings,
currentCommand
currentCommand,
installedPackages
}

establishDummyDistDirLayout :: Verbosity -> ProjectConfig -> FilePath -> IO DistDirLayout
Expand Down
11 changes: 7 additions & 4 deletions cabal-install/src/Distribution/Client/ProjectPlanning.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -468,6 +468,7 @@ rebuildInstallPlan :: Verbosity
-> DistDirLayout -> CabalDirLayout
-> ProjectConfig
-> [PackageSpecifier UnresolvedSourcePackage]
-> Maybe InstalledPackageIndex
-> IO ( ElaboratedInstallPlan -- with store packages
, ElaboratedInstallPlan -- with source packages
, ElaboratedSharedConfig
Expand All @@ -482,7 +483,7 @@ rebuildInstallPlan verbosity
}
CabalDirLayout {
cabalStoreDirLayout
} = \projectConfig localPackages ->
} = \projectConfig localPackages mbInstalledPackages ->
runRebuild distProjectRootDirectory $ do
progsearchpath <- liftIO $ getSystemSearchPath
let projectConfigMonitored = projectConfig { projectConfigBuildOnly = mempty }
Expand All @@ -505,6 +506,7 @@ rebuildInstallPlan verbosity
<- phaseRunSolver projectConfig
compilerEtc
localPackages
(fromMaybe mempty mbInstalledPackages)
(elaboratedPlan,
elaboratedShared) <- phaseElaboratePlan projectConfig
compilerEtc pkgConfigDB
Expand Down Expand Up @@ -578,13 +580,15 @@ rebuildInstallPlan verbosity
:: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier UnresolvedSourcePackage]
-> InstalledPackageIndex
-> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
phaseRunSolver projectConfig@ProjectConfig {
projectConfigShared,
projectConfigBuildOnly
}
(compiler, platform, progdb)
localPackages =
localPackages
installedPackages =
rerunIfChanged verbosity fileMonitorSolverPlan
(solverSettings,
localPackages, localPackagesEnabledStanzas,
Expand All @@ -611,7 +615,7 @@ rebuildInstallPlan verbosity
notice verbosity "Resolving dependencies..."
planOrError <- foldProgress logMsg (pure . Left) (pure . Right) $
planPackages verbosity compiler platform solver solverSettings
installedPkgIndex sourcePkgDb pkgConfigDB
(installedPackages <> installedPkgIndex) sourcePkgDb pkgConfigDB
localPackages localPackagesEnabledStanzas
case planOrError of
Left msg -> do reportPlanningFailure projectConfig compiler platform localPackages
Expand Down Expand Up @@ -1037,7 +1041,6 @@ planPackages :: Verbosity
planPackages verbosity comp platform solver SolverSettings{..}
installedPkgIndex sourcePkgDb pkgConfigDB
localPackages pkgStanzasEnable =

resolveDependencies
platform (compilerInfo comp)
pkgConfigDB solver
Expand Down
1 change: 1 addition & 0 deletions cabal-install/tests/IntegrationTests2.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1729,6 +1729,7 @@ planProject testdir cliConfig = do
distDirLayout cabalDirLayout
projectConfig
localPackages
Nothing
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This tests the new behaviour or it was edded to make it compile?
Afaiu a test checking the env file expected content would be needed

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I agree adding a test would be good. This indeed just makes it compile.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

However -- a regression test against this behavior is not the test needed. The behavior was something complicated that was removed, its not just going to magically reappear. What we need are some standard integration tests for "cabal v2-install" at all.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah i was thinking in generating a env file with the version of this pr and test against a golden file (or regexp-like checks testing the relevant parts)
And well regression test goal is just that, ensure the behaviour, well, does not regress, magically or by accident 😄


return (projDetails,
elaboratedPlan,
Expand Down
13 changes: 13 additions & 0 deletions changelog.d/pr-8607
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
synopsis: No global packages auto written to env files, allow --force-reinstalls
packages: cabal-install
issues: #6165 #5559
prs: #8607
significance: significant

description: {

- When v2-install runs on a library, it does not pin global packages in the env file, only those directly necessary for the library.

-- Further, it now fails if there is a reinstall in the plan, and suggests the --force-reinstalls flag, which also now works, cleaning out previous entries from the env file for any target which is reinstalled.

}