diff --git a/src/Data/Filterable.purs b/src/Data/Filterable.purs index a19c093..750ca82 100644 --- a/src/Data/Filterable.purs +++ b/src/Data/Filterable.purs @@ -15,6 +15,22 @@ module Data.Filterable , filterDefaultPartitionMap , filterMapDefault , cleared + , class FilterableWithIndex + , ipartitionMap + , ipartition + , ifilterMap + , ifilter + , ieitherBool + , ipartitionDefault + , ipartitionDefaultFilter + , ipartitionDefaultFilterMap + , ipartitionMapDefault + , imaybeBool + , ifilterDefault + , ifilterDefaultPartition + , ifilterDefaultPartitionMap + , ifilterMapDefault + , icleared , module Data.Compactable ) where @@ -24,7 +40,9 @@ import Data.Array (partition, mapMaybe, filter) as Array import Data.Compactable (class Compactable, compact, separate) import Data.Either (Either(..)) import Data.Foldable (foldl, foldr) +import Data.FoldableWithIndex (foldlWithIndex) import Data.Functor (class Functor, map) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.HeytingAlgebra (not) import Data.List (List(..), filter, mapMaybe) as List import Data.Map (Map, empty, insert, alter, toUnfoldable) as Map @@ -34,6 +52,88 @@ import Data.Semigroup ((<>)) import Data.Tuple (Tuple(..)) import Prelude (const, class Ord) +class (Filterable f, FunctorWithIndex i f) <= FilterableWithIndex i f | f -> i where + ipartitionMap :: forall a l r. + (i -> a -> Either l r) -> f a -> { left :: f l, right :: f r } + + ipartition :: forall a. + (i -> a -> Boolean) -> f a -> { no :: f a, yes :: f a } + + ifilterMap :: forall a b. + (i -> a -> Maybe b) -> f a -> f b + + ifilter :: forall a. + (i -> a -> Boolean) -> f a -> f a + +-- | Upgrade a boolean-style predicate to an either-style predicate mapping. +ieitherBool :: forall a i. + (i -> a -> Boolean) -> i -> a -> Either a a +ieitherBool p i x = if p i x then Right x else Left x + +-- | Upgrade a boolean-style predicate to a maybe-style predicate mapping. +imaybeBool :: forall a i. + (i -> a -> Boolean) -> i -> a -> Maybe a +imaybeBool p i x = if p i x then Just x else Nothing + +-- | A default implementation of `ipartitionMap` using `separate`. Note that this is +-- | almost certainly going to be suboptimal compared to direct implementations. +ipartitionMapDefault :: forall f a l r i. FilterableWithIndex i f => + (i -> a -> Either l r) -> f a -> { left :: f l, right :: f r } +ipartitionMapDefault p = separate <<< mapWithIndex p + +-- | A default implementation of `ipartition` using `ipartitionMap`. +ipartitionDefault :: forall f i a. FilterableWithIndex i f => + (i -> a -> Boolean) -> f a -> { no :: f a, yes :: f a } +ipartitionDefault p xs = let o = ipartitionMap (ieitherBool p) xs in {no: o.left, yes: o.right} + +-- | A default implementation of `ipartition` using `ifilter`. Note that this is +-- | almost certainly going to be suboptimal compared to direct implementations. +ipartitionDefaultFilter :: forall f a i. FilterableWithIndex i f => + (i -> a -> Boolean) -> f a -> { no :: f a, yes :: f a } +ipartitionDefaultFilter p xs = { yes: ifilter p xs, no: ifilter (not p) xs } + +-- | A default implementation of `ifilterMap` using `separate`. Note that this is +-- | almost certainly going to be suboptimal compared to direct implementations. +ifilterMapDefault :: forall f i a b. FilterableWithIndex i f => + (i -> a -> Maybe b) -> f a -> f b +ifilterMapDefault p = compact <<< mapWithIndex p + +-- | A default implementation of `ipartition` using `ifilterMap`. Note that this +-- | is almost certainly going to be suboptimal compared to direct +-- | implementations. +ipartitionDefaultFilterMap :: forall f i a. FilterableWithIndex i f => + (i -> a -> Boolean) -> f a -> { no :: f a, yes :: f a } +ipartitionDefaultFilterMap p xs = {yes: ifilterMap (imaybeBool p) xs, no: ifilterMap (imaybeBool (not p)) xs} + +-- | A default implementation of `ifilter` using `ifilterMap`. +ifilterDefault :: forall f i a. FilterableWithIndex i f => + (i -> a -> Boolean) -> f a -> f a +ifilterDefault = ifilterMap <<< imaybeBool + +-- | A default implementation of `ifilter` using `ipartition`. +ifilterDefaultPartition :: forall f i a. FilterableWithIndex i f => + (i -> a -> Boolean) -> f a -> f a +ifilterDefaultPartition p xs = (ipartition p xs).yes + +-- | A default implementation of `ifilter` using `ipartitionMap`. +ifilterDefaultPartitionMap :: forall f i a. FilterableWithIndex i f => + (i -> a -> Boolean) -> f a -> f a +ifilterDefaultPartitionMap p xs = (ipartitionMap (ieitherBool p) xs).right + +-- | Filter out all values. +icleared :: forall f i a b. FilterableWithIndex i f => + f a -> f b +icleared = ifilterMap \i a -> Nothing + +instance filterableWithIndexArray :: FilterableWithIndex Int Array where + ipartitionMap p = foldlWithIndex go {left: [], right: []} where + go i acc x = case p i x of + Left l -> acc { left = acc.left <> [l] } + Right r -> acc { right = acc.right <> [r] } + ipartition p = ipartitionDefault p + ifilterMap p = ifilterMapDefault p + ifilter p = ifilterDefault p + -- | `Filterable` represents data structures which can be _partitioned_/_filtered_. -- | -- | - `partitionMap` - partition a data structure based on an either predicate. diff --git a/src/Data/Witherable.purs b/src/Data/Witherable.purs index a55772b..4379228 100644 --- a/src/Data/Witherable.purs +++ b/src/Data/Witherable.purs @@ -9,6 +9,16 @@ module Data.Witherable , withered , witherDefault , wiltDefault + , class WitherableWithIndex + , iwilt + , iwither + , ipartitionMapByWilt + , ifilterMapByWither + , itraverseByWither + , iwilted + , iwithered + , iwitherDefault + , iwiltDefault , module Data.Filterable ) where @@ -26,9 +36,56 @@ import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid, mempty) import Data.Newtype (unwrap) import Data.Traversable (class Traversable, traverse) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(..)) import Prelude (class Ord) +class (TraversableWithIndex i t, Witherable t) <= WitherableWithIndex i t | t -> i where + iwilt :: forall m a l r. Applicative m => + (i -> a -> m (Either l r)) -> t a -> m { left :: t l, right :: t r } + + iwither :: forall m a b. Applicative m => + (i -> a -> m (Maybe b)) -> t a -> m (t b) + +-- | A default implementation of `iwilt` using `separate` +iwiltDefault :: forall t m a l r i. WitherableWithIndex i t => Applicative m => + (i -> a -> m (Either l r)) -> t a -> m { left :: t l, right :: t r } +iwiltDefault p = map separate <<< traverseWithIndex p + +-- | A default implementation of `iwither` using `compact`. +iwitherDefault :: forall t m a b i. WitherableWithIndex i t => Applicative m => + (i -> a -> m (Maybe b)) -> t a -> m (t b) +iwitherDefault p = map compact <<< traverseWithIndex p + +-- | A default implementation of `ipartitionMap` given a `WitherableWithIndex`. +ipartitionMapByWilt :: forall t a l r i. WitherableWithIndex i t => + (i -> a -> Either l r) -> t a -> { left :: t l, right :: t r } +ipartitionMapByWilt p = unwrap <<< iwilt (\i a -> Identity (p i a)) + +-- | A default implementation of `ifilterMap` given a `WitherableWithIndex`. +ifilterMapByWither :: forall t a b i. WitherableWithIndex i t => + (i -> a -> Maybe b) -> t a -> t b +ifilterMapByWither p = unwrap <<< iwither (\i a -> Identity (p i a)) + +-- | A default implementation of `itraverse` given a `WitherableWithIndex`. +itraverseByWither :: forall t m a b i. WitherableWithIndex i t => Applicative m => + (i -> a -> m b) -> t a -> m (t b) +itraverseByWither f = iwither (\i a -> map Just (f i a)) + +-- | Partition between `Left` and `Right` values - with effects in `m`. +iwilted :: forall t m l r i. WitherableWithIndex i t => Applicative m => + t (m (Either l r)) -> m { left :: t l, right :: t r } +iwilted = iwilt (\i a -> a) + +-- | Filter out all the `Nothing` values - with effects in `m`. +iwithered :: forall t m x i. WitherableWithIndex i t => Applicative m => + t (m (Maybe x)) -> m (t x) +iwithered = iwither (\i a -> a) + +instance iwitherableArray :: WitherableWithIndex Int Array where + iwilt = iwiltDefault + iwither = iwitherDefault + -- | `Witherable` represents data structures which can be _partitioned_ with -- | effects in some `Applicative` functor. -- |