{-# 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 :: 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 p => Swap (Flip p) where
    swap :: forall a b. Flip p a b -> Flip p b a
swap = forall {k} {k1} (p :: k -> k1 -> *) (a :: k1) (b :: k).
p b a -> Flip p a b
Flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (p :: k1 -> k2 -> *) (a :: k2) (b :: k1).
Flip p a b -> p b a
runFlip

instance (Swap p, Swap q) => Swap (Product p q) where
    swap :: forall a b. Product p q a b -> Product p q b a
swap (Pair p a b
p q a b
q) = 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 (forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap p a b
p) (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 :: forall a b. Sum p q a b -> Sum p q b a
swap (L2 p a b
p) = forall {k} {k1} (p :: k -> k1 -> *) (q :: k -> k1 -> *) (a :: k)
       (b :: k1).
p a b -> Sum p q a b
L2 (forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap p a b
p)
    swap (R2 q a b
q) = forall {k} {k1} (p :: k -> k1 -> *) (q :: k -> k1 -> *) (a :: k)
       (b :: k1).
q a b -> Sum p q a b
R2 (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 :: forall a b. Tannen f p a b -> Tannen f p b a
swap = forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} (f :: k1 -> *) (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 :: forall a b. Biff p f g a b -> Biff p f g b a
swap = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} {k4} (p :: k1 -> k2 -> *) (f :: k3 -> k1)
       (g :: k4 -> k2) (a :: k3) (b :: k4).
Biff p f g a b -> p (f a) (g b)
runBiff

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)