module Control.Proxy.Trans.Identity (
IdentityP(..),
identityK,
runIdentityK
) where
import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))
import Control.Monad (MonadPlus(mzero, mplus))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.MFunctor (MFunctor(hoist))
import Control.PFunctor (PFunctor(hoistP))
import Control.Proxy.Class
import Control.Proxy.Trans (ProxyTrans(liftP))
newtype IdentityP p a' a b' b (m :: * -> *) r =
IdentityP { runIdentityP :: p a' a b' b m r }
instance (Proxy p, Monad m)
=> Functor (IdentityP p a' a b' b m) where
fmap f p = IdentityP (
runIdentityP p ?>= \x ->
return_P (f x) )
instance (Proxy p, Monad m)
=> Applicative (IdentityP p a' a b' b m) where
pure = return
fp <*> xp = IdentityP (
runIdentityP fp ?>= \f ->
runIdentityP xp ?>= \x ->
return_P (f x) )
instance (Proxy p, Monad m)
=> Monad (IdentityP p a' a b' b m) where
return = return_P
(>>=) = (?>=)
instance (MonadPlusP p, Monad m)
=> Alternative (IdentityP p a' a b' b m) where
empty = mzero
(<|>) = mplus
instance (MonadPlusP p )
=> MonadPlusP (IdentityP p) where
mzero_P = IdentityP mzero_P
mplus_P m1 m2 = IdentityP (mplus_P (runIdentityP m1) (runIdentityP m2))
instance (MonadPlusP p, Monad m)
=> MonadPlus (IdentityP p a' a b' b m) where
mzero = mzero_P
mplus = mplus_P
instance (Proxy p )
=> MonadTrans (IdentityP p a' a b' b) where
lift = lift_P
instance (MonadIOP p )
=> MonadIOP (IdentityP p) where
liftIO_P m = IdentityP (liftIO_P m)
instance (MonadIOP p, MonadIO m)
=> MonadIO (IdentityP p a' a b' b m) where
liftIO = liftIO_P
instance (Proxy p )
=> MFunctor (IdentityP p a' a b' b) where
hoist = hoist_P
instance (Proxy p )
=> Proxy (IdentityP p) where
p1 >-> p2 = \c'1 -> IdentityP (
((\c'2 -> runIdentityP (p1 c'2))
>-> (\b' -> runIdentityP (p2 b' )) ) c'1 )
p1 >~> p2 = \c'1 -> IdentityP (
((\c'2 -> runIdentityP (p1 c'2))
>~> (\b' -> runIdentityP (p2 b' )) ) c'1 )
request = \a' -> IdentityP (request a')
respond = \b -> IdentityP (respond b)
return_P = \r -> IdentityP (return_P r)
m ?>= f = IdentityP (
runIdentityP m ?>= \x ->
runIdentityP (f x) )
lift_P m = IdentityP (lift_P m)
hoist_P nat p = IdentityP (hoist_P nat (runIdentityP p))
instance (Interact p )
=> Interact (IdentityP p) where
p1 \>\ p2 = \c'1 -> IdentityP (
((\b' -> runIdentityP (p1 b' ))
\>\ (\c'2 -> runIdentityP (p2 c'2)) ) c'1 )
p1 />/ p2 = \a1 -> IdentityP (
((\a2 -> runIdentityP (p1 a2))
/>/ (\b -> runIdentityP (p2 b )) ) a1 )
instance ProxyTrans IdentityP where
liftP = IdentityP
instance PFunctor IdentityP where
hoistP nat = IdentityP . nat . runIdentityP
identityK :: (q -> p a' a b' b m r) -> (q -> IdentityP p a' a b' b m r)
identityK k q = IdentityP (k q)
runIdentityK :: (q -> IdentityP p a' a b' b m r) -> (q -> p a' a b' b m r)
runIdentityK k q = runIdentityP (k q)