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

    import Control.Applicative
    import Data.Tagged

    -- | Minimal definition either 'bimap' or 'first' and 'second'

    -- | Formally, the class 'Bifunctor' represents a bifunctor
    -- from @Hask@ -> @Hask@.
    --
    -- Intuitively it is a bifunctor where both the first and second arguments are covariant.
    --
    -- You can define a 'Bifunctor' by either defining 'bimap' or by defining both
    -- 'first' and 'second'.
    --
    -- If you supply 'bimap', you should ensure that:
    --
    -- @'bimap' 'id' 'id' ≡ 'id'@
    --
    -- If you supply 'first' and 'second', ensure:
    --
    -- @
    -- 'first' 'id' ≡ 'id'
    -- 'second' 'id' ≡ 'id'
    -- @
    --
    -- If you supply both, you should also ensure:
    --
    -- @'bimap' f g ≡ 'first' f '.' 'second' g@
    --
    -- These ensure by parametricity:
    --
    -- @
    -- 'bimap'  (f '.' g) (h '.' i) ≡ 'bimap' f h '.' 'bimap' g i
    -- 'first'  (f '.' g) ≡ 'first'  f '.' 'first'  g
    -- 'second' (f '.' g) ≡ 'second' f '.' 'second' g
    -- @
    class Bifunctor p where
      -- | Map over both arguments at the same time.
      --
      -- @'bimap' f g ≡ 'first' f '.' 'second' g@
      bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
      bimap f g = first f . second g
      {-# INLINE bimap #-}

      -- | Map covariantly over the first argument.
      --
      -- @'first' f ≡ 'bimap' f 'id'@
      first :: (a -> b) -> p a c -> p b c
      first f = bimap f id
      {-# INLINE first #-}

      -- | Map covariantly over the second argument.
      --
      -- @'second' ≡ 'bimap' 'id'@
      second :: (b -> c) -> p a b -> p a c
      second = bimap id
      {-# INLINE second #-}

    instance Bifunctor (,) where
      bimap f g ~(a, b) = (f a, g b)
      {-# INLINE bimap #-}

    instance Bifunctor ((,,) x) where
      bimap f g ~(x, a, b) = (x, f a, g b)
      {-# INLINE bimap #-}

    instance Bifunctor ((,,,) x y) where
      bimap f g ~(x, y, a, b) = (x, y, f a, g b)
      {-# INLINE bimap #-}

    instance Bifunctor ((,,,,) x y z) where
      bimap f g ~(x, y, z, a, b) = (x, y, z, f a, g b)
      {-# INLINE bimap #-}

    instance Bifunctor Either where
      bimap f _ (Left a) = Left (f a)
      bimap _ g (Right b) = Right (g b)
      {-# INLINE bimap #-}

    instance Bifunctor Const where
      bimap f _ (Const a) = Const (f a)
      {-# INLINE bimap #-}

    instance Bifunctor Tagged where
      bimap _ g (Tagged b) = Tagged (g b)
      {-# INLINE bimap #-}