From 120b5216c31c832526b82095e4ac6b1e16f0fb71 Mon Sep 17 00:00:00 2001 From: Cyril Sobierajewicz Date: Tue, 24 Nov 2020 19:36:46 +0100 Subject: [PATCH] Fix the Semigroup instance for Foreign.Object.Object The Semigroup instance for Foreign.Object.Object currently appends values from the right to values from the left: `singleton k a <> singleton k b` is equivalent to `singleton k (b <> a)` and not to `singleton k (a <> b)` as expected. --- src/Foreign/Object.purs | 2 +- test/Test/Foreign/Object.purs | 13 ++++++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/Foreign/Object.purs b/src/Foreign/Object.purs index e295df7..b2b78cf 100644 --- a/src/Foreign/Object.purs +++ b/src/Foreign/Object.purs @@ -273,7 +273,7 @@ mapWithKey :: forall a b. (String -> a -> b) -> Object a -> Object b mapWithKey f m = runFn2 _mapWithKey m f instance semigroupObject :: (Semigroup a) => Semigroup (Object a) where - append m1 m2 = mutate (\s1 -> foldM (\s2 k v2 -> OST.poke k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2) s2) s1 m1) m2 + append m1 m2 = mutate (\s1 -> foldM (\s2 k v1 -> OST.poke k (runFn4 _lookup v1 (\v2 -> v1 <> v2) k m2) s2) s1 m1) m2 instance monoidObject :: (Semigroup a) => Monoid (Object a) where mempty = empty diff --git a/test/Test/Foreign/Object.purs b/test/Test/Foreign/Object.purs index ff4cbe2..e737a41 100644 --- a/test/Test/Foreign/Object.purs +++ b/test/Test/Foreign/Object.purs @@ -11,12 +11,13 @@ import Data.List as L import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) +import Data.Semigroup.First (First(..)) +import Data.Semigroup.Last (Last(..)) import Data.Traversable (sequence, traverse) import Data.TraversableWithIndex (traverseWithIndex) import Data.Tuple (Tuple(..), fst, snd, uncurry) import Effect (Effect) import Effect.Console (log) -import Foreign.Object (Object) import Foreign.Object as O import Foreign.Object.Gen (genForeignObject) import Partial.Unsafe (unsafePartial) @@ -257,3 +258,13 @@ objectTests = do { expected: entries , actual: O.size (O.fromFoldable (map (\x -> Tuple (show x) x) (A.range 1 entries))) } + + log "Semigroup instance" + assertEqual + { expected: O.singleton "a" (First 1) + , actual: O.singleton "a" (First 1) <> O.singleton "a" (First 2) + } + assertEqual + { expected: O.singleton "a" (Last 2) + , actual: O.singleton "a" (Last 1) <> O.singleton "a" (Last 2) + }