module Holumbus.Data.MultiMap
(
MultiMap
, empty
, null
, insert
, insertSet
, insertKeys
, lookup
, keys
, elems
, filterElements
, member
, delete
, deleteKey
, deleteElem
, deleteAllElems
, fromList
, fromTupleList
, toList
, toAscList
)
where
import Prelude hiding (null, lookup)
import qualified Data.Map as Map
import qualified Data.Set as Set
data MultiMap k a = MM (Map.Map k (Set.Set a))
deriving (Show, Eq, Ord)
empty :: (Ord k, Ord a) => MultiMap k a
empty = MM Map.empty
null :: (Ord k, Ord a) => MultiMap k a -> Bool
null (MM m) = Map.null m
insert :: (Ord k, Ord a) => k -> a -> MultiMap k a -> MultiMap k a
insert k a (MM m) = MM $ Map.alter altering k m
where
altering Nothing = Just $ Set.singleton a
altering (Just s) = Just $ Set.insert a s
insertSet :: (Ord k, Ord a) => k -> Set.Set a -> MultiMap k a -> MultiMap k a
insertSet k newSet mm@(MM m) =
if (Set.null newSet) then mm else MM $ Map.alter altering k m
where
altering Nothing = Just newSet
altering (Just s) = Just $ Set.union newSet s
insertKeys :: (Ord k, Ord a) => [k] -> Set.Set a -> MultiMap k a -> MultiMap k a
insertKeys ks a m = foldl (\m' k -> insertSet k a m') m ks
lookup :: (Ord k, Ord a) => k -> MultiMap k a -> Set.Set a
lookup k (MM m) = maybe (Set.empty) (id) (Map.lookup k m)
lookupKeys :: (Ord k, Ord a) => [k] -> MultiMap k a -> Set.Set a
lookupKeys ks m = Set.unions $ map (\k -> lookup k m) ks
keys :: (Ord k, Ord a) => MultiMap k a -> Set.Set k
keys (MM m) = Set.fromList $ Map.keys m
elems :: (Ord k, Ord a) => MultiMap k a -> Set.Set a
elems (MM m) = Set.unions $ Map.elems m
filterElements :: (Ord k, Ord a) => [k] -> MultiMap k a -> Set.Set a
filterElements [] m = elems m
filterElements ks m = lookupKeys ks m
member :: (Ord k, Ord a) => k -> MultiMap k a -> Bool
member k m = Set.empty /= lookup k m
delete :: (Ord k, Ord a) => k -> Maybe a -> MultiMap k a -> MultiMap k a
delete k Nothing m = deleteKey k m
delete k (Just a) m = deleteElem k a m
deleteKey :: (Ord k, Ord a) => k -> MultiMap k a -> MultiMap k a
deleteKey k (MM m) = MM $ Map.delete k m
deleteElem :: (Ord k, Ord a) => k -> a -> MultiMap k a -> MultiMap k a
deleteElem k a (MM m) = MM $ Map.alter delSet k m
where
delSet Nothing = Nothing
delSet (Just set) = filterEmpty $ Set.delete a set
filterEmpty set
| set == Set.empty = Nothing
| otherwise = Just set
deleteAllElems :: (Ord k, Ord a) => a -> MultiMap k a -> MultiMap k a
deleteAllElems a m = foldl (\m'' k -> deleteElem k a m'') m ks
where
ks = Set.toList $ keys m
fromList :: (Ord k, Ord a) => [(k,Set.Set a)] -> MultiMap k a
fromList ks = foldl (\m (k,as) -> insertSet k as m) empty ks
fromTupleList :: (Ord k, Ord a) => [(k,a)] -> MultiMap k a
fromTupleList ks = foldl (\m (k,a) -> insert k a m) empty ks
toList :: (Ord k, Ord a) => MultiMap k a -> [(k,Set.Set a)]
toList (MM m) = Map.toList m
toAscList :: (Ord k, Ord a) => MultiMap k a -> [(k,Set.Set a)]
toAscList (MM m) = Map.toAscList m