Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3e892f21fd8cf49a9bf58ec413d5aef31cad3be3 >--------------------------------------------------------------- commit 3e892f21fd8cf49a9bf58ec413d5aef31cad3be3 Author: Lennart Kolmodin <[email protected]> Date: Sat Mar 1 20:21:17 2008 +0000 Improve 'cabal list' Make the output of 'cabal list' prettier. $ cabal list xmonad * xmonad Latest version available: 0.6 Latest installed version: 0.6 Homepage: http://xmonad.org Category: System Synopsis: A tiling window manager License: BSD3 * xmonad-contrib ...[snip] Very much like the gentoo tools eix and esearch. This targets part of ticket #235. It still does not show packages that are installed but not available. >--------------------------------------------------------------- cabal-install/Hackage/List.hs | 76 +++++++++++++++++++++++++++++++---------- cabal-install/Main.hs | 4 ++- 2 files changed, 61 insertions(+), 19 deletions(-) diff --git a/cabal-install/Hackage/List.hs b/cabal-install/Hackage/List.hs index db9ba27..c800785 100644 --- a/cabal-install/Hackage/List.hs +++ b/cabal-install/Hackage/List.hs @@ -14,30 +14,58 @@ module Hackage.List ( list ) where -import Data.List (nub, sortBy, groupBy) -import Data.Monoid (Monoid(mconcat)) +import Data.List (sortBy, groupBy) +import Data.Maybe (catMaybes) +import Data.Monoid (Monoid(mconcat,mempty)) +import Data.Map as Map (Map) +import qualified Data.Map as Map import Distribution.Package (PackageIdentifier(..), Package(..)) -import Distribution.PackageDescription +import Distribution.PackageDescription as Cabal import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Version (showVersion) +import Distribution.Version (Version,showVersion) import Distribution.Verbosity (Verbosity) import qualified Hackage.IndexUtils as IndexUtils import Hackage.Types (PkgInfo(..), Repo) -import Distribution.Simple.Utils (equating, comparing, intercalate, lowercase) +import Distribution.Simple.Configure as Cabal (getInstalledPackages) +import Distribution.Simple.Compiler as Cabal (Compiler,PackageDB) +import Distribution.Simple.PackageIndex as Installed +import Distribution.Simple.Program as Cabal (ProgramConfiguration) +import Distribution.Simple.Utils (equating, comparing, lowercase, notice) +import Distribution.InstalledPackageInfo as Installed -- |Show information about packages -list :: Verbosity -> [Repo] -> [String] -> IO () -list verbosity repos pats = do +list :: Verbosity -> PackageDB -> [Repo] -> Compiler -> ProgramConfiguration -> [String] -> IO () +list verbosity packageDB repos comp conf pats = do indexes <- mapM (IndexUtils.readRepoIndex verbosity) repos let index = mconcat indexes pkgs | null pats = PackageIndex.allPackages index | otherwise = concatMap (PackageIndex.searchByNameSubstring index) pats - putStrLn + + instPkgs <- do + pkgsM <- Cabal.getInstalledPackages verbosity comp packageDB conf + case pkgsM of + Nothing -> do + notice verbosity "Unable to read list of installed packages." + notice verbosity $ "Your compiler (" ++ show comp ++ ") is not supported." + notice verbosity "Pretending no packages are installed." + return mempty + Just ps -> + return + . Map.fromList $ + [ (name, maximum versions) + | installed <- allPackagesByName ps + , let name = pkgName . packageId . Installed.package . head $ installed + , let versions = + [ pkgVersion . packageId . Installed.package $ i + | i <- installed + ] + ] + putStr . unlines - . map showPkgVersions + . map (showPkgVersions instPkgs) . groupBy (equating (pkgName . packageId)) . sortBy (comparing nameAndVersion) $ pkgs @@ -48,14 +76,26 @@ list verbosity repos pats = do version = pkgVersion (packageId p) -showPkgVersions :: [PkgInfo] -> String -showPkgVersions pkgs = - padTo 35 $ pkgName (packageId pkg) - ++ " [" - ++ intercalate ", " (map showVersion versions) - ++ "] " - ++ synopsis (packageDescription (pkgDesc pkg)) +showPkgVersions :: Map String Version -> [PkgInfo] -> String +showPkgVersions installedPkgs pkgs = unlines $ + [ " * " ++ name ] ++ map (indent 6) (catMaybes [ + -- does it matter which repo the package came from? + -- compare to gentoo overlays + p $ "Latest version available: " ++ showVersion (pkgVersion (packageId pkg)) + , installedVersion >>= return . ("Latest version installed: " ++) . showVersion + -- TODO: add size of required downloads? need hackage support for this + , s (Cabal.homepage pd) ("Homepage: " ++) + , s (Cabal.category pd) ("Category: " ++) + , p $ "Synopsis: " ++ synopsis (packageDescription (pkgDesc pkg)) + , p $ "License: " ++ show (Cabal.license pd) + ]) where + p = Just + s str f + | not (null str) = Just (f str) + | otherwise = Nothing + indent n str = replicate n ' ' ++ str + pd = packageDescription (pkgDesc pkg) + name = pkgName (packageId pkg) pkg = last pkgs - versions = nub (map (pkgVersion . packageId) pkgs) - padTo n s = s ++ (replicate (n - length s) ' ') + installedVersion = Map.lookup name installedPkgs diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index e265f75..c6b176e 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -135,7 +135,9 @@ listAction verbosityFlag extraArgs = do configFile <- defaultConfigFile --FIXME let verbosity = fromFlag verbosityFlag config <- loadConfig verbosity configFile - list verbosity (configRepos config) extraArgs + let flags = savedConfigToConfigFlags (configPackageDB config) config + (comp, conf) <- configCompilerAux flags + list verbosity (fromFlag $ Cabal.configPackageDB flags) (configRepos config) comp conf extraArgs updateAction :: Flag Verbosity -> [String] -> IO () updateAction verbosityFlag _extraArgs = do _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
