Re-add Semigroup/Monoid Map instances with Warn (#54)

* Add Semigroup/Monoid Map instance with Warn

* Ignore user defined warning

* Drop udw censoring since only test uses it

* Added changelog entry

Author: JordanMartinez

CHANGELOG.md

@@ -9,6 +9,7 @@ Breaking changes:
 
 New features:
 - Exported `Data.Map.Internal` data constructors (#52 by @natefaubion)
+- Add unbiased `Semigroup`/`Monoid` instances to `Map` with `Warn` (#54 by @JordanMartinez)
 
 Bugfixes:
 

src/Data/Map/Internal.purs

@@ -64,6 +64,7 @@ import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
 import Data.Tuple (Tuple(Tuple), snd, uncurry)
 import Data.Unfoldable (class Unfoldable, unfoldr)
 import Partial.Unsafe (unsafePartial)
+import Prim.TypeError (class Warn, Text)
 
 -- | `Map k v` represents maps from keys of type `k` to values of type `v`.
 data Map k v
@@ -92,6 +93,20 @@ instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where
 instance showMap :: (Show k, Show v) => Show (Map k v) where
   show m = "(fromFoldable " <> show (toAscArray m) <> ")"
 
+instance semigroupMap ::
+  ( Warn (Text "Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.")
+  , Ord k
+  , Semigroup v
+  ) => Semigroup (Map k v) where
+  append l r = unionWith append l r
+
+instance monoidSemigroupMap ::
+  ( Warn (Text "Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.")
+  , Ord k
+  , Semigroup v
+  ) => Monoid (Map k v) where
+  mempty = empty
+
 instance altMap :: Ord k => Alt (Map k) where
   alt = union
 

test/Test/Data/Map.purs

@@ -402,6 +402,27 @@ mapTests = do
     let expected = M.delete 1 m
     result === expected
 
+  log "SemigroupMap's Semigroup instance is based on value's Semigroup instance"
+  quickCheck \(Tuple leftStr rightStr :: Tuple String String) -> do
+    let key = "foo"
+    let left = M.singleton key leftStr
+    let right = M.singleton key rightStr
+    let result = left <> right
+    let expected = M.singleton key $ leftStr <> rightStr
+    result == expected
+  quickCheck \(Tuple leftStr rightStr :: Tuple String String) -> do
+    let key = "foo"
+    let left = M.singleton key $ First leftStr
+    let right = M.singleton key $ First rightStr
+    let result = left <> right
+    result == left
+  quickCheck \(Tuple leftStr rightStr :: Tuple String String) -> do
+    let key = "foo"
+    let left = M.singleton key $ Last leftStr
+    let right = M.singleton key $ Last rightStr
+    let result = left <> right
+    result == right
+
   log "SemigroupMap's Semigroup instance is based on value's Semigroup instance"
   quickCheck \(Tuple leftStr rightStr :: Tuple String String) -> do
     let key = "foo"