[commit: Cabal] master: proper constraint origins also for flag-introduced dependencies (436a204)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/436a204542a6482e51288c517cb62486884e23f5

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

commit 436a204542a6482e51288c517cb62486884e23f5
Author: Andres Loeh <andres at well-typed.com>
Date:   Mon Jun 20 10:08:52 2011 +0000

    proper constraint origins also for flag-introduced dependencies

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

 .../Client/Dependency/Modular/Dependency.hs        |   13 +++++++++++++
 .../Client/Dependency/Modular/Validate.hs          |    3 ++-
 2 files changed, 15 insertions(+), 1 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
index d9be3de..18feeb3 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
@@ -22,6 +22,12 @@ instance Functor Var where
   fmap f (P n)  = P (f n)
   fmap f (F fn) = F (fmap f fn)
 
+class ResetVar f where
+  resetVar :: Var qpn -> f qpn -> f qpn
+
+instance ResetVar Var where
+  resetVar = const
+
 -- | Constrained instance. If the choice has already been made, this is
 -- a fixed instance, and we record the package name for which the choice
 -- is for convenience. Otherwise, it is a list of version ranges paired with
@@ -33,6 +39,10 @@ instance Functor CI where
   fmap f (Fixed i n)       = Fixed i (f n)
   fmap f (Constrained vrs) = Constrained (L.map (\ (x, y) -> (x, fmap f y)) vrs)
 
+instance ResetVar CI where
+  resetVar v (Constrained vrs) = Constrained (L.map (\ (x, y) -> (x, resetVar v y)) vrs)
+  resetVar v x                 = x
+
 type VROrigin qpn = (VR, Var qpn)
 
 -- | Helper function to collapse a list of version ranges with origins into
@@ -87,6 +97,9 @@ showDep (Dep qpn ci) = showQPN qpn ++ showCI ci
 instance Functor Dep where
   fmap f (Dep x y) = Dep (f x) (fmap f y)
 
+instance ResetVar Dep where
+  resetVar v (Dep qpn ci) = Dep qpn (resetVar v ci)
+
 -- | A map containing reverse dependencies between qualified
 -- package names.
 type RevDepMap = Map QPN [QPN]
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
index 5259ee9..75153e0 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
@@ -161,7 +161,8 @@ extractNewFlagDeps qfn b fa deps = do
   case d of
     Simple _             -> mzero
     Flagged qfn' _ td fd
-      | qfn == qfn'      -> if b then extractDeps fa td else extractDeps fa fd
+      | qfn == qfn'      -> L.map (resetVar (F qfn)) $
+                            if b then extractDeps fa td else extractDeps fa fd
       | otherwise        -> case M.lookup qfn' fa of
                               Nothing    -> mzero
                               Just True  -> extractNewFlagDeps qfn b fa td