-----------------------------------------------------------------------------
--
-- Module      :  Data.DualCategory.Instances.Categories
-- Copyright   :
-- License     :  BSD3
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.DualCategory.Instances.Categories (

) where

import Prelude hiding (Functor, fmap, (.), id)

import Data.DualCategory.DualCategory (DualCategory(DualCategory))
import Control.Category (Category, (.), id, (>>>), (<<<))
import Control.Categorical.Bifunctor (PFunctor, QFunctor, Bifunctor, first, second, bimap)
import Control.Category.Associative (Associative, associate, disassociate)
import Control.Categorical.Functor (Functor, fmap)
import Control.Category.Braided (Braided, braid, Symmetric, braid, swap)
import Control.Category.Monoidal (Monoidal, Id, idl, idr, coidl, coidr)
import Control.Arrow (Kleisli(Kleisli))
import qualified Control.Arrow as A

instance (Category c1, Category c2) => Category (DualCategory c1 c2) where
  id = DualCategory id id
  (DualCategory l1 r1) . (DualCategory l2 r2) = DualCategory (l1 . l2) (r2 . r1)

instance (PFunctor p c1 c1, PFunctor p c2 c2) => PFunctor p (DualCategory c1 c2) (DualCategory c1 c2) where
  first (DualCategory l r) = DualCategory (first l) (first r)

instance (QFunctor p c1 c1, QFunctor p c2 c2) => QFunctor p (DualCategory c1 c2) (DualCategory c1 c2) where
  second (DualCategory l r) = DualCategory (second l) (second r)

instance (Bifunctor p c1 c1 c1, Bifunctor p c2 c2 c2) => Bifunctor p (DualCategory c1 c2)  (DualCategory c1 c2) (DualCategory c1 c2) where
  bimap (DualCategory l1 r1) (DualCategory l2 r2) = DualCategory (bimap l1 l2) (bimap r1 r2)

instance (Category c1, Category c2, Functor f c1 c3, Functor f c2 c4) => Functor f (DualCategory c1 c2) (DualCategory c3 c4) where
  fmap (DualCategory l r) = DualCategory (fmap l) (fmap r)

instance (Associative c1 p, Associative c2 p) => (Associative (DualCategory c1 c2) p) where
  associate = DualCategory associate disassociate
  disassociate = DualCategory disassociate associate

instance (Braided c1 p, Braided c2 p) => Braided (DualCategory c1 c2) p where
  braid = DualCategory braid braid

instance (Braided (DualCategory c1 c2) p) => Symmetric (DualCategory c1 c2) p

instance (Associative (DualCategory c1 c2) p, Monoidal c1 p, Monoidal c2 p, Id c1 p ~ Id c2 p) => Monoidal (DualCategory c1 c2) p where
  type Id (DualCategory c1 c2) p = Id c1 p
  idl = DualCategory idl coidl
  idr = DualCategory idr coidr
  coidl = DualCategory coidl idl
  coidr = DualCategory coidr idr