Merge pull request #1956 from kosmikus/new-flag-fix

Treat all flags of a package as interdependent.

cabal-install/Distribution/Client/Dependency/Modular/Builder.hs

@@ -78,17 +78,21 @@ scopedExtendOpen qpn i gr fdeps fdefs s = extendOpen qpn gs s
     qfdefs = L.map (\ (fn, b) -> Flagged (FN (PI qpn i) fn) b [] []) $ M.toList fdefs
     -- Combine new package and flag goals
     gs     = L.map (flip OpenGoal gr) (qfdefs ++ qfdeps)
-    -- IMPORTANT AND SUBTLE: The order of the concatenation above is
-    -- important. Flags occur potentially multiple times: both via the
-    -- flag declaration ('qfdefs') and via dependencies ('qfdeps').
-    -- We want the information from qfdeps if it's present, because that
-    -- includes dependencies between flags. We use qfdefs mainly so that
-    -- we are forced to make choices for flags that don't affect
-    -- dependencies at all.
+    -- NOTE:
     --
-    -- When goals are actually extended in 'extendOpen', later additions
-    -- override earlier additions, so it's important that the
-    -- lower-quality templates without dependency information come first.
+    -- In the expression @qfdefs ++ qfdeps@ above, flags occur potentially
+    -- multiple times, both via the flag declaration and via dependencies.
+    -- The order is potentially important, because the occurrences via
+    -- dependencies may record flag-dependency information. After a number
+    -- of bugs involving computing this information incorrectly, however,
+    -- we're currently not using carefully computed inter-flag dependencies
+    -- anymore, but instead use 'simplifyVar' when computing conflict sets
+    -- to map all flags of one package to a single flag for conflict set
+    -- purposes, thereby treating them all as interdependent.
+    --
+    -- If we ever move to a more clever algorithm again, then the line above
+    -- needs to be looked at very carefully, and probably be replaced by
+    -- more systematically computed flag dependency information.
 
 -- | Datatype that encodes what to build next
 data BuildType =

cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs

@@ -22,6 +22,16 @@ import Distribution.Client.Dependency.Modular.Version
 data Var qpn = P qpn | F (FN qpn) | S (SN qpn)
   deriving (Eq, Ord, Show, Functor)
 
+-- | For computing conflict sets, we map flag choice vars to a
+-- single flag choice. This means that all flag choices are treated
+-- as interdependent. So if one flag of a package ends up in a
+-- conflict set, then all flags are being treated as being part of
+-- the conflict set.
+simplifyVar :: Var qpn -> Var qpn
+simplifyVar (P qpn)       = P qpn
+simplifyVar (F (FN pi _)) = F (FN pi (mkFlag "flag"))
+simplifyVar (S qsn)       = S qsn
+
 showVar :: Var QPN -> String
 showVar (P qpn) = showQPN qpn
 showVar (F qfn) = showQFN qfn
@@ -149,7 +159,7 @@ type QGoalReasonChain = GoalReasonChain QPN
 goalReasonToVars :: GoalReason qpn -> ConflictSet qpn
 goalReasonToVars UserGoal                 = S.empty
 goalReasonToVars (PDependency (PI qpn _)) = S.singleton (P qpn)
-goalReasonToVars (FDependency qfn _)      = S.singleton (F qfn)
+goalReasonToVars (FDependency qfn _)      = S.singleton (simplifyVar (F qfn))
 goalReasonToVars (SDependency qsn)        = S.singleton (S qsn)
 
 goalReasonChainToVars :: Ord qpn => GoalReasonChain qpn -> ConflictSet qpn
@@ -168,4 +178,4 @@ close (OpenGoal (Stanza  qsn _)      gr) = Goal (S qsn) gr
 -- | Compute a conflic set from a goal. The conflict set contains the
 -- closure of goal reasons as well as the variable of the goal itself.
 toConflictSet :: Ord qpn => Goal qpn -> ConflictSet qpn
-toConflictSet (Goal g grs) = S.insert g (goalReasonChainToVars grs)
+toConflictSet (Goal g grs) = S.insert (simplifyVar g) (goalReasonChainToVars grs)

cabal-install/Distribution/Client/Dependency/Modular/Explore.hs

@@ -66,9 +66,9 @@ combine :: Var QPN -> [(a, (Maybe (ConflictSet QPN), b))] ->
 combine _   []                      c = (Just c, [])
 combine var ((k, (     d, v)) : xs) c = (\ ~(e, ys) -> (e, (k, v) : ys)) $
                                         case d of
-                                          Just e | not (var `S.member` e) -> (Just e, [])
-                                                 | otherwise              -> combine var xs (e `S.union` c)
-                                          Nothing                         -> (Nothing, snd $ combine var xs S.empty)
+                                          Just e | not (simplifyVar var `S.member` e) -> (Just e, [])
+                                                 | otherwise                          -> combine var xs (e `S.union` c)
+                                          Nothing                                     -> (Nothing, snd $ combine var xs S.empty)
 
 -- | Naive backtracking exploration of the search tree. This will yield correct
 -- assignments only once the tree itself is validated.

cabal-install/Distribution/Client/Dependency/Modular/Flag.hs

@@ -23,6 +23,9 @@ type Flag = FlagName
 unFlag :: Flag -> String
 unFlag (FlagName fn) = fn
 
+mkFlag :: String -> Flag
+mkFlag fn = FlagName fn
+
 -- | Flag info. Default value, whether the flag is manual, and
 -- whether the flag is weak. Manual flags can only be set explicitly.
 -- Weak flags are typically deferred by the solver.