module Control.Proxy.Trans.Maybe (
MaybeP(..),
runMaybeK,
nothing,
just
) 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 MaybeP p a' a b' b (m :: * -> *) r
= MaybeP { runMaybeP :: p a' a b' b m (Maybe r) }
instance (Proxy p, Monad m)
=> Functor (MaybeP p a' a b' b m) where
fmap f p = MaybeP (
runMaybeP p ?>= \m ->
return_P (case m of
Nothing -> Nothing
Just x -> Just (f x) ) )
instance (Proxy p, Monad m)
=> Applicative (MaybeP p a' a b' b m) where
pure = return
fp <*> xp = MaybeP (
runMaybeP fp ?>= \m1 ->
case m1 of
Nothing -> return_P Nothing
Just f ->
runMaybeP xp ?>= \m2 ->
case m2 of
Nothing -> return_P Nothing
Just x -> return_P (Just (f x)) )
instance (Proxy p, Monad m)
=> Monad (MaybeP p a' a b' b m) where
return = return_P
(>>=) = (?>=)
instance (Proxy p, Monad m)
=> Alternative (MaybeP p a' a b' b m) where
empty = mzero
(<|>) = mplus
instance (Proxy p )
=> MonadPlusP (MaybeP p) where
mzero_P = nothing
mplus_P m1 m2 = MaybeP (
runMaybeP m1 ?>= \ma ->
runMaybeP (case ma of
Nothing -> m2
Just a -> just a ) )
instance (Proxy p, Monad m)
=> MonadPlus (MaybeP p a' a b' b m) where
mzero = mzero_P
mplus = mplus_P
instance (Proxy p )
=> MonadTrans (MaybeP p a' a b' b) where
lift = lift_P
instance (MonadIOP p )
=> MonadIOP (MaybeP p) where
liftIO_P m = MaybeP (liftIO_P (m >>= \x -> return (Just x)))
instance (MonadIOP p, MonadIO m)
=> MonadIO (MaybeP p a' a b' b m) where
liftIO = liftIO_P
instance (Proxy p )
=> MFunctor (MaybeP p a' a b' b) where
hoist = hoist_P
instance (Proxy p )
=> Proxy (MaybeP p) where
p1 >-> p2 = \c'1 -> MaybeP (
((\b' -> runMaybeP (p1 b')) >-> (\c'2 -> runMaybeP (p2 c'2))) c'1 )
p1 >~> p2 = \c'1 -> MaybeP (
((\b' -> runMaybeP (p1 b')) >~> (\c'2 -> runMaybeP (p2 c'2))) c'1 )
request = \a' -> MaybeP (request a' ?>= \a -> return_P (Just a ))
respond = \b -> MaybeP (respond b ?>= \b' -> return_P (Just b'))
return_P = just
m ?>= f = MaybeP (
runMaybeP m ?>= \ma ->
runMaybeP (case ma of
Nothing -> nothing
Just a -> f a ) )
lift_P m = MaybeP (lift_P (m >>= \x -> return (Just x)))
hoist_P nat p = MaybeP (hoist_P nat (runMaybeP p))
instance ProxyTrans MaybeP where
liftP p = MaybeP (p ?>= \x -> return_P (Just x))
instance PFunctor MaybeP where
hoistP nat = MaybeP . nat . runMaybeP
runMaybeK :: (q -> MaybeP p a' a b' b m r) -> (q -> p a' a b' b m (Maybe r))
runMaybeK p q = runMaybeP (p q)
nothing :: (Monad m, Proxy p) => MaybeP p a' a b' b m r
nothing = MaybeP (return_P Nothing)
just :: (Monad m, Proxy p) => r -> MaybeP p a' a b' b m r
just r = MaybeP (return_P (Just r))