Backport #18753 and #19962 to 2.9.x

sdk/compiler/damlc/daml-stdlib-src/DA/Map.daml

@@ -39,6 +39,8 @@ module DA.Map
     , toList
     , fromList
     , fromListWith
+    , fromListWithL
+    , fromListWithR
     , null
     , lookup
     , member
@@ -70,22 +72,38 @@ fromList : Ord k => [(k, v)] -> Map k v
 fromList list = foldl (\acc (key, value) -> insert key value acc) empty list
 
 -- | Create a map from a list of key/value pairs with a combining
--- function. Examples:
+-- function. The combining function is only used when a key appears multiple
+-- times in the list and it takes two arguments: the first one is the new value
+-- being inserted at that key and the second one is the value accumulated so
+-- far at that key.
+-- Examples:
 --
 -- ```
--- >>> fromListWith (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])]
+-- >>> fromListWithL (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])]
+-- fromList [("A", [3, 2, 1]), ("B", [1, 2])]
+-- >>> fromListWithL (++) [] == (empty : Map Text [Int])
+-- True
+-- ```
+fromListWithL : Ord k => (v -> v -> v) -> [(k, v)] -> Map k v
+fromListWithL f = foldl g empty
+  where
+    g acc (k, v) = insertWith f k v acc
+
+-- | Create a map from a list of key/value pairs like `fromListWithL`
+-- with the combining function flipped. Examples:
+--
+-- ```
+-- >>> fromListWithR (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])]
 -- fromList [("A", [1, 2, 3]), ("B", [2, 1])]
--- >>> fromListWith (++) [] == (empty : Map Text [Int])
+-- >>> fromListWithR (++) [] == (empty : Map Text [Int])
 -- True
 -- ```
+fromListWithR : Ord k => (v -> v -> v) -> [(k, v)] -> Map k v
+fromListWithR = fromListWithL . flip
+
+{-# DEPRECATED fromListWith "Daml compatibility helper, use 'fromListWithR' instead of 'fromListWith'" #-}
 fromListWith : Ord k => (v -> v -> v) -> [(k, v)] -> Map k v
-fromListWith f = foldl g empty
-  where
-    g acc (k, x) =
-      let z = case lookup k acc of
-            None -> x
-            Some y -> f y x
-      in insert k z acc
+fromListWith = fromListWithR
 
 -- | Get the list of keys in the map. Keys are sorted according to the
 -- built-in order for the type `k`, which matches the `Ord k` instance

sdk/compiler/damlc/daml-stdlib-src/DA/TextMap.daml

@@ -11,13 +11,16 @@ module DA.TextMap
   , toList
   , fromList
   , fromListWith
+  , fromListWithL
+  , fromListWithR
   , null
   , lookup
   , member
   , filter
   , filterWithKey
   , delete
   , insert
+  , insertWith
   , union
   , merge
   ) where
@@ -36,19 +39,38 @@ fromList : [(Text, a)] -> TextMap a
 fromList list = foldl (\acc (key, value) -> insert key value acc) empty list
 
 -- | Create a map from a list of key/value pairs with a combining
--- function. Examples:
+-- function. The combining function is only used when a key appears multiple
+-- times in the list and it takes two arguments: the first one is the new value
+-- being inserted at that key and the second one is the value accumulated so
+-- far at that key.
+-- Examples:
+--
 -- ```
---   fromListWith (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])] == fromList [("A", [1, 2, 3]), ("B", [2, 1])]
---   fromListWith (++) [] == (empty : TextMap [Int])
+-- >>> fromListWithL (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])]
+-- fromList [("A", [3, 2, 1]), ("B", [1, 2])]
+-- >>> fromListWithL (++) [] == (empty : TextMap [Int])
+-- True
 -- ```
-fromListWith : (a -> a -> a) -> [(Text, a)] -> TextMap a
-fromListWith f = foldl g empty
+fromListWithL : (a -> a -> a) -> [(Text, a)] -> TextMap a
+fromListWithL f = foldl g empty
   where
-    g acc (k, x) =
-      let z = case lookup k acc of
-            None -> x
-            Some y -> f y x
-      in insert k z acc
+    g acc (k, v) = insertWith f k v acc
+
+-- | Create a map from a list of key/value pairs like `fromListWithL`
+-- with the combining function flipped. Examples:
+--
+-- ```
+-- >>> fromListWithR (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])]
+-- fromList [("A", [1, 2, 3]), ("B", [2, 1])]
+-- >>> fromListWithR (++) [] == (empty : TextMap [Int])
+-- True
+-- ```
+fromListWithR : (a -> a -> a) -> [(Text, a)] -> TextMap a
+fromListWithR = fromListWithL . flip
+
+{-# DEPRECATED fromListWith "Daml compatibility helper, use 'fromListWithR' instead of 'fromListWith'" #-}
+fromListWith : (a -> a -> a) -> [(Text, a)] -> TextMap a
+fromListWith = fromListWithR
 
 -- | Convert the map to a list of key/value pairs where the keys are
 -- in ascending order.
@@ -96,6 +118,15 @@ delete = primitive @"BETextMapDelete"
 insert : Text -> a -> TextMap a -> TextMap a
 insert = primitive @"BETextMapInsert"
 
+-- | Insert a new key/value pair in the map. If the key is already
+-- present in the map, it is combined with the previous value using the given function
+-- `f new_value old_value`.
+insertWith : (v -> v -> v) -> Text -> v -> TextMap v -> TextMap v
+insertWith f k v m =
+  case lookup k m of
+    None -> insert k v m
+    Some v' -> insert k (f v v') m
+
 -- | The union of two maps, preferring the first map when equal
 -- keys are encountered.
 union : TextMap a -> TextMap a -> TextMap a

sdk/compiler/damlc/tests/daml-test-files/Map.daml

@@ -26,9 +26,13 @@ testFromList = script do
   True === member 3 (fromList [(1, "a"), (3, "b"), (4, "c")])
   [(1, "b")] === toList (fromList [(1, "a"), (1, "c"), (1, "b")])
 
-testFromListWith = script do
-  fromListWith (<>) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] === fromList [(5, "abc"), (3, "ba")]
-  fromListWith (<>) [] === (M.empty : Map Int Text)
+testFromListWithL = script do
+  fromListWithL (<>) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] === fromList [(5, "cba"), (3, "ab")]
+  fromListWithL (<>) [] === (M.empty : Map Int Text)
+
+testFromListWithR = script do
+  fromListWithR (<>) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] === fromList [(5, "abc"), (3, "ba")]
+  fromListWithR (<>) [] === (M.empty : Map Int Text)
 
 testMember = script do
   False === member "a" (fromList ([("", 1.0), ("b", 2.0), ("c", 3.0)] : [(Text, Decimal)]))
@@ -87,4 +91,4 @@ testUnionWith = script do
 
 testInsertWith = script do
   insertWith (-) 1 2 (fromList []) === fromList [(1, 2)]
-  insertWith (-) 1 2 (fromList [(1,1)]) === fromList [(1, 2-1)]
+  insertWith (-) 1 2 (fromList [(1,1)]) === fromList [(1, 2-1)]

sdk/compiler/damlc/tests/daml-test-files/TextMap.daml

@@ -24,9 +24,13 @@ testFromList = script do
   True === member "3" (fromList [("1", "a"), ("3", "b"), ("4", "c")])
   fromList [("1", "b")] === fromList [("1", "a"), ("1", "c"), ("1", "b")]
 
-testFromListWith = script do
-  fromListWith (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])] === fromList [("A", [1, 2, 3]), ("B", [2, 1])]
-  fromListWith (++) [] === (empty : TextMap [Int])
+testFromListWithL = script do
+  fromListWithL (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])] === fromList [("A", [3, 2, 1]), ("B", [1, 2])]
+  fromListWithL (++) [] === (empty : TextMap [Int])
+
+testFromListWithR = script do
+  fromListWithR (++) [("A", [1]), ("A", [2]), ("B", [2]), ("B", [1]), ("A", [3])] === fromList [("A", [1, 2, 3]), ("B", [2, 1])]
+  fromListWithR (++) [] === (empty : TextMap [Int])
 
 testMember = script do
   False === member "a" (fromList ([("", 1.0), ("b", 2.0), ("c", 3.0)] : [(Text, Decimal)]))
@@ -76,3 +80,7 @@ testMerge = script do
   [("A", "bb"), ("C", "aa")] === toList (merge (\_ v -> if v <= "bb" then Some v else None) (\_ v -> Some v) (\_ _ _ -> None) m1 empty)
   [("A", "a"), ("C", "b")] === toList (merge (\_ v -> Some v) (\_ v -> if v <= "bb" then Some v else None) (\_ _ _ -> None) empty m2)
   [("A","bb"), ("B","dd"), ("C","aa")] === toList (merge (\_ _ -> None) (\_ _ -> None) (\_ v _ -> Some v) m1 m2)
+
+testInsertWith = script do
+  insertWith (-) "A" 2 (fromList []) === fromList [("A", 2)]
+  insertWith (-) "A" 2 (fromList [("A",1)]) === fromList [("A", 2-1)]