    {-# 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 :: forall a b c. ((a, b), c) -> (a, (b, c))
    associate ((a
    a,b
    b),c
    c) = (a
    a,(b
    b,c
    c))
            disassociate :: forall a b c. (a, (b, c)) -> ((a, b), c)
    disassociate (a
    a,(b
    b,c
    c)) = ((a
    a,b
    b),c
    c)

    instance Associative (->) Either where
            associate :: forall a b c. Either (Either a b) c -> Either a (Either b c)
    associate (Left (Left a
    a)) = a -> Either a (Either b c)
    forall a b. a -> Either a b
    Left a
    a
            associate (Left (Right 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) = 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 :: forall a b c. Either a (Either b c) -> Either (Either a b) c
    disassociate (Left 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)) = 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 -> Either (Either a b) c
    forall a b. b -> Either a b
    Right c
    c