From 688543baf7221e068bbdc0e6d7d4394e2845a862 Mon Sep 17 00:00:00 2001
From: Ryan Hendrickson <ryan.hendrickson@alum.mit.edu>
Date: Thu, 4 Feb 2021 18:52:07 -0500
Subject: [PATCH 1/3] Refactor functors and related packages

This is part of a set of commits that rearrange the dependencies between
multiple packages. The immediate motivation is to allow certain newtypes
to be reused between `profunctor` and `bifunctors`, but this particular
approach goes a little beyond that in two ways: first, it attempts to
move data types (`either`, `tuple`) toward the bottom of the dependency
stack; and second, it tries to ensure no package comes between
`functors` and the packages most closely related to it, in order to open
the possibility of merging those packages together (which may be
desirable if at some point in the future additional newtypes are added
which reveal new and exciting constraints on the module dependency
graph).
---
 CHANGELOG.md                        |  1 +
 bower.json                          |  7 +++-
 src/Data/Bifoldable.purs            | 41 ++++++++++++++-------
 src/Data/Bitraversable.purs         | 34 ++++++++++++------
 src/Data/Foldable.purs              | 55 +++++++++++++++++++++++++++++
 src/Data/FoldableWithIndex.purs     | 53 +++++++++++++++++++++++++--
 src/Data/FunctorWithIndex.purs      | 33 +++++++++++++++++
 src/Data/Semigroup/Foldable.purs    | 12 +++++++
 src/Data/Semigroup/Traversable.purs | 10 ++++++
 src/Data/Traversable.purs           | 49 ++++++++++++++++++++++++-
 src/Data/TraversableWithIndex.purs  | 36 +++++++++++++++++++
 11 files changed, 303 insertions(+), 28 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 87e917d..395d449 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -21,6 +21,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..7892cbe 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 foldable1Tuple :: 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.
 -- |
 -- |

From ca0f3863e86cf5fd241ca5e17874d2607ac65d73 Mon Sep 17 00:00:00 2001
From: Ryan Hendrickson <ryan.hendrickson@alum.mit.edu>
Date: Thu, 4 Feb 2021 19:19:45 -0500
Subject: [PATCH 2/3] fixup! Refactor functors and related packages

---
 CHANGELOG.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 395d449..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:
 

From be262a02d483ae710daca8131e23bd32cdced881 Mon Sep 17 00:00:00 2001
From: Ryan Hendrickson <ryan.hendrickson@alum.mit.edu>
Date: Thu, 4 Feb 2021 21:02:29 -0500
Subject: [PATCH 3/3] fixup! Refactor functors and related packages

---
 src/Data/Semigroup/Foldable.purs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Semigroup/Foldable.purs b/src/Data/Semigroup/Foldable.purs
index 7892cbe..a8d8eb6 100644
--- a/src/Data/Semigroup/Foldable.purs
+++ b/src/Data/Semigroup/Foldable.purs
@@ -95,7 +95,7 @@ instance foldableMultiplicative :: Foldable1 Multiplicative where
   foldl1 _ (Multiplicative x) = x
   foldMap1 f (Multiplicative x) = f x
 
-instance foldable1Tuple :: Foldable1 (Tuple a) where
+instance foldableTuple :: Foldable1 (Tuple a) where
   foldMap1 f (Tuple _ x) = f x
   foldr1 _ (Tuple _ x) = x
   foldl1 _ (Tuple _ x) = x