[commit: Cabal] master: Generalise the logging of selected and discarded packages (fe336ff)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/fe336ffd7d381fbb8310a9fc413e4b1783949b2f

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

commit fe336ffd7d381fbb8310a9fc413e4b1783949b2f
Author: Duncan Coutts <duncan at haskell.org>
Date:   Sat Oct 4 23:25:55 2008 +0000

    Generalise the logging of selected and discarded packages
    Allow for selecting several packages in one go.
    Currently when we select a package we only list the over versions
    of the same package that that excludes, and not the other packages
    we exclude by applying the dependency constraints of the selected
    package. In future we would like to do that so we now report the
    package name of discards not just the version. Though we do group
    by the package name to avoid too much repition.

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

 .../Distribution/Client/Dependency/TopDown.hs      |   37 +++++++++++++------
 1 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs
index 160f3f9..7d2030b 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs
@@ -50,7 +50,7 @@ import Distribution.Text
          ( display )
 
 import Data.List
-         ( foldl', maximumBy, minimumBy, deleteBy, nub, sort )
+         ( foldl', maximumBy, minimumBy, delete, nub, sort, groupBy )
 import Data.Maybe
          ( fromJust, fromMaybe )
 import Data.Monoid
@@ -91,14 +91,14 @@ explore _    (Failure failure)      = Fail failure
 explore _explore    (ChoiceNode result []) = Done result
 explore pref (ChoiceNode _ choices) =
   case [ choice | [choice] <- choices ] of
-    ((pkg, node'):_) -> Step (Select pkg [])    (explore pref node')
+    ((pkg, node'):_) -> Step (Select [pkg] [])    (explore pref node')
     []               -> seq pkgs' -- avoid retaining defaultChoice
-                      $ Step (Select pkg pkgs') (explore pref node')
+                      $ Step (Select [pkg] pkgs') (explore pref node')
       where
         choice       = minimumBy (comparing topSortNumber) choices
         pkgname      = packageName . fst . head $ choice
         (pkg, node') = maximumBy (bestByPref pkgname) choice
-        pkgs' = deleteBy (equating packageId) pkg (map fst choice)
+        pkgs'        = delete (packageId pkg) (map (packageId.fst) choice)
 
   where
     topSortNumber choice = case fst (head choice) of
@@ -519,7 +519,7 @@ showExclusionReason pkgid (ExcludedByTopLevelDependency dep) =
 -- * Logging progress and failures
 -- ------------------------------------------------------------
 
-data Log = Select SelectablePackage [SelectablePackage]
+data Log = Select [SelectablePackage] [PackageIdentifier]
 data Failure
    = ConfigureFailed
        SelectablePackage
@@ -534,18 +534,31 @@ data Failure
        Dependency
 
 showLog :: Log -> String
-showLog (Select selected discarded) =
-     "selecting " ++ displayPkg selected ++ " " ++ kind selected
-  ++ case discarded of
-       []  -> ""
-       [d] -> " and discarding version " ++ display (packageVersion d)
-       _   -> " and discarding versions "
-           ++ listOf (display . packageVersion) discarded
+showLog (Select selected discarded) = case (selectedMsg, discardedMsg) of
+  ("", y) -> y
+  (x, "") -> x
+  (x,  y) -> x ++ " and " ++ y
+
   where
+    selectedMsg  = "selecting " ++ case selected of
+      []     -> ""
+      [s]    -> display (packageId s) ++ " " ++ kind s
+      (s:ss) -> listOf id
+              $ (display (packageId s) ++ " " ++ kind s)
+              : [ display (packageVersion s') ++ " " ++ kind s'
+                | s' <- ss ]
+
     kind (InstalledOnly _)           = "(installed)"
     kind (AvailableOnly _)           = "(hackage)"
     kind (InstalledAndAvailable _ _) = "(installed or hackage)"
 
+    discardedMsg = case discarded of
+      []  -> ""
+      _   -> "discarding " ++ listOf id
+        [ element
+        | (pkgid:pkgids) <- groupBy (equating packageName) (sort discarded)
+        , element <- display pkgid : map (display . packageVersion) pkgids ]
+
 showFailure :: Failure -> String
 showFailure (ConfigureFailed pkg missingDeps) =
      "cannot configure " ++ displayPkg pkg ++ ". It requires "