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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6ece788c1074822a2d518d94bf376243e54673c0

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

commit 6ece788c1074822a2d518d94bf376243e54673c0
Author: Andres Loeh <[email protected]>
Date:   Sun Jul 3 13:14:35 2011 +0000

    better conflict reporting

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

 .../Client/Dependency/Modular/Assignment.hs        |   18 +++++++++---------
 .../Client/Dependency/Modular/Dependency.hs        |    9 +++++++--
 .../Client/Dependency/Modular/Message.hs           |    5 ++++-
 .../Client/Dependency/Modular/Preference.hs        |    1 -
 .../Distribution/Client/Dependency/Modular/Tree.hs |    2 +-
 .../Client/Dependency/Modular/Validate.hs          |    1 -
 6 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs 
b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs
index 651412c..3766eac 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs
@@ -41,21 +41,21 @@ data PreAssignment = PA PPreAssignment FAssignment
 --
 -- Either returns a witness of the conflict that would arise during the merge,
 -- or the successfully extended assignment.

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

--- TODO: Check again if we couldn't actually do better in providing user
--- feedback. There is far more information now compared to when 
'mostInformative'
--- was implemented.
-extend :: Var QPN -> PPreAssignment -> [Dep QPN] -> Either (ConflictSet QPN, 
Dep QPN) PPreAssignment
+extend :: Var QPN -> PPreAssignment -> [Dep QPN] -> Either (ConflictSet QPN, 
[Dep QPN]) PPreAssignment
 extend var pa qa = foldM (\ a (Dep qpn ci) ->
                      let ci' = M.findWithDefault (Constrained []) qpn a
                      in  case (\ x -> M.insert qpn x a) <$> merge ci' ci of
-                           Left (c, (d, d')) -> Left  (c, Dep qpn 
(mostInformative d d'))
+                           Left (c, (d, d')) -> Left  (c, L.map (Dep qpn) 
(simplify (P qpn) d d'))
                            Right x           -> Right x)
                     pa qa
   where
-    mostInformative (Fixed _ (Goal var' _))          c | var' == var = c
-    mostInformative (Constrained [(_, Goal var' _)]) c | var' == var = c
-    mostInformative c                                _               = c
+    -- We're trying to remove trivial elements of the conflict. If we're just
+    -- making a choice pkg == instance, and pkg => pkg == instance is a part
+    -- of the conflict, then this info is clear from the context and does not
+    -- have to be repeated.
+    simplify v (Fixed _ (Goal var' _)) c | v == var && var' == var = [c]
+    simplify v c (Fixed _ (Goal var' _)) | v == var && var' == var = [c]
+    simplify _ c                       d                           = [c, d]
 
 -- | Delivers an ordered list of fully configured packages.
 --
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs 
b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
index 293429d..17a36d0 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
@@ -109,8 +109,13 @@ data Dep qpn = Dep qpn (CI qpn)
   deriving (Eq, Show)
 
 showDep :: Dep QPN -> String
-showDep (Dep qpn (Constrained [(vr, Goal v _)])) = showQPN qpn ++ showVR vr ++ 
" introduced by " ++ showVar v
-showDep (Dep qpn ci                            ) = showQPN qpn ++ showCI ci
+showDep (Dep qpn (Fixed i (Goal v _))          ) =
+  (if P qpn /= v then showVar v ++ " => " else "") ++
+  showQPN qpn ++ "==" ++ showI i
+showDep (Dep qpn (Constrained [(vr, Goal v _)])) =
+  showVar v ++ " => " ++ showQPN qpn ++ showVR vr
+showDep (Dep qpn ci                            ) =
+  showQPN qpn ++ showCI ci
 
 instance Functor Dep where
   fmap f (Dep x y) = Dep (f x) (fmap f y)
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Message.hs 
b/cabal-install/Distribution/Client/Dependency/Modular/Message.hs
index 3de3a02..594e62c 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Message.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Message.hs
@@ -58,7 +58,7 @@ showGR (FDependency qfn b) = " (dependency of " ++ 
showQFNBool qfn b ++ ")"
 
 showFR :: ConflictSet QPN -> FailReason -> String
 showFR _ InconsistentInitialConstraints = " (inconsistent initial constraints)"
-showFR _ (Conflicting d)                = " (conflicts with " ++ showDep d ++ 
")"
+showFR _ (Conflicting ds)               = " (conflict: " ++ L.intercalate ", " 
(map showDep ds) ++ ")"
 showFR _ ConflictingFlag                = " (conflicts with previous choice of 
same flag)"
 showFR _ CannotInstall                  = " (only already installed versions 
can be used)"
 showFR _ CannotReinstall                = " (avoiding to reinstall a package 
with same version but new dependencies)"
@@ -67,5 +67,8 @@ showFR _ GlobalConstraintInstalled      = " (global 
constraint requires installe
 showFR _ GlobalConstraintSource         = " (global constraint requires source 
instance)"
 showFR _ GlobalConstraintFlag           = " (global constraint requires 
opposite flag selection)"
 showFR c Backjump                       = " (backjumping, conflict set: " ++ 
showCS c ++ ")"
+-- The following are internal failures. They should not occur. In the
+-- interest of not crashing unnecessarily, we still just print an error
+-- message though.
 showFR _ (BuildFailureNotInIndex pn)    = " (BUILD FAILURE: NOT IN INDEX: " ++ 
display pn ++ ")"
 showFR _ EmptyGoalChoice                = " (INTERNAL ERROR: EMPTY GOAL 
CHOICE)"
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs 
b/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs
index a897d3e..d291e14 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs
@@ -5,7 +5,6 @@ module Distribution.Client.Dependency.Modular.Preference where
 import Control.Applicative
 import qualified Data.List as L
 import qualified Data.Map as M
-import qualified Data.Set as S
 import Data.Monoid
 import Data.Ord
 
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs 
b/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
index f48a32c..7a6329d 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
@@ -24,7 +24,7 @@ data Tree a =
   deriving (Eq, Show)
 
 data FailReason = InconsistentInitialConstraints
-                | Conflicting (Dep QPN)
+                | Conflicting [Dep QPN]
                 | ConflictingFlag
                 | CannotInstall
                 | CannotReinstall
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs 
b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
index fcfdd20..bf6141b 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
@@ -10,7 +10,6 @@ import Control.Applicative
 import Control.Monad.Reader hiding (sequence)
 import Data.List as L
 import Data.Map as M
-import Data.Set as S
 import Data.Traversable
 import Prelude hiding (sequence)
 



_______________________________________________
Cvs-libraries mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-libraries

Reply via email to