{-# LANGUAGE CPP #-}
#ifdef DEBUG_CONFLICT_SETS
{-# LANGUAGE ImplicitParams #-}
#endif
module Distribution.Solver.Modular.ConflictSet (
ConflictSet
, Conflict(..)
, ConflictMap
, OrderedVersionRange(..)
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin
#endif
, showConflictSet
, showCSSortedByFrequency
, showCSWithFrequency
, toSet
, toList
, union
, unions
, insert
, delete
, empty
, singleton
, singletonWithConflict
, size
, member
, lookup
, filter
, fromList
) where
import Prelude hiding (lookup)
import Data.List (intercalate, sortBy)
import Data.Map (Map)
import Data.Set (Set)
import Data.Function (on)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
#ifdef DEBUG_CONFLICT_SETS
import Data.Tree
import GHC.Stack
#endif
import Distribution.Solver.Modular.Var
import Distribution.Solver.Modular.Version
import Distribution.Solver.Types.PackagePath
data ConflictSet = CS {
ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap :: !(Map (Var QPN) (Set Conflict))
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin :: Tree CallStack
#endif
}
deriving (Int -> ConflictSet -> ShowS
[ConflictSet] -> ShowS
ConflictSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConflictSet] -> ShowS
$cshowList :: [ConflictSet] -> ShowS
show :: ConflictSet -> String
$cshow :: ConflictSet -> String
showsPrec :: Int -> ConflictSet -> ShowS
$cshowsPrec :: Int -> ConflictSet -> ShowS
Show)
data Conflict =
GoalConflict QPN
| VersionConstraintConflict QPN Ver
| VersionConflict QPN OrderedVersionRange
| OtherConflict
deriving (Conflict -> Conflict -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conflict -> Conflict -> Bool
$c/= :: Conflict -> Conflict -> Bool
== :: Conflict -> Conflict -> Bool
$c== :: Conflict -> Conflict -> Bool
Eq, Eq Conflict
Conflict -> Conflict -> Bool
Conflict -> Conflict -> Ordering
Conflict -> Conflict -> Conflict
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Conflict -> Conflict -> Conflict
$cmin :: Conflict -> Conflict -> Conflict
max :: Conflict -> Conflict -> Conflict
$cmax :: Conflict -> Conflict -> Conflict
>= :: Conflict -> Conflict -> Bool
$c>= :: Conflict -> Conflict -> Bool
> :: Conflict -> Conflict -> Bool
$c> :: Conflict -> Conflict -> Bool
<= :: Conflict -> Conflict -> Bool
$c<= :: Conflict -> Conflict -> Bool
< :: Conflict -> Conflict -> Bool
$c< :: Conflict -> Conflict -> Bool
compare :: Conflict -> Conflict -> Ordering
$ccompare :: Conflict -> Conflict -> Ordering
Ord, Int -> Conflict -> ShowS
[Conflict] -> ShowS
Conflict -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conflict] -> ShowS
$cshowList :: [Conflict] -> ShowS
show :: Conflict -> String
$cshow :: Conflict -> String
showsPrec :: Int -> Conflict -> ShowS
$cshowsPrec :: Int -> Conflict -> ShowS
Show)
newtype OrderedVersionRange = OrderedVersionRange VR
deriving (OrderedVersionRange -> OrderedVersionRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderedVersionRange -> OrderedVersionRange -> Bool
$c/= :: OrderedVersionRange -> OrderedVersionRange -> Bool
== :: OrderedVersionRange -> OrderedVersionRange -> Bool
$c== :: OrderedVersionRange -> OrderedVersionRange -> Bool
Eq, Int -> OrderedVersionRange -> ShowS
[OrderedVersionRange] -> ShowS
OrderedVersionRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderedVersionRange] -> ShowS
$cshowList :: [OrderedVersionRange] -> ShowS
show :: OrderedVersionRange -> String
$cshow :: OrderedVersionRange -> String
showsPrec :: Int -> OrderedVersionRange -> ShowS
$cshowsPrec :: Int -> OrderedVersionRange -> ShowS
Show)
instance Ord OrderedVersionRange where
compare :: OrderedVersionRange -> OrderedVersionRange -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Show a => a -> String
show
instance Eq ConflictSet where
== :: ConflictSet -> ConflictSet -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
instance Ord ConflictSet where
compare :: ConflictSet -> ConflictSet -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
showConflictSet :: ConflictSet -> String
showConflictSet :: ConflictSet -> String
showConflictSet = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Var QPN -> String
showVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> [Var QPN]
toList
showCSSortedByFrequency :: ConflictMap -> ConflictSet -> String
showCSSortedByFrequency :: ConflictMap -> ConflictSet -> String
showCSSortedByFrequency = Bool -> ConflictMap -> ConflictSet -> String
showCS Bool
False
showCSWithFrequency :: ConflictMap -> ConflictSet -> String
showCSWithFrequency :: ConflictMap -> ConflictSet -> String
showCSWithFrequency = Bool -> ConflictMap -> ConflictSet -> String
showCS Bool
True
showCS :: Bool -> ConflictMap -> ConflictSet -> String
showCS :: Bool -> ConflictMap -> ConflictSet -> String
showCS Bool
showCount ConflictMap
cm =
forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (Var QPN, Maybe a) -> String
showWithFrequency forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> [(Var QPN, Maybe Int)]
indexByFrequency
where
indexByFrequency :: ConflictSet -> [(Var QPN, Maybe Int)]
indexByFrequency = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Var QPN
c -> (Var QPN
c, forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var QPN
c ConflictMap
cm)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> [Var QPN]
toList
showWithFrequency :: (Var QPN, Maybe a) -> String
showWithFrequency (Var QPN
conflict, Maybe a
maybeFrequency) = case Maybe a
maybeFrequency of
Just a
frequency
| Bool
showCount -> Var QPN -> String
showVar Var QPN
conflict forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
frequency forall a. [a] -> [a] -> [a]
++ String
")"
Maybe a
_ -> Var QPN -> String
showVar Var QPN
conflict
toSet :: ConflictSet -> Set (Var QPN)
toSet :: ConflictSet -> Set (Var QPN)
toSet = forall k a. Map k a -> Set k
M.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
toList :: ConflictSet -> [Var QPN]
toList :: ConflictSet -> [Var QPN]
toList = forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
union ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
ConflictSet -> ConflictSet -> ConflictSet
union :: ConflictSet -> ConflictSet -> ConflictSet
union ConflictSet
cs ConflictSet
cs' = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Ord a => Set a -> Set a -> Set a
S.union (ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap ConflictSet
cs) (ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap ConflictSet
cs')
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin = Node ?loc (map conflictSetOrigin [cs, cs'])
#endif
}
unions ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
[ConflictSet] -> ConflictSet
unions :: [ConflictSet] -> ConflictSet
unions [ConflictSet]
css = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith forall a. Ord a => Set a -> Set a -> Set a
S.union (forall a b. (a -> b) -> [a] -> [b]
map ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap [ConflictSet]
css)
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin = Node ?loc (map conflictSetOrigin css)
#endif
}
insert ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
Var QPN -> ConflictSet -> ConflictSet
insert :: Var QPN -> ConflictSet -> ConflictSet
insert Var QPN
var ConflictSet
cs = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var QPN
var (forall a. a -> Set a
S.singleton Conflict
OtherConflict) (ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap ConflictSet
cs)
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin = Node ?loc [conflictSetOrigin cs]
#endif
}
delete :: Var QPN -> ConflictSet -> ConflictSet
delete :: Var QPN -> ConflictSet -> ConflictSet
delete Var QPN
var ConflictSet
cs = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall k a. Ord k => k -> Map k a -> Map k a
M.delete Var QPN
var (ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap ConflictSet
cs)
}
empty ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
ConflictSet
empty :: ConflictSet
empty = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall k a. Map k a
M.empty
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin = Node ?loc []
#endif
}
singleton ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
Var QPN -> ConflictSet
singleton :: Var QPN -> ConflictSet
singleton Var QPN
var = Var QPN -> Conflict -> ConflictSet
singletonWithConflict Var QPN
var Conflict
OtherConflict
singletonWithConflict ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
Var QPN -> Conflict -> ConflictSet
singletonWithConflict :: Var QPN -> Conflict -> ConflictSet
singletonWithConflict Var QPN
var Conflict
conflict = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall k a. k -> a -> Map k a
M.singleton Var QPN
var (forall a. a -> Set a
S.singleton Conflict
conflict)
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin = Node ?loc []
#endif
}
size :: ConflictSet -> Int
size :: ConflictSet -> Int
size = forall k a. Map k a -> Int
M.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
member :: Var QPN -> ConflictSet -> Bool
member :: Var QPN -> ConflictSet -> Bool
member Var QPN
var = forall k a. Ord k => k -> Map k a -> Bool
M.member Var QPN
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
lookup :: Var QPN -> ConflictSet -> Maybe (Set Conflict)
lookup :: Var QPN -> ConflictSet -> Maybe (Set Conflict)
lookup Var QPN
var = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var QPN
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConflictSet -> Map (Var QPN) (Set Conflict)
conflictSetToMap
fromList ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
[Var QPN] -> ConflictSet
fromList :: [Var QPN] -> ConflictSet
fromList [Var QPN]
vars = CS {
conflictSetToMap :: Map (Var QPN) (Set Conflict)
conflictSetToMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var QPN
var, forall a. a -> Set a
S.singleton Conflict
OtherConflict) | Var QPN
var <- [Var QPN]
vars]
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin = Node ?loc []
#endif
}
type ConflictMap = Map (Var QPN) Int