Commit cfb124f5 authored by Edward Z. Yang's avatar Edward Z. Yang

Introduce SolverId/SolverInstallPlan as solver output.

Currently, dependency solving immediately produces an 'InstallPlan'
which is then consumed by cabal install, or elaborated into
an 'ElaboratedInstallPlan' for cabal new-build.  However, this
translation is awkward, because the dependency solver knows nothing
about 'UnitId's, yet an 'InstallPlan' must indexed by 'UnitId's.
So there's a bit of faffing around to generate a "fake" unit id
to satisfy the interface, and then eventually correct it to the
right one.

So this patch starts moving us in a better direction, by introducing
a 'SolverInstallPlan', 'SolverPackage' and 'SolverId', intended
to be generated by the solver.  Then 'configureInstallPlan' or
'elaborateInstallPlan' elaborate this representation into the
representation needed by the destination.

The next step will be to generate the 'UnitId' during
'configureInstallPlan', and then we can get rid of the fake map
(so only Solver data types generate a fake identity, which
is only temporary until we generate 'UnitId's.)
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 1b0080d0
......@@ -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
......
......@@ -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)))
......
......@@ -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,7 +27,7 @@ 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
......@@ -35,20 +35,17 @@ convCP iidx sidx (CP qpi 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
......@@ -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,11 +612,11 @@ 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)
......@@ -624,32 +624,10 @@ finaliseSelectedPackages pref selected constraints =
-- 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
......
......@@ -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
......
......@@ -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
......
......@@ -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 ]
......
......@@ -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 )
......@@ -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,9 +214,9 @@ 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
pruneInstallPlan :: SolverInstallPlan
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PlanPackage]
-> [SolverPlanPackage]
pruneInstallPlan installPlan pkgSpecifiers =
removeSelf pkgIds $
InstallPlan.dependencyClosure installPlan (map fakeUnitId pkgIds)
......
......@@ -79,7 +79,7 @@ import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.InstallPlan (SolverInstallPlan, InstallPlan)
import Distribution.Client.Setup
( GlobalFlags(..), RepoContext(..)
, ConfigFlags(..), configureCommand, filterConfigureFlags
......@@ -294,7 +294,7 @@ makeInstallContext verbosity
-- | Make an install plan given install context and install arguments.
makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext
-> IO (Progress String String InstallPlan)
-> IO (Progress String String SolverInstallPlan)
makeInstallPlan verbosity
(_, _, comp, platform, _, _, mSandboxPkgInfo,
_, configFlags, configExFlags, installFlags,
......@@ -306,17 +306,18 @@ makeInstallPlan verbosity
(compilerInfo comp)
notice verbosity "Resolving dependencies..."
return $ planPackages comp platform mSandboxPkgInfo solver
configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers
configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers
-- | Given an install plan, perform the actual installations.
processInstallPlan :: Verbosity -> InstallArgs -> InstallContext
-> InstallPlan
-> SolverInstallPlan
-> IO ()
processInstallPlan verbosity
args@(_,_, _, _, _, _, _, _, _, _, installFlags, _)
(installedPkgIndex, sourcePkgDb, _,
userTargets, pkgSpecifiers, _) installPlan = do
userTargets, pkgSpecifiers, _) installPlan0 = do
checkPrintPlan verbosity installedPkgIndex installPlan sourcePkgDb
installFlags pkgSpecifiers
......@@ -325,6 +326,7 @@ processInstallPlan verbosity
args installedPkgIndex installPlan
postInstallActions verbosity args userTargets installPlan'
where
installPlan = InstallPlan.configureInstallPlan installPlan0
dryRun = fromFlag (installDryRun installFlags)
nothingToInstall = null (InstallPlan.ready installPlan)
......@@ -343,7 +345,7 @@ planPackages :: Compiler
-> SourcePackageDb
-> PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> Progress String String InstallPlan
-> Progress String String SolverInstallPlan
planPackages comp platform mSandboxPkgInfo solver
configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers =
......@@ -429,8 +431,8 @@ planPackages comp platform mSandboxPkgInfo solver
-- | Remove the provided targets from the install plan.
pruneInstallPlan :: Package targetpkg
=> [PackageSpecifier targetpkg]
-> InstallPlan
-> Progress String String InstallPlan
-> SolverInstallPlan
-> Progress String String SolverInstallPlan
pruneInstallPlan pkgSpecifiers =
-- TODO: this is a general feature and should be moved to D.C.Dependency
-- Also, the InstallPlan.remove should return info more precise to the
......
......@@ -15,14 +15,17 @@
-----------------------------------------------------------------------------
module Distribution.Client.InstallPlan (
InstallPlan,
SolverInstallPlan,
GenericInstallPlan,
PlanPackage,
SolverPlanPackage,
GenericPlanPackage(..),
-- * Operations on 'InstallPlan's
new,
toList,
mapPreservingGraph,
configureInstallPlan,
ready,
processing,
......@@ -60,8 +63,9 @@ import Distribution.Package
, HasUnitId(..), UnitId(..) )
import Distribution.Client.Types
( BuildSuccess, BuildFailure
, PackageFixedDeps(..), ConfiguredPackage
, UnresolvedPkgLoc
, PackageFixedDeps(..)
, ConfiguredPackage(..), ConfiguredId(..)
, UnresolvedPkgLoc, SolverPackage(..)
, GenericReadyPackage(..), fakeUnitId )
import Distribution.Version
( Version )
......@@ -75,6 +79,8 @@ import Distribution.Client.PlanIndex
import qualified Distribution.Client.PlanIndex as PlanIndex
import Distribution.Text
( display )
-- TODO: Need this when we compute final UnitIds
-- import qualified Distribution.Simple.Configure as Configure
import Data.List
( foldl', intercalate )
......@@ -159,6 +165,10 @@ type PlanPackage = GenericPlanPackage
InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)
BuildSuccess BuildFailure
type SolverPlanPackage = GenericPlanPackage
InstalledPackageInfo (SolverPackage UnresolvedPkgLoc)
BuildSuccess BuildFailure
instance (Package ipkg, Package srcpkg) =>
Package (GenericPlanPackage ipkg srcpkg iresult ifailure) where
packageId (PreExisting ipkg) = packageId ipkg
......@@ -215,6 +225,45 @@ planPkgOf plan v =
Just pkg -> pkg
Nothing -> error "InstallPlan: internal error: planPkgOf lookup failed"
-- | 'GenericInstallPlan' that the solver produces. We'll "run this" in
-- order to compute the 'UnitId's for everything we want to build.
type SolverInstallPlan = GenericInstallPlan
InstalledPackageInfo (SolverPackage UnresolvedPkgLoc)
-- Technically, these are not used here, but
-- setting the type this way makes it easier
-- to run some operations.
BuildSuccess BuildFailure
-- | Conversion of 'SolverInstallPlan' to 'InstallPlan'.
-- Similar to 'elaboratedInstallPlan'
configureInstallPlan :: SolverInstallPlan -> InstallPlan
configureInstallPlan solverPlan =
flip mapPreservingGraph solverPlan $ \mapDep planpkg ->
case planpkg of
PreExisting pkg ->
PreExisting pkg
Configured pkg ->
Configured (configureSolverPackage mapDep pkg)
_ -> error "configureInstallPlan: unexpected package state"
where
configureSolverPackage :: (UnitId -> UnitId)
-> SolverPackage UnresolvedPkgLoc
-> ConfiguredPackage UnresolvedPkgLoc
configureSolverPackage mapDep spkg =
ConfiguredPackage {
confPkgSource = solverPkgSource spkg,
confPkgFlags = solverPkgFlags spkg,
confPkgStanzas = solverPkgStanzas spkg,
confPkgDeps = fmap (map (configureSolverId mapDep)) (solverPkgDeps spkg)
}
configureSolverId mapDep sid =
ConfiguredId {
confSrcId = packageId sid, -- accurate!
confInstId = mapDep (installedUnitId sid)
}
-- | 'GenericInstallPlan' specialised to most commonly used types.
type InstallPlan = GenericInstallPlan
......
......@@ -64,7 +64,7 @@ import Distribution.Client.Types hiding
(BuildResult,BuildSuccess(..), BuildFailure(..), DocsResult(..)
,TestsResult(..))
import Distribution.Client.InstallPlan
( GenericInstallPlan, InstallPlan, GenericPlanPackage )
( GenericInstallPlan, GenericPlanPackage, SolverInstallPlan )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Dependency
import Distribution.Client.Dependency.Types
......@@ -197,9 +197,6 @@ type ElaboratedPlanPackage
ElaboratedConfiguredPackage
BuildSuccess BuildFailure
type SolverInstallPlan
= InstallPlan --TODO: [code cleanup] redefine locally or move def to solver interface
--TODO: [code cleanup] decide if we really need this, there's not much in it, and in principle
-- even platform and compiler could be different if we're building things
-- like a server + client with ghc + ghcjs
......@@ -808,7 +805,7 @@ getPackageSourceHashes verbosity withRepoCtx installPlan = do
mloc <- checkFetched locm
return (pkg, locm, mloc)
| InstallPlan.Configured
(ConfiguredPackage pkg _ _ _) <- InstallPlan.toList installPlan ]
SolverPackage { solverPkgSource = pkg } <- InstallPlan.toList installPlan ]
let requireDownloading = [ (pkg, locm) | (pkg, locm, Nothing) <- pkgslocs ]
alreadyDownloaded = [ (pkg, loc) | (pkg, _, Just loc) <- pkgslocs ]
......@@ -1028,24 +1025,17 @@ elaborateInstallPlan platform compiler progdb
InstallPlan.Configured pkg ->
InstallPlan.Configured
(elaborateConfiguredPackage (fixupDependencies mapDep pkg))
(elaborateSolverPackage mapDep pkg)
_ -> error "elaborateInstallPlan: unexpected package state"
-- remap the installed package ids of the direct deps, since we're
-- changing the installed package ids of all the packages to use the
-- final nix-style hashed ids.
fixupDependencies mapDep
(ConfiguredPackage pkg flags stanzas deps) =
ConfiguredPackage pkg flags stanzas deps'
where
deps' = fmap (map (\d -> d { confInstId = mapDep (confInstId d) })) deps
elaborateConfiguredPackage :: ConfiguredPackage UnresolvedPkgLoc
-> ElaboratedConfiguredPackage
elaborateConfiguredPackage
pkg@(ConfiguredPackage (SourcePackage pkgid gdesc srcloc descOverride)
flags stanzas deps) =
elaborateSolverPackage :: (UnitId -> UnitId)
-> SolverPackage UnresolvedPkgLoc
-> ElaboratedConfiguredPackage
elaborateSolverPackage
mapDep
pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride)
flags stanzas deps0) =
elaboratedPackage
where
-- Knot tying: the final elaboratedPackage includes the
......@@ -1054,6 +1044,15 @@ elaborateInstallPlan platform compiler progdb
--
elaboratedPackage = ElaboratedConfiguredPackage {..}
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)
}
pkgInstalledId
| shouldBuildInplaceOnly pkg
= mkUnitId (display pkgid ++ "-inplace")
......@@ -1802,7 +1801,7 @@ rememberImplicitSetupDeps sourcePkgIndex plan =
Set.fromList
[ installedPackageId pkg
| InstallPlan.Configured
pkg@(ConfiguredPackage newpkg _ _ _) <- InstallPlan.toList plan
pkg@(SolverPackage newpkg _ _ _) <- InstallPlan.toList plan
-- has explicit setup deps now
, hasExplicitSetupDeps newpkg
-- but originally had no setup deps
......@@ -1823,7 +1822,7 @@ rememberImplicitSetupDeps sourcePkgIndex plan =
-- through the solver.
--
packageSetupScriptStylePostSolver :: Set InstalledPackageId
-> ConfiguredPackage loc
-> SolverPackage loc
-> PD.PackageDescription
-> SetupScriptStyle
packageSetupScriptStylePostSolver pkgsImplicitSetupDeps pkg pkgDescription =
......
......@@ -172,6 +172,58 @@ newtype GenericReadyPackage srcpkg = ReadyPackage srcpkg -- see 'ConfiguredPacka
type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc)
-- | A 'SolverPackage' is a package specified by the dependency solver.
-- It will get elaborated into a 'ConfiguredPackage' or even an
-- 'ElaboratedConfiguredPackage'.
--
-- NB: 'SolverPackage's are essentially always with 'UnresolvedPkgLoc',
-- but for symmetry we have the parameter. (Maybe it can be removed.)
--
data SolverPackage loc = SolverPackage {
solverPkgSource :: SourcePackage loc,
solverPkgFlags :: FlagAssignment,
solverPkgStanzas :: [OptionalStanza],
solverPkgDeps :: ComponentDeps [SolverId]
}
deriving (Eq, Show, Generic)
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 = fakeUnitId . packageId . solverPkgSource
instance PackageFixedDeps (SolverPackage loc) where
depends pkg = fmap (map installedUnitId) (solverPkgDeps pkg)
-- | The solver can produce references to existing packages or
-- packages we plan to install. Unlike 'ConfiguredId' we don't