Commit 0de4177c authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Start using new InstallPlan.Installed state

Change improvement and --dry-run phases to use Installed state rather
than the PreExisting state. This means that PreExisting is now only used
for installed packages from the global db, and never for installed
packages from the store.
parent 9d6205e6
......@@ -34,6 +34,7 @@ module Distribution.Client.InstallPlan (
configureInstallPlan,
remove,
preexisting,
installed,
lookup,
directDeps,
revDirectDeps,
......@@ -310,6 +311,25 @@ preexisting pkgid ipkg plan = plan'
$ planIndex plan
}
-- | Change a package in a 'Configured' state to an 'Installed' state.
--
-- To preserve invariants, the package must have all of its dependencies
-- already installed too (that is 'PreExisting' or 'Installed').
--
installed :: (IsUnit ipkg,
IsUnit srcpkg)
=> UnitId
-> GenericInstallPlan ipkg srcpkg
-> GenericInstallPlan ipkg srcpkg
installed pkgid plan =
case lookup plan pkgid of
Just (Configured srcpkg) ->
assert (all isInstalled (directDeps plan pkgid)) $
plan {
planIndex = Graph.insert (Installed srcpkg) (planIndex plan)
}
_ -> error "InstallPlan.installed: unexpected state"
-- | Lookup a package in the plan.
--
lookup :: (IsUnit ipkg, IsUnit srcpkg)
......
......@@ -363,25 +363,20 @@ improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan
-> BuildStatusMap
-> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus =
replaceWithPrePreExisting installPlan
[ (installedUnitId pkg, mipkg)
replaceWithInstalled installPlan
[ installedUnitId pkg
| InstallPlan.Configured pkg
<- InstallPlan.reverseTopologicalOrder installPlan
, let uid = installedUnitId pkg
Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus
, BuildStatusUpToDate (BuildResult { buildResultLibInfo = mipkg })
<- [pkgBuildStatus]
, case Map.lookup (installedUnitId pkg) pkgsBuildStatus of
Just BuildStatusUpToDate {} -> True
Just _ -> False
Nothing -> error "improveInstallPlanWithUpToDatePackages: impossible"
]
where
replaceWithPrePreExisting =
foldl' (\plan (uid, mipkg) ->
-- TODO: A grievous hack. Better to have a special type
-- of entry representing pre-existing executables.
let stub_ipkg = Installed.emptyInstalledPackageInfo {
Installed.installedUnitId = uid
}
ipkg = fromMaybe stub_ipkg mipkg
in InstallPlan.preexisting uid ipkg plan)
replaceWithInstalled :: ElaboratedInstallPlan -> [UnitId]
-> ElaboratedInstallPlan
replaceWithInstalled =
foldl' (flip InstallPlan.installed)
-----------------------------
......
......@@ -87,7 +87,6 @@ import Distribution.Solver.Types.SourcePackage
import Distribution.Package hiding
(InstalledPackageId, installedPackageId)
import Distribution.System
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
......@@ -610,7 +609,7 @@ rebuildInstallPlan verbosity
compiler progdb platform
storePackageDb
storeExeIndex <- getExecutableDBContents storeDirectory
let improvedPlan = improveInstallPlanWithPreExistingPackages
let improvedPlan = improveInstallPlanWithInstalledPackages
storePkgIndex
storeExeIndex
elaboratedPlan
......@@ -2696,19 +2695,19 @@ packageHashConfigInputs
-- | Given the 'InstalledPackageIndex' for a nix-style package store, and an
-- 'ElaboratedInstallPlan', replace configured source packages by pre-existing
-- installed packages whenever they exist.
-- 'ElaboratedInstallPlan', replace configured source packages by installed
-- packages from the store whenever they exist.
--
improveInstallPlanWithPreExistingPackages :: InstalledPackageIndex
-> Set ComponentId
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithPreExistingPackages installedPkgIndex installedExes installPlan =
replaceWithPreExisting installPlan
[ ipkg
improveInstallPlanWithInstalledPackages :: InstalledPackageIndex
-> Set ComponentId
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithInstalledPackages installedPkgIndex installedExes installPlan =
replaceWithInstalled installPlan
[ installedUnitId pkg
| InstallPlan.Configured pkg
<- InstallPlan.reverseTopologicalOrder installPlan
, ipkg <- maybeToList (canPackageBeImproved pkg) ]
, canPackageBeImproved pkg ]
where
--TODO: sanity checks:
-- * the installed package must have the expected deps etc
......@@ -2720,15 +2719,13 @@ improveInstallPlanWithPreExistingPackages installedPkgIndex installedExes instal
canPackageBeImproved pkg =
case PackageIndex.lookupUnitId
installedPkgIndex (installedUnitId pkg) of
Just x -> Just x
Just _ -> True
Nothing | SimpleUnitId cid <- installedUnitId pkg
, cid `Set.member` installedExes
-- Same hack as replacewithPrePreExisting
-> Just (Installed.emptyInstalledPackageInfo {
Installed.installedUnitId = installedUnitId pkg
})
| otherwise -> Nothing
replaceWithPreExisting =
foldl' (\plan ipkg -> InstallPlan.preexisting
(installedUnitId ipkg) ipkg plan)
-> True
| otherwise -> False
replaceWithInstalled :: ElaboratedInstallPlan -> [UnitId]
-> ElaboratedInstallPlan
replaceWithInstalled = foldl' (flip InstallPlan.installed)
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