Refactor functors and related packages (#131)

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

* fixup! Refactor functors and related packages

Author: rhendric

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