diff options
author | Tom Smeding <tom@tomsmeding.com> | 2024-03-24 17:07:06 +0100 |
---|---|---|
committer | Tom Smeding <tom@tomsmeding.com> | 2024-03-24 17:07:06 +0100 |
commit | 5ec984da477375794f31b6484b929c21046c6849 (patch) | |
tree | 01f8556a4236386f9e32f00d6d747e9bb2883252 /src/Data | |
parent | 2de6cede93912457babc79bcb0f58c9e6b20f05a (diff) |
WIP
Diffstat (limited to 'src/Data')
-rw-r--r-- | src/Data/Map/Monoidal.hs | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/src/Data/Map/Monoidal.hs b/src/Data/Map/Monoidal.hs new file mode 100644 index 0000000..7007934 --- /dev/null +++ b/src/Data/Map/Monoidal.hs @@ -0,0 +1,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) |