{-# 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 a
x) = a -> Either b a
forall a b. b -> Either a b
Right a
x
    swap (Right 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 a b
p 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 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 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,a
a,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,y
y,a
a,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,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 :: (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 :: (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)