[commit: Cabal] master: Implement 'cabal list --simple-output' (70e293e)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/70e293ed82a23a24b9469bec2de915048510b4b6

>---------------------------------------------------------------

commit 70e293ed82a23a24b9469bec2de915048510b4b6
Author: Lennart Kolmodin <kolmodin at gentoo.org>
Date:   Sun Mar 2 19:54:37 2008 +0000

    Implement 'cabal list --simple-output'
    Provides a output format that is easier to pass on to unix tools and other
    scripting tools. Also works together with --installed.

>---------------------------------------------------------------

 cabal-install/Hackage/List.hs  |   38 +++++++++++++++++++++++++++++---------
 cabal-install/Hackage/Setup.hs |   12 ++++++++++--
 2 files changed, 39 insertions(+), 11 deletions(-)

diff --git a/cabal-install/Hackage/List.hs b/cabal-install/Hackage/List.hs
index 9210352..dd7cfb0 100644
--- a/cabal-install/Hackage/List.hs
+++ b/cabal-install/Hackage/List.hs
@@ -64,7 +64,7 @@ list verbosity packageDB repos comp conf listFlags pats = do
             Just ps ->
                 return
                     . Map.fromList $
-                    [ (name, maximum versions)
+                    [ (name, versions)
                     | installed <- allPackagesByName ps
                     , let name = pkgName . packageId . Installed.package . head $ installed
                     , let versions =
@@ -78,20 +78,40 @@ list verbosity packageDB repos comp conf listFlags pats = do
           . sortBy (comparing nameAndVersion)
           $ pkgs
 
-    if null matches
-        then notice verbosity "No mathes found."
-        else putStr . unlines . map (showPkgVersions instPkgs) $ matches
+    if fromFlag (listSimpleOutput listFlags)
+      then putStr . unlines . map (simpleShowPackageId . packageId) . concat $ matches
+      else
+        if null matches
+            then notice verbosity "No mathes found."
+            else putStr . unlines . map (showPkgVersions instPkgs) $ matches
 
    where
     nameAndVersion p = (lowercase name, name, version)
         where name = pkgName (packageId p)
               version = pkgVersion (packageId p)
-    installedFilter pkgs
+    simpleShowPackageId :: PackageIdentifier -> String
+    simpleShowPackageId pkg = pkgName pkg ++ " " ++ showVersion (pkgVersion pkg)
+    installedFilter :: Map String [Version] -> [[PkgInfo]] -> [[PkgInfo]]
+    installedFilter installed pkgs
         | fromFlag (listInstalled listFlags) =
-            filter (\p -> Map.member (pkgName . packageId . head $ p) pkgs)
-        | otherwise = id
+            [ matches
+            | pkg <- pkgs
+            , let installedVersions =
+                    maybe [] id
+                        (Map.lookup
+                            (pkgName . packageId . head $ pkg)
+                            installed)
+            , let matches =
+                    [ cab
+                    | cab <- pkg
+                    , any (\i -> (pkgVersion . packageId) cab == i)
+                          installedVersions
+                    ]
+            , not (null matches)
+            ]
+        | otherwise = pkgs
 
-showPkgVersions :: Map String Version -> [PkgInfo] -> String
+showPkgVersions :: Map String [Version] -> [PkgInfo] -> String
 showPkgVersions installedPkgs pkgs = unlines $
     [ " * " ++ name ] ++ map (indent 6) (catMaybes [
       -- does it matter which repo the package came from?
@@ -113,4 +133,4 @@ showPkgVersions installedPkgs pkgs = unlines $
     pd = packageDescription (pkgDesc pkg)
     name = pkgName (packageId pkg)
     pkg = last pkgs
-    installedVersion = Map.lookup name installedPkgs
+    installedVersion = fmap maximum $ Map.lookup name installedPkgs
diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs
index d44e8e8..c338574 100644
--- a/cabal-install/Hackage/Setup.hs
+++ b/cabal-install/Hackage/Setup.hs
@@ -139,12 +139,14 @@ checkCommand = CommandUI {
 
 data ListFlags = ListFlags {
     listInstalled :: Flag Bool,
+    listSimpleOutput :: Flag Bool,
     listVerbosity :: Flag Verbosity
   }
 
 defaultListFlags :: ListFlags
 defaultListFlags = ListFlags {
     listInstalled = Flag False,
+    listSimpleOutput = Flag False,
     listVerbosity = toFlag normal
   }
 
@@ -156,13 +158,18 @@ listCommand = CommandUI {
     commandUsage        = usagePackages "list",
     commandDefaultFlags = mempty,
     commandOptions      = \_ -> [
-        optionVerbose listVerbosity (\v flags -> flags { listVerbosity = v }),
+        optionVerbose listVerbosity (\v flags -> flags { listVerbosity = v })
 
-        option "I" ["installed"]
+        , option "I" ["installed"]
             "Only print installed packages"
             listInstalled (\v flags -> flags { listInstalled = v })
             trueArg
 
+        , option [] ["simple-output"]
+            "Print in a easy-to-parse format"
+            listSimpleOutput (\v flags -> flags { listSimpleOutput = v })
+            trueArg
+
         ]
   }
 
@@ -170,6 +177,7 @@ instance Monoid ListFlags where
   mempty = defaultListFlags
   mappend a b = ListFlags {
     listInstalled = combine listInstalled,
+    listSimpleOutput = combine listSimpleOutput,
     listVerbosity = combine listVerbosity
   }
     where combine field = field a `mappend` field b