Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/9e90e150a415250be6d398ca1ff03add0d146660 >--------------------------------------------------------------- commit 9e90e150a415250be6d398ca1ff03add0d146660 Author: bjorn <[email protected]> Date: Wed Oct 17 19:08:48 2007 +0000 Fixed error message when some depedencies couldn't be resolved. Before it used show on Dependency, not showDependency. Using fail here produces things like: cabal: user error (Unresolved dependencies: containers -any, array -any, bytestring >=0.9) It would be nice to get rid of the "user error" here. >--------------------------------------------------------------- cabal-install/Hackage/Fetch.hs | 3 ++- cabal-install/Hackage/Info.hs | 5 +---- cabal-install/Hackage/Install.hs | 5 +++-- cabal-install/Hackage/Utils.hs | 6 ++++++ 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/cabal-install/Hackage/Fetch.hs b/cabal-install/Hackage/Fetch.hs index 3ba17c3..abcb76e 100644 --- a/cabal-install/Hackage/Fetch.hs +++ b/cabal-install/Hackage/Fetch.hs @@ -33,6 +33,7 @@ import System.Directory (doesFileExist, createDirectoryIfMissing) import Hackage.Types (ConfigFlags (..), UnresolvedDependency (..), Repo(..), PkgInfo, pkgInfoId) import Hackage.Config (repoCacheDir, packageFile, packageDir, pkgURL, message) import Hackage.Dependency (resolveDependencies, packagesToInstall) +import Hackage.Utils import Distribution.Package (showPackageId) import Distribution.Simple.Compiler (Compiler) @@ -126,7 +127,7 @@ fetch :: ConfigFlags -> Compiler -> ProgramConfiguration -> [String] -> [Unresol fetch cfg comp conf _globalArgs deps = do depTree <- resolveDependencies cfg comp conf deps case packagesToInstall depTree of - Left missing -> fail $ "Unresolved dependencies: " ++ show missing + Left missing -> fail $ "Unresolved dependencies: " ++ showDependencies missing Right pkgs -> do ps <- filterM (fmap not . isFetched cfg) $ map fst pkgs mapM_ (fetchPackage cfg) ps diff --git a/cabal-install/Hackage/Info.hs b/cabal-install/Hackage/Info.hs index c5bea60..07e3c32 100644 --- a/cabal-install/Hackage/Info.hs +++ b/cabal-install/Hackage/Info.hs @@ -16,12 +16,12 @@ import Hackage.Config import Hackage.Dependency import Hackage.Fetch import Hackage.Types +import Hackage.Utils import Distribution.Package (showPackageId) import Distribution.ParseUtils (showDependency) import Distribution.Simple.Compiler (Compiler) import Distribution.Simple.Program (ProgramConfiguration) -import Distribution.Version (Dependency) import Data.List (intersperse, nubBy) import Text.Printf (printf) @@ -62,6 +62,3 @@ infoPkg cfg (Available dep pkg opts deps) infoPkg _ (Unavailable dep) = do printf " Requested: %s\n" (show $ showDependency dep) printf " Not available!\n\n" - -showDependencies :: [Dependency] -> String -showDependencies = concat . intersperse ", " . map (show . showDependency) diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs index 01281df..342aadd 100644 --- a/cabal-install/Hackage/Install.hs +++ b/cabal-install/Hackage/Install.hs @@ -29,6 +29,7 @@ import Hackage.Fetch (fetchPackage) import Hackage.Tar (extractTarGzFile) import Hackage.Types (ConfigFlags(..), UnresolvedDependency(..) , PkgInfo(..)) +import Hackage.Utils import Distribution.Simple.Compiler (Compiler(..)) import Distribution.Simple.InstallDirs (InstallDirs(..), absoluteInstallDirs) @@ -56,7 +57,7 @@ installLocalPackage cfg comp conf globalArgs = desc <- readPackageDescription (configVerbose cfg) cabalFile resolvedDeps <- resolveDependenciesLocal cfg comp conf desc globalArgs case packagesToInstall resolvedDeps of - Left missing -> fail $ "Unresolved dependencies: " ++ show missing + Left missing -> fail $ "Unresolved dependencies: " ++ showDependencies missing Right pkgs -> installPackages cfg comp globalArgs pkgs let pkgId = package (packageDescription desc) installUnpackedPkg cfg comp globalArgs pkgId [] Nothing @@ -65,7 +66,7 @@ installRepoPackages :: ConfigFlags -> Compiler -> ProgramConfiguration -> [Strin installRepoPackages cfg comp conf globalArgs deps = do resolvedDeps <- resolveDependencies cfg comp conf deps case packagesToInstall resolvedDeps of - Left missing -> fail $ "Unresolved dependencies: " ++ show missing + Left missing -> fail $ "Unresolved dependencies: " ++ showDependencies missing Right [] -> message cfg normal "All requested packages already installed. Nothing to do." Right pkgs -> installPackages cfg comp globalArgs pkgs diff --git a/cabal-install/Hackage/Utils.hs b/cabal-install/Hackage/Utils.hs index 2f28dbf..5a0ee42 100644 --- a/cabal-install/Hackage/Utils.hs +++ b/cabal-install/Hackage/Utils.hs @@ -2,10 +2,12 @@ module Hackage.Utils where import Distribution.Compat.ReadP (ReadP, readP_to_S, pfail, get, look, choice) import Distribution.ParseUtils +import Distribution.Version import Control.Exception import Control.Monad (foldM, guard) import Data.Char (isSpace, toLower) +import Data.List (intersperse) import Data.Maybe (listToMaybe) import System.IO.Error (isDoesNotExistError) import Text.PrettyPrint.HughesPJ (Doc, render, vcat, text, (<>), (<+>)) @@ -79,3 +81,7 @@ stringNoCase this = look >>= scan this scan [] _ = return this scan (x:xs) (y:ys) | toLower x == toLower y = get >> scan xs ys scan _ _ = pfail + + +showDependencies :: [Dependency] -> String +showDependencies = concat . intersperse ", " . map (show . showDependency) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
