Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/627bf40857160b7065a14d9e74d7c91ee9f87e10 >--------------------------------------------------------------- commit 627bf40857160b7065a14d9e74d7c91ee9f87e10 Author: Duncan Coutts <[email protected]> Date: Fri May 9 11:41:53 2008 +0000 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. >--------------------------------------------------------------- cabal-install/Hackage/Install.hs | 31 ++++++++++---------- cabal-install/Hackage/InstallPlan.hs | 52 +++++++++++++++------------------ 2 files changed, 39 insertions(+), 44 deletions(-) diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs index 8308e0f..69337b5 100644 --- a/cabal-install/Hackage/Install.hs +++ b/cabal-install/Hackage/Install.hs @@ -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 diff --git a/cabal-install/Hackage/InstallPlan.hs b/cabal-install/Hackage/InstallPlan.hs index 31b2d55..271a199 100644 --- a/cabal-install/Hackage/InstallPlan.hs +++ b/cabal-install/Hackage/InstallPlan.hs @@ -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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
