module Util.SetLike where
import Data.List(foldl')
import Data.Monoid
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Util.HasSize
import Data.Foldable hiding(toList, foldl')
import Data.Traversable
infixl 9 \\
(\\) :: Unionize s => s -> s -> s
m1 \\ m2 = difference m1 m2
class Monoid s => Unionize s where
union :: s -> s -> s
difference :: s -> s -> s
intersection :: s -> s -> s
unions :: [s] -> s
sempty :: s
sempty = mempty
union = mappend
unions = foldl' union mempty
type family Elem es :: *
type family Key s :: *
type family Value m :: *
class Monoid s => Collection s where
fromList :: [Elem s] -> s
fromDistinctAscList :: [Elem s] -> s
toList :: s -> [Elem s]
singleton :: Elem s -> s
singleton e = fromList [e]
fromDistinctAscList = fromList
class Collection s => SetLike s where
keys :: s -> [Key s]
member :: Key s -> s -> Bool
delete :: Key s -> s -> s
sfilter :: (Elem s -> Bool) -> s -> s
insert :: Elem s -> s -> s
spartition :: (Elem s -> Bool) -> s -> (s,s)
notMember :: SetLike s => Key s -> s -> Bool
notMember k s = not $ member k s
class SetLike m => MapLike m where
mlookup :: Key m -> m -> Maybe (Value m)
values :: m -> [Value m]
unionWith :: (Value m -> Value m -> Value m) -> m -> m -> m
instance Unionize IS.IntSet where
union = IS.union
difference = IS.difference
intersection = IS.intersection
type instance Elem IS.IntSet = Int
instance Collection IS.IntSet where
fromList = IS.fromList
toList = IS.toList
singleton = IS.singleton
fromDistinctAscList = IS.fromDistinctAscList
type instance Key IS.IntSet = Int
instance SetLike IS.IntSet where
keys = IS.toList
member = IS.member
sfilter = IS.filter
delete = IS.delete
insert = IS.insert
spartition = IS.partition
instance Ord k => Unionize (S.Set k) where
union = S.union
intersection = S.intersection
difference = S.difference
type instance Elem (S.Set k) = k
instance Ord k => Collection (S.Set k) where
fromList = S.fromList
toList = S.toList
singleton = S.singleton
fromDistinctAscList = S.fromDistinctAscList
type instance Key (S.Set k) = k
instance Ord k => SetLike (S.Set k) where
keys = S.toList
member = S.member
sfilter = S.filter
delete = S.delete
insert = S.insert
spartition = S.partition
instance Unionize (IM.IntMap v) where
union = IM.union
difference = IM.difference
intersection = IM.intersection
type instance Elem (IM.IntMap v) = (Int,v)
instance Collection (IM.IntMap v) where
fromList = IM.fromList
toList = IM.toList
singleton (k,v) = IM.singleton k v
fromDistinctAscList = IM.fromDistinctAscList
type instance Key (IM.IntMap v) = Int
instance SetLike (IM.IntMap v) where
keys = IM.keys
member = IM.member
sfilter f = IM.filterWithKey (\ k v -> f (k,v))
delete = IM.delete
insert (k,v) = IM.insert k v
spartition f = IM.partitionWithKey (\ k v -> f (k,v))
type instance Value (IM.IntMap v) = v
instance MapLike (IM.IntMap v) where
mlookup = IM.lookup
values = IM.elems
unionWith = IM.unionWith
instance Ord k => Unionize (M.Map k v) where
union = M.union
difference = M.difference
intersection = M.intersection
type instance Elem (M.Map k v) = (k,v)
instance Ord k => Collection (M.Map k v) where
fromList = M.fromList
toList = M.toList
singleton (k,v) = M.singleton k v
fromDistinctAscList = M.fromDistinctAscList
type instance Key (M.Map k v) = k
instance Ord k => SetLike (M.Map k v) where
keys = M.keys
member = M.member
sfilter f = M.filterWithKey (\ k v -> f (k,v))
delete = M.delete
insert (k,v) = M.insert k v
spartition f = M.partitionWithKey (\ k v -> f (k,v))
type instance Value (M.Map k v) = v
instance Ord k => MapLike (M.Map k v) where
mlookup = M.lookup
values = M.elems
unionWith = M.unionWith
minsert :: (MapLike m, Elem m ~ (k,v)) => k -> v -> m -> m
minsert k v = insert (k,v)
msingleton :: (MapLike m, Elem m ~ (k,v)) => k -> v -> m
msingleton k v = singleton (k,v)
intersects x y = not $ isEmpty (x `intersection` y)
findWithDefault :: MapLike m => Value m -> Key m -> m -> Value m
findWithDefault d k m = case mlookup k m of
Nothing -> d
Just x -> x
newtype EnumSet a = EnumSet IS.IntSet
deriving(Monoid,IsEmpty,HasSize,Unionize,Eq,Ord)
type instance Elem (EnumSet a) = a
type instance Key (EnumSet a) = a
instance Enum a => Collection (EnumSet a) where
singleton i = EnumSet $ singleton (fromEnum i)
fromList ts = EnumSet $ fromList (map fromEnum ts)
toList (EnumSet w) = map toEnum $ toList w
instance Enum a => SetLike (EnumSet a) where
keys = toList
delete (fromEnum -> i) (EnumSet v) = EnumSet $ delete i v
member (fromEnum -> i) (EnumSet v) = member i v
insert (fromEnum -> i) (EnumSet v) = EnumSet $ insert i v
sfilter f (EnumSet v) = EnumSet $ sfilter (f . toEnum) v
spartition f (EnumSet v) = case spartition (f . toEnum) v of
(x,y) -> (EnumSet x,EnumSet y)
newtype EnumMap k v = EnumMap (IM.IntMap v)
deriving(Monoid,IsEmpty,Functor,Foldable,Traversable,HasSize,Unionize,Eq,Ord)
type instance Elem (EnumMap k v) = (k,v)
type instance Key (EnumMap k v) = k
type instance Value (EnumMap k v) = v
instance Enum k => Collection (EnumMap k v) where
singleton (k,v) = EnumMap $ singleton (fromEnum k,v)
fromList ts = EnumMap $ fromList [ (fromEnum k,v) | (k,v) <- ts ]
toList (EnumMap kv) = [ (toEnum k,v) | (k,v) <- toList kv]
instance Enum k => SetLike (EnumMap k v) where
keys (EnumMap v) = map toEnum $ keys v
delete (fromEnum -> i) (EnumMap v) = EnumMap $ delete i v
member (fromEnum -> i) (EnumMap v) = member i v
insert (fromEnum -> k,v) (EnumMap m) = EnumMap $ insert (k,v) m
sfilter f (EnumMap v) = EnumMap $ sfilter (\ (k,v) -> f (toEnum k,v)) v
spartition f (EnumMap v) = case spartition (\ (k,v) -> f (toEnum k,v)) v of
(x,y) -> (EnumMap x,EnumMap y)
instance Enum k => MapLike (EnumMap k v) where
mlookup (fromEnum -> i) (EnumMap v) = mlookup i v
values (EnumMap v) = values v
unionWith f (EnumMap x) (EnumMap y) = EnumMap $ unionWith f x y
class Intjection a where
fromIntjection :: a -> Int
toIntjection :: Int -> a
newtype IntjectionSet a = IntjectionSet IS.IntSet
deriving(Monoid,IsEmpty,HasSize,Unionize,Eq,Ord)
instance (Intjection a,Show a) => Show (IntjectionSet a) where
showsPrec n is = showsPrec n $ toList is
type instance Elem (IntjectionSet a) = a
type instance Key (IntjectionSet a) = a
instance Intjection a => Collection (IntjectionSet a) where
singleton i = IntjectionSet $ singleton (fromIntjection i)
fromList ts = IntjectionSet $ fromList (map fromIntjection ts)
toList (IntjectionSet w) = map toIntjection $ toList w
instance Intjection a => SetLike (IntjectionSet a) where
keys = toList
delete (fromIntjection -> i) (IntjectionSet v) = IntjectionSet $ delete i v
member (fromIntjection -> i) (IntjectionSet v) = member i v
insert (fromIntjection -> i) (IntjectionSet v) = IntjectionSet $ insert i v
sfilter f (IntjectionSet v) = IntjectionSet $ sfilter (f . toIntjection) v
spartition f (IntjectionSet v) = case spartition (f . toIntjection) v of
(x,y) -> (IntjectionSet x,IntjectionSet y)
newtype IntjectionMap k v = IntjectionMap (IM.IntMap v)
deriving(Monoid,IsEmpty,Functor,Foldable,Traversable,HasSize,Unionize,Eq,Ord)
type instance Elem (IntjectionMap k v) = (k,v)
type instance Key (IntjectionMap k v) = k
type instance Value (IntjectionMap k v) = v
instance Intjection k => Collection (IntjectionMap k v) where
singleton (k,v) = IntjectionMap $ singleton (fromIntjection k,v)
fromList ts = IntjectionMap $ fromList [ (fromIntjection k,v) | (k,v) <- ts ]
toList (IntjectionMap kv) = [ (toIntjection k,v) | (k,v) <- toList kv]
instance Intjection k => SetLike (IntjectionMap k v) where
keys (IntjectionMap v) = map toIntjection $ keys v
delete (fromIntjection -> i) (IntjectionMap v) = IntjectionMap $ delete i v
member (fromIntjection -> i) (IntjectionMap v) = member i v
insert (fromIntjection -> k,v) (IntjectionMap m) = IntjectionMap $ insert (k,v) m
sfilter f (IntjectionMap v) = IntjectionMap $ sfilter (\ (k,v) -> f (toIntjection k,v)) v
spartition f (IntjectionMap v) = case spartition (\ (k,v) -> f (toIntjection k,v)) v of
(x,y) -> (IntjectionMap x,IntjectionMap y)
instance Intjection k => MapLike (IntjectionMap k v) where
mlookup (fromIntjection -> i) (IntjectionMap v) = mlookup i v
values (IntjectionMap v) = values v
unionWith f (IntjectionMap x) (IntjectionMap y) = IntjectionMap $ unionWith f x y