aboutsummaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2024-03-24 17:07:06 +0100
committerTom Smeding <tom@tomsmeding.com>2024-03-24 17:07:06 +0100
commit5ec984da477375794f31b6484b929c21046c6849 (patch)
tree01f8556a4236386f9e32f00d6d747e9bb2883252 /src/Data
parent2de6cede93912457babc79bcb0f58c9e6b20f05a (diff)
WIP
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Map/Monoidal.hs31
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)