module Control.Monad.Throw where
import Prelude hiding (catch)
import Control.Monad.Reader
import Control.Monad.Error
import Control.Arrow ((+++))
import Control.Applicative ((<$>))
class (Monad m) => Throw e m where
throw :: e -> m a
catch :: m a -> (e -> m a) -> m a
throwLeft :: (Throw e m) => m (Either e a) -> m a
throwLeft = throwLeft' id
throwLeft' :: (Throw e m) => (x -> e) -> m (Either x a) -> m a
throwLeft' f = (either (throw . f) return =<<)
onException :: (Throw e m) => m a -> (e -> m b) -> m a
onException action releaser = catch action $ \e -> releaser e >> throw e
instance (Error e) => Throw e (Either e) where
throw = throwError
catch = catchError
instance (Error e, Monad m) => Throw e (ErrorT e m) where
throw = throwError
catch = catchError
instance (Error e, Throw e m, Error x) => Throw e (ErrorT x m) where
throw = lift . throw
catch a h = ErrorT $ catch (runErrorT a) (runErrorT . h)
instance (Throw e m) => Throw e (ReaderT x m) where
throw = lift . throw
catch a h = ReaderT $ \x -> catch (runReaderT a x) (flip runReaderT x . h)
mapError :: (Functor m) => (e -> e') -> ErrorT e m a -> ErrorT e' m a
mapError f (ErrorT m) = ErrorT $ (f +++ id) <$> m