Merge pull request #56 from LiamGoodacre/feature/bifunctor-instances

Add instances for bifunctor newtypes

Author: garyb

src/Data/Bifoldable.purs

@@ -10,6 +10,12 @@ 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(..))
 
 -- | `Bifoldable` represents data structures with two type arguments which can be
 -- | folded.
@@ -33,6 +39,31 @@ class Bifoldable p where
   bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c
   bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m
 
+instance bifoldableClown :: Foldable f => Bifoldable (Clown f) where
+  bifoldr l _ u (Clown f) = foldr l u f
+  bifoldl l _ u (Clown f) = foldl l u f
+  bifoldMap l _ (Clown f) = foldMap l f
+
+instance bifoldableJoker :: Foldable f => Bifoldable (Joker f) where
+  bifoldr _ r u (Joker f) = foldr r u f
+  bifoldl _ r u (Joker f) = foldl r u f
+  bifoldMap _ r (Joker f) = foldMap r f
+
+instance bifoldableFlip :: Bifoldable p => Bifoldable (Flip p) where
+  bifoldr r l u (Flip p) = bifoldr l r u p
+  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
+  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
+
 -- | A default implementation of `bifoldr` using `bifoldMap`.
 -- |
 -- | Note: when defining a `Bifoldable` instance, this function is unsafe to

src/Data/Bitraversable.purs

@@ -13,7 +13,13 @@ module Data.Bitraversable
 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(..))
 
 -- | `Bitraversable` represents data structures with two type arguments which can be
 -- | traversed.
@@ -30,6 +36,26 @@ class (Bifunctor t, Bifoldable t) <= Bitraversable t where
   bitraverse :: forall f a b c d. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
   bisequence :: forall f a b. Applicative f => t (f a) (f b) -> f (t a b)
 
+instance bitraversableClown :: Traversable f => Bitraversable (Clown f) where
+  bitraverse l _ (Clown f) = Clown <$> traverse l f
+  bisequence (Clown f) = Clown <$> sequence f
+
+instance bitraversableJoker :: Traversable f => Bitraversable (Joker f) where
+  bitraverse _ r (Joker f) = Joker <$> traverse r f
+  bisequence (Joker f) = Joker <$> sequence f
+
+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 bitraversableWrap :: Bitraversable p => Bitraversable (Wrap p) where
+  bitraverse l r (Wrap p) = Wrap <$> bitraverse l r p
+  bisequence (Wrap p) = Wrap <$> bisequence p
+
 ltraverse
   :: forall t b c a f
    . (Bitraversable t, Applicative f)