{-# LANGUAGE CPP #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Bifunctor
-- Copyright   :  (C) 2008-2014 Edward Kmett,
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- @since 4.8.0.0
----------------------------------------------------------------------------
module Data.Bifunctor
  ( Bifunctor(..)
  ) where

import Control.Applicative  ( Const(..) )
import GHC.Generics ( K1(..) )
import Prelude

-- $setup
-- >>> import Prelude
-- >>> import Data.Char (toUpper)

-- | A bifunctor is a type constructor that takes
-- two type arguments and is a functor in /both/ arguments. That
-- is, unlike with 'Functor', a type constructor such as 'Either'
-- does not need to be partially applied for a 'Bifunctor'
-- instance, and the methods in this class permit mapping
-- functions over the 'Left' value or the 'Right' value,
-- or both at the same time.
--
-- Formally, the class 'Bifunctor' represents a bifunctor
-- from @Hask@ -> @Hask@.
--
-- Intuitively it is a bifunctor where both the first and second
-- arguments are covariant.
--
-- The class definition of a 'Bifunctor' @p@ uses the
-- [QuantifiedConstraints](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/quantified_constraints.html)
-- language extension to quantify over the first type
-- argument @a@ in its context. The context requires that @p a@
-- must be a 'Functor' for all @a@. In other words a partially
-- applied 'Bifunctor' must be a 'Functor'. This makes 'Functor' a
-- superclass of 'Bifunctor' such that a function with a
-- 'Bifunctor' constraint may use 'fmap' in its implementation.
-- 'Functor' has been a quantified superclass of
-- 'Bifunctor' since base-4.18.0.0.
--
-- You can define a 'Bifunctor' by either defining 'bimap' or by
-- defining both 'first' and 'second'. The 'second' method must
-- agree with 'fmap':
--
-- @'second' ≡ 'fmap'@
--
-- From this it follows that:
--
-- @'second' 'id' ≡ 'id'@
--
-- 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
-- @
--
-- @since 4.8.0.0
class (forall a. Functor (p a)) => Bifunctor p where
    {-# MINIMAL bimap | first, second #-}

    -- | Map over both arguments at the same time.
    --
    -- @'bimap' f g ≡ 'first' f '.' 'second' g@
    --
    -- ==== __Examples__
    -- >>> bimap toUpper (+1) ('j', 3)
    -- ('J',4)
    --
    -- >>> bimap toUpper (+1) (Left 'j')
    -- Left 'J'
    --
    -- >>> bimap toUpper (+1) (Right 3)
    -- Right 4
    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
    bimap a -> b
f c -> d
g = (a -> b) -> p a d -> p b d
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f (p a d -> p b d) -> (p a c -> p a d) -> p a c -> p b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> p a c -> p a d
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second c -> d
g


    -- | Map covariantly over the first argument.
    --
    -- @'first' f ≡ 'bimap' f 'id'@
    --
    -- ==== __Examples__
    -- >>> first toUpper ('j', 3)
    -- ('J',3)
    --
    -- >>> first toUpper (Left 'j')
    -- Left 'J'
    first :: (a -> b) -> p a c -> p b c
    first a -> b
f = (a -> b) -> (c -> c) -> p a c -> p b c
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> c
forall a. a -> a
id


    -- | Map covariantly over the second argument.
    --
    -- @'second' ≡ 'bimap' 'id'@
    --
    -- ==== __Examples__
    -- >>> second (+1) ('j', 3)
    -- ('j',4)
    --
    -- >>> second (+1) (Right 3)
    -- Right 4
    second :: (b -> c) -> p a b -> p a c
    second = (a -> a) -> (b -> c) -> p a b -> p a c
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> a
forall a. a -> a
id


-- | Class laws for tuples hold only up to laziness. Both
-- 'first' 'id' and 'second' 'id' are lazier than 'id' (and 'fmap' 'id'):
--
-- >>> first id (undefined :: (Int, Word)) `seq` ()
-- ()
-- >>> second id (undefined :: (Int, Word)) `seq` ()
-- ()
-- >>> id (errorWithoutStackTrace "error!" :: (Int, Word)) `seq` ()
-- *** Exception: error!
--
-- @since 4.8.0.0
instance Bifunctor (,) where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimap a -> b
f c -> d
g ~(a
a, c
b) = (a -> b
f a
a, c -> d
g c
b)

-- | @since 4.8.0.0
instance Bifunctor ((,,) x1) where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> (x1, a, c) -> (x1, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, a
a, c
b) = (x1
x1, a -> b
f a
a, c -> d
g c
b)

-- | @since 4.8.0.0
instance Bifunctor ((,,,) x1 x2) where
    bimap :: forall a b c d.
(a -> b) -> (c -> d) -> (x1, x2, a, c) -> (x1, x2, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, a
a, c
b) = (x1
x1, x2
x2, a -> b
f a
a, c -> d
g c
b)

-- | @since 4.8.0.0
instance Bifunctor ((,,,,) x1 x2 x3) where
    bimap :: forall a b c d.
(a -> b) -> (c -> d) -> (x1, x2, x3, a, c) -> (x1, x2, x3, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, x3
x3, a
a, c
b) = (x1
x1, x2
x2, x3
x3, a -> b
f a
a, c -> d
g c
b)

-- | @since 4.8.0.0
instance Bifunctor ((,,,,,) x1 x2 x3 x4) where
    bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> (x1, x2, x3, x4, a, c) -> (x1, x2, x3, x4, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, x3
x3, x4
x4, a
a, c
b) = (x1
x1, x2
x2, x3
x3, x4
x4, a -> b
f a
a, c -> d
g c
b)

-- | @since 4.8.0.0
instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where
    bimap :: forall a b c d.
(a -> b)
-> (c -> d)
-> (x1, x2, x3, x4, x5, a, c)
-> (x1, x2, x3, x4, x5, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, x3
x3, x4
x4, x5
x5, a
a, c
b) = (x1
x1, x2
x2, x3
x3, x4
x4, x5
x5, a -> b
f a
a, c -> d
g c
b)


-- | @since 4.8.0.0
instance Bifunctor Either where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap a -> b
f c -> d
_ (Left a
a) = b -> Either b d
forall a b. a -> Either a b
Left (a -> b
f a
a)
    bimap a -> b
_ c -> d
g (Right c
b) = d -> Either b d
forall a b. b -> Either a b
Right (c -> d
g c
b)

-- | @since 4.8.0.0
instance Bifunctor Const where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Const a c -> Const b d
bimap a -> b
f c -> d
_ (Const a
a) = b -> Const b d
forall {k} a (b :: k). a -> Const a b
Const (a -> b
f a
a)

-- | @since 4.9.0.0
instance Bifunctor (K1 i) where
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> K1 i a c -> K1 i b d
bimap a -> b
f c -> d
_ (K1 a
c) = b -> K1 i b d
forall k i c (p :: k). c -> K1 i c p
K1 (a -> b
f a
c)