module Control.Proxy.Trans.Either (
EitherP(..),
runEitherK,
left,
right,
throw,
catch,
handle
) 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))
#if MIN_VERSION_base(4,6,0)
#else
import Prelude hiding (catch)
#endif
newtype EitherP e p a' a b' b (m :: * -> *) r
= EitherP { runEitherP :: p a' a b' b m (Either e r) }
instance (Proxy p, Monad m)
=> Functor (EitherP e p a' a b' b m) where
fmap f p = EitherP (
runEitherP p ?>= \e ->
return_P (case e of
Left l -> Left l
Right r -> Right (f r) ) )
instance (Proxy p, Monad m)
=> Applicative (EitherP e p a' a b' b m) where
pure = return
fp <*> xp = EitherP (
runEitherP fp ?>= \e1 ->
case e1 of
Left l -> return_P (Left l)
Right f ->
runEitherP xp ?>= \e2 ->
return_P (case e2 of
Left l -> Left l
Right x -> Right (f x) ) )
instance (Proxy p, Monad m)
=> Monad (EitherP e p a' a b' b m) where
return = return_P
(>>=) = (?>=)
instance (MonadPlusP p, Monad m)
=> Alternative (EitherP e p a' a b' b m) where
empty = mzero
(<|>) = mplus
instance (MonadPlusP p )
=> MonadPlusP (EitherP e p) where
mzero_P = EitherP mzero_P
mplus_P m1 m2 = EitherP (mplus_P (runEitherP m1) (runEitherP m2))
instance (MonadPlusP p, Monad m)
=> MonadPlus (EitherP e p a' a b' b m) where
mzero = mzero_P
mplus = mplus_P
instance (Proxy p )
=> MonadTrans (EitherP e p a' a b' b) where
lift = lift_P
instance (MonadIOP p )
=> MonadIOP (EitherP e p) where
liftIO_P m = EitherP (liftIO_P (m >>= \x -> return (Right x)))
instance (MonadIOP p, MonadIO m)
=> MonadIO (EitherP e p a' a b' b m) where
liftIO = liftIO_P
instance (Proxy p )
=> MFunctor (EitherP e p a' a b' b) where
hoist = hoist_P
instance (Proxy p )
=> Proxy (EitherP e p) where
p1 >-> p2 = \c'1 -> EitherP (
((\b' -> runEitherP (p1 b')) >-> (\c'2 -> runEitherP (p2 c'2))) c'1 )
p1 >~> p2 = \c'1 -> EitherP (
((\b' -> runEitherP (p1 b')) >~> (\c'2 -> runEitherP (p2 c'2))) c'1 )
request = \a' -> EitherP (request a' ?>= \a -> return_P (Right a ))
respond = \b -> EitherP (respond b ?>= \b' -> return_P (Right b'))
return_P = right
m ?>= f = EitherP (
runEitherP m ?>= \e ->
runEitherP (case e of
Left l -> left l
Right r -> f r ) )
lift_P m = EitherP (lift_P (m >>= \x -> return (Right x)))
hoist_P nat p = EitherP (hoist_P nat (runEitherP p))
instance ProxyTrans (EitherP e) where
liftP p = EitherP (p ?>= \x -> return_P (Right x))
instance PFunctor (EitherP e) where
hoistP nat = EitherP . nat . runEitherP
runEitherK
:: (q -> EitherP e p a' a b' b m r) -> (q -> p a' a b' b m (Either e r))
runEitherK p q = runEitherP (p q)
left :: (Monad m, Proxy p) => e -> EitherP e p a' a b' b m r
left e = EitherP (return_P (Left e))
right :: (Monad m, Proxy p) => r -> EitherP e p a' a b' b m r
right r = EitherP (return_P (Right r))
throw :: (Monad m, Proxy p) => e -> EitherP e p a' a b' b m r
throw = left
catch
:: (Monad m, Proxy p)
=> EitherP e p a' a b' b m r
-> (e -> EitherP f p a' a b' b m r)
-> EitherP f p a' a b' b m r
catch m f = EitherP (
runEitherP m ?>= \e ->
runEitherP (case e of
Left l -> f l
Right r -> right r ))
handle
:: (Monad m, Proxy p)
=> (e -> EitherP f p a' a b' b m r)
-> EitherP e p a' a b' b m r
-> EitherP f p a' a b' b m r
handle f m = catch m f