Commit caf691f8 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

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: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent f76e3cbe
......@@ -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)
......@@ -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)
......
......@@ -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
......
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
......@@ -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
......
......@@ -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
......@@ -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)
......@@ -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
......
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