aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Map/Monoidal.hs
blob: 7007934525ac2ab1f16c5f2f8eb84a354c6e9eff (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
{-# LANGUAGE DeriveTraversable #-}
module Data.Map.Monoidal where

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)


newtype MMap k v = MMap (Map k v)
  deriving (Show, Functor, Foldable, Traversable)

instance (Ord k, Semigroup v) => Semigroup (MMap k v) where
  MMap m1 <> MMap m2 = MMap (Map.unionWith (<>) m1 m2)

instance (Ord k, Semigroup v) => Monoid (MMap k v) where
  mempty = MMap Map.empty

fromList :: (Ord k, Semigroup v) => [(k, v)] -> MMap k v
fromList l = MMap (Map.fromListWith (<>) l)

singleton :: k -> v -> MMap k v
singleton k v = MMap (Map.singleton k v)

lookup :: (Ord k, Monoid v) => k -> MMap k v -> v
lookup k (MMap m) = fromMaybe mempty (Map.lookup k m)

lookup' :: Ord k => k -> MMap k v -> Maybe v
lookup' k (MMap m) = Map.lookup k m

insert :: (Ord k, Semigroup v) => k -> v -> MMap k v -> MMap k v
insert k v (MMap m) = MMap (Map.insertWith (<>) k v m)