module Data.MultiMap
(
MultiMap
, mkMultiMap
, fromSingletons
, itemed
, reverse
)
where
import KMonad.Prelude hiding (reverse)
import qualified RIO.HashMap as M
import qualified RIO.HashSet as S
type CanMM k v = (Eq k, Ord v, Hashable k, Hashable v)
newtype MultiMap k v = MultiMap { _unMM :: M.HashMap k (S.HashSet v) }
deriving Show
makeLenses ''MultiMap
instance (CanMM k v) => Semigroup (MultiMap k v) where
(MultiMap a) <> (MultiMap b) = MultiMap $ M.unionWith (<>) a b
instance (CanMM k v) => Monoid (MultiMap k v) where
mempty = MultiMap $ M.empty
type instance Index (MultiMap k v) = k
type instance IxValue (MultiMap k v) = S.HashSet v
instance CanMM k v => Ixed (MultiMap k v)
instance CanMM k v => At (MultiMap k v) where
at k = unMM . at k
mkMultiMap :: (Foldable t1, Foldable t2, CanMM k v)
=> t1 (k, t2 v) -> MultiMap k v
mkMultiMap = foldMap
( MultiMap
. uncurry M.singleton
. over _2 (S.fromList . toList)
)
fromSingletons :: (Foldable t, CanMM k v)
=> t (k, v) -> MultiMap k v
fromSingletons = mkMultiMap . map (over _2 (:[])) . toList
itemed :: (CanMM k v) => Fold (MultiMap k v) (k, v)
itemed = folding $ \m -> m ^@.. unMM . ifolded <. folded
reverse :: (CanMM k v, CanMM v k) => MultiMap k v -> MultiMap v k
reverse m = mkMultiMap $ m ^.. itemed . swapped . to (over _2 (:[]))