Refactor functors and related packages

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
 

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",

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`.
 -- |

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

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)

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.
 -- |

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)

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