diff --git a/CHANGELOG.md b/CHANGELOG.md index 87e917d..c451dca 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ New features: - Added `findMapWithIndex` (#119) - Added `foldr1`, `foldl1`, `foldr1Default`, `foldl1Default`, `foldMap1DefaultR`, `foldMap1DefaultL` (#121, #128) - Added `maximumBy` and `minimumBy` to `Data.Semigroup.Foldable` (#123) +- Added `lookup` to `Data.Foldable`; this function previously lived in `Data.Tuple` in the `purescript-tuples` package (#131) Bugfixes: @@ -21,6 +22,7 @@ Other improvements: - Wrapped `traverseArrayImpl` IIFE in parentheses (#52) - Added examples for `sequence` and `traverse` (#115) - Changed `foldM` type signature to more closely match `foldl` (#111) +- This package now depends on the `purescript-const`, `purescript-either`, `purescript-functors`, `purescript-identity`, and `purescript-tuples` packages, and contains instances previously in those packages or the `purescript-bifunctors` or `purescript-profunctor` packages (#131) ## [v4.1.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.1.1) - 2018-11-23 diff --git a/bower.json b/bower.json index fa33d12..b0e97fb 100644 --- a/bower.json +++ b/bower.json @@ -18,11 +18,16 @@ ], "dependencies": { "purescript-bifunctors": "master", + "purescript-const": "master", "purescript-control": "master", + "purescript-either": "master", + "purescript-functors": "master", + "purescript-identity": "master", "purescript-maybe": "master", "purescript-newtype": "master", "purescript-orders": "master", - "purescript-prelude": "master" + "purescript-prelude": "master", + "purescript-tuples": "master" }, "devDependencies": { "purescript-assert": "master", diff --git a/src/Data/Bifoldable.purs b/src/Data/Bifoldable.purs index c0cc6e0..9b18723 100644 --- a/src/Data/Bifoldable.purs +++ b/src/Data/Bifoldable.purs @@ -3,17 +3,19 @@ module Data.Bifoldable where import Prelude import Control.Apply (applySecond) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, foldr, foldl, foldMap) +import Data.Functor.Clown (Clown(..)) +import Data.Functor.Flip (Flip(..)) +import Data.Functor.Joker (Joker(..)) +import Data.Functor.Product2 (Product2(..)) import Data.Monoid.Conj (Conj(..)) import Data.Monoid.Disj (Disj(..)) import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Endo (Endo(..)) import Data.Newtype (unwrap) -import Data.Foldable (class Foldable, foldr, foldl, foldMap) -import Data.Bifunctor.Clown (Clown(..)) -import Data.Bifunctor.Joker (Joker(..)) -import Data.Bifunctor.Flip (Flip(..)) -import Data.Bifunctor.Product (Product(..)) -import Data.Bifunctor.Wrap (Wrap(..)) +import Data.Tuple (Tuple(..)) -- | `Bifoldable` represents data structures with two type arguments which can be -- | folded. @@ -52,15 +54,28 @@ instance bifoldableFlip :: Bifoldable p => Bifoldable (Flip p) where bifoldl r l u (Flip p) = bifoldl l r u p bifoldMap r l (Flip p) = bifoldMap l r p -instance bifoldableProduct :: (Bifoldable f, Bifoldable g) => Bifoldable (Product f g) where +instance bifoldableProduct2 :: (Bifoldable f, Bifoldable g) => Bifoldable (Product2 f g) where bifoldr l r u m = bifoldrDefault l r u m bifoldl l r u m = bifoldlDefault l r u m - bifoldMap l r (Product f g) = bifoldMap l r f <> bifoldMap l r g - -instance bifoldableWrap :: Bifoldable p => Bifoldable (Wrap p) where - bifoldr l r u (Wrap p) = bifoldr l r u p - bifoldl l r u (Wrap p) = bifoldl l r u p - bifoldMap l r (Wrap p) = bifoldMap l r p + bifoldMap l r (Product2 f g) = bifoldMap l r f <> bifoldMap l r g + +instance bifoldableEither :: Bifoldable Either where + bifoldr f _ z (Left a) = f a z + bifoldr _ g z (Right b) = g b z + bifoldl f _ z (Left a) = f z a + bifoldl _ g z (Right b) = g z b + bifoldMap f _ (Left a) = f a + bifoldMap _ g (Right b) = g b + +instance bifoldableTuple :: Bifoldable Tuple where + bifoldMap f g (Tuple a b) = f a <> g b + bifoldr f g z (Tuple a b) = f a (g b z) + bifoldl f g z (Tuple a b) = g (f z a) b + +instance bifoldableConst :: Bifoldable Const where + bifoldr f _ z (Const a) = f a z + bifoldl f _ z (Const a) = f z a + bifoldMap f _ (Const a) = f a -- | A default implementation of `bifoldr` using `bifoldMap`. -- | diff --git a/src/Data/Bitraversable.purs b/src/Data/Bitraversable.purs index 77ce7ff..6760549 100644 --- a/src/Data/Bitraversable.purs +++ b/src/Data/Bitraversable.purs @@ -15,11 +15,13 @@ import Prelude import Data.Bifoldable (class Bifoldable, biall, biany, bifold, bifoldMap, bifoldMapDefaultL, bifoldMapDefaultR, bifoldl, bifoldlDefault, bifoldr, bifoldrDefault, bifor_, bisequence_, bitraverse_) import Data.Traversable (class Traversable, traverse, sequence) import Data.Bifunctor (class Bifunctor, bimap) -import Data.Bifunctor.Clown (Clown(..)) -import Data.Bifunctor.Joker (Joker(..)) -import Data.Bifunctor.Flip (Flip(..)) -import Data.Bifunctor.Product (Product(..)) -import Data.Bifunctor.Wrap (Wrap(..)) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Functor.Clown (Clown(..)) +import Data.Functor.Flip (Flip(..)) +import Data.Functor.Joker (Joker(..)) +import Data.Functor.Product2 (Product2(..)) +import Data.Tuple (Tuple(..)) -- | `Bitraversable` represents data structures with two type arguments which can be -- | traversed. @@ -48,13 +50,23 @@ instance bitraversableFlip :: Bitraversable p => Bitraversable (Flip p) where bitraverse r l (Flip p) = Flip <$> bitraverse l r p bisequence (Flip p) = Flip <$> bisequence p -instance bitraversableProduct :: (Bitraversable f, Bitraversable g) => Bitraversable (Product f g) where - bitraverse l r (Product f g) = Product <$> bitraverse l r f <*> bitraverse l r g - bisequence (Product f g) = Product <$> bisequence f <*> bisequence g +instance bitraversableProduct2 :: (Bitraversable f, Bitraversable g) => Bitraversable (Product2 f g) where + bitraverse l r (Product2 f g) = Product2 <$> bitraverse l r f <*> bitraverse l r g + bisequence (Product2 f g) = Product2 <$> bisequence f <*> bisequence g -instance bitraversableWrap :: Bitraversable p => Bitraversable (Wrap p) where - bitraverse l r (Wrap p) = Wrap <$> bitraverse l r p - bisequence (Wrap p) = Wrap <$> bisequence p +instance bitraversableEither :: Bitraversable Either where + bitraverse f _ (Left a) = Left <$> f a + bitraverse _ g (Right b) = Right <$> g b + bisequence (Left a) = Left <$> a + bisequence (Right b) = Right <$> b + +instance bitraversableTuple :: Bitraversable Tuple where + bitraverse f g (Tuple a b) = Tuple <$> f a <*> g b + bisequence (Tuple a b) = Tuple <$> a <*> b + +instance bitraversableConst :: Bitraversable Const where + bitraverse f _ (Const a) = Const <$> f a + bisequence (Const a) = Const <$> a ltraverse :: forall t b c a f diff --git a/src/Data/Foldable.purs b/src/Data/Foldable.purs index d6d0935..339f407 100644 --- a/src/Data/Foldable.purs +++ b/src/Data/Foldable.purs @@ -34,6 +34,13 @@ module Data.Foldable import Prelude import Control.Plus (class Plus, alt, empty) +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct, coproduct) +import Data.Functor.Product (Product(..)) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Maybe.First (First(..)) import Data.Maybe.Last (Last(..)) @@ -44,6 +51,7 @@ import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Endo (Endo(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Newtype (alaF, unwrap) +import Data.Tuple (Tuple(..)) -- | `Foldable` represents data structures which can be _folded_. -- | @@ -169,6 +177,49 @@ instance foldableMultiplicative :: Foldable Multiplicative where foldl f z (Multiplicative x) = z `f` x foldMap f (Multiplicative x) = f x +instance foldableEither :: Foldable (Either a) where + foldr _ z (Left _) = z + foldr f z (Right x) = f x z + foldl _ z (Left _) = z + foldl f z (Right x) = f z x + foldMap f (Left _) = mempty + foldMap f (Right x) = f x + +instance foldableTuple :: Foldable (Tuple a) where + foldr f z (Tuple _ x) = f x z + foldl f z (Tuple _ x) = f z x + foldMap f (Tuple _ x) = f x + +instance foldableIdentity :: Foldable Identity where + foldr f z (Identity x) = f x z + foldl f z (Identity x) = f z x + foldMap f (Identity x) = f x + +instance foldableConst :: Foldable (Const a) where + foldr _ z _ = z + foldl _ z _ = z + foldMap _ _ = mempty + +instance foldableProduct :: (Foldable f, Foldable g) => Foldable (Product f g) where + foldr f z (Product (Tuple fa ga)) = foldr f (foldr f z ga) fa + foldl f z (Product (Tuple fa ga)) = foldl f (foldl f z fa) ga + foldMap f (Product (Tuple fa ga)) = foldMap f fa <> foldMap f ga + +instance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f g) where + foldr f z = coproduct (foldr f z) (foldr f z) + foldl f z = coproduct (foldl f z) (foldl f z) + foldMap f = coproduct (foldMap f) (foldMap f) + +instance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) where + foldr f i (Compose fga) = foldr (flip (foldr f)) i fga + foldl f i (Compose fga) = foldl (foldl f) i fga + foldMap f (Compose fga) = foldMap (foldMap f) fga + +instance foldableApp :: Foldable f => Foldable (App f) where + foldr f i (App x) = foldr f i x + foldl f i (App x) = foldl f i x + foldMap f (App x) = foldMap f x + -- | Fold a data structure, accumulating values in some `Monoid`. fold :: forall f m. Foldable f => Monoid m => f m -> m fold = foldMap identity @@ -413,3 +464,7 @@ null = foldr (\_ _ -> false) true -- | is no general way to do better. length :: forall a b f. Foldable f => Semiring b => f a -> b length = foldl (\c _ -> add one c) zero + +-- | Lookup a value in a data structure of `Tuple`s, generalizing association lists. +lookup :: forall a b f. Foldable f => Eq a => a -> f (Tuple a b) -> Maybe b +lookup a = unwrap <<< foldMap \(Tuple a' b) -> First (if a == a' then Just b else Nothing) diff --git a/src/Data/FoldableWithIndex.purs b/src/Data/FoldableWithIndex.purs index 40bbf09..8bac6d3 100644 --- a/src/Data/FoldableWithIndex.purs +++ b/src/Data/FoldableWithIndex.purs @@ -19,8 +19,15 @@ module Data.FoldableWithIndex import Prelude +import Data.Const (Const) +import Data.Either (Either(..)) import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct, coproduct) +import Data.Functor.Product (Product(..)) import Data.FunctorWithIndex (mapWithIndex) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Maybe.First (First) import Data.Maybe.Last (Last) @@ -31,6 +38,7 @@ import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Endo (Endo(..)) import Data.Monoid.Multiplicative (Multiplicative) import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..), curry) -- | A `Foldable` with an additional index. -- | A `FoldableWithIndex` instance must be compatible with its `Foldable` @@ -108,8 +116,6 @@ foldMapWithIndexDefaultL -> m foldMapWithIndexDefaultL f = foldlWithIndex (\i acc x -> acc <> f i x) mempty -data Tuple a b = Tuple a b - instance foldableWithIndexArray :: FoldableWithIndex Int Array where foldrWithIndex f z = foldr (\(Tuple i x) y -> f i x y) z <<< mapWithIndex Tuple foldlWithIndex f z = foldl (\y (Tuple i x) -> f i y x) z <<< mapWithIndex Tuple @@ -155,6 +161,49 @@ instance foldableWithIndexMultiplicative :: FoldableWithIndex Unit Multiplicativ foldlWithIndex f = foldl $ f unit foldMapWithIndex f = foldMap $ f unit +instance foldableWithIndexEither :: FoldableWithIndex Unit (Either a) where + foldrWithIndex _ z (Left _) = z + foldrWithIndex f z (Right x) = f unit x z + foldlWithIndex _ z (Left _) = z + foldlWithIndex f z (Right x) = f unit z x + foldMapWithIndex f (Left _) = mempty + foldMapWithIndex f (Right x) = f unit x + +instance foldableWithIndexTuple :: FoldableWithIndex Unit (Tuple a) where + foldrWithIndex f z (Tuple _ x) = f unit x z + foldlWithIndex f z (Tuple _ x) = f unit z x + foldMapWithIndex f (Tuple _ x) = f unit x + +instance foldableWithIndexIdentity :: FoldableWithIndex Unit Identity where + foldrWithIndex f z (Identity x) = f unit x z + foldlWithIndex f z (Identity x) = f unit z x + foldMapWithIndex f (Identity x) = f unit x + +instance foldableWithIndexConst :: FoldableWithIndex Void (Const a) where + foldrWithIndex _ z _ = z + foldlWithIndex _ z _ = z + foldMapWithIndex _ _ = mempty + +instance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where + foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa + foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga + foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga + +instance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where + foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z) + foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z) + foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right)) + +instance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where + foldrWithIndex f i (Compose fga) = foldrWithIndex (\a -> flip (foldrWithIndex (curry f a))) i fga + foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga + foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga + +instance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f) where + foldrWithIndex f z (App x) = foldrWithIndex f z x + foldlWithIndex f z (App x) = foldlWithIndex f z x + foldMapWithIndex f (App x) = foldMapWithIndex f x + -- | Similar to 'foldlWithIndex', but the result is encapsulated in a monad. -- | diff --git a/src/Data/FunctorWithIndex.purs b/src/Data/FunctorWithIndex.purs index 0167a41..3db4d83 100644 --- a/src/Data/FunctorWithIndex.purs +++ b/src/Data/FunctorWithIndex.purs @@ -4,6 +4,14 @@ module Data.FunctorWithIndex import Prelude +import Data.Bifunctor (bimap) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..)) +import Data.Functor.Product (Product(..)) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe) import Data.Maybe.First (First) import Data.Maybe.Last (Last) @@ -12,6 +20,7 @@ import Data.Monoid.Conj (Conj) import Data.Monoid.Disj (Disj) import Data.Monoid.Dual (Dual) import Data.Monoid.Multiplicative (Multiplicative) +import Data.Tuple (Tuple, curry) -- | A `Functor` with an additional index. -- | Instances must satisfy a modified form of the `Functor` laws @@ -55,6 +64,30 @@ instance functorWithIndexDisj :: FunctorWithIndex Unit Disj where instance functorWithIndexMultiplicative :: FunctorWithIndex Unit Multiplicative where mapWithIndex f = map $ f unit +instance functorWithIndexEither :: FunctorWithIndex Unit (Either a) where + mapWithIndex f = map $ f unit + +instance functorWithIndexTuple :: FunctorWithIndex Unit (Tuple a) where + mapWithIndex f = map $ f unit + +instance functorWithIndexIdentity :: FunctorWithIndex Unit Identity where + mapWithIndex f (Identity a) = Identity (f unit a) + +instance functorWithIndexConst :: FunctorWithIndex Void (Const a) where + mapWithIndex _ (Const x) = Const x + +instance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where + mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga) + +instance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where + mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e) + +instance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where + mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga + +instance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f) where + mapWithIndex f (App x) = App $ mapWithIndex f x + -- | A default implementation of Functor's `map` in terms of `mapWithIndex` mapDefault :: forall i f a b. FunctorWithIndex i f => (a -> b) -> f a -> f b mapDefault f = mapWithIndex (const f) diff --git a/src/Data/Semigroup/Foldable.purs b/src/Data/Semigroup/Foldable.purs index 7728612..a8d8eb6 100644 --- a/src/Data/Semigroup/Foldable.purs +++ b/src/Data/Semigroup/Foldable.purs @@ -23,11 +23,13 @@ module Data.Semigroup.Foldable import Prelude import Data.Foldable (class Foldable) +import Data.Identity (Identity(..)) import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Newtype (ala, alaF) import Data.Ord.Max (Max(..)) import Data.Ord.Min (Min(..)) +import Data.Tuple (Tuple(..)) import Prim.TypeError (class Warn, Text) -- | `Foldable1` represents data structures with a minimum of one element that can be _folded_. @@ -93,6 +95,16 @@ instance foldableMultiplicative :: Foldable1 Multiplicative where foldl1 _ (Multiplicative x) = x foldMap1 f (Multiplicative x) = f x +instance foldableTuple :: Foldable1 (Tuple a) where + foldMap1 f (Tuple _ x) = f x + foldr1 _ (Tuple _ x) = x + foldl1 _ (Tuple _ x) = x + +instance foldableIdentity :: Foldable1 Identity where + foldMap1 f (Identity x) = f x + foldl1 _ (Identity x) = x + foldr1 _ (Identity x) = x + -- | Fold a data structure, accumulating values in some `Semigroup`. fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m fold1 = foldMap1 identity diff --git a/src/Data/Semigroup/Traversable.purs b/src/Data/Semigroup/Traversable.purs index e0dce56..c01c671 100644 --- a/src/Data/Semigroup/Traversable.purs +++ b/src/Data/Semigroup/Traversable.purs @@ -2,10 +2,12 @@ module Data.Semigroup.Traversable where import Prelude +import Data.Identity (Identity(..)) import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Semigroup.Foldable (class Foldable1) import Data.Traversable (class Traversable) +import Data.Tuple (Tuple(..)) -- | `Traversable1` represents data structures with a minimum of one element that can be _traversed_, -- | accumulating results and effects in some `Applicative` functor. @@ -42,6 +44,14 @@ instance traversableMultiplicative :: Traversable1 Multiplicative where traverse1 f (Multiplicative x) = Multiplicative <$> f x sequence1 = sequence1Default +instance traversableTuple :: Traversable1 (Tuple a) where + traverse1 f (Tuple x y) = Tuple x <$> f y + sequence1 (Tuple x y) = Tuple x <$> y + +instance traversableIdentity :: Traversable1 Identity where + traverse1 f (Identity x) = Identity <$> f x + sequence1 (Identity x) = Identity <$> x + -- | A default implementation of `traverse1` using `sequence1`. traverse1Default :: forall t a b m diff --git a/src/Data/Traversable.purs b/src/Data/Traversable.purs index 18c8fa4..612499f 100644 --- a/src/Data/Traversable.purs +++ b/src/Data/Traversable.purs @@ -12,7 +12,15 @@ module Data.Traversable import Prelude -import Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, product, sequence_, sum, traverse_) +import Control.Apply (lift2) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, sequence_, sum, traverse_) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Functor.Product (Product(..), product) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Maybe.First (First(..)) import Data.Maybe.Last (Last(..)) @@ -23,6 +31,7 @@ import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Traversable.Accum (Accum) import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) +import Data.Tuple (Tuple(..)) -- | `Traversable` represents data structures which can be _traversed_, -- | accumulating results and effects in some `Applicative` functor. @@ -137,6 +146,44 @@ instance traversableMultiplicative :: Traversable Multiplicative where traverse f (Multiplicative x) = Multiplicative <$> f x sequence (Multiplicative x) = Multiplicative <$> x +instance traversableEither :: Traversable (Either a) where + traverse _ (Left x) = pure (Left x) + traverse f (Right x) = Right <$> f x + sequence (Left x) = pure (Left x) + sequence (Right x) = Right <$> x + +instance traversableTuple :: Traversable (Tuple a) where + traverse f (Tuple x y) = Tuple x <$> f y + sequence (Tuple x y) = Tuple x <$> y + +instance traversableIdentity :: Traversable Identity where + traverse f (Identity x) = Identity <$> f x + sequence (Identity x) = Identity <$> x + +instance traversableConst :: Traversable (Const a) where + traverse _ (Const x) = pure (Const x) + sequence (Const x) = pure (Const x) + +instance traversableProduct :: (Traversable f, Traversable g) => Traversable (Product f g) where + traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga) + sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga) + +instance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where + traverse f = coproduct + (map (Coproduct <<< Left) <<< traverse f) + (map (Coproduct <<< Right) <<< traverse f) + sequence = coproduct + (map (Coproduct <<< Left) <<< sequence) + (map (Coproduct <<< Right) <<< sequence) + +instance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where + traverse f (Compose fga) = map Compose $ traverse (traverse f) fga + sequence = traverse identity + +instance traversableApp :: Traversable f => Traversable (App f) where + traverse f (App x) = App <$> traverse f x + sequence (App x) = App <$> sequence x + -- | A version of `traverse` with its arguments flipped. -- | -- | diff --git a/src/Data/TraversableWithIndex.purs b/src/Data/TraversableWithIndex.purs index e8e26de..f09d5e7 100644 --- a/src/Data/TraversableWithIndex.purs +++ b/src/Data/TraversableWithIndex.purs @@ -12,8 +12,16 @@ module Data.TraversableWithIndex import Prelude +import Control.Apply (lift2) +import Data.Const (Const(..)) +import Data.Either (Either(..)) import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Functor.Product (Product(..), product) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe) import Data.Maybe.First (First) import Data.Maybe.Last (Last) @@ -25,6 +33,7 @@ import Data.Monoid.Multiplicative (Multiplicative) import Data.Traversable (class Traversable, sequence, traverse) import Data.Traversable.Accum (Accum) import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) +import Data.Tuple (Tuple(..), curry) -- | A `Traversable` with an additional index. @@ -83,6 +92,33 @@ instance traversableWithIndexDisj :: TraversableWithIndex Unit Disj where instance traversableWithIndexMultiplicative :: TraversableWithIndex Unit Multiplicative where traverseWithIndex f = traverse $ f unit +instance traversableWithIndexEither :: TraversableWithIndex Unit (Either a) where + traverseWithIndex _ (Left x) = pure (Left x) + traverseWithIndex f (Right x) = Right <$> f unit x + +instance traversableWithIndexTuple :: TraversableWithIndex Unit (Tuple a) where + traverseWithIndex f (Tuple x y) = Tuple x <$> f unit y + +instance traversableWithIndexIdentity :: TraversableWithIndex Unit Identity where + traverseWithIndex f (Identity x) = Identity <$> f unit x + +instance traversableWithIndexConst :: TraversableWithIndex Void (Const a) where + traverseWithIndex _ (Const x) = pure (Const x) + +instance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where + traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga) + +instance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where + traverseWithIndex f = coproduct + (map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left)) + (map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right)) + +instance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where + traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga + +instance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f) where + traverseWithIndex f (App x) = App <$> traverseWithIndex f x + -- | A version of `traverseWithIndex` with its arguments flipped. -- | -- |