Commit 713af703 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Remove a number of now-unused InstallPlan operations

These were the primitives used by executeInstallPlan to change the
package states to Processing, Installed, Failed etc.

The 'ready' is still used in a couple other places, so those need to be
modified before the old 'ready' can be removed.
parent 448714b8
......@@ -30,12 +30,8 @@ module Distribution.Client.InstallPlan (
configureInstallPlan,
ready,
processing,
completed,
failed,
remove,
preexisting,
preinstalled,
-- * Traversal
executionOrder,
......@@ -357,105 +353,6 @@ lookupReadyPackage plan pkg = do
++ " depends on a non-library package "
++ display dep
-- | Marks packages in the graph as currently processing (e.g. building).
--
-- * The package must exist in the graph and be in the configured state.
--
processing :: forall ipkg srcpkg iresult ifailure.
(HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> [GenericReadyPackage srcpkg]
-> GenericInstallPlan ipkg srcpkg iresult ifailure
-> GenericInstallPlan ipkg srcpkg iresult ifailure
processing pkgs plan = assert (invariant plan') plan'
where
plan' = plan {
planIndex = Graph.unionRight (planIndex plan) processingPkgs
}
processingPkgs :: PlanIndex ipkg srcpkg iresult ifailure
processingPkgs = Graph.fromList [Processing pkg | pkg <- pkgs]
-- | Marks a package in the graph as completed. Also saves the build result for
-- the completed package in the plan.
--
-- * The package must exist in the graph and be in the processing state.
-- * The package must have had no uninstalled dependent packages.
--
completed :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> UnitId
-> Maybe ipkg -> iresult
-> GenericInstallPlan ipkg srcpkg iresult ifailure
-> GenericInstallPlan ipkg srcpkg iresult ifailure
completed pkgid mipkg buildResult plan = assert (invariant plan') plan'
where
plan' = plan {
planIndex = Graph.insert installed
. Graph.deleteKey pkgid
$ planIndex plan
}
installed = Installed (lookupProcessingPackage plan pkgid) mipkg buildResult
-- | Marks a package in the graph as having failed. It also marks all the
-- packages that depended on it as having failed.
--
-- * The package must exist in the graph and be in the processing
-- state.
--
failed :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> UnitId -- ^ The id of the package that failed to install
-> ifailure -- ^ The build result to use for the failed package
-> ifailure -- ^ The build result to use for its dependencies
-> GenericInstallPlan ipkg srcpkg iresult ifailure
-> GenericInstallPlan ipkg srcpkg iresult ifailure
failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
where
-- NB: failures don't update IPIDs
plan' = plan {
planIndex = Graph.unionRight (planIndex plan) failures
}
ReadyPackage srcpkg = lookupProcessingPackage plan pkgid
failures = Graph.fromList
$ Failed srcpkg buildResult
: [ Failed pkg' buildResult'
| Just pkg' <- map checkConfiguredPackage
$ packagesThatDependOn plan pkgid ]
-- | Lookup the reachable packages in the reverse dependency graph.
-- Does NOT include the package for @pkgid@!
--
packagesThatDependOn :: (HasUnitId ipkg, HasUnitId srcpkg)
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> UnitId
-> [GenericPlanPackage ipkg srcpkg iresult ifailure]
packagesThatDependOn plan pkgid = filter ((/= pkgid) . installedUnitId)
$ case Graph.revClosure (planIndex plan) [pkgid] of
Nothing -> []
Just r -> r
-- | Lookup a package that we expect to be in the processing state.
--
lookupProcessingPackage :: (PackageFixedDeps ipkg, PackageFixedDeps srcpkg,
HasUnitId ipkg, HasUnitId srcpkg)
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> UnitId
-> GenericReadyPackage srcpkg
lookupProcessingPackage plan pkgid =
case Graph.lookup pkgid (planIndex plan) of
Just (Processing pkg) -> pkg
_ -> internalError $ "not in processing state or no such pkg " ++
display pkgid
-- | Check a package that we expect to be in the configured or failed state.
--
checkConfiguredPackage :: (Package srcpkg, Package ipkg)
=> GenericPlanPackage ipkg srcpkg iresult ifailure
-> Maybe srcpkg
checkConfiguredPackage (Configured pkg) = Just pkg
checkConfiguredPackage (Failed _ _) = Nothing
checkConfiguredPackage pkg =
internalError $ "not configured or no such pkg " ++ display (packageId pkg)
-- | Replace a ready package with a pre-existing one. The pre-existing one
-- must have exactly the same dependencies as the source one was configured
......@@ -477,24 +374,6 @@ preexisting pkgid ipkg plan = assert (invariant plan') plan'
$ planIndex plan
}
-- | Replace a ready package with an installed one. The installed one
-- must have exactly the same dependencies as the source one was configured
-- with.
--
preinstalled :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> UnitId
-> Maybe ipkg -> iresult
-> GenericInstallPlan ipkg srcpkg iresult ifailure
-> GenericInstallPlan ipkg srcpkg iresult ifailure
preinstalled pkgid mipkg buildResult plan = assert (invariant plan') plan'
where
plan' = plan { planIndex = Graph.insert installed (planIndex plan) }
Just installed = do
Configured pkg <- Graph.lookup pkgid (planIndex plan)
rpkg <- lookupReadyPackage plan pkg
return (Installed rpkg mipkg buildResult)
-- ------------------------------------------------------------
-- * Checking validity of plans
......
Supports Markdown
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