Delete FakeMap

cabal-install/Distribution/Client/BuildReports/Storage.hs

@@ -132,15 +132,15 @@ fromPlanPackage :: Platform -> CompilerId
                 -> InstallPlan.PlanPackage
                 -> Maybe (BuildReport, Maybe Repo)
 fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
-  InstallPlan.Installed (ReadyPackage (ConfiguredPackage srcPkg flags _ deps))
+  InstallPlan.Installed (ReadyPackage (ConfiguredPackage _ srcPkg flags _ deps))
                          _ result
     -> Just $ ( BuildReport.new os arch comp
                                 (packageId srcPkg) flags
                                 (map packageId (CD.nonSetupDeps deps))
                                 (Right result)
               , extractRepo srcPkg)
 
-  InstallPlan.Failed (ConfiguredPackage srcPkg flags _ deps) result
+  InstallPlan.Failed (ConfiguredPackage _ srcPkg flags _ deps) result
     -> Just $ ( BuildReport.new os arch comp
                                 (packageId srcPkg) flags
                                 (map confSrcId (CD.nonSetupDeps deps))

cabal-install/Distribution/Client/Configure.hs

@@ -23,7 +23,7 @@ import Distribution.Client.Dependency.Types
          ( ConstraintSource(..)
          , LabeledPackageConstraint(..), showConstraintSource )
 import qualified Distribution.Client.InstallPlan as InstallPlan
-import Distribution.Client.InstallPlan (InstallPlan)
+import Distribution.Client.InstallPlan (SolverInstallPlan)
 import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
 import Distribution.Client.PackageIndex ( PackageIndex, elemByPackageName )
@@ -130,9 +130,11 @@ configure verbosity packageDBs repoCtxt comp platform conf
       setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
         Nothing configureCommand (const configFlags) extraArgs
 
-    Right installPlan -> case InstallPlan.ready installPlan of
+    Right installPlan0 ->
+     let installPlan = InstallPlan.configureInstallPlan installPlan0
+     in case InstallPlan.ready installPlan of
       [pkg@(ReadyPackage
-             (ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _)
+              (ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
                                  _ _ _))] -> do
         configurePackage verbosity
           platform (compilerInfo comp)
@@ -269,7 +271,7 @@ planLocalPackage :: Verbosity -> Compiler
                  -> InstalledPackageIndex
                  -> SourcePackageDb
                  -> PkgConfigDb
-                 -> IO (Progress String String InstallPlan)
+                 -> IO (Progress String String SolverInstallPlan)
 planLocalPackage verbosity comp platform configFlags configExFlags
   installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
   pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
@@ -344,7 +346,7 @@ configurePackage :: Verbosity
                  -> [String]
                  -> IO ()
 configurePackage verbosity platform comp scriptOptions configFlags
-                 (ReadyPackage (ConfiguredPackage spkg flags stanzas deps))
+                 (ReadyPackage (ConfiguredPackage ipid spkg flags stanzas deps))
                  extraArgs =
 
   setupWrapper verbosity
@@ -353,6 +355,7 @@ configurePackage verbosity platform comp scriptOptions configFlags
   where
     gpkg = packageDescription spkg
     configureFlags   = filterConfigureFlags configFlags {
+      configIPID = toFlag (display ipid),
       configConfigurationsFlags = flags,
       -- We generate the legacy constraints as well as the new style precise
       -- deps.  In the end only one set gets passed to Setup.hs configure,

cabal-install/Distribution/Client/Dependency.hs

@@ -68,11 +68,11 @@ import qualified Distribution.Client.PackageIndex as PackageIndex
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
 import qualified Distribution.Client.InstallPlan as InstallPlan
-import Distribution.Client.InstallPlan (InstallPlan)
+import Distribution.Client.InstallPlan (SolverInstallPlan)
 import Distribution.Client.PkgConfigDb (PkgConfigDb)
 import Distribution.Client.Types
          ( SourcePackageDb(SourcePackageDb), SourcePackage(..)
-         , ConfiguredPackage(..), ConfiguredId(..)
+         , SolverPackage(..), SolverId(..)
          , UnresolvedPkgLoc, UnresolvedSourcePackage
          , OptionalStanza(..), enableStanzas )
 import Distribution.Client.Dependency.Types
@@ -528,7 +528,7 @@ resolveDependencies :: Platform
                     -> PkgConfigDb
                     -> Solver
                     -> DepResolverParams
-                    -> Progress String String InstallPlan
+                    -> Progress String String SolverInstallPlan
 
     --TODO: is this needed here? see dontUpgradeNonUpgradeablePackages
 resolveDependencies platform comp _pkgConfigDB _solver params
@@ -621,7 +621,7 @@ validateSolverResult :: Platform
                      -> CompilerInfo
                      -> Bool
                      -> [ResolverPackage UnresolvedPkgLoc]
-                     -> InstallPlan
+                     -> SolverInstallPlan
 validateSolverResult platform comp indepGoals pkgs =
     case planPackagesProblems platform comp pkgs of
       [] -> case InstallPlan.new indepGoals index of
@@ -648,7 +648,7 @@ validateSolverResult platform comp indepGoals pkgs =
 
 
 data PlanPackageProblem =
-       InvalidConfiguredPackage (ConfiguredPackage UnresolvedPkgLoc) [PackageProblem]
+       InvalidConfiguredPackage (SolverPackage UnresolvedPkgLoc) [PackageProblem]
 
 showPlanPackageProblem :: PlanPackageProblem -> String
 showPlanPackageProblem (InvalidConfiguredPackage pkg packageProblems) =
@@ -707,9 +707,9 @@ showPackageProblem (InvalidDep dep pkgid) =
 -- dependencies are satisfied by the specified packages.
 --
 configuredPackageProblems :: Platform -> CompilerInfo
-                          -> ConfiguredPackage UnresolvedPkgLoc -> [PackageProblem]
+                          -> SolverPackage UnresolvedPkgLoc -> [PackageProblem]
 configuredPackageProblems platform cinfo
-  (ConfiguredPackage pkg specifiedFlags stanzas specifiedDeps') =
+  (SolverPackage pkg specifiedFlags stanzas specifiedDeps') =
      [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]
   ++ [ MissingFlag flag | OnlyInLeft  flag <- mergedFlags ]
   ++ [ ExtraFlag   flag | OnlyInRight flag <- mergedFlags ]
@@ -722,7 +722,7 @@ configuredPackageProblems platform cinfo
                             , not (packageSatisfiesDependency pkgid dep) ]
   where
     specifiedDeps :: ComponentDeps [PackageId]
-    specifiedDeps = fmap (map confSrcId) specifiedDeps'
+    specifiedDeps = fmap (map solverSrcId) specifiedDeps'
 
     mergedFlags = mergeBy compare
       (sort $ map PD.flagName (PD.genPackageFlags (packageDescription pkg)))

cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs

@@ -5,7 +5,7 @@ module Distribution.Client.Dependency.Modular.ConfiguredConversion
 import Data.Maybe
 import Prelude hiding (pi)
 
-import Distribution.Package (UnitId)
+import Distribution.Package (UnitId, packageId)
 
 import Distribution.Client.Types
 import Distribution.Client.Dependency.Types (ResolverPackage(..))
@@ -27,28 +27,25 @@ convCP iidx sidx (CP qpi fa es ds) =
   case convPI qpi of
     Left  pi -> PreExisting
                   (fromJust $ SI.lookupUnitId iidx pi)
-    Right pi -> Configured $ ConfiguredPackage
+    Right pi -> Configured $ SolverPackage
                   srcpkg
                   fa
                   es
                   ds'
       where
         Just srcpkg = CI.lookupPackageId sidx pi
   where
-    ds' :: ComponentDeps [ConfiguredId]
+    ds' :: ComponentDeps [SolverId]
     ds' = fmap (map convConfId) ds
 
 convPI :: PI QPN -> Either UnitId PackageId
 convPI (PI _ (I _ (Inst pi))) = Left pi
-convPI qpi                    = Right $ confSrcId $ convConfId qpi
+convPI pi                     = Right (packageId (convConfId pi))
 
-convConfId :: PI QPN -> ConfiguredId
-convConfId (PI (Q _ pn) (I v loc)) = ConfiguredId {
-      confSrcId  = sourceId
-    , confInstId = installedId
-    }
+convConfId :: PI QPN -> SolverId
+convConfId (PI (Q _ pn) (I v loc)) =
+    case loc of
+        Inst pi -> PreExistingId sourceId pi
+        _otherwise -> PlannedId sourceId
   where
     sourceId    = PackageIdentifier pn v
-    installedId = case loc of
-                    Inst pi    -> pi
-                    _otherwise -> fakeUnitId sourceId

cabal-install/Distribution/Client/Dependency/TopDown.hs

@@ -20,9 +20,9 @@ import qualified Distribution.Client.Dependency.TopDown.Constraints as Constrain
 import Distribution.Client.Dependency.TopDown.Constraints
          ( Satisfiable(..) )
 import Distribution.Client.Types
-         ( SourcePackage(..), ConfiguredPackage(..)
+         ( SourcePackage(..), SolverPackage(..)
          , UnresolvedPkgLoc, UnresolvedSourcePackage
-         , enableStanzas, ConfiguredId(..), fakeUnitId )
+         , enableStanzas, SolverId(..) )
 import Distribution.Client.Dependency.Types
          ( DependencyResolver, ResolverPackage(..)
          , PackageConstraint(..), unlabelPackageConstraint
@@ -612,44 +612,22 @@ finaliseSelectedPackages pref selected constraints =
 
     finaliseInstalled (InstalledPackageEx pkg _ _) = SelectedInstalled pkg
     finaliseSource mipkg (SemiConfiguredPackage pkg flags stanzas deps) =
-        SelectedSource (ConfiguredPackage pkg flags stanzas deps')
+        SelectedSource (SolverPackage pkg flags stanzas deps')
       where
         -- We cheat in the cabal solver, and classify all dependencies as
         -- library dependencies.
-        deps' :: ComponentDeps [ConfiguredId]
+        deps' :: ComponentDeps [SolverId]
         deps' = CD.fromLibraryDeps (unPackageName (packageName pkg))
                                    (map (confId . pickRemaining mipkg) deps)
 
     -- InstalledOrSource indicates that we either have a source package
     -- available, or an installed one, or both. In the case that we have both
     -- available, we don't yet know if we can pick the installed one (the
     -- dependencies may not match up, for instance); this is verified in
-    -- `improvePlan`.
-    --
-    -- This means that at this point we cannot construct a valid installed
-    -- package ID yet for the dependencies. We therefore have two options:
-    --
-    -- * We could leave the installed package ID undefined here, and have a
-    --   separate pass over the output of the top-down solver, fixing all
-    --   dependencies so that if we depend on an already installed package we
-    --   use the proper installed package ID.
-    --
-    -- * We can _always_ use fake installed IDs, irrespective of whether we the
-    --   dependency is on an already installed package or not. This is okay
-    --   because (i) the top-down solver does not (and never will) support
-    --   multiple package instances, and (ii) we initialize the FakeMap with
-    --   fake IDs for already installed packages.
-    --
-    -- For now we use the second option; if however we change the implementation
-    -- of these fake IDs so that we do away with the FakeMap and update a
-    -- package reverse dependencies as we execute the install plan and discover
-    -- real package IDs, then this is no longer possible and we have to
-    -- implement the first option (see also Note [FakeMap] in Cabal).
-    confId :: InstalledOrSource InstalledPackageEx UnconfiguredPackage -> ConfiguredId
-    confId pkg = ConfiguredId {
-        confSrcId  = packageId pkg
-      , confInstId = fakeUnitId (packageId pkg)
-      }
+    -- `improvePlan`.  So we just set everything to be a planned ID for
+    -- now.
+    confId :: InstalledOrSource InstalledPackageEx UnconfiguredPackage -> SolverId
+    confId pkg = PlannedId (packageId pkg)
 
     pickRemaining mipkg dep@(Dependency _name versionRange) =
           case PackageIndex.lookupDependency remainingChoices dep of

cabal-install/Distribution/Client/Dependency/TopDown/Types.hs

@@ -14,9 +14,8 @@
 module Distribution.Client.Dependency.TopDown.Types where
 
 import Distribution.Client.Types
-         ( ConfiguredPackage(..)
-         , UnresolvedPkgLoc, UnresolvedSourcePackage
-         , OptionalStanza, ConfiguredId(..) )
+         ( UnresolvedPkgLoc, UnresolvedSourcePackage
+         , OptionalStanza, SolverPackage(..), SolverId(..) )
 import Distribution.InstalledPackageInfo
          ( InstalledPackageInfo )
 import qualified Distribution.Client.ComponentDeps as CD
@@ -45,7 +44,7 @@ data InstalledOrSource installed source
 
 data FinalSelectedPackage
    = SelectedInstalled InstalledPackage
-   | SelectedSource    (ConfiguredPackage UnresolvedPkgLoc)
+   | SelectedSource    (SolverPackage UnresolvedPkgLoc)
 
 type TopologicalSortNumber = Int
 
@@ -68,6 +67,7 @@ data UnconfiguredPackage
        FlagAssignment
        [OptionalStanza]
 
+-- | This is a minor misnomer: it's more of a 'SemiSolverPackage'.
 data SemiConfiguredPackage
    = SemiConfiguredPackage
        UnresolvedSourcePackage           -- package info
@@ -132,8 +132,8 @@ class Package a => PackageSourceDeps a where
 instance PackageSourceDeps InstalledPackageEx where
   sourceDeps (InstalledPackageEx _ _ deps) = deps
 
-instance PackageSourceDeps (ConfiguredPackage loc) where
-  sourceDeps cpkg = map confSrcId $ CD.nonSetupDeps (confPkgDeps cpkg)
+instance PackageSourceDeps (SolverPackage loc) where
+  sourceDeps pkg = map solverSrcId $ CD.nonSetupDeps (solverPkgDeps pkg)
 
 instance PackageSourceDeps InstalledPackage where
   sourceDeps (InstalledPackage _ deps) = deps

cabal-install/Distribution/Client/Dependency/Types.hs

@@ -52,7 +52,7 @@ import Data.Monoid
 import Distribution.Client.PkgConfigDb
          ( PkgConfigDb )
 import Distribution.Client.Types
-         ( OptionalStanza(..), SourcePackage(..), ConfiguredPackage )
+         ( OptionalStanza(..), SourcePackage(..), SolverPackage )
 
 import qualified Distribution.Compat.ReadP as Parse
          ( pfail, munch1 )
@@ -129,7 +129,7 @@ type DependencyResolver loc = Platform
 -- This is like the 'InstallPlan.PlanPackage' but with fewer cases.
 --
 data ResolverPackage loc = PreExisting InstalledPackageInfo
-                         | Configured  (ConfiguredPackage loc)
+                         | Configured  (SolverPackage loc)
 
 -- | Per-package constraints. Package constraints must be respected by the
 -- solver. Multiple constraints for each package can be given, though obviously

cabal-install/Distribution/Client/Fetch.hs

@@ -138,7 +138,7 @@ planPackages verbosity comp platform fetchFlags
       -- The packages we want to fetch are those packages the 'InstallPlan'
       -- that are in the 'InstallPlan.Configured' state.
       return
-        [ confPkgSource cpkg
+        [ solverPkgSource cpkg
         | (InstallPlan.Configured cpkg)
             <- InstallPlan.toList installPlan ]
 

cabal-install/Distribution/Client/Freeze.hs

@@ -25,7 +25,7 @@ import Distribution.Client.Dependency.Types
 import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
 import Distribution.Client.InstallPlan
-         ( InstallPlan, PlanPackage )
+         ( SolverInstallPlan, SolverPlanPackage )
 import qualified Distribution.Client.InstallPlan as InstallPlan
 import Distribution.Client.PkgConfigDb
          ( PkgConfigDb, readPkgConfigDb )
@@ -39,7 +39,7 @@ import Distribution.Client.Sandbox.Types
          ( SandboxPackageInfo(..) )
 
 import Distribution.Package
-         ( Package, packageId, packageName, packageVersion )
+         ( Package, packageId, packageName, packageVersion, installedUnitId )
 import Distribution.Simple.Compiler
          ( Compiler, compilerInfo, PackageDBStack )
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
@@ -116,7 +116,7 @@ getFreezePkgs :: Verbosity
               -> Maybe SandboxPackageInfo
               -> GlobalFlags
               -> FreezeFlags
-              -> IO [PlanPackage]
+              -> IO [SolverPlanPackage]
 getFreezePkgs verbosity packageDBs repoCtxt comp platform conf mSandboxPkgInfo
       globalFlags freezeFlags = do
 
@@ -151,7 +151,7 @@ planPackages :: Verbosity
              -> SourcePackageDb
              -> PkgConfigDb
              -> [PackageSpecifier UnresolvedSourcePackage]
-             -> IO [PlanPackage]
+             -> IO [SolverPlanPackage]
 planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
              installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers = do
 
@@ -214,14 +214,17 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
 -- 2) not a dependency (directly or transitively) of the package we are
 --    freezing.  This is useful for removing previously installed packages
 --    which are no longer required from the install plan.
-pruneInstallPlan :: InstallPlan
+--
+-- Invariant: @pkgSpecifiers@ must refer to packages which are not
+-- 'PreExisting' in the 'SolverInstallPlan'.
+pruneInstallPlan :: SolverInstallPlan
                  -> [PackageSpecifier UnresolvedSourcePackage]
-                 -> [PlanPackage]
+                 -> [SolverPlanPackage]
 pruneInstallPlan installPlan pkgSpecifiers =
     removeSelf pkgIds $
-    InstallPlan.dependencyClosure installPlan (map fakeUnitId pkgIds)
+    InstallPlan.dependencyClosure installPlan (map installedUnitId pkgIds)
   where
-    pkgIds = [ packageId pkg
+    pkgIds = [ PlannedId (packageId pkg)
              | SpecificSourcePackage pkg <- pkgSpecifiers ]
     removeSelf [thisPkg] = filter (\pp -> packageId pp /= packageId thisPkg)
     removeSelf _  = error $ "internal error: 'pruneInstallPlan' given "