Commit 49d69a90 authored by Edward Z. Yang's avatar Edward Z. Yang

Move SolverInstallPlan to its own module.

This is a preparatory commit for giving SolverInstallPlan
its own type.  We first start by moving the type synonyms
for SolverInstallPlan into their own module, and update
module references to point to them.

TODO: Maybe this module should go in the Solver hierarchy
rather than the client hierarchy?
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 457605cc
......@@ -20,7 +20,8 @@ module Distribution.Client.Configure (
import Distribution.Client.Dependency
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (SolverInstallPlan)
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.Setup
......@@ -135,7 +136,7 @@ configure verbosity packageDBs repoCtxt comp platform conf
Nothing configureCommand (const configFlags) extraArgs
Right installPlan0 ->
let installPlan = InstallPlan.configureInstallPlan installPlan0
let installPlan = SolverInstallPlan.configureInstallPlan installPlan0
in case InstallPlan.ready installPlan of
[pkg@(ReadyPackage
(ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
......
......@@ -71,7 +71,8 @@ import Distribution.Solver.Modular
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (SolverInstallPlan)
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.Types
( SourcePackageDb(SourcePackageDb)
, UnresolvedPkgLoc, UnresolvedSourcePackage
......@@ -718,7 +719,7 @@ validateSolverResult :: Platform
-> SolverInstallPlan
validateSolverResult platform comp indepGoals pkgs =
case planPackagesProblems platform comp pkgs of
[] -> case InstallPlan.new indepGoals index of
[] -> case SolverInstallPlan.new indepGoals index of
Right plan -> plan
Left problems -> error (formatPlanProblems problems)
problems -> error (formatPkgProblems problems)
......
......@@ -22,7 +22,7 @@ import Distribution.Client.Targets
import Distribution.Client.Dependency
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.InstallPlan
import Distribution.Client.SolverInstallPlan
( SolverInstallPlan, SolverPlanPackage )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Setup
......
......@@ -81,7 +81,9 @@ 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 (SolverInstallPlan, InstallPlan)
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import Distribution.Client.Setup
( GlobalFlags(..), RepoContext(..)
, ConfigFlags(..), configureCommand, filterConfigureFlags
......@@ -338,7 +340,7 @@ processInstallPlan verbosity
args installedPkgIndex installPlan
postInstallActions verbosity args userTargets installPlan'
where
installPlan = InstallPlan.configureInstallPlan installPlan0
installPlan = SolverInstallPlan.configureInstallPlan installPlan0
dryRun = fromFlag (installDryRun installFlags)
nothingToInstall = null (InstallPlan.ready installPlan)
......
......@@ -15,17 +15,14 @@
-----------------------------------------------------------------------------
module Distribution.Client.InstallPlan (
InstallPlan,
SolverInstallPlan,
GenericInstallPlan,
PlanPackage,
SolverPlanPackage,
GenericPlanPackage(..),
-- * Operations on 'InstallPlan's
new,
toList,
mapPreservingGraph,
configureInstallPlan,
ready,
processing,
......@@ -63,16 +60,13 @@ import Distribution.Package
, HasUnitId(..), UnitId(..) )
import Distribution.Client.Types
( BuildSuccess, BuildFailure
, ConfiguredPackage(..), ConfiguredId(..)
, ConfiguredPackage(..)
, UnresolvedPkgLoc
, GenericReadyPackage(..) )
import Distribution.Version
( Version )
import Distribution.Simple.PackageIndex
( PackageIndex )
import qualified Distribution.Simple.Configure as Configure
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.Simple.PackageIndex as PackageIndex
import qualified Distribution.Client.PlanIndex as PlanIndex
import Distribution.Text
......@@ -82,7 +76,6 @@ 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.SolverPackage
-- TODO: Need this when we compute final UnitIds
-- import qualified Distribution.Simple.Configure as Configure
......@@ -170,10 +163,6 @@ 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
......@@ -229,57 +218,6 @@ 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 {
confPkgId = SimpleUnitId
$ Configure.computeComponentId
Cabal.NoFlag
(packageId spkg)
(PD.CLibName (display (pkgName (packageId spkg))))
-- TODO: this is a hack that won't work for Backpack.
(map ((\(SimpleUnitId cid0) -> cid0) . confInstId)
(CD.libraryDeps deps))
(solverPkgFlags spkg),
confPkgSource = solverPkgSource spkg,
confPkgFlags = solverPkgFlags spkg,
confPkgStanzas = solverPkgStanzas spkg,
confPkgDeps = deps
}
where
deps = 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
InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)
......
......@@ -41,7 +41,9 @@ import Distribution.Client.Types
hiding ( BuildResult, BuildSuccess(..), BuildFailure(..)
, DocsResult(..), TestsResult(..) )
import Distribution.Client.InstallPlan
( GenericInstallPlan, SolverInstallPlan, GenericPlanPackage )
( GenericInstallPlan, GenericPlanPackage )
import Distribution.Client.SolverInstallPlan
( SolverInstallPlan )
import Distribution.Package
hiding (InstalledPackageId, installedPackageId)
......
module Distribution.Client.SolverInstallPlan(
SolverInstallPlan,
SolverPlanPackage,
configureInstallPlan,
new
) where
import Distribution.Solver.Types.SolverPackage
import Distribution.Client.Types
import qualified Distribution.Simple.Configure as Configure
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.Package
( PackageIdentifier(..), Package(..)
, HasUnitId(..), UnitId(..) )
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Text
( display )
import Distribution.Client.InstallPlan
-- | '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
type SolverPlanPackage = GenericPlanPackage
InstalledPackageInfo (SolverPackage UnresolvedPkgLoc)
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 {
confPkgId = SimpleUnitId
$ Configure.computeComponentId
Cabal.NoFlag
(packageId spkg)
(PD.CLibName (display (pkgName (packageId spkg))))
-- TODO: this is a hack that won't work for Backpack.
(map ((\(SimpleUnitId cid0) -> cid0) . confInstId)
(CD.libraryDeps deps))
(solverPkgFlags spkg),
confPkgSource = solverPkgSource spkg,
confPkgFlags = solverPkgFlags spkg,
confPkgStanzas = solverPkgStanzas spkg,
confPkgDeps = deps
}
where
deps = fmap (map (configureSolverId mapDep)) (solverPkgDeps spkg)
configureSolverId mapDep sid =
ConfiguredId {
confSrcId = packageId sid, -- accurate!
confInstId = mapDep (installedUnitId sid)
}
......@@ -249,6 +249,7 @@ executable cabal
Distribution.Client.Setup
Distribution.Client.SetupWrapper
Distribution.Client.SrcDist
Distribution.Client.SolverInstallPlan
Distribution.Client.Tar
Distribution.Client.Targets
Distribution.Client.Types
......
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