{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE MultiParamTypeClasses #-}
-------------------------------------------------------------------------------------------
-- |
-- Module    : Control.Category.Associative
-- Copyright : 2008 Edward Kmett
-- License   : BSD
--
-- Maintainer  : Edward Kmett <ekmett@gmail.com>
-- Stability   : experimental
-- Portability : portable
--
-- NB: this contradicts another common meaning for an 'Associative' 'Category', which is one
-- where the pentagonal condition does not hold, but for which there is an identity.
--
-------------------------------------------------------------------------------------------
module Control.Category.Associative
    ( Associative(..)
    ) where

import Control.Categorical.Bifunctor

{- | A category with an associative bifunctor satisfying Mac Lane\'s pentagonal coherence identity law:

> bimap id associate . associate . bimap associate id = associate . associate
> bimap disassociate id . disassociate . bimap id disassociate = disassociate . disassociate
-}
class Bifunctor p k k k => Associative k p where
    associate :: k (p (p a b) c) (p a (p b c))
    disassociate :: k (p a (p b c)) (p (p a b) c)

{-- RULES
"copentagonal coherence" first disassociate . disassociate . second disassociate = disassociate . disassociate
"pentagonal coherence"   second associate . associate . first associate = associate . associate
 --}

instance Associative (->) (,) where
        associate :: ((a, b), c) -> (a, (b, c))
associate ((a :: a
a,b :: b
b),c :: c
c) = (a
a,(b
b,c
c))
        disassociate :: (a, (b, c)) -> ((a, b), c)
disassociate (a :: a
a,(b :: b
b,c :: c
c)) = ((a
a,b
b),c
c)

instance Associative (->) Either where
        associate :: Either (Either a b) c -> Either a (Either b c)
associate (Left (Left a :: a
a)) = a -> Either a (Either b c)
forall a b. a -> Either a b
Left a
a
        associate (Left (Right b :: b
b)) = Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (b -> Either b c
forall a b. a -> Either a b
Left b
b)
        associate (Right c :: c
c) = Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (c -> Either b c
forall a b. b -> Either a b
Right c
c)
        disassociate :: Either a (Either b c) -> Either (Either a b) c
disassociate (Left a :: a
a) = Either a b -> Either (Either a b) c
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a)
        disassociate (Right (Left b :: b
b)) = Either a b -> Either (Either a b) c
forall a b. a -> Either a b
Left (b -> Either a b
forall a b. b -> Either a b
Right b
b)
        disassociate (Right (Right c :: c
c)) = c -> Either (Either a b) c
forall a b. b -> Either a b
Right c
c