Fix partitionDefault and add instances for Map (#9)

Author: LiamGoodacre

bower.json

@@ -22,7 +22,8 @@
     "purescript-identity": "^3.0.0",
     "purescript-arrays": "^4.0.0",
     "purescript-either": "^3.0.0",
-    "purescript-lists": "^4.1.1"
+    "purescript-lists": "^4.1.1",
+    "purescript-maps": "^3.0.0"
   },
   "devDependencies": {
     "purescript-assert": "^3.0.0",

src/Data/Filterable.purs

@@ -21,9 +21,11 @@ import Data.Foldable (foldl, foldr)
 import Data.Functor (class Functor)
 import Data.List (List(..), filter, mapMaybe) as List
 import Data.Maybe (Maybe(..))
+import Data.Map (Map, empty, insert, alter, toUnfoldable) as Map
 import Data.Monoid (class Monoid, mempty)
 import Data.Semigroup ((<>))
-import Prelude (const)
+import Data.Tuple (Tuple(..))
+import Prelude (const, class Ord)
 
 -- | `Filterable` represents data structures which can be _partitioned_/_filtered_.
 -- |
@@ -56,7 +58,7 @@ class (Functor f) <= Filterable f where
 -- | Upgrade a boolean-style predicate to an either-style predicate mapping.
 eitherBool :: forall a.
   (a -> Boolean) -> a -> Either a a
-eitherBool p x = if p x then Left x else Right x
+eitherBool p x = if p x then Right x else Left x
 
 -- | A default implementation of `partition` using `partitionMap`.
 partitionDefault :: forall f a. Filterable f =>
@@ -149,3 +151,27 @@ instance filterableList :: Filterable List.List where
 
   -- filter :: forall a. (a -> Boolean) -> List a -> List a
   filter = List.filter
+
+instance filterableMap :: Ord k => Filterable (Map.Map k) where
+  partitionMap p xs =
+    foldr select { left: Map.empty, right: Map.empty } (toList xs)
+    where
+      toList :: forall v. Map.Map k v -> List.List (Tuple k v)
+      toList = Map.toUnfoldable
+
+      select (Tuple k x) { left, right } = case p x of
+        Left l -> { left: Map.insert k l left, right }
+        Right r -> { left, right: Map.insert k r right }
+
+  partition p = partitionDefault p
+
+  filterMap p xs =
+    foldr select Map.empty (toList xs)
+    where
+      toList :: forall v. Map.Map k v -> List.List (Tuple k v)
+      toList = Map.toUnfoldable
+
+      select (Tuple k x) m = Map.alter (const (p x)) k m
+
+  filter p = filterDefault p
+

src/Data/Witherable.purs

@@ -18,10 +18,12 @@ import Data.Functor (map)
 import Data.Identity (Identity(..))
 import Data.List (List)
 import Data.Maybe (Maybe(..))
+import Data.Map (Map)
 import Data.Monoid (class Monoid, mempty)
 import Data.Newtype (unwrap)
 import Data.Traversable (class Traversable, traverse)
 import Data.Unit (unit)
+import Prelude (class Ord)
 
 -- | `Witherable` represents data structures which can be _partitioned_ with
 -- | effects in some `Applicative` functor.
@@ -94,6 +96,10 @@ instance witherableList :: Witherable List where
   wilt p xs = map partitioned (traverse p xs)
   wither p xs = map filtered (traverse p xs)
 
+instance witherableMap :: Ord k => Witherable (Map k) where
+  wilt p xs = map partitioned (traverse p xs)
+  wither p xs = map filtered (traverse p xs)
+
 instance witherableMaybe :: Witherable Maybe where
   wilt p Nothing = pure { left: Nothing, right: Nothing }
   wilt p (Just x) = map convert (p x) where

test/Main.purs

@@ -8,6 +8,8 @@ import Data.Filterable (filter, filterMap, partition, partitionMap)
 import Data.Identity (Identity(Identity))
 import Data.List (List(Nil), (:))
 import Data.Maybe (Maybe(..))
+import Data.Map (fromFoldable) as Map
+import Data.Tuple (Tuple(..))
 import Data.Witherable (wither)
 import Test.Assert (ASSERT, assert)
 
@@ -53,4 +55,16 @@ main = do
     assert $ filter (_ > 5) [1,2,3,4,5,6,7,8,9] == [6,7,8,9]
     assert $ partition (_ > 5) [1,2,3,4,5,6,7,8,9] `testEqNoYes` { no: [1,2,3,4,5], yes: [6,7,8,9]}
 
+  log "Test filterableMap instance" *> do
+    let pred x = if x > 2 then Just (x * 10) else Nothing
+    let predE x = if x > 2 then Right (x * 10) else Left x
+    let m = Map.fromFoldable
+    let xs = m [Tuple 1 1, Tuple 2 2, Tuple 3 3, Tuple 4 4]
+    assert $ filterMap pred xs == m [Tuple 3 30, Tuple 4 40]
+    assert $ filter (_ > 2) xs == m [Tuple 3 3, Tuple 4 4]
+    assert $ partition (_ > 2) xs `testEqNoYes` { no: m [Tuple 1 1, Tuple 2 2]
+                                                , yes: m [Tuple 3 3, Tuple 4 4] }
+    assert $ partitionMap predE xs `testEqLeftRight` { left: m [Tuple 1 1, Tuple 2 2]
+                                                     , right: m [Tuple 3 30, Tuple 4 40] }
+
   log "All done!"