{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE MultiParamTypeClasses #-}
-------------------------------------------------------------------------------------------
-- |
-- Module     : Control.Category.Braided
-- Copyright  : 2008-2012 Edward Kmett
-- License    : BSD
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability  : experimental
-- Portability: portable
--
-------------------------------------------------------------------------------------------
module Control.Category.Braided
  ( Braided(..)
  , Symmetric
  , swap
  ) where

-- import Control.Categorical.Bifunctor
import Control.Category.Associative

{- | A braided (co)(monoidal or associative) category can commute the arguments of its bi-endofunctor. Obeys the laws:

> associate . braid . associate = second braid . associate . first braid
> disassociate . braid . disassociate = first braid . disassociate . second braid

If the category is Monoidal the following laws should be satisfied

> idr . braid = idl
> idl . braid = idr

If the category is Comonoidal the following laws should be satisfied

> braid . coidr = coidl
> braid . coidl = coidr

-}

class Associative k p => Braided k p where
    braid :: k (p a b) (p b a)

instance Braided (->) Either where
    braid :: Either a b -> Either b a
braid (Left a :: a
a) = a -> Either b a
forall a b. b -> Either a b
Right a
a
    braid (Right b :: b
b) = b -> Either b a
forall a b. a -> Either a b
Left b
b

instance Braided (->) (,) where
    braid :: (a, b) -> (b, a)
braid ~(a :: a
a,b :: b
b) = (b
b,a
a)

{-- RULES
"braid/associate/braid"         second braid . associate . first braid    = associate . braid . associate
"braid/disassociate/braid"      first braid . disassociate . second braid = disassociate . braid . disassociate
  --}

{- |
If we have a symmetric (co)'Monoidal' category, you get the additional law:

> swap . swap = id
 -}
class Braided k p => Symmetric k p

swap :: Symmetric k p => k (p a b) (p b a)
swap :: k (p a b) (p b a)
swap = k (p a b) (p b a)
forall (k :: * -> * -> *) (p :: * -> * -> *) a b.
Braided k p =>
k (p a b) (p b a)
braid

{-- RULES
"swap/swap" swap . swap = id
  --}

instance Symmetric (->) Either
instance Symmetric (->) (,)