module Control.Proxy.Trans.Either (
EitherP(..),
runEitherK,
left,
right,
throw,
catch,
handle
) 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, (>->)))
import Control.Proxy.Trans (ProxyTrans(liftP))
import Prelude hiding (catch)
newtype EitherP e p a' a b' b (m :: * -> *) r
= EitherP { runEitherP :: p a' a b' b m (Either e r) }
instance (Monad (p a' a b' b m)) => Functor (EitherP e p a' a b' b m) where
fmap = liftM
instance (Monad (p a' a b' b m)) => Applicative (EitherP e p a' a b' b m) where
pure = return
(<*>) = ap
instance (Monad (p a' a b' b m)) => Monad (EitherP e p a' a b' b m) where
return = right
m >>= f = EitherP $ do
e <- runEitherP m
runEitherP $ case e of
Left e -> left e
Right r -> f r
instance (MonadPlus (p a' a b' b m))
=> Alternative (EitherP e p a' a b' b m) where
empty = mzero
(<|>) = mplus
instance (MonadPlus (p a' a b' b m))
=> MonadPlus (EitherP e p a' a b' b m) where
mzero = EitherP mzero
mplus m1 m2 = EitherP $ mplus (runEitherP m1) (runEitherP m2)
instance (MonadTrans (p a' a b' b)) => MonadTrans (EitherP e p a' a b' b) where
lift = EitherP . lift . liftM Right
instance (MonadIO (p a' a b' b m)) => MonadIO (EitherP e p a' a b' b m) where
liftIO = EitherP . liftIO . liftM Right
instance (MFunctor (p a' a b' b)) => MFunctor (EitherP e p a' a b' b) where
mapT nat = EitherP . mapT nat . runEitherP
instance (Channel p) => Channel (EitherP e p) where
idT = EitherP . idT
p1 >-> p2 = (EitherP .) $ runEitherP . p1 >-> runEitherP . p2
instance ProxyTrans (EitherP e) where
liftP = EitherP . liftM Right
runEitherK
:: (q -> EitherP e p a' a b' b m r) -> (q -> p a' a b' b m (Either e r))
runEitherK = (runEitherP .)
left :: (Monad (p a' a b' b m)) => e -> EitherP e p a' a b' b m r
left = EitherP . return . Left
right :: (Monad (p a' a b' b m)) => r -> EitherP e p a' a b' b m r
right = EitherP . return . Right
throw :: (Monad (p a' a b' b m)) => e -> EitherP e p a' a b' b m r
throw = left
catch
:: (Monad (p a' a b' b m))
=> 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 $ do
e <- runEitherP m
runEitherP $ case e of
Left e -> f e
Right r -> right r
handle
:: (Monad (p a' a b' b m))
=> (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 = EitherP $ do
e <- runEitherP m
runEitherP $ case e of
Left e -> f e
Right r -> right r