Commit 86853416 authored by Duncan Coutts's avatar Duncan Coutts

Rename the new InstallPlan.{ready,completed,failed}

Rename from prime' versions to the normal names, now that the old ones
have been removed.
parent f28cf318
......@@ -138,7 +138,7 @@ configure verbosity packageDBs repoCtxt comp platform conf
Right installPlan0 ->
let installPlan = InstallPlan.configureInstallPlan installPlan0
in case fst (InstallPlan.ready' installPlan) of
in case fst (InstallPlan.ready installPlan) of
[pkg@(ReadyPackage
(ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
_ _ _))] -> do
......
......@@ -345,7 +345,7 @@ processInstallPlan verbosity
where
installPlan = InstallPlan.configureInstallPlan installPlan0
dryRun = fromFlag (installDryRun installFlags)
nothingToInstall = null (fst (InstallPlan.ready' installPlan))
nothingToInstall = null (fst (InstallPlan.ready installPlan))
-- ------------------------------------------------------------
-- * Installation planning
......@@ -581,7 +581,7 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb
++ "\nTry using 'cabal fetch'."
where
nothingToInstall = null (fst (InstallPlan.ready' installPlan))
nothingToInstall = null (fst (InstallPlan.ready installPlan))
dryRun = fromFlag (installDryRun installFlags)
overrideReinstall = fromFlag (installOverrideReinstall installFlags)
......
......@@ -39,9 +39,9 @@ module Distribution.Client.InstallPlan (
-- ** Traversal helpers
-- $traversal
Processing,
ready',
completed',
failed',
ready,
completed,
failed,
-- * Display
showPlanIndex,
......@@ -547,11 +547,11 @@ data Processing = Processing' !(Set UnitId) !(Set UnitId) !(Set UnitId)
-- all the packages that are ready will now be processed and so we can consider
-- them to be in the processing state.
--
ready' :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
ready :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> GenericInstallPlan ipkg srcpkg unused1 unused2
-> ([GenericReadyPackage srcpkg], Processing)
ready' plan =
ready plan =
assert (processingInvariant plan processing) $
(readyPackages, processing)
where
......@@ -574,12 +574,12 @@ ready' plan =
-- and return any packages that are newly in the processing state (ie ready to
-- process), along with the updated 'Processing' state.
--
completed' :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
completed :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> GenericInstallPlan ipkg srcpkg unused1 unused2
-> Processing -> UnitId
-> ([GenericReadyPackage srcpkg], Processing)
completed' plan (Processing' processingSet completedSet failedSet) pkgid =
completed plan (Processing' processingSet completedSet failedSet) pkgid =
assert (pkgid `Set.member` processingSet) $
assert (processingInvariant plan processing') $
......@@ -603,12 +603,12 @@ completed' plan (Processing' processingSet completedSet failedSet) pkgid =
asReadyPackage (Configured pkg) = ReadyPackage pkg
asReadyPackage _ = error "InstallPlan.completed: internal error"
failed' :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
failed :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> GenericInstallPlan ipkg srcpkg unused1 unused2
-> Processing -> UnitId
-> ([srcpkg], Processing)
failed' plan (Processing' processingSet completedSet failedSet) pkgid =
failed plan (Processing' processingSet completedSet failedSet) pkgid =
assert (pkgid `Set.member` processingSet) $
assert (all (`Set.notMember` processingSet) (tail newlyFailedIds)) $
assert (all (`Set.notMember` completedSet) (tail newlyFailedIds)) $
......@@ -691,7 +691,7 @@ executionOrder :: (HasUnitId ipkg, PackageFixedDeps ipkg,
=> GenericInstallPlan ipkg srcpkg unused1 unused2
-> [GenericReadyPackage srcpkg]
executionOrder plan =
let (newpkgs, processing) = ready' plan
let (newpkgs, processing) = ready plan
in tryNewTasks processing newpkgs
where
tryNewTasks _processing [] = []
......@@ -700,7 +700,7 @@ executionOrder plan =
waitForTasks processing p todo =
p : tryNewTasks processing' (todo++nextpkgs)
where
(nextpkgs, processing') = completed' plan processing (installedUnitId p)
(nextpkgs, processing') = completed plan processing (installedUnitId p)
-- ------------------------------------------------------------
......@@ -739,7 +739,7 @@ execute :: forall m ipkg srcpkg result failure unused1 unused2.
-> (GenericReadyPackage srcpkg -> m (Either failure result))
-> m (BuildResults failure result)
execute jobCtl keepGoing depFailure plan installPkg =
let (newpkgs, processing) = ready' plan
let (newpkgs, processing) = ready plan
in tryNewTasks Map.empty False False processing newpkgs
where
tryNewTasks :: BuildResults failure result
......@@ -786,7 +786,7 @@ execute jobCtl keepGoing depFailure plan installPkg =
processing' nextpkgs
where
results' = Map.insert pkgid result results
(nextpkgs, processing') = completed' plan processing pkgid
(nextpkgs, processing') = completed plan processing pkgid
Left _failure -> do
-- if this is the first failure and we're not trying to keep going
......@@ -797,7 +797,7 @@ execute jobCtl keepGoing depFailure plan installPkg =
tasksRemaining <- remainingJobs jobCtl
tryNewTasks results' True tasksRemaining processing' []
where
(depsfailed, processing') = failed' plan processing pkgid
(depsfailed, processing') = failed plan processing pkgid
results' = Map.insert pkgid result results `Map.union` depResults
depResults = Map.fromList
[ (installedUnitId deppkg, Left (depFailure deppkg))
......
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