Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5ba6715cde26eecc4a763ab730a64563afc4f534 >--------------------------------------------------------------- commit 5ba6715cde26eecc4a763ab730a64563afc4f534 Author: Duncan Coutts <[email protected]> Date: Thu Aug 14 18:02:01 2008 +0000 Fetch packages even if they happen to already be installed Though obviously not if they have already been fetched. This lets people study the source for core packages that came with their compiler say, so they did not get have the sources downloaded via cabal-install. Fixes ticket #297. >--------------------------------------------------------------- cabal-install/Distribution/Client/Fetch.hs | 34 +++++++++++++++++++++++----- 1 files changed, 28 insertions(+), 6 deletions(-) diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs index 1429f3c..1145e95 100644 --- a/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal-install/Distribution/Client/Fetch.hs @@ -26,14 +26,17 @@ import Distribution.Client.Types , AvailablePackageSource(..) , Repo(..), RemoteRepo(..), LocalRepo(..) ) import Distribution.Client.Dependency - ( resolveDependencies, PackagesVersionPreference(..) ) + ( resolveDependenciesWithProgress, PackagesVersionPreference(..) ) +import Distribution.Client.Dependency.Types + ( foldProgress ) import Distribution.Client.IndexUtils as IndexUtils ( getAvailablePackages, disambiguateDependencies ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.HttpUtils (getHTTP, isOldHackageURI) import Distribution.Package - ( PackageIdentifier(..) ) + ( PackageIdentifier(..), Dependency(..) ) +import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.Compiler ( Compiler(compilerId), PackageDB ) import Distribution.Simple.Program @@ -41,7 +44,7 @@ import Distribution.Simple.Program import Distribution.Simple.Configure ( getInstalledPackages ) import Distribution.Simple.Utils - ( die, notice, debug, setupMessage + ( die, notice, info, debug, setupMessage , copyFileVerbose, writeFileAtomic ) import Distribution.System ( buildOS, buildArch ) @@ -51,7 +54,7 @@ import Distribution.Verbosity ( Verbosity ) import Control.Monad - ( filterM ) + ( when, filterM ) import System.Directory ( doesFileExist, createDirectoryIfMissing ) import System.FilePath @@ -142,14 +145,33 @@ fetch verbosity packageDB repos comp conf deps = do installed <- getInstalledPackages verbosity comp packageDB conf available <- getAvailablePackages verbosity repos deps' <- IndexUtils.disambiguateDependencies available deps - case resolveDependencies buildOS buildArch (compilerId comp) - installed available PreferLatestForSelected deps' of + + let -- Hide the packages given on the command line so that the dep resolver + -- will decide that they need fetching, even if they're already + -- installed. Sicne we want to get the source packages of things we might + -- have installed (but not have the sources for). + installed' = fmap (hideGivenDeps deps') installed + hideGivenDeps pkgs index = + foldr PackageIndex.deletePackageName index + [ name | UnresolvedDependency (Dependency name _) _ <- pkgs ] + + let progress = resolveDependenciesWithProgress + buildOS buildArch (compilerId comp) + installed' available PreferLatestForSelected deps' + notice verbosity "Resolving dependencies..." + maybePlan <- foldProgress (\message rest -> info verbosity message >> rest) + (return . Left) (return . Right) progress + case maybePlan of Left message -> die message Right pkgs -> do ps <- filterM (fmap not . isFetched) [ pkg | (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _)) <- InstallPlan.toList pkgs ] + when (null ps) $ + notice verbosity $ "No packages need to be fetched. " + ++ "All the requested packages are already cached." + sequence_ [ fetchPackage verbosity repo pkgid | (AvailablePackage pkgid _ (RepoTarballPackage repo)) <- ps ] _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
