{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Bifunctor.Swap (
    Swap (..),
    ) where

import Data.Bifunctor (Bifunctor (..))

import qualified Data.Tuple

-- | Symmetric 'Bifunctor's.
--
-- @
-- 'swap' . 'swap' = 'id'
-- @
--
-- If @p@ is a 'Bifunctor' the following property is assumed to hold:
--
-- @
-- 'swap' . 'bimap' f g = 'bimap' g f . 'swap'
-- @
--
-- 'Swap' isn't a subclass of 'Bifunctor', as for example
--
-- >>> newtype Bipredicate a b = Bipredicate (a -> b -> Bool)
--
-- is not a 'Bifunctor' but has 'Swap' instance
--
-- >>> instance Swap Bipredicate where swap (Bipredicate p) = Bipredicate (flip p)
--
class Swap p where
    swap :: p a b -> p b a

instance Swap (,) where
    swap :: forall a b. (a, b) -> (b, a)
swap = forall a b. (a, b) -> (b, a)
Data.Tuple.swap

instance Swap Either where
    swap :: forall a b. Either a b -> Either b a
swap (Left a
x) = forall a b. b -> Either a b
Right a
x
    swap (Right b
x) = forall a b. a -> Either a b
Left b
x

instance Swap ((,,) x) where
    swap :: forall a b. (x, a, b) -> (x, b, a)
swap (x
x,a
a,b
b) = (x
x,b
b,a
a)

instance Swap ((,,,) x y) where
    swap :: forall a b. (x, y, a, b) -> (x, y, b, a)
swap (x
x,y
y,a
a,b
b) = (x
x,y
y,b
b,a
a)

instance Swap ((,,,,) x y z) where
    swap :: forall a b. (x, y, z, a, b) -> (x, y, z, b, a)
swap (x
x,y
y,z
z,a
a,b
b) = (x
x,y
y,z
z,b
b,a
a)

instance Swap ((,,,,,) x y z w) where
    swap :: forall a b. (x, y, z, w, a, b) -> (x, y, z, w, b, a)
swap (x
x,y
y,z
z,w
w,a
a,b
b) = (x
x,y
y,z
z,w
w,b
b,a
a)

instance Swap ((,,,,,,) x y z w v) where
    swap :: forall a b. (x, y, z, w, v, a, b) -> (x, y, z, w, v, b, a)
swap (x
x,y
y,z
z,w
w,v
v,a
a,b
b) = (x
x,y
y,z
z,w
w,v
v,b
b,a
a)