    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Semigroup.Bitraversable
    -- Copyright   :  (C) 2011 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    ----------------------------------------------------------------------------
    module Data.Semigroup.Bitraversable
      ( Bitraversable1(..)
      , bifoldMap1Default
      ) where

    import Control.Applicative
    import Data.Bitraversable
    import Data.Bifunctor
    import Data.Functor.Apply
    import Data.Semigroup
    import Data.Semigroup.Bifoldable
    import Data.Tagged

    class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where
      bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d)
      bitraverse1 f g  = bisequence1 . bimap f g
      {-# INLINE bitraverse1 #-}

      bisequence1 :: Apply f => t (f a) (f b) -> f (t a b)
      bisequence1 = bitraverse1 id id
      {-# INLINE bisequence1 #-}

    bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m
    bifoldMap1Default f g = getConst . bitraverse1 (Const . f) (Const . g)
    {-# INLINE bifoldMap1Default #-}

    instance Bitraversable1 Either where
      bitraverse1 f _ (Left a) = Left <$> f a
      bitraverse1 _ g (Right b) = Right <$> g b
      {-# INLINE bitraverse1 #-}

    instance Bitraversable1 (,) where
      bitraverse1 f g (a, b) = (,) <$> f a <.> g b
      {-# INLINE bitraverse1 #-}

    instance Bitraversable1 ((,,) x) where
      bitraverse1 f g (x, a, b) = (,,) x <$> f a <.> g b
      {-# INLINE bitraverse1 #-}

    instance Bitraversable1 ((,,,) x y) where
      bitraverse1 f g (x, y, a, b) = (,,,) x y <$> f a <.> g b
      {-# INLINE bitraverse1 #-}

    instance Bitraversable1 ((,,,,) x y z) where
      bitraverse1 f g (x, y, z, a, b) = (,,,,) x y z <$> f a <.> g b
      {-# INLINE bitraverse1 #-}

    instance Bitraversable1 Const where
      bitraverse1 f _ (Const a) = Const <$> f a
      {-# INLINE bitraverse1 #-}

    instance Bitraversable1 Tagged where
      bitraverse1 _ g (Tagged b) = Tagged <$> g b
      {-# INLINE bitraverse1 #-}