Commit 627bf408 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Change InstallPlan.done and .next into .ready that returns a list

So kind of like uncons style rather than null and head.
It returns all the ready ones by lazily so it's no extra expense.
It'll allow parallel installations since all ready packages are
independent of each other. Also update callers.
parent 111e9bd0
......@@ -14,6 +14,8 @@ module Hackage.Install
( install
) where
import Data.List
( unfoldr )
import Data.Monoid (Monoid(mconcat))
import Control.Exception as Exception
( handle, Exception )
......@@ -195,27 +197,24 @@ planRepoPackages _verbosity comp installed available deps = do
installed available deps'
printDryRun :: Verbosity -> InstallPlan BuildResult -> IO ()
printDryRun verbosity pkgs
| InstallPlan.done pkgs = notice verbosity "No packages to be installed."
| otherwise = do
notice verbosity $ "In order, the following would be installed:\n"
++ unlines (map display (order pkgs))
where
order ps
| InstallPlan.done ps = []
| otherwise =
let (InstallPlan.ConfiguredPackage pkgInfo _ _) = InstallPlan.next ps
pkgId = packageId pkgInfo
in (pkgId : order (InstallPlan.completed pkgId ps))
printDryRun verbosity plan = case unfoldr next plan of
[] -> notice verbosity "No packages to be installed."
pkgs -> notice verbosity $ unlines $
"In order, the following would be installed:"
: map display pkgs
where
next plan' = case InstallPlan.ready plan' of
[] -> Nothing
(pkg:_) -> Just (pkgid, InstallPlan.completed pkgid plan')
where pkgid = packageId pkg
executeInstallPlan :: Monad m
=> InstallPlan BuildResult
-> (ConfiguredPackage -> m BuildResult)
-> m (InstallPlan BuildResult)
executeInstallPlan plan installPkg
| InstallPlan.done plan = return plan
| otherwise = do
let pkg = InstallPlan.next plan
executeInstallPlan plan installPkg = case InstallPlan.ready plan of
[] -> return plan
(pkg: _) -> do
buildResult <- installPkg pkg
let pkgid = packageId pkg
updatePlan = case buildResult of
......
......@@ -19,8 +19,7 @@ module Hackage.InstallPlan (
-- * Operations on 'InstallPlan's
new,
toList,
done,
next,
ready,
completed,
failed,
......@@ -114,6 +113,12 @@ import Control.Exception
-- also in the set. It is consistent if for every package in the set, all
-- dependencies which target that package have the same version.
-- Note that plans do not necessarily compose. You might have a valid plan for
-- package A and a valid plan for package B. That does not mean the composition
-- is simultaniously valid for A and B. In particular you're most likely to
-- have problems with inconsistent dependencies.
-- On the other hand it is true that every closed sub plan is valid.
data PlanPackage buildResult = PreExisting InstalledPackageInfo
| Configured ConfiguredPackage
| Installed ConfiguredPackage
......@@ -174,35 +179,26 @@ new os arch compiler index =
toList :: InstallPlan buildResult -> [PlanPackage buildResult]
toList = PackageIndex.allPackages . planIndex
-- | Is the plan completed?
--
done :: InstallPlan buildResult -> Bool
done (InstallPlan { planIndex = index}) =
null [ () | Configured _ <- PackageIndex.allPackages index ]
-- | The next package, meaning a package which has all its dependencies
-- installed already.
--
-- * The graph must not be 'done'.
-- | The packages that are ready to be installed. That is they are in the
-- configured state and have all their dependencies installed already.
-- The plan is complete if the result is @[]@.
--
next :: InstallPlan buildResult -> ConfiguredPackage
next plan@(InstallPlan { planIndex = index }) = assert (invariant plan) $
let allReadyPackages =
[ pkg
| Configured pkg <- PackageIndex.allPackages index
, flip all (depends pkg) $ \dep ->
case PackageIndex.lookupPackageId index dep of
Just (Configured _) -> False
Just (Failed _ _) -> internalError depOnFailed
Just (PreExisting _) -> True
Just (Installed _) -> True
Nothing -> internalError incomplete ]
in case allReadyPackages of
[] -> internalError noNextPkg
(pkg:_) -> pkg
ready :: InstallPlan buildResult -> [ConfiguredPackage]
ready plan = assert check readyPackages
where
check = invariant plan
&& null readyPackages <= null configuredPackages
configuredPackages =
[ pkg | Configured pkg <- PackageIndex.allPackages (planIndex plan) ]
readyPackages = filter (all isInstalled . depends) configuredPackages
isInstalled pkg =
case PackageIndex.lookupPackageId (planIndex plan) pkg of
Just (Configured _) -> False
Just (Failed _ _) -> internalError depOnFailed
Just (PreExisting _) -> True
Just (Installed _) -> True
Nothing -> internalError incomplete
incomplete = "install plan is not closed"
noNextPkg = "no configured pkg with all installed deps"
depOnFailed = "configured package depends on failed package"
-- | Marks a package in the graph as completed. Also saves the build result for
......
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