-- | This module provides the proxy transformer equivalent of 'IdentityT'.

{-# LANGUAGE FlexibleContexts, KindSignatures #-}

module Control.Proxy.Trans.Identity (
    -- * IdentityP
    IdentityP(..),
    runIdentityK
    ) where

import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))
import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.MFunctor (MFunctor(mapT))
import Control.Proxy.Class (
    Channel(idT    , (>->)), 
    Interact(request, (\>\), respond, (/>/)) )
import Control.Proxy.Trans (ProxyTrans(liftP))

-- | The 'Identity' proxy transformer
newtype IdentityP p a' a b' b (m :: * -> *) r
  = IdentityP { runIdentityP :: p a' a b' b m r }

instance (Monad (p a' a b' b m)) => Functor (IdentityP p a' a b' b m) where
    fmap = liftM

instance (Monad (p a' a b' b m)) => Applicative (IdentityP p a' a b' b m) where
    pure  = return
    (<*>) = ap

instance (Monad (p a' a b' b m)) => Monad (IdentityP p a' a b' b m) where
    return = IdentityP . return
    m >>= f = IdentityP $ runIdentityP m >>= runIdentityP . f

instance (MonadPlus (p a' a b' b m))
 => Alternative (IdentityP p a' a b' b m) where
    empty = mzero
    (<|>) = mplus

instance (MonadPlus (p a' a b' b m))
 => MonadPlus (IdentityP p a' a b' b m) where
    mzero = IdentityP mzero
    mplus m1 m2 = IdentityP $ mplus (runIdentityP m1) (runIdentityP m2)

instance (MonadTrans (p a' a b' b)) => MonadTrans (IdentityP p a' a b' b) where
    lift = IdentityP . lift

instance (MonadIO (p a' a b' b m)) => MonadIO (IdentityP p a' a b' b m) where
    liftIO = IdentityP . liftIO

instance (MFunctor (p a' a b' b)) => MFunctor (IdentityP p a' a b' b) where
    mapT nat = IdentityP . mapT nat . runIdentityP

instance (Channel p) => Channel (IdentityP p) where
    idT = IdentityP . idT
    p1 >-> p2 = (IdentityP .) $ runIdentityP . p1 >-> runIdentityP . p2

instance (Interact p) => Interact (IdentityP p) where
    request = IdentityP . request
    p1 \>\ p2 = (IdentityP .) $ runIdentityP . p1 \>\ runIdentityP . p2
    respond = IdentityP . respond
    p1 />/ p2 = (IdentityP .) $ runIdentityP . p1 />/ runIdentityP . p2

instance ProxyTrans IdentityP where
    liftP = IdentityP

-- | Run an 'IdentityP' \'@K@\'leisli arrow
runIdentityK :: (q -> IdentityP p a' a b' b m r) -> (q -> p a' a b' b m r)
runIdentityK = (runIdentityP .)