Delete unsafeInternalFakeUnitId and chase consequences.

The main point is solver packages don't HasUnitId; now that the
solver install plan is separate from install plan the knock-on
changes are quite localized and pleasing.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

cabal-install/Distribution/Client/InstallPlan.hs

@@ -63,6 +63,7 @@ import           Distribution.Solver.Types.ComponentDeps (ComponentDeps)
 import qualified Distribution.Solver.Types.ComponentDeps as CD
 import           Distribution.Solver.Types.PackageFixedDeps
 import           Distribution.Solver.Types.Settings
+import           Distribution.Solver.Types.SolverId
 
 -- TODO: Need this when we compute final UnitIds
 -- import qualified Distribution.Simple.Configure as Configure
@@ -567,7 +568,10 @@ reverseTopologicalOrder plan = Graph.revTopSort (planIndex plan)
 fromSolverInstallPlan ::
       (HasUnitId ipkg,   PackageFixedDeps ipkg,
        HasUnitId srcpkg, PackageFixedDeps srcpkg)
-    => ((UnitId -> UnitId) -> SolverInstallPlan.SolverPlanPackage -> GenericPlanPackage ipkg srcpkg iresult ifailure)
+    -- Maybe this should be a UnitId not ConfiguredId?
+    => (   (SolverId -> ConfiguredId)
+        -> SolverInstallPlan.SolverPlanPackage
+        -> GenericPlanPackage ipkg srcpkg iresult ifailure    )
     -> SolverInstallPlan
     -> GenericInstallPlan ipkg srcpkg iresult ifailure
 fromSolverInstallPlan f plan =
@@ -576,18 +580,30 @@ fromSolverInstallPlan f plan =
   where
     (_, pkgs') = foldl' f' (Map.empty, []) (SolverInstallPlan.reverseTopologicalOrder plan)
 
-    f' (ipkgidMap, pkgs) pkg = (ipkgidMap', pkg' : pkgs)
+    f' (pidMap, pkgs) pkg = (pidMap', pkg' : pkgs)
       where
-       pkg' = f (mapDep ipkgidMap) pkg
-
-       ipkgidMap'
-         | ipkgid /= ipkgid' = Map.insert ipkgid ipkgid' ipkgidMap
-         | otherwise         =                           ipkgidMap
+       pkg' = f (mapDep pidMap) pkg
+
+       pidMap'
+         = case sid of
+            PreExistingId _pid uid ->
+                assert (uid == uid') pidMap
+            PlannedId pid ->
+                Map.insert pid uid' pidMap
          where
-           ipkgid  = installedUnitId pkg
-           ipkgid' = installedUnitId pkg'
-
-    mapDep ipkgidMap ipkgid = Map.findWithDefault ipkgid ipkgid ipkgidMap
+           sid  = nodeKey pkg
+           uid' = nodeKey pkg'
+
+    mapDep _ (PreExistingId pid uid) = ConfiguredId pid uid
+    mapDep pidMap (PlannedId pid)
+        | Just uid <- Map.lookup pid pidMap
+        = ConfiguredId pid uid
+        -- This shouldn't happen, since mapDep should only be called
+        -- on neighbor SolverId, which must have all been done already
+        -- by the reverse top-sort (this also assumes that the graph
+        -- is not broken).
+        | otherwise
+        = error ("fromSolverInstallPlan mapDep: " ++ display pid)
 
 -- | Conversion of 'SolverInstallPlan' to 'InstallPlan'.
 -- Similar to 'elaboratedInstallPlan'
@@ -601,7 +617,7 @@ configureInstallPlan solverPlan =
         SolverInstallPlan.Configured  pkg ->
           Configured (configureSolverPackage mapDep pkg)
   where
-    configureSolverPackage :: (UnitId -> UnitId)
+    configureSolverPackage :: (SolverId -> ConfiguredId)
                            -> SolverPackage UnresolvedPkgLoc
                            -> ConfiguredPackage UnresolvedPkgLoc
     configureSolverPackage mapDep spkg =
@@ -621,10 +637,4 @@ configureInstallPlan solverPlan =
         confPkgDeps   = deps
       }
       where
-        deps = fmap (map (configureSolverId mapDep)) (solverPkgDeps spkg)
-
-    configureSolverId mapDep sid =
-      ConfiguredId {
-        confSrcId  = packageId sid, -- accurate!
-        confInstId = mapDep (installedUnitId sid)
-      }
+        deps = fmap (map mapDep) (solverPkgDeps spkg)

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -1027,7 +1027,7 @@ elaborateInstallPlan platform compiler compilerprogdb
             InstallPlan.Configured
               (elaborateSolverPackage mapDep pkg)
 
-    elaborateSolverPackage :: (UnitId -> UnitId)
+    elaborateSolverPackage :: (SolverId -> ConfiguredId)
                            -> SolverPackage UnresolvedPkgLoc
                            -> ElaboratedConfiguredPackage
     elaborateSolverPackage
@@ -1044,12 +1044,7 @@ elaborateInstallPlan platform compiler compilerprogdb
 
         deps = fmap (map elaborateSolverId) deps0
 
-        elaborateSolverId sid =
-            ConfiguredId {
-                confSrcId  = packageId sid,
-                -- Update the 'UnitId' to the final nix-style hashed ID
-                confInstId = mapDep (installedPackageId sid)
-            }
+        elaborateSolverId = mapDep
 
         pkgInstalledId
           | shouldBuildInplaceOnly pkg
@@ -1178,7 +1173,7 @@ elaborateInstallPlan platform compiler compilerprogdb
           -- use the ordinary default install dirs
           = (InstallDirs.absoluteInstallDirs
                pkgid
-               (installedUnitId pkg)
+               pkgInstalledId
                (compilerInfo compiler)
                InstallDirs.NoCopyDest
                platform
@@ -1248,14 +1243,14 @@ elaborateInstallPlan platform compiler compilerprogdb
     -- dir (as opposed to a tarball), or depends on such a package, will be
     -- built inplace into a shared dist dir. Tarball packages that depend on
     -- source dir packages will also get unpacked locally.
-    shouldBuildInplaceOnly :: HasUnitId pkg => pkg -> Bool
-    shouldBuildInplaceOnly pkg = Set.member (installedPackageId pkg)
+    shouldBuildInplaceOnly :: SolverPackage loc -> Bool
+    shouldBuildInplaceOnly pkg = Set.member (packageId pkg)
                                             pkgsToBuildInplaceOnly
 
-    pkgsToBuildInplaceOnly :: Set InstalledPackageId
+    pkgsToBuildInplaceOnly :: Set PackageId
     pkgsToBuildInplaceOnly =
         Set.fromList
-      $ map installedPackageId
+      $ map packageId
       $ SolverInstallPlan.reverseDependencyClosure
           solverPlan
           [ PlannedId (packageId pkg)

cabal-install/Distribution/Client/SolverInstallPlan.hs

@@ -61,7 +61,6 @@ import Distribution.Client.Types
 import Distribution.Version
          ( Version )
 
-import           Distribution.Solver.Types.PackageFixedDeps
 import           Distribution.Solver.Types.Settings
 import           Distribution.Solver.Types.ResolverPackage
 import           Distribution.Solver.Types.SolverId
@@ -121,17 +120,15 @@ instance Binary SolverInstallPlan where
 showPlanIndex :: SolverPlanIndex -> String
 showPlanIndex index =
     intercalate "\n" (map showPlanPackage (Graph.toList index))
-  where showPlanPackage p =
-            showPlanPackageTag p ++ " "
-                ++ display (packageId p) ++ " ("
-                ++ display (installedUnitId p) ++ ")"
 
 showInstallPlan :: SolverInstallPlan -> String
 showInstallPlan = showPlanIndex . planIndex
 
-showPlanPackageTag :: SolverPlanPackage -> String
-showPlanPackageTag (PreExisting _ _) = "PreExisting"
-showPlanPackageTag (Configured  _)   = "Configured"
+showPlanPackage :: SolverPlanPackage -> String
+showPlanPackage (PreExisting ipkg _) = "PreExisting " ++ display (packageId ipkg)
+                                            ++ " (" ++ display (installedUnitId ipkg)
+                                            ++ ")"
+showPlanPackage (Configured  spkg)   = "Configured " ++ display (packageId spkg)
 
 -- | Build an installation plan from a valid set of resolved packages.
 --
@@ -336,10 +333,10 @@ dependencyInconsistencies' index =
     reallyIsInconsistent []       = False
     reallyIsInconsistent [_p]     = False
     reallyIsInconsistent [p1, p2] =
-      let pid1 = installedUnitId p1
-          pid2 = installedUnitId p2
-      in pid1 `notElem` CD.nonSetupDeps (depends p2)
-      && pid2 `notElem` CD.nonSetupDeps (depends p1)
+      let pid1 = nodeKey p1
+          pid2 = nodeKey p2
+      in pid1 `notElem` CD.nonSetupDeps (resolverPackageDeps p2)
+      && pid2 `notElem` CD.nonSetupDeps (resolverPackageDeps p1)
     reallyIsInconsistent _ = True
 
 

cabal-install/Distribution/Solver/Types/Internal/Utils.hs

-module Distribution.Solver.Types.Internal.Utils
-    ( unsafeInternalFakeUnitId
-    ) where
-
-import Distribution.Package (PackageId, UnitId, mkUnitId)
-import Distribution.Text (display)
-
--- | In order to reuse the implementation of PackageIndex which relies
--- on 'UnitId' for 'SolverInstallPlan', we need to be able to synthesize
--- these IDs prior to installation.   These should never be written out!
--- Additionally, they need to be guaranteed unique within the install
--- plan; this holds because an install plan only ever contains one
--- instance of a particular package and version.  (To fix this,
--- the IDs not only have to identify a package ID, but also the
--- transitive requirementso n it.)
-unsafeInternalFakeUnitId :: PackageId -> UnitId
-unsafeInternalFakeUnitId = mkUnitId . (".fake."++) . display
-

cabal-install/Distribution/Solver/Types/ResolverPackage.hs

@@ -7,7 +7,6 @@ module Distribution.Solver.Types.ResolverPackage
 
 import Distribution.Solver.Types.SolverId
 import Distribution.Solver.Types.SolverPackage
-import Distribution.Solver.Types.PackageFixedDeps
 import qualified Distribution.Solver.Types.ComponentDeps as CD
 
 import Distribution.Compat.Binary (Binary(..))
@@ -31,14 +30,6 @@ instance Package (ResolverPackage loc) where
   packageId (PreExisting ipkg _)   = packageId ipkg
   packageId (Configured  spkg)     = packageId spkg
 
-instance PackageFixedDeps (ResolverPackage loc) where
-  depends (PreExisting pkg _)   = depends pkg
-  depends (Configured  pkg)     = depends pkg
-
-instance HasUnitId (ResolverPackage loc) where
-  installedUnitId (PreExisting ipkg _) = installedUnitId ipkg
-  installedUnitId (Configured  spkg)  = installedUnitId spkg
-
 resolverPackageDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId]
 resolverPackageDeps (PreExisting _ deps) = deps
 resolverPackageDeps (Configured spkg) = solverPkgDeps spkg

cabal-install/Distribution/Solver/Types/SolverId.hs

@@ -6,8 +6,7 @@ module Distribution.Solver.Types.SolverId
 where
 
 import Distribution.Compat.Binary (Binary(..))
-import Distribution.Package (PackageId, Package(..), UnitId(..), HasUnitId(..))
-import Distribution.Solver.Types.Internal.Utils (unsafeInternalFakeUnitId)
+import Distribution.Package (PackageId, Package(..), UnitId(..))
 import GHC.Generics (Generic)
 
 -- | The solver can produce references to existing packages or
@@ -26,7 +25,3 @@ instance Show SolverId where
 
 instance Package SolverId where
   packageId = solverSrcId
-
-instance HasUnitId SolverId where
-  installedUnitId (PreExistingId _ instId) = instId
-  installedUnitId (PlannedId pid) = unsafeInternalFakeUnitId pid

cabal-install/Distribution/Solver/Types/SolverPackage.hs

@@ -4,12 +4,10 @@ module Distribution.Solver.Types.SolverPackage
     ) where
 
 import Distribution.Compat.Binary (Binary(..))
-import Distribution.Package ( Package(..), HasUnitId(..) )
+import Distribution.Package ( Package(..) )
 import Distribution.PackageDescription ( FlagAssignment )
 import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
-import Distribution.Solver.Types.Internal.Utils ( unsafeInternalFakeUnitId )
 import Distribution.Solver.Types.OptionalStanza
-import Distribution.Solver.Types.PackageFixedDeps
 import Distribution.Solver.Types.SolverId
 import Distribution.Solver.Types.SourcePackage
 import GHC.Generics (Generic)
@@ -33,14 +31,3 @@ instance Binary loc => Binary (SolverPackage loc)
 
 instance Package (SolverPackage loc) where
   packageId = packageId . solverPkgSource
-
--- | This is a minor hack as 'PackageIndex' assumes keys are
--- 'UnitId's but prior to computing 'UnitId's (i.e., immediately
--- after running the solver, we don't have this information.)
--- But this is strictly temporary: once we convert to a
--- 'ConfiguredPackage' we'll record 'UnitId's for everything.
-instance HasUnitId (SolverPackage loc) where
-  installedUnitId = unsafeInternalFakeUnitId . packageId . solverPkgSource
-
-instance PackageFixedDeps (SolverPackage loc) where
-  depends pkg = fmap (map installedUnitId) (solverPkgDeps pkg)

cabal-install/cabal-install.cabal

@@ -266,7 +266,6 @@ executable cabal
         Distribution.Solver.Types.ComponentDeps
         Distribution.Solver.Types.ConstraintSource
         Distribution.Solver.Types.DependencyResolver
-        Distribution.Solver.Types.Internal.Utils
         Distribution.Solver.Types.InstalledPreference
         Distribution.Solver.Types.LabeledPackageConstraint
         Distribution.Solver.Types.OptionalStanza