    {-# LANGUAGE TypeFamilies #-}
    module Data.Bifunctor.Swap (
        Swap (..),
        ) where

    import Data.Bifunctor         (Bifunctor (..))
    import Data.Bifunctor.Biff    (Biff (..))
    import Data.Bifunctor.Flip    (Flip (..))
    import Data.Bifunctor.Product (Product (..))
    import Data.Bifunctor.Sum     (Sum (..))
    import Data.Bifunctor.Tannen  (Tannen (..))

    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 :: (a, b) -> (b, a)
    swap = (a, b) -> (b, a)
    forall a b. (a, b) -> (b, a)
    Data.Tuple.swap

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

    instance Swap p => Swap (Flip p) where
        swap :: Flip p a b -> Flip p b a
    swap = p a b -> Flip p b a
    forall k k1 (p :: k -> k1 -> *) (a :: k1) (b :: k).
    p b a -> Flip p a b
    Flip (p a b -> Flip p b a)
    -> (Flip p a b -> p a b) -> Flip p a b -> Flip p b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p b a -> p a b
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap (p b a -> p a b) -> (Flip p a b -> p b a) -> Flip p a b -> p a b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Flip p a b -> p b a
    forall k1 k2 (p :: k2 -> k1 -> *) (a :: k1) (b :: k2).
    Flip p a b -> p b a
    runFlip

    instance (Swap p, Swap q) => Swap (Product p q) where
        swap :: Product p q a b -> Product p q b a
    swap (Pair p :: p a b
    p q :: q a b
    q) = p b a -> q b a -> Product p q b a
    forall k k1 (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
           (b :: k1).
    f a b -> g a b -> Product f g a b
    Pair (p a b -> p b a
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap p a b
    p) (q a b -> q b a
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap q a b
    q)

    instance (Swap p, Swap q) => Swap (Sum p q) where
        swap :: Sum p q a b -> Sum p q b a
    swap (L2 p :: p a b
    p) = p b a -> Sum p q b a
    forall k k1 (p :: k -> k1 -> *) (q :: k -> k1 -> *) (a :: k)
           (b :: k1).
    p a b -> Sum p q a b
    L2 (p a b -> p b a
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap p a b
    p)
        swap (R2 q :: q a b
    q) = q b a -> Sum p q b a
    forall k k1 (p :: k -> k1 -> *) (q :: k -> k1 -> *) (a :: k)
           (b :: k1).
    q a b -> Sum p q a b
    R2 (q a b -> q b a
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap q a b
    q)

    instance (Functor f, Swap p) => Swap (Tannen f p) where
        swap :: Tannen f p a b -> Tannen f p b a
    swap = f (p b a) -> Tannen f p b a
    forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
           (b :: k2).
    f (p a b) -> Tannen f p a b
    Tannen (f (p b a) -> Tannen f p b a)
    -> (Tannen f p a b -> f (p b a))
    -> Tannen f p a b
    -> Tannen f p b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p a b -> p b a) -> f (p a b) -> f (p b a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap p a b -> p b a
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap (f (p a b) -> f (p b a))
    -> (Tannen f p a b -> f (p a b)) -> Tannen f p a b -> f (p b a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tannen f p a b -> f (p a b)
    forall k1 (f :: k1 -> *) k2 k3 (p :: k2 -> k3 -> k1) (a :: k2)
           (b :: k3).
    Tannen f p a b -> f (p a b)
    runTannen

    instance (f ~ g, Functor f, Swap p) => Swap (Biff p f g) where
        swap :: Biff p f g a b -> Biff p f g b a
    swap = p (f b) (g a) -> Biff p f g b a
    forall k k1 k2 k3 (p :: k -> k1 -> *) (f :: k2 -> k)
           (g :: k3 -> k1) (a :: k2) (b :: k3).
    p (f a) (g b) -> Biff p f g a b
    Biff (p (f b) (g a) -> Biff p f g b a)
    -> (Biff p g f a b -> p (f b) (g a))
    -> Biff p g f a b
    -> Biff p f g b a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p (g a) (f b) -> p (f b) (g a)
    forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
    swap (p (g a) (f b) -> p (f b) (g a))
    -> (Biff p g f a b -> p (g a) (f b))
    -> Biff p g f a b
    -> p (f b) (g a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Biff p g f a b -> p (g a) (f b)
    forall k1 k2 (p :: k1 -> k2 -> *) k3 (f :: k3 -> k1) k4
           (g :: k4 -> k2) (a :: k3) (b :: k4).
    Biff p f g a b -> p (f a) (g b)
    runBiff

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

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

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

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

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