Copyright | (c) Duncan Coutts 2008 |
---|---|
License | BSD-like |
Maintainer | [email protected] |
Stability | provisional |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Distribution.Client.InstallPlan
Description
Package installation plan
Synopsis
- type InstallPlan = GenericInstallPlan InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)
- data GenericInstallPlan ipkg srcpkg
- type PlanPackage = GenericPlanPackage InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)
- data GenericPlanPackage ipkg srcpkg
- = PreExisting ipkg
- | Configured srcpkg
- | Installed srcpkg
- foldPlanPackage :: (ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
- type IsUnit a = (IsNode a, Key a ~ UnitId)
- new :: (IsUnit ipkg, IsUnit srcpkg) => IndependentGoals -> Graph (GenericPlanPackage ipkg srcpkg) -> GenericInstallPlan ipkg srcpkg
- toGraph :: GenericInstallPlan ipkg srcpkg -> Graph (GenericPlanPackage ipkg srcpkg)
- toList :: GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
- toMap :: GenericInstallPlan ipkg srcpkg -> Map UnitId (GenericPlanPackage ipkg srcpkg)
- keys :: GenericInstallPlan ipkg srcpkg -> [UnitId]
- keysSet :: GenericInstallPlan ipkg srcpkg -> Set UnitId
- planIndepGoals :: GenericInstallPlan ipkg srcpkg -> IndependentGoals
- depends :: IsUnit a => a -> [UnitId]
- fromSolverInstallPlan :: (IsUnit ipkg, IsUnit srcpkg) => ((SolverId -> [GenericPlanPackage ipkg srcpkg]) -> SolverPlanPackage -> [GenericPlanPackage ipkg srcpkg]) -> SolverInstallPlan -> GenericInstallPlan ipkg srcpkg
- fromSolverInstallPlanWithProgress :: (IsUnit ipkg, IsUnit srcpkg) => ((SolverId -> [GenericPlanPackage ipkg srcpkg]) -> SolverPlanPackage -> LogProgress [GenericPlanPackage ipkg srcpkg]) -> SolverInstallPlan -> LogProgress (GenericInstallPlan ipkg srcpkg)
- configureInstallPlan :: ConfigFlags -> SolverInstallPlan -> InstallPlan
- remove :: (IsUnit ipkg, IsUnit srcpkg) => (GenericPlanPackage ipkg srcpkg -> Bool) -> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg
- installed :: (IsUnit ipkg, IsUnit srcpkg) => (srcpkg -> Bool) -> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg
- lookup :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg)
- directDeps :: GenericInstallPlan ipkg srcpkg -> UnitId -> [GenericPlanPackage ipkg srcpkg]
- revDirectDeps :: GenericInstallPlan ipkg srcpkg -> UnitId -> [GenericPlanPackage ipkg srcpkg]
- executionOrder :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> [GenericReadyPackage srcpkg]
- execute :: forall m ipkg srcpkg result failure. (IsUnit ipkg, IsUnit srcpkg, Monad m) => JobControl m (UnitId, Either failure result) -> Bool -> (srcpkg -> failure) -> GenericInstallPlan ipkg srcpkg -> (GenericReadyPackage srcpkg -> m (Either failure result)) -> m (BuildOutcomes failure result)
- type BuildOutcomes failure result = Map UnitId (Either failure result)
- lookupBuildOutcome :: HasUnitId pkg => pkg -> BuildOutcomes failure result -> Maybe (Either failure result)
- data Processing
- ready :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> ([GenericReadyPackage srcpkg], Processing)
- completed :: forall ipkg srcpkg. (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([GenericReadyPackage srcpkg], Processing)
- failed :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([srcpkg], Processing)
- showPlanGraph :: [ShowPlanNode] -> String
- data ShowPlanNode = ShowPlanNode {
- showPlanHerald :: Doc
- showPlanNeighbours :: [Doc]
- showInstallPlan :: forall ipkg srcpkg. (Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> String
- showInstallPlan_gen :: forall ipkg srcpkg. (GenericPlanPackage ipkg srcpkg -> ShowPlanNode) -> GenericInstallPlan ipkg srcpkg -> String
- showPlanPackageTag :: GenericPlanPackage ipkg srcpkg -> String
- dependencyClosure :: GenericInstallPlan ipkg srcpkg -> [UnitId] -> [GenericPlanPackage ipkg srcpkg]
- reverseTopologicalOrder :: GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
- reverseDependencyClosure :: GenericInstallPlan ipkg srcpkg -> [UnitId] -> [GenericPlanPackage ipkg srcpkg]
Documentation
type InstallPlan = GenericInstallPlan InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc) Source #
GenericInstallPlan
specialised to most commonly used types.
data GenericInstallPlan ipkg srcpkg Source #
Instances
(Structured ipkg, Structured srcpkg) => Structured (GenericInstallPlan ipkg srcpkg) Source # | |
Defined in Distribution.Client.InstallPlan Methods structure :: Proxy (GenericInstallPlan ipkg srcpkg) -> Structure # structureHash' :: Tagged (GenericInstallPlan ipkg srcpkg) MD5 | |
(IsNode ipkg, Key ipkg ~ UnitId, IsNode srcpkg, Key srcpkg ~ UnitId, Binary ipkg, Binary srcpkg) => Binary (GenericInstallPlan ipkg srcpkg) Source # | |
Defined in Distribution.Client.InstallPlan Methods put :: GenericInstallPlan ipkg srcpkg -> Put # get :: Get (GenericInstallPlan ipkg srcpkg) # putList :: [GenericInstallPlan ipkg srcpkg] -> Put # |
type PlanPackage = GenericPlanPackage InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc) Source #
data GenericPlanPackage ipkg srcpkg Source #
Packages in an install plan
NOTE: ConfiguredPackage
, GenericReadyPackage
and GenericPlanPackage
intentionally have no PackageInstalled
instance. `This is important:
PackageInstalled returns only library dependencies, but for package that
aren't yet installed we know many more kinds of dependencies (setup
dependencies, exe, test-suite, benchmark, ..). Any functions that operate on
dependencies in cabal-install should consider what to do with these
dependencies; if we give a PackageInstalled
instance it would be too easy
to get this wrong (and, for instance, call graph traversal functions from
Cabal rather than from cabal-install). Instead, see PackageInstalled
.
Constructors
PreExisting ipkg | |
Configured srcpkg | |
Installed srcpkg |
Instances
foldPlanPackage :: (ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a Source #
Convenience combinator for destructing GenericPlanPackage
.
This is handy because if you case manually, you have to handle
Configured
and Installed
separately (where often you want
them to be the same.)
Operations on InstallPlan
s
new :: (IsUnit ipkg, IsUnit srcpkg) => IndependentGoals -> Graph (GenericPlanPackage ipkg srcpkg) -> GenericInstallPlan ipkg srcpkg Source #
Build an installation plan from a valid set of resolved packages.
toGraph :: GenericInstallPlan ipkg srcpkg -> Graph (GenericPlanPackage ipkg srcpkg) Source #
toList :: GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg] Source #
toMap :: GenericInstallPlan ipkg srcpkg -> Map UnitId (GenericPlanPackage ipkg srcpkg) Source #
keys :: GenericInstallPlan ipkg srcpkg -> [UnitId] Source #
planIndepGoals :: GenericInstallPlan ipkg srcpkg -> IndependentGoals Source #
fromSolverInstallPlan :: (IsUnit ipkg, IsUnit srcpkg) => ((SolverId -> [GenericPlanPackage ipkg srcpkg]) -> SolverPlanPackage -> [GenericPlanPackage ipkg srcpkg]) -> SolverInstallPlan -> GenericInstallPlan ipkg srcpkg Source #
fromSolverInstallPlanWithProgress :: (IsUnit ipkg, IsUnit srcpkg) => ((SolverId -> [GenericPlanPackage ipkg srcpkg]) -> SolverPlanPackage -> LogProgress [GenericPlanPackage ipkg srcpkg]) -> SolverInstallPlan -> LogProgress (GenericInstallPlan ipkg srcpkg) Source #
configureInstallPlan :: ConfigFlags -> SolverInstallPlan -> InstallPlan Source #
Conversion of SolverInstallPlan
to InstallPlan
.
Similar to elaboratedInstallPlan
remove :: (IsUnit ipkg, IsUnit srcpkg) => (GenericPlanPackage ipkg srcpkg -> Bool) -> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg Source #
Remove packages from the install plan. This will result in an error if there are remaining packages that depend on any matching package. This is primarily useful for obtaining an install plan for the dependencies of a package or set of packages without actually installing the package itself, as when doing development.
installed :: (IsUnit ipkg, IsUnit srcpkg) => (srcpkg -> Bool) -> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg Source #
Change a number of packages in the Configured
state to the Installed
state.
To preserve invariants, the package must have all of its dependencies
already installed too (that is PreExisting
or Installed
).
lookup :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg) Source #
Lookup a package in the plan.
directDeps :: GenericInstallPlan ipkg srcpkg -> UnitId -> [GenericPlanPackage ipkg srcpkg] Source #
Find all the direct dependencies of the given package.
Note that the package must exist in the plan or it is an error.
revDirectDeps :: GenericInstallPlan ipkg srcpkg -> UnitId -> [GenericPlanPackage ipkg srcpkg] Source #
Find all the direct reverse dependencies of the given package.
Note that the package must exist in the plan or it is an error.
Traversal
executionOrder :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> [GenericReadyPackage srcpkg] Source #
Flatten an InstallPlan
, producing the sequence of source packages in
the order in which they would be processed when the plan is executed. This
can be used for simulations or presenting execution dry-runs.
It is guaranteed to give the same order as using execute
(with a serial
in-order JobControl
), which is a reverse topological orderings of the
source packages in the dependency graph, albeit not necessarily exactly the
same ordering as that produced by reverseTopologicalOrder
.
Arguments
:: forall m ipkg srcpkg result failure. (IsUnit ipkg, IsUnit srcpkg, Monad m) | |
=> JobControl m (UnitId, Either failure result) | |
-> Bool | Keep going after failure |
-> (srcpkg -> failure) | Value for dependents of failed packages |
-> GenericInstallPlan ipkg srcpkg | |
-> (GenericReadyPackage srcpkg -> m (Either failure result)) | |
-> m (BuildOutcomes failure result) |
Execute an install plan. This traverses the plan in dependency order.
Executing each individual package can fail and if so all dependents fail
too. The result for each package is collected as a BuildOutcomes
map.
Visiting each package happens with optional parallelism, as determined by
the JobControl
. By default, after any failure we stop as soon as possible
(using the JobControl
to try to cancel in-progress tasks). This behaviour
can be reversed to keep going and build as many packages as possible.
Note that the BuildOutcomes
is not guaranteed to cover all the packages
in the plan. In particular in the default mode where we stop as soon as
possible after a failure then there may be packages which are skipped and
these will have no BuildOutcome
.
type BuildOutcomes failure result = Map UnitId (Either failure result) Source #
The set of results we get from executing an install plan.
lookupBuildOutcome :: HasUnitId pkg => pkg -> BuildOutcomes failure result -> Maybe (Either failure result) Source #
Lookup the build result for a single package.
Traversal helpers
Algorithms to traverse or execute an InstallPlan
, especially in parallel,
may make use of the Processing
type and the associated operations
ready
, completed
and failed
.
The Processing
type is used to keep track of the state of a traversal and
includes the set of packages that are in the processing state, e.g. in the
process of being installed, plus those that have been completed and those
where processing failed.
Traversal algorithms start with an InstallPlan
:
- Initially there will be certain packages that can be processed immediately
(since they are configured source packages and have all their dependencies
installed already). The function
ready
returns these packages plus aProcessing
state that marks these same packages as being in the processing state. - The algorithm must now arrange for these packages to be processed
(possibly in parallel). When a package has completed processing, the
algorithm needs to know which other packages (if any) are now ready to
process as a result. The
completed
function marks a package as completed and returns any packages that are newly in the processing state (ie ready to process), along with the updatedProcessing
state. - If failure is possible then when processing a package fails, the algorithm
needs to know which other packages have also failed as a result. The
failed
function marks the given package as failed as well as all the other packages that depend on the failed package. In addition it returns the other failed packages.
data Processing Source #
The Processing
type is used to keep track of the state of a traversal
and includes the set of packages that are in the processing state, e.g. in
the process of being installed, plus those that have been completed and
those where processing failed.
ready :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> ([GenericReadyPackage srcpkg], Processing) Source #
The packages in the plan that are initially ready to be installed. That is they are in the configured state and have all their dependencies installed already.
The result is both the packages that are now ready to be installed and also
a Processing
state containing those same packages. The assumption is that
all the packages that are ready will now be processed and so we can consider
them to be in the processing state.
completed :: forall ipkg srcpkg. (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([GenericReadyPackage srcpkg], Processing) Source #
Given a package in the processing state, mark the package as completed
and return any packages that are newly in the processing state (ie ready to
process), along with the updated Processing
state.
failed :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([srcpkg], Processing) Source #
Display
showPlanGraph :: [ShowPlanNode] -> String Source #
data ShowPlanNode Source #
Constructors
ShowPlanNode | |
Fields
|
showInstallPlan :: forall ipkg srcpkg. (Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> String Source #
showInstallPlan_gen :: forall ipkg srcpkg. (GenericPlanPackage ipkg srcpkg -> ShowPlanNode) -> GenericInstallPlan ipkg srcpkg -> String Source #
Generic way to show a GenericInstallPlan
which elicits quite a lot of information
showPlanPackageTag :: GenericPlanPackage ipkg srcpkg -> String Source #
Graph-like operations
dependencyClosure :: GenericInstallPlan ipkg srcpkg -> [UnitId] -> [GenericPlanPackage ipkg srcpkg] Source #
Return the packages in the plan that are direct or indirect dependencies of the given packages.
reverseTopologicalOrder :: GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg] Source #
Return all the packages in the InstallPlan
in reverse topological order.
That is, for each package, all dependencies of the package appear first.
Compared to executionOrder
, this function returns all the installed and
source packages rather than just the source ones. Also, while both this
and executionOrder
produce reverse topological orderings of the package
dependency graph, it is not necessarily exactly the same order.
reverseDependencyClosure :: GenericInstallPlan ipkg srcpkg -> [UnitId] -> [GenericPlanPackage ipkg srcpkg] Source #
Return the packages in the plan that depend directly or indirectly on the given packages.