Added fromListWith

Author: pseudonom

src/Data/Map.purs

@@ -15,6 +15,7 @@ module Data.Map
     lookup,
     toList,
     fromList,
+    fromListWith,
     delete,
     member,
     alter,
@@ -228,6 +229,11 @@ toList (Three left k1 v1 mid k2 v2 right) = toList left P.++ [Tuple k1 v1] P.++
 fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v
 fromList = foldl (\m (Tuple k v) -> insert k v m) empty
 
+fromListWith :: forall k v. (P.Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v
+fromListWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where
+  combine v (Just v') = Just P.$ f v v'
+  combine v Nothing = Just v
+
 keys :: forall k v. Map k v -> [k]
 keys Leaf = []
 keys (Two left k _ right) = keys left P.++ [k] P.++ keys right

src/Data/StrMap.purs

@@ -14,6 +14,7 @@ module Data.StrMap
     lookup,
     toList,
     fromList,
+    fromListWith,
     delete,
     member,
     alter,
@@ -255,6 +256,21 @@ fromList l = pureST (do
   for_ l (\(Tuple k v) -> SM.poke s k v)
   P.return s)
 
+foreign import _lookupST
+  """
+  function _lookupST(no, yes, k, m) {
+    return function() {
+      return k in m ? yes(m[k]) : no;
+    }
+  }
+  """ :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z)
+
+fromListWith :: forall a. (a -> a -> a) -> [Tuple String a] -> StrMap a
+fromListWith f l = pureST (do
+  s <- SM.new
+  for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s P.>>= SM.poke s k)
+  P.return s)
+
 foreign import _collect
   """
   function _collect(f) {