[commit: Cabal] master: more compact output for multiple subsequently rejected packages (9ddcb0b)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/9ddcb0b23e23fa81189ff39e3b677837fce6ebe2

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

commit 9ddcb0b23e23fa81189ff39e3b677837fce6ebe2
Author: Andres Loeh <andres at well-typed.com>
Date:   Tue Jun 21 13:32:31 2011 +0000

    more compact output for multiple subsequently rejected packages

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

 .../Client/Dependency/Modular/Message.hs           |    9 +++++++--
 1 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Message.hs b/cabal-install/Distribution/Client/Dependency/Modular/Message.hs
index f9167ca..daf1b43 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Message.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Message.hs
@@ -1,6 +1,6 @@
 module Distribution.Client.Dependency.Modular.Message where
 
-import qualified Data.Set as S
+import qualified Data.List as L
 import Prelude hiding (pi)
 
 import Distribution.Text -- from Cabal
@@ -25,7 +25,7 @@ showMessages = go 0
     go :: Int -> [Message] -> [String]
     go _ []                  = []
     -- complex patterns
-    go l (TryP pi : Enter : Failure c fr : Leave : ms) = (atLevel l $ "rejecting: " ++ showPI pi ++ showFR c fr) : go l ms
+    go l (TryP (PI qpn i) : Enter : Failure c fr : Leave : ms) = goPReject l qpn [i] c fr ms
     go l (TryF qfn b : Enter : Failure c fr : Leave : ms) = (atLevel l $ "rejecting: " ++ showQFNBool qfn b ++ showFR c fr) : go l ms
     go l (Next (Goal (Simple (Dep _ _)) gr) : TryP pi : ms@(Enter : Next _ : _)) = (atLevel l $ "trying: " ++ showPI pi ++ showGRs gr) : go l ms
     go l (Failure c Backjump : ms@(Leave : Failure c' Backjump : _)) | c == c' = go l ms
@@ -39,6 +39,11 @@ showMessages = go 0
     go l (Success      : ms) = (atLevel l $ "done") : go l ms
     go l (Failure c fr : ms) = (atLevel l $ "fail" ++ showFR c fr) : go l ms
 
+    -- special handler for many subsequent package rejections
+    goPReject :: Int -> QPN -> [I] -> ConflictSet QPN -> FailReason -> [Message] -> [String]
+    goPReject l qpn is c fr (TryP (PI qpn' i) : Enter : Failure _ fr' : Leave : ms) | qpn == qpn' && fr == fr' = goPReject l qpn (i : is) c fr ms
+    goPReject l qpn is c fr ms = (atLevel l $ "rejecting: " ++ showQPN qpn ++ "-" ++ L.intercalate ", " (map showI (reverse is)) ++ showFR c fr) : go l ms
+
     atLevel l x = let s = show l
                   in  "[" ++ replicate (3 - length s) '_' ++ s ++ "] " ++ x