Add Apply instance for Map (#16)

Co-authored-by: Thomas Honeyman <[email protected]>

Author: rhendric

src/Data/Map/Internal.purs

@@ -106,6 +106,12 @@ instance functorWithIndexMap :: FunctorWithIndex k (Map k) where
   mapWithIndex f (Two left k v right) = Two (mapWithIndex f left) k (f k v) (mapWithIndex f right)
   mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right)
 
+instance applyMap :: Ord k => Apply (Map k) where
+  apply = intersectionWith identity
+
+instance bindMap :: Ord k => Bind (Map k) where
+  bind m f = mapMaybeWithKey (\k -> lookup k <<< f) m
+
 instance foldableMap :: Foldable (Map k) where
   foldl   f z m = foldl   f z (values m)
   foldr   f z m = foldr   f z (values m)

src/Data/Set.purs

@@ -162,7 +162,7 @@ properSubset s1 s2 = subset s1 s2 && (s1 /= s2)
 
 -- | The set of elements which are in both the first and second set
 intersection :: forall a. Ord a => Set a -> Set a -> Set a
-intersection s1 s2 = fromFoldable (ST.run (STArray.empty >>= intersect >>= STArray.unsafeFreeze))
+intersection s1 s2 = fromFoldable (ST.run (STArray.new >>= intersect >>= STArray.unsafeFreeze))
   where
   toArray = Array.fromFoldable <<< toList
   ls = toArray s1

test/Test/Data/Map.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Control.Alt ((<|>))
 import Data.Array as A
+import Data.Array.NonEmpty as NEA
 import Data.Foldable (foldl, for_, all, and)
 import Data.FoldableWithIndex (foldrWithIndex)
 import Data.Function (on)
@@ -44,7 +45,7 @@ instance showSmallKey :: Show SmallKey where
   show J = "J"
 
 instance arbSmallKey :: Arbitrary SmallKey where
-  arbitrary = elements $ A :| [B, C, D, E, F, G, H, I, J]
+  arbitrary = elements $ NEA.fromNonEmpty $ A :| [B, C, D, E, F, G, H, I, J]
 
 data Instruction k v = Insert k v | Delete k
 
@@ -53,7 +54,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where
   show (Delete k) = "Delete (" <> show k <> ")"
 
 instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where
-  arbitrary = oneOf $ (Insert <$> arbitrary <*> arbitrary) :| [Delete <$> arbitrary]
+  arbitrary = oneOf $ NEA.fromNonEmpty $ (Insert <$> arbitrary <*> arbitrary) :| [Delete <$> arbitrary]
 
 runInstructions :: forall k v. Ord k => List (Instruction k v) -> M.Map k v -> M.Map k v
 runInstructions instrs t0 = foldl step t0 instrs
@@ -240,6 +241,12 @@ mapTests = do
            Nothing -> not (M.member k m1 && M.member k m2)
            Just v -> Just v == (op <$> M.lookup k m1 <*> M.lookup k m2)
 
+  log "map-apply is equivalent to intersectionWith"
+  for_ [(+), (*)] $ \op ->
+    quickCheck $ \(TestMap m1) (TestMap m2) ->
+      let u = M.intersectionWith op m1 m2 :: M.Map SmallKey Int
+      in u == (op <$> m1 <*> m2)
+
   log "difference"
   quickCheck $ \(TestMap m1) (TestMap m2) ->
     let d = M.difference (m1 :: M.Map SmallKey Int) (m2 :: M.Map SmallKey String)
@@ -315,23 +322,23 @@ mapTests = do
 
   log "filterWithKey keeps those keys for which predicate is true"
   quickCheck $ \(TestMap s :: TestMap String Int) p ->
-                 A.all (uncurry p) (M.toUnfoldable (M.filterWithKey p s) :: Array (Tuple String Int))
+                 all (uncurry p) (M.toUnfoldable (M.filterWithKey p s) :: Array (Tuple String Int))
 
   log "filterKeys gives submap"
   quickCheck $ \(TestMap s :: TestMap String Int) p ->
                  M.isSubmap (M.filterKeys p s) s
 
   log "filterKeys keeps those keys for which predicate is true"
   quickCheck $ \(TestMap s :: TestMap String Int) p ->
-                 A.all p (M.keys (M.filterKeys p s))
+                 all p (M.keys (M.filterKeys p s))
 
   log "filter gives submap"
   quickCheck $ \(TestMap s :: TestMap String Int) p ->
                  M.isSubmap (M.filter p s) s
 
   log "filter keeps those values for which predicate is true"
   quickCheck $ \(TestMap s :: TestMap String Int) p ->
-                 A.all p (M.values (M.filter p s))
+                 all p (M.values (M.filter p s))
 
   log "submap with no bounds = id"
   quickCheck \(TestMap m :: TestMap SmallKey Int) ->
@@ -371,6 +378,17 @@ mapTests = do
     let outList = foldrWithIndex (\i a b -> (Tuple i a) : b) Nil m
     in outList == sort outList
 
+  log "bind"
+  quickCheck $ \(TestMap m1) (TestMap m2 :: TestMap SmallKey Int) (TestMap m3) k ->
+    let
+      u = do
+        v <- m1
+        if v then m2 else m3
+    in case M.lookup k m1 of
+      Just true -> M.lookup k m2 == M.lookup k u
+      Just false -> M.lookup k m3 == M.lookup k u
+      Nothing -> not $ M.member k u
+
   log "catMaybes creates a new map of size less than or equal to the original"
   quickCheck \(TestMap m :: TestMap Int (Maybe Int)) -> do
     let result = M.catMaybes m