{-# LANGUAGE CPP #-}
module Data.EitherR (
EitherR(..),
succeed,
throwEither,
catchEither,
handleEither,
fmapL,
flipEither,
ExceptRT(..),
succeedT,
handleE,
fmapLT,
flipET,
) where
import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))
import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT, throwE, catchE)
import Data.Monoid (Monoid(mempty, mappend))
import qualified Control.Monad.Trans.Except
newtype EitherR r e = EitherR { forall r e. EitherR r e -> Either e r
runEitherR :: Either e r }
instance Functor (EitherR r) where
fmap :: forall a b. (a -> b) -> EitherR r a -> EitherR r b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (EitherR r) where
pure :: forall a. a -> EitherR r a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. EitherR r (a -> b) -> EitherR r a -> EitherR r b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (EitherR r) where
return :: forall a. a -> EitherR r a
return a
e = forall r e. Either e r -> EitherR r e
EitherR (forall a b. a -> Either a b
Left a
e)
EitherR Either a r
m >>= :: forall a b. EitherR r a -> (a -> EitherR r b) -> EitherR r b
>>= a -> EitherR r b
f = case Either a r
m of
Left a
e -> a -> EitherR r b
f a
e
Right r
r -> forall r e. Either e r -> EitherR r e
EitherR (forall a b. b -> Either a b
Right r
r)
instance (Monoid r) => Alternative (EitherR r) where
empty :: forall a. EitherR r a
empty = forall r e. Either e r -> EitherR r e
EitherR (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
e1 :: EitherR r a
e1@(EitherR (Left a
_)) <|> :: forall a. EitherR r a -> EitherR r a -> EitherR r a
<|> EitherR r a
_ = EitherR r a
e1
EitherR r a
_ <|> e2 :: EitherR r a
e2@(EitherR (Left a
_)) = EitherR r a
e2
EitherR (Right r
r1) <|> EitherR (Right r
r2)
= forall r e. Either e r -> EitherR r e
EitherR (forall a b. b -> Either a b
Right (forall a. Monoid a => a -> a -> a
mappend r
r1 r
r2))
instance (Monoid r) => MonadPlus (EitherR r) where
mzero :: forall a. EitherR r a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. EitherR r a -> EitherR r a -> EitherR r a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
succeed :: r -> EitherR r e
succeed :: forall r e. r -> EitherR r e
succeed r
r = forall r e. Either e r -> EitherR r e
EitherR (forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
throwEither :: e -> Either e r
throwEither :: forall a b. a -> Either a b
throwEither e
e = forall r e. EitherR r e -> Either e r
runEitherR (forall (m :: * -> *) a. Monad m => a -> m a
return e
e)
catchEither :: Either a r -> (a -> Either b r) -> Either b r
Either a r
e catchEither :: forall a r b. Either a r -> (a -> Either b r) -> Either b r
`catchEither` a -> Either b r
f = forall r e. EitherR r e -> Either e r
runEitherR forall a b. (a -> b) -> a -> b
$ forall r e. Either e r -> EitherR r e
EitherR Either a r
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall r e. Either e r -> EitherR r e
EitherR (a -> Either b r
f a
a)
handleEither :: (a -> Either b r) -> Either a r -> Either b r
handleEither :: forall a b r. (a -> Either b r) -> Either a r -> Either b r
handleEither = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a r b. Either a r -> (a -> Either b r) -> Either b r
catchEither
fmapL :: (a -> b) -> Either a r -> Either b r
fmapL :: forall a b r. (a -> b) -> Either a r -> Either b r
fmapL a -> b
f = forall r e. EitherR r e -> Either e r
runEitherR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r e. Either e r -> EitherR r e
EitherR
flipEither :: Either a b -> Either b a
flipEither :: forall a b. Either a b -> Either b a
flipEither Either a b
e = case Either a b
e of
Left a
a -> forall a b. b -> Either a b
Right a
a
Right b
b -> forall a b. a -> Either a b
Left b
b
newtype ExceptRT r m e = ExceptRT { forall r (m :: * -> *) e. ExceptRT r m e -> ExceptT e m r
runExceptRT :: ExceptT e m r }
instance (Monad m) => Functor (ExceptRT r m) where
fmap :: forall a b. (a -> b) -> ExceptRT r m a -> ExceptRT r m b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m) => Applicative (ExceptRT r m) where
pure :: forall a. a -> ExceptRT r m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b.
ExceptRT r m (a -> b) -> ExceptRT r m a -> ExceptRT r m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Monad m) => Monad (ExceptRT r m) where
return :: forall a. a -> ExceptRT r m a
return a
e = forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE a
e)
ExceptRT r m a
m >>= :: forall a b.
ExceptRT r m a -> (a -> ExceptRT r m b) -> ExceptRT r m b
>>= a -> ExceptRT r m b
f = forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
Either a r
x <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) e. ExceptRT r m e -> ExceptT e m r
runExceptRT ExceptRT r m a
m
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) e. ExceptRT r m e -> ExceptT e m r
runExceptRT forall a b. (a -> b) -> a -> b
$ case Either a r
x of
Left a
e -> a -> ExceptRT r m b
f a
e
Right r
r -> forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT (forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
instance (Monad m, Monoid r) => Alternative (ExceptRT r m) where
empty :: forall a. ExceptRT r m a
empty = forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
ExceptRT r m a
e1 <|> :: forall a. ExceptRT r m a -> ExceptRT r m a -> ExceptRT r m a
<|> ExceptRT r m a
e2 = forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
Either a r
x1 <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) e. ExceptRT r m e -> ExceptT e m r
runExceptRT ExceptRT r m a
e1
case Either a r
x1 of
Left a
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
l)
Right r
r1 -> do
Either a r
x2 <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) e. ExceptRT r m e -> ExceptT e m r
runExceptRT ExceptRT r m a
e2
case Either a r
x2 of
Left a
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
l)
Right r
r2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall a. Monoid a => a -> a -> a
mappend r
r1 r
r2))
instance (Monad m, Monoid r) => MonadPlus (ExceptRT r m) where
mzero :: forall a. ExceptRT r m a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. ExceptRT r m a -> ExceptRT r m a -> ExceptRT r m a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance MonadTrans (ExceptRT r) where
lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptRT r m a
lift = forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. a -> Either a b
Left
instance (MonadIO m) => MonadIO (ExceptRT r m) where
liftIO :: forall a. IO a -> ExceptRT r m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
succeedT :: (Monad m) => r -> ExceptRT r m e
succeedT :: forall (m :: * -> *) r e. Monad m => r -> ExceptRT r m e
succeedT r
r = forall r (m :: * -> *) e. ExceptT e m r -> ExceptRT r m e
ExceptRT (forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
handleE :: (Monad m) => (a -> ExceptT b m r) -> ExceptT a m r -> ExceptT b m r
handleE :: forall (m :: * -> *) a b r.
Monad m =>
(a -> ExceptT b m r) -> ExceptT a m r -> ExceptT b m r
handleE = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE
#if MIN_VERSION_base(4,8,0)
fmapLT :: Functor m => (a -> b) -> ExceptT a m r -> ExceptT b m r
fmapLT :: forall (m :: * -> *) a b r.
Functor m =>
(a -> b) -> ExceptT a m r -> ExceptT b m r
fmapLT = forall (m :: * -> *) a b r.
Functor m =>
(a -> b) -> ExceptT a m r -> ExceptT b m r
Control.Monad.Trans.Except.withExceptT
#else
fmapLT :: (Monad m) => (a -> b) -> ExceptT a m r -> ExceptT b m r
fmapLT f = runExceptRT . fmap f . ExceptRT
#endif
flipET :: (Monad m) => ExceptT a m b -> ExceptT b m a
flipET :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> ExceptT b m a
flipET = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. Either a b -> Either b a
flipEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT