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.

cabal-install/Distribution/Client/InstallPlan.hs

@@ -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)

cabal-install/Distribution/Client/ProjectBuilding.hs

@@ -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)
 
 
 -----------------------------

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -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)