[commit: Cabal] master: Improve 'cabal list' (3e892f2)

[Paolo Capriotti]

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 <kolmodin at gentoo.org>
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