module Control.Error.Util (
hush,
hushT,
note,
noteT,
hoistMaybe,
hoistEither,
(??),
(!?),
failWith,
failWithM,
bool,
(?:),
maybeT,
just,
nothing,
isJustT,
isNothingT,
isLeft,
isRight,
fmapR,
AllE(..),
AnyE(..),
isLeftT,
isRightT,
fmapRT,
exceptT,
bimapExceptT,
err,
errLn,
tryIO,
handleExceptT,
syncIO
) where
import Control.Applicative (Applicative, pure, (<$>))
import Control.Exception (Handler(..), IOException, SomeException, Exception)
import Control.Monad (liftM)
import Control.Monad.Catch (MonadCatch, try)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT, withExceptT)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
import Data.Dynamic (Dynamic)
import Data.Monoid (Monoid(mempty, mappend))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.Exit (ExitCode)
import System.IO (hPutStr, hPutStrLn, stderr)
import UnexceptionalIO (UIO, Unexceptional)
import qualified Control.Exception as Exception
import qualified Data.Text.IO
import qualified UnexceptionalIO as UIO
exceptT :: Monad m => (a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT f g (ExceptT m) = m >>= \z -> case z of
Left a -> f a
Right b -> g b
bimapExceptT :: Functor m => (e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT f g (ExceptT m) = ExceptT (fmap h m)
where
h (Left e) = Left (f e)
h (Right a) = Right (g a)
hoistEither :: Monad m => Either e a -> ExceptT e m a
hoistEither = ExceptT . return
hush :: Either a b -> Maybe b
hush = either (const Nothing) Just
hushT :: (Monad m) => ExceptT a m b -> MaybeT m b
hushT = MaybeT . liftM hush . runExceptT
note :: a -> Maybe b -> Either a b
note a = maybe (Left a) Right
noteT :: (Monad m) => a -> MaybeT m b -> ExceptT a m b
noteT a = ExceptT . liftM (note a) . runMaybeT
hoistMaybe :: (Monad m) => Maybe b -> MaybeT m b
hoistMaybe = MaybeT . return
(??) :: Applicative m => Maybe a -> e -> ExceptT e m a
(??) a e = ExceptT (pure $ note e a)
(!?) :: Applicative m => m (Maybe a) -> e -> ExceptT e m a
(!?) a e = ExceptT (note e <$> a)
(?:) :: Maybe a -> a -> a
maybeA ?: b = fromMaybe b maybeA
failWith :: Applicative m => e -> Maybe a -> ExceptT e m a
failWith e a = a ?? e
failWithM :: Applicative m => e -> m (Maybe a) -> ExceptT e m a
failWithM e a = a !? e
bool :: a -> a -> Bool -> a
bool a b = \c -> if c then b else 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)
isJustT :: (Monad m) => MaybeT m a -> m Bool
isJustT = maybeT (return False) (\_ -> return True)
isNothingT :: (Monad m) => MaybeT m a -> m Bool
isNothingT = maybeT (return True) (\_ -> return False)
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
newtype AllE e r = AllE { runAllE :: Either e r }
instance (Monoid e, Monoid r) => Monoid (AllE e r) where
mempty = AllE (Right mempty)
mappend (AllE (Right x)) (AllE (Right y)) = AllE (Right (mappend x y))
mappend (AllE (Right _)) (AllE (Left y)) = AllE (Left y)
mappend (AllE (Left x)) (AllE (Right _)) = AllE (Left x)
mappend (AllE (Left x)) (AllE (Left y)) = AllE (Left (mappend x y))
newtype AnyE e r = AnyE { runAnyE :: Either e r }
instance (Monoid e, Monoid r) => Monoid (AnyE e r) where
mempty = AnyE (Right mempty)
mappend (AnyE (Right x)) (AnyE (Right y)) = AnyE (Right (mappend x y))
mappend (AnyE (Right x)) (AnyE (Left _)) = AnyE (Right x)
mappend (AnyE (Left _)) (AnyE (Right y)) = AnyE (Right y)
mappend (AnyE (Left x)) (AnyE (Left y)) = AnyE (Left (mappend x y))
isLeftT :: (Monad m) => ExceptT a m b -> m Bool
isLeftT = exceptT (\_ -> return True) (\_ -> return False)
isRightT :: (Monad m) => ExceptT a m b -> m Bool
isRightT = exceptT (\_ -> return False) (\_ -> return True)
fmapRT :: (Monad m) => (a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT = liftM
err :: Text -> IO ()
err = Data.Text.IO.hPutStr stderr
errLn :: Text -> IO ()
errLn = Data.Text.IO.hPutStrLn stderr
tryIO :: MonadIO m => IO a -> ExceptT IOException m a
tryIO = ExceptT . liftIO . Exception.try
handleExceptT :: (Exception e, Functor m, MonadCatch m) => (e -> x) -> m a -> ExceptT x m a
handleExceptT handler = bimapExceptT handler id . ExceptT . try
syncIO :: Unexceptional m => IO a -> ExceptT SomeException m a
syncIO = ExceptT . UIO.liftUIO . UIO.fromIO