From 8ee2bf0eb5739e1dd1b0a19138519cf661c38759 Mon Sep 17 00:00:00 2001 From: Zelenya Date: Wed, 23 Dec 2020 17:18:39 +0100 Subject: [PATCH 1/3] Add unionWith --- src/Foreign/Object.purs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Foreign/Object.purs b/src/Foreign/Object.purs index 773c769..9b3c29a 100644 --- a/src/Foreign/Object.purs +++ b/src/Foreign/Object.purs @@ -28,6 +28,7 @@ module Foreign.Object , keys , values , union + , unionWith , unions , isSubmap , fold @@ -262,6 +263,12 @@ values = toArrayWithKey (\_ v -> v) union :: forall a. Object a -> Object a -> Object a union m = mutate (\s -> foldM (\s' k v -> OST.poke k v s') s m) +-- | Compute the union of two maps. If a key exists in both maps, +-- | its value is computed using the supplied function +unionWith :: forall a. (a -> a -> a) -> Object a -> Object a -> Object a +unionWith f m1 m2 = + mutate (\s1 -> foldM (\s2 k v2 -> OST.poke k (runFn4 _lookup v2 (\v1 -> f v2 v1) k m2) s2) s1 m1) m2 + -- | Compute the union of a collection of maps unions :: forall f a. Foldable f => f (Object a) -> Object a unions = foldl union empty From 32eddf76b7409b827bf0e68dbdbc84a29d3bb520 Mon Sep 17 00:00:00 2001 From: Zelenya Date: Wed, 23 Dec 2020 17:27:54 +0100 Subject: [PATCH 2/3] Add unionWith --- test/Test/Foreign/Object.purs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/test/Test/Foreign/Object.purs b/test/Test/Foreign/Object.purs index ff4cbe2..ad33951 100644 --- a/test/Test/Foreign/Object.purs +++ b/test/Test/Foreign/Object.purs @@ -2,6 +2,8 @@ module Test.Foreign.Object where import Prelude +import Control.Alt ((<|>)) +import Control.Apply (lift2) import Control.Monad.Writer (runWriter, tell) import Data.Array as A import Data.Foldable (foldl, foldr) @@ -9,7 +11,7 @@ import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex, foldMapWithIndex) import Data.Function (on) import Data.List as L import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe(..), fromJust) import Data.NonEmpty ((:|)) import Data.Traversable (sequence, traverse) import Data.TraversableWithIndex (traverseWithIndex) @@ -190,6 +192,24 @@ objectTests = do log "Union is idempotent" quickCheck $ \(TestObject m1) (TestObject m2) -> (m1 `O.union` m2) == ((m1 `O.union` m2) `O.union` (m2 :: O.Object Int)) (show (O.size (m1 `O.union` m2)) <> " != " <> show (O.size ((m1 `O.union` m2) `O.union` m2))) + + log "Lookup from unionWith" + quickCheck $ \(TestObject m1 :: TestObject Int) (TestObject m2 :: TestObject Int) k -> let + v1 = O.lookup k m1 + v2 = O.lookup k m2 + f a1 a2 = a1 - a2 + in case O.lookup k (O.unionWith f m1 m2) of + Nothing -> not (O.member k m1 || O.member k m2) + ("k: " <> show k <> ", v1: " <> show v1 <> ", v2: " <> show v2 <> ", key doesn't appear in the union object") + Just v -> + let expected = unsafePartial fromJust $ lift2 f v1 v2 <|> v1 <|> v2 + in v == expected + ("k: " <> show k <> ", v1: " <> show v1 <> ", v2: " <> show v2 <> ", expected: " <> show expected <> ", actual: " <> show v) + + log "union = unionWith const" + quickCheck $ \(TestObject m1 :: TestObject Int) (TestObject m2 :: TestObject Int) -> + O.union m1 m2 == O.unionWith const m1 m2 + (show (O.union m1 m2) <> " != " <> show (O.unionWith const m1 m2)) log "fromFoldable = zip keys values" quickCheck $ \(TestObject m) -> O.toUnfoldable m == A.zipWith Tuple (O.keys m) (O.values m :: Array Int) From a2b1d15f07234254edbb2a9dbccc752a5c001b59 Mon Sep 17 00:00:00 2001 From: Zelenya Date: Thu, 24 Dec 2020 10:20:57 +0100 Subject: [PATCH 3/3] Add unionWith --- src/Foreign/Object.purs | 6 ++--- test/Test/Foreign/Object.purs | 51 +++++++++++++++-------------------- 2 files changed, 24 insertions(+), 33 deletions(-) diff --git a/src/Foreign/Object.purs b/src/Foreign/Object.purs index 9b3c29a..ac63708 100644 --- a/src/Foreign/Object.purs +++ b/src/Foreign/Object.purs @@ -263,11 +263,11 @@ values = toArrayWithKey (\_ v -> v) union :: forall a. Object a -> Object a -> Object a union m = mutate (\s -> foldM (\s' k v -> OST.poke k v s') s m) --- | Compute the union of two maps. If a key exists in both maps, --- | its value is computed using the supplied function +-- | Compute the union of two maps, using the specified function +-- | to combine values for duplicate keys. unionWith :: forall a. (a -> a -> a) -> Object a -> Object a -> Object a unionWith f m1 m2 = - mutate (\s1 -> foldM (\s2 k v2 -> OST.poke k (runFn4 _lookup v2 (\v1 -> f v2 v1) k m2) s2) s1 m1) m2 + mutate (\s1 -> foldM (\s2 k v1 -> OST.poke k (runFn4 _lookup v1 (\v2 -> f v1 v2) k m2) s2) s1 m1) m2 -- | Compute the union of a collection of maps unions :: forall f a. Foldable f => f (Object a) -> Object a diff --git a/test/Test/Foreign/Object.purs b/test/Test/Foreign/Object.purs index ad33951..4577346 100644 --- a/test/Test/Foreign/Object.purs +++ b/test/Test/Foreign/Object.purs @@ -2,16 +2,14 @@ module Test.Foreign.Object where import Prelude -import Control.Alt ((<|>)) -import Control.Apply (lift2) import Control.Monad.Writer (runWriter, tell) import Data.Array as A -import Data.Foldable (foldl, foldr) +import Data.Foldable (foldl, foldr, for_) import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex, foldMapWithIndex) import Data.Function (on) import Data.List as L import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..), fromJust) +import Data.Maybe (Maybe(..), fromMaybe) import Data.NonEmpty ((:|)) import Data.Traversable (sequence, traverse) import Data.TraversableWithIndex (traverseWithIndex) @@ -183,33 +181,26 @@ objectTests = do L.groupBy ((==) `on` fst) <<< L.sortBy (compare `on` fst) in O.fromFoldableWith (<>) arr == f (arr :: L.List (Tuple String String)) show arr - log "Lookup from union" + log "unionWith" + for_ [Tuple (+) 0, Tuple (*) 1] $ \(Tuple op ident) -> + quickCheck $ \(TestObject m1) (TestObject m2) k -> + let u = O.unionWith op m1 m2 :: Object Int + in case O.lookup k u of + Nothing -> not (O.member k m1 || O.member k m2) + Just v -> v == op (fromMaybe ident (O.lookup k m1)) (fromMaybe ident (O.lookup k m2)) + + log "unionWith argument order" quickCheck $ \(TestObject m1) (TestObject m2) k -> - O.lookup k (O.union m1 m2) == (case O.lookup k m1 of - Nothing -> O.lookup k m2 - Just v -> Just (number v)) ("m1: " <> show m1 <> ", m2: " <> show m2 <> ", k: " <> show k <> ", v1: " <> show (O.lookup k m1) <> ", v2: " <> show (O.lookup k m2) <> ", union: " <> show (O.union m1 m2)) - - log "Union is idempotent" - quickCheck $ \(TestObject m1) (TestObject m2) -> - (m1 `O.union` m2) == ((m1 `O.union` m2) `O.union` (m2 :: O.Object Int)) (show (O.size (m1 `O.union` m2)) <> " != " <> show (O.size ((m1 `O.union` m2) `O.union` m2))) - - log "Lookup from unionWith" - quickCheck $ \(TestObject m1 :: TestObject Int) (TestObject m2 :: TestObject Int) k -> let - v1 = O.lookup k m1 - v2 = O.lookup k m2 - f a1 a2 = a1 - a2 - in case O.lookup k (O.unionWith f m1 m2) of - Nothing -> not (O.member k m1 || O.member k m2) - ("k: " <> show k <> ", v1: " <> show v1 <> ", v2: " <> show v2 <> ", key doesn't appear in the union object") - Just v -> - let expected = unsafePartial fromJust $ lift2 f v1 v2 <|> v1 <|> v2 - in v == expected - ("k: " <> show k <> ", v1: " <> show v1 <> ", v2: " <> show v2 <> ", expected: " <> show expected <> ", actual: " <> show v) - - log "union = unionWith const" - quickCheck $ \(TestObject m1 :: TestObject Int) (TestObject m2 :: TestObject Int) -> - O.union m1 m2 == O.unionWith const m1 m2 - (show (O.union m1 m2) <> " != " <> show (O.unionWith const m1 m2)) + let u = O.unionWith (-) m1 m2 :: Object Int + in1 = O.member k m1 + v1 = O.lookup k m1 + in2 = O.member k m2 + v2 = O.lookup k m2 + in case O.lookup k u of + Just v | in1 && in2 -> Just v == ((-) <$> v1 <*> v2) + Just v | in1 -> Just v == v1 + Just v -> Just v == v2 + Nothing -> not (in1 || in2) log "fromFoldable = zip keys values" quickCheck $ \(TestObject m) -> O.toUnfoldable m == A.zipWith Tuple (O.keys m) (O.values m :: Array Int)