module Control.Error.Util (
hush,
hushT,
note,
noteT,
hoistMaybe,
(??),
(!?),
maybeT,
just,
nothing,
isLeft,
isRight,
fmapR,
fmapRT,
err,
errLn,
tryIO,
syncIO
) where
import Control.Applicative (Applicative, pure, (<$>))
import qualified Control.Exception as Ex
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Either (EitherT(EitherT, runEitherT))
import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
import Data.Dynamic (Dynamic)
import System.Exit (ExitCode)
import System.IO (hPutStr, hPutStrLn, stderr)
import Data.EitherR (fmapL, fmapLT)
hush :: Either a b -> Maybe b
hush = either (const Nothing) Just
hushT :: (Monad m) => EitherT a m b -> MaybeT m b
hushT = MaybeT . liftM hush . runEitherT
note :: a -> Maybe b -> Either a b
note a = maybe (Left a) Right
noteT :: (Monad m) => a -> MaybeT m b -> EitherT a m b
noteT a = EitherT . liftM (note a) . runMaybeT
hoistMaybe :: (Monad m) => Maybe b -> MaybeT m b
hoistMaybe = MaybeT . return
(??) :: Applicative m => Maybe a -> e -> EitherT e m a
(??) a e = EitherT (pure $ note e a)
(!?) :: Applicative m => m (Maybe a) -> e -> EitherT e m a
(!?) a e = EitherT (note e <$> a)
maybeT :: Monad m => m b -> (a -> m b) -> MaybeT m a -> m b
maybeT mb kb (MaybeT ma) = ma >>= maybe mb kb
just :: (Monad m) => a -> MaybeT m a
just a = MaybeT (return (Just a))
nothing :: (Monad m) => MaybeT m a
nothing = MaybeT (return Nothing)
isLeft :: Either a b -> Bool
isLeft = either (const True) (const False)
isRight :: Either a b -> Bool
isRight = either (const False) (const True)
fmapR :: (a -> b) -> Either l a -> Either l b
fmapR = fmap
fmapRT :: (Monad m) => (a -> b) -> EitherT l m a -> EitherT l m b
fmapRT = liftM
err :: String -> IO ()
err = hPutStr stderr
errLn :: String -> IO ()
errLn = hPutStrLn stderr
tryIO :: (MonadIO m) => IO a -> EitherT Ex.IOException m a
tryIO = EitherT . liftIO . Ex.try
syncIO :: MonadIO m => IO a -> EitherT Ex.SomeException m a
syncIO a = EitherT . liftIO $ Ex.catches (Right <$> a)
[ Ex.Handler $ \e -> Ex.throw (e :: Ex.ArithException)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.ArrayException)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.AssertionFailed)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.AsyncException)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.BlockedIndefinitelyOnMVar)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.BlockedIndefinitelyOnSTM)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.Deadlock)
, Ex.Handler $ \e -> Ex.throw (e :: Dynamic)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.ErrorCall)
, Ex.Handler $ \e -> Ex.throw (e :: ExitCode)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.NestedAtomically)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.NoMethodError)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.NonTermination)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.PatternMatchFail)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.RecConError)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.RecSelError)
, Ex.Handler $ \e -> Ex.throw (e :: Ex.RecUpdError)
, Ex.Handler $ return . Left
]