Swap.hs

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

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

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 = Data.Tuple.swap

instance Swap Either where
    swap (Left x) = Right x
    swap (Right x) = Left x

instance Swap p => Swap (Flip p) where
    swap = Flip . swap . runFlip

instance (Swap p, Swap q) => Swap (Product p q) where
    swap (Pair p q) = Pair (swap p) (swap q)

instance (Swap p, Swap q) => Swap (Sum p q) where
    swap (L2 p) = L2 (swap p)
    swap (R2 q) = R2 (swap q)

instance (Functor f, Swap p) => Swap (Tannen f p) where
    swap = Tannen . fmap swap . runTannen

instance (f ~ g, Functor f, Swap p) => Swap (Biff p f g) where
    swap = Biff . swap . runBiff