From 47c95590ec9c10a493bb72d64bda6f63952d7365 Mon Sep 17 00:00:00 2001 From: Andrew Condon Date: Sat, 13 May 2017 17:18:11 +0200 Subject: [PATCH] add instances for List and a couple of tests (#7) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * add instances for List and a couple of tests no tests for Witherable List or Witherable Array yet * fix error in List foldMap and formatting issues * replace non-performant snoc with Cons… …reverting to foldr. --- bower.json | 3 ++- src/Data/Filterable.purs | 36 +++++++++++++++++++++++++++++------- src/Data/Witherable.purs | 16 ++++++++++------ test/Main.purs | 28 +++++++++++++++++++++++++++- 4 files changed, 68 insertions(+), 15 deletions(-) diff --git a/bower.json b/bower.json index d212d0b..d1f14b8 100644 --- a/bower.json +++ b/bower.json @@ -21,7 +21,8 @@ "purescript-foldable-traversable": "^3.0.0", "purescript-identity": "^3.0.0", "purescript-arrays": "^4.0.0", - "purescript-either": "^3.0.0" + "purescript-either": "^3.0.0", + "purescript-lists": "^4.1.1" }, "devDependencies": { "purescript-assert": "^3.0.0", diff --git a/src/Data/Filterable.purs b/src/Data/Filterable.purs index 72f6068..b430b1d 100644 --- a/src/Data/Filterable.purs +++ b/src/Data/Filterable.purs @@ -13,16 +13,17 @@ module Data.Filterable , cleared ) where -import Prelude (const) -import Control.Category ((<<<), id) import Control.Bind ((=<<)) -import Data.Semigroup ((<>)) +import Control.Category ((<<<), id) +import Data.Array (partition, mapMaybe, filter) as Array +import Data.Either (Either(..)) +import Data.Foldable (foldl, foldr) import Data.Functor (class Functor) -import Data.Foldable (foldl) -import Data.Monoid (class Monoid, mempty) +import Data.List (List(..), filter, mapMaybe) as List import Data.Maybe (Maybe(..)) -import Data.Either (Either(..)) -import Data.Array (partition, mapMaybe, filter) as Array +import Data.Monoid (class Monoid, mempty) +import Data.Semigroup ((<>)) +import Prelude (const) -- | `Filterable` represents data structures which can be _partitioned_/_filtered_. -- | @@ -127,3 +128,24 @@ instance filterableEither :: Monoid m => Filterable (Either m) where filter p = filterDefault p +instance filterableList :: Filterable List.List where + -- partitionMap :: forall a l r. (a -> Either l r) -> List a -> { left :: List l, right :: List r } + partitionMap p xs = foldr select { left: List.Nil, right: List.Nil } xs + where + select x { left, right } = case p x of + Left l -> { left: List.Cons l left, right } + Right r -> { left, right: List.Cons r right } + + -- partition :: forall a. (a -> Boolean) -> List a -> { no :: List a, yes :: List a } + partition p xs = foldr select { no: List.Nil, yes: List.Nil } xs + where + -- select :: (a -> Boolean) -> a -> { no :: List a, yes :: List a } -> { no :: List a, yes :: List a } + select x { no, yes } = if p x + then { no, yes: List.Cons x yes } + else { no: List.Cons x no, yes } + + -- filterMap :: forall a b. (a -> Maybe b) -> List a -> List b + filterMap p = List.mapMaybe p + + -- filter :: forall a. (a -> Boolean) -> List a -> List a + filter = List.filter diff --git a/src/Data/Witherable.purs b/src/Data/Witherable.purs index ab72544..cd2ee3b 100644 --- a/src/Data/Witherable.purs +++ b/src/Data/Witherable.purs @@ -10,17 +10,18 @@ module Data.Witherable , module Data.Filterable ) where -import Data.Unit (unit) -import Control.Category ((<<<), id) import Control.Applicative (class Applicative, pure) -import Data.Monoid (class Monoid, mempty) -import Data.Identity (Identity(..)) +import Control.Category ((<<<), id) +import Data.Either (Either(..)) import Data.Filterable (class Filterable, partitioned, filtered) import Data.Functor (map) -import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.List (List) import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid, mempty) import Data.Newtype (unwrap) import Data.Traversable (class Traversable, traverse) +import Data.Unit (unit) -- | `Witherable` represents data structures which can be _partitioned_ with -- | effects in some `Applicative` functor. @@ -89,6 +90,10 @@ instance witherableArray :: Witherable Array where wilt p xs = map partitioned (traverse p xs) wither p xs = map filtered (traverse p xs) +instance witherableList :: Witherable List 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 @@ -108,4 +113,3 @@ instance witherableEither :: Monoid m => Witherable (Either m) where wither p (Right er) = map convert (p er) where convert Nothing = Left mempty convert (Just r) = Right r - diff --git a/test/Main.purs b/test/Main.purs index f8f607f..23ec876 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,12 +3,23 @@ module Test.Main where import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) -import Data.Filterable (filter, filterMap) +import Data.Either (Either(..)) +import Data.Filterable (filter, filterMap, partition, partitionMap) import Data.Identity (Identity(Identity)) +import Data.List (List(Nil), (:)) import Data.Maybe (Maybe(..)) import Data.Witherable (wither) import Test.Assert (ASSERT, assert) +testEqNoYes :: ∀ a. (Ord a) => { no :: a, yes :: a } -> { no :: a, yes :: a } -> Boolean +testEqNoYes { no: n1, yes: y1 } { no: n2, yes: y2 } = + n1 == n2 && y1 == y2 + +testEqLeftRight :: ∀ a. (Ord a) => { left :: a, right :: a } -> { left :: a, right :: a } -> Boolean +testEqLeftRight { left: l1, right: r1 } { left: l2, right: r2 } = + l1 == l2 && r1 == r2 + + main :: Eff (console :: CONSOLE, assert :: ASSERT) Unit main = do log "Test filterableMaybe instance" *> do @@ -27,4 +38,19 @@ main = do assert $ wither pred (Just 5) == Identity Nothing assert $ wither pred Nothing == Identity Nothing + log "Test filterableList instance" *> do + let pred x = if x > 5 then Just (x * 10) else Nothing + let testlist = (1 : 2 : 3 : 4 : 5 : 6 : 7 : 8 : 9 : Nil) + assert $ filterMap pred testlist == (60 : 70 : 80 : 90 : Nil) + assert $ filter (_ > 5) testlist == (6 : 7 : 8 : 9 : Nil) + assert $ partition (_ > 5) testlist `testEqNoYes` { no: (1 : 2 : 3 : 4 : 5 : Nil), yes: (6 : 7 : 8 : 9 : Nil)} + assert $ (partitionMap Right $ (1 : 2 : 3 : 4 : 5 : Nil)).right == (1 : 2 : 3 : 4 : 5 : Nil) + assert $ (partitionMap Left $ (1 : 2 : 3 : 4 : 5 : Nil)).left == (1 : 2 : 3 : 4 : 5 : Nil) + + log "Test filterableArray instance" *> do + let pred x = if x > 5 then Just (x * 10) else Nothing + assert $ filterMap pred [1,2,3,4,5,6,7,8,9] == [60,70,80,90] + 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 "All done!"