Add fromListUpsert for HashMap

Add fromListUpsert for compatibility with containers, which added it
in PR #1190:

  fromListUpsert :: Hashable k => (a -> Maybe v -> v) -> [(k, a)] -> HashMap k v

This builds a map from a list, using the provided function to combine
values. Equivalent to performing an upsert for each key/value pair.

Assisted-by: GLM-5 via Fireworks AI <noreply@fireworks.ai>

Author: sjakobi

Data/HashMap/Internal.hs

@@ -112,6 +112,7 @@ module Data.HashMap.Internal
     , fromList
     , fromListWith
     , fromListWithKey
+    , fromListUpsert
 
       -- ** Internals used by the strict version
     , Hash
@@ -2746,6 +2747,33 @@ fromListWithKey :: Hashable k => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v
 fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey (\k' a b -> (# f k' a b #)) k v m) empty
 {-# INLINE fromListWithKey #-}
 
+-- | \(O(n \log n)\) Construct a map from a list of elements.  Uses
+-- the provided function to combine values.
+--
+-- The result is equivalent to performing an 'upsert' for every key\/value
+-- in the list.
+--
+-- @
+-- fromListUpsert f = 'List.foldl'' (\\m (k, x) -> 'upsert' (f x) k m) 'empty'
+-- @
+--
+-- ==== __Examples__
+--
+-- Group all values by their keys:
+--
+-- > let xs = [('a', 1), ('b', 2), ('a', 3)]
+-- > in fromListUpsert (\x -> maybe [x] (x:)) xs
+-- >
+-- > = fromList [('a', [3, 1]), ('b', [2])]
+--
+-- Note that the lists in the resulting map contain elements in reverse order
+-- from their occurrences in the original list.
+--
+-- @since 0.2.21
+fromListUpsert :: Hashable k => (a -> Maybe v -> v) -> [(k, a)] -> HashMap k v
+fromListUpsert f = List.foldl' (\ m (k, x) -> upsert (f x) k m) empty
+{-# INLINE fromListUpsert #-}
+
 ------------------------------------------------------------------------
 -- Array operations
 

Data/HashMap/Internal/Strict.hs

@@ -125,6 +125,7 @@ module Data.HashMap.Internal.Strict
     , fromList
     , fromListWith
     , fromListWithKey
+    , fromListUpsert
     ) where
 
 import Control.Applicative   (Const (..))
@@ -757,6 +758,33 @@ fromListWithKey :: Hashable k => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v
 fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) HM.empty
 {-# INLINE fromListWithKey #-}
 
+-- | \(O(n \log n)\) Construct a map from a list of elements.  Uses
+-- the provided function to combine values.
+--
+-- The result is equivalent to performing an 'upsert' for every key\/value
+-- in the list.
+--
+-- @
+-- fromListUpsert f = 'List.foldl'' (\\m (k, x) -> 'upsert' (f x) k m) 'empty'
+-- @
+--
+-- ==== __Examples__
+--
+-- Group all values by their keys:
+--
+-- > let xs = [('a', 1), ('b', 2), ('a', 3)]
+-- > in fromListUpsert (\x -> maybe [x] (x:)) xs
+-- >
+-- > = fromList [('a', [3, 1]), ('b', [2])]
+--
+-- Note that the lists in the resulting map contain elements in reverse order
+-- from their occurrences in the original list.
+--
+-- @since 0.2.21
+fromListUpsert :: Hashable k => (a -> Maybe v -> v) -> [(k, a)] -> HashMap k v
+fromListUpsert f = List.foldl' (\ m (k, x) -> upsert (f x) k m) HM.empty
+{-# INLINE fromListUpsert #-}
+
 ------------------------------------------------------------------------
 -- Array operations
 

Data/HashMap/Lazy.hs

@@ -105,6 +105,7 @@ module Data.HashMap.Lazy
     , fromList
     , fromListWith
     , fromListWithKey
+    , fromListUpsert
 
       -- ** HashSets
     , HS.keysSet

Data/HashMap/Strict.hs

@@ -104,6 +104,7 @@ module Data.HashMap.Strict
     , fromList
     , fromListWith
     , fromListWithKey
+    , fromListUpsert
 
       -- ** HashSets
     , HS.keysSet

tests/Properties/HashMapLazy.hs

@@ -486,6 +486,13 @@ tests =
       , testProperty "valid" $
         \(Fn3 f) (kvs :: [(Key, A)]) -> isValid (HM.fromListWithKey f kvs)
       ]
+    , testGroup "fromListUpsert"
+      [ testProperty "model" $
+        \(Fn2 f :: Fun (A, Maybe A) A) (kvs :: [(Key, A)]) ->
+          toOrdMap (HM.fromListUpsert f kvs) === M.fromListUpsert f kvs
+      , testProperty "valid" $
+        \(Fn2 f :: Fun (A, Maybe A) A) (kvs :: [(Key, A)]) -> isValid (HM.fromListUpsert f kvs)
+      ]
     , testProperty "toList" $
       \(m :: HMKI) -> List.sort (HM.toList m) === List.sort (M.toList (toOrdMap m))
     ]