cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs

   1 -- | Conflict sets
   2 --
   3 -- Intended for double import
   4 --
   5 -- > import Distribution.Solver.Modular.ConflictSet (ConflictSet)
   6 -- > import qualified Distribution.Solver.Modular.ConflictSet as CS
   7 module Distribution.Solver.Modular.ConflictSet (
   8     ConflictSet -- opaque
   9   , Conflict(..)
  10   , ConflictMap
  11   , OrderedVersionRange(..)
  12   , showConflictSet
  13   , showCSSortedByFrequency
  14   , showCSWithFrequency
  15     -- Set-like operations
  16   , toSet
  17   , toList
  18   , union
  19   , unions
  20   , insert
  21   , delete
  22   , empty
  23   , singleton
  24   , singletonWithConflict
  25   , size
  26   , member
  27   , lookup
  28   , filter
  29   , fromList
  30   ) where
  31
  32 import Prelude hiding (lookup)
  33 import Data.List (intercalate, sortBy)
  34 import Data.Map (Map)
  35 import Data.Set (Set)
  36 import Data.Function (on)
  37 import qualified Data.Map.Strict as M
  38 import qualified Data.Set as S
  39
  40 import Distribution.Solver.Modular.Var
  41 import Distribution.Solver.Modular.Version
  42 import Distribution.Solver.Types.PackagePath
  43
  44 -- | The set of variables involved in a solver conflict, each paired with
  45 -- details about the conflict.
  46 newtype ConflictSet = CS {
  47     -- | The set of variables involved in the conflict
  48     conflictSetToMap :: Map (Var QPN) (Set Conflict)
  49   }
  50   deriving (Eq, Show)
  51
  52 -- | More detailed information about how a conflict set variable caused a
  53 -- conflict. This information can be used to determine whether a second value
  54 -- for that variable would lead to the same conflict.
  55 --
  56 -- TODO: Handle dependencies under flags or stanzas.
  57 data Conflict =
  58
  59     -- | The conflict set variable represents a package which depends on the
  60     -- specified problematic package. For example, the conflict set entry
  61     -- '(P x, GoalConflict y)' means that package x introduced package y, and y
  62     -- led to a conflict.
  63     GoalConflict QPN
  64
  65     -- | The conflict set variable represents a package with a constraint that
  66     -- excluded the specified package and version. For example, the conflict set
  67     -- entry '(P x, VersionConstraintConflict y (mkVersion [2, 0]))' means that
  68     -- package x's constraint on y excluded y-2.0.
  69   | VersionConstraintConflict QPN Ver
  70
  71     -- | The conflict set variable represents a package that was excluded by a
  72     -- constraint from the specified package. For example, the conflict set
  73     -- entry '(P x, VersionConflict y (orLaterVersion (mkVersion [2, 0])))'
  74     -- means that package y's constraint 'x >= 2.0' excluded some version of x.
  75   | VersionConflict QPN OrderedVersionRange
  76
  77     -- | Any other conflict.
  78   | OtherConflict
  79   deriving (Eq, Ord, Show)
  80
  81 -- | Version range with an 'Ord' instance.
  82 newtype OrderedVersionRange = OrderedVersionRange VR
  83   deriving (Eq, Show)
  84
  85 -- TODO: Avoid converting the version ranges to strings.
  86 instance Ord OrderedVersionRange where
  87   compare = compare `on` show
  88
  89 showConflictSet :: ConflictSet -> String
  90 showConflictSet = intercalate ", " . map showVar . toList
  91
  92 showCSSortedByFrequency :: ConflictMap -> ConflictSet -> String
  93 showCSSortedByFrequency = showCS False
  94
  95 showCSWithFrequency :: ConflictMap -> ConflictSet -> String
  96 showCSWithFrequency = showCS True
  97
  98 showCS :: Bool -> ConflictMap -> ConflictSet -> String
  99 showCS showCount cm =
 100     intercalate ", " . map showWithFrequency . indexByFrequency
 101   where
 102     indexByFrequency = sortBy (flip compare `on` snd) . map (\c -> (c, M.lookup c cm)) . toList
 103     showWithFrequency (conflict, maybeFrequency) = case maybeFrequency of
 104       Just frequency
 105         | showCount -> showVar conflict ++ " (" ++ show frequency ++ ")"
 106       _             -> showVar conflict
 107
 108 {-------------------------------------------------------------------------------
 109   Set-like operations
 110 -------------------------------------------------------------------------------}
 111
 112 toSet :: ConflictSet -> Set (Var QPN)
 113 toSet = M.keysSet . conflictSetToMap
 114
 115 toList :: ConflictSet -> [Var QPN]
 116 toList = M.keys . conflictSetToMap
 117
 118 union :: ConflictSet -> ConflictSet -> ConflictSet
 119 union cs cs' = CS {
 120       conflictSetToMap = M.unionWith S.union (conflictSetToMap cs) (conflictSetToMap cs')
 121     }
 122
 123 unions :: [ConflictSet] -> ConflictSet
 124 unions css = CS {
 125       conflictSetToMap = M.unionsWith S.union (map conflictSetToMap css)
 126     }
 127
 128 insert :: Var QPN -> ConflictSet -> ConflictSet
 129 insert var cs = CS {
 130       conflictSetToMap = M.insert var (S.singleton OtherConflict) (conflictSetToMap cs)
 131     }
 132
 133 delete :: Var QPN -> ConflictSet -> ConflictSet
 134 delete var cs = CS {
 135       conflictSetToMap = M.delete var (conflictSetToMap cs)
 136     }
 137
 138 empty :: ConflictSet
 139 empty = CS {
 140       conflictSetToMap = M.empty
 141     }
 142
 143 singleton :: Var QPN -> ConflictSet
 144 singleton var = singletonWithConflict var OtherConflict
 145
 146 singletonWithConflict :: Var QPN -> Conflict -> ConflictSet
 147 singletonWithConflict var conflict = CS {
 148       conflictSetToMap = M.singleton var (S.singleton conflict)
 149     }
 150
 151 size :: ConflictSet -> Int
 152 size = M.size . conflictSetToMap
 153
 154 member :: Var QPN -> ConflictSet -> Bool
 155 member var = M.member var . conflictSetToMap
 156
 157 lookup :: Var QPN -> ConflictSet -> Maybe (Set Conflict)
 158 lookup var = M.lookup var . conflictSetToMap
 159
 160 fromList :: [Var QPN] -> ConflictSet
 161 fromList vars = CS {
 162       conflictSetToMap = M.fromList [(var, S.singleton OtherConflict) | var <- vars]
 163     }
 164
 165 type ConflictMap = Map (Var QPN) Int