{-# LANGUAGE CPP #-}

-- | This module exports miscellaneous error-handling functions.

module Control.Error.Util (
    -- * Conversion
    -- $conversion
    hush,
    hushT,
    note,
    noteT,
    hoistMaybe,
    hoistEither,
    (??),
    (!?),
    failWith,
    failWithM,

    -- * Bool
    bool,

    -- * Maybe
    (?:),

    -- * MaybeT
    maybeT,
    just,
    nothing,
    isJustT,
    isNothingT,

    -- * Either
    isLeft,
    isRight,
    fmapR,
    AllE(..),
    AnyE(..),

    -- * ExceptT
    isLeftT,
    isRightT,
    fmapRT,
    exceptT,
    bimapExceptT,

    -- * Error Reporting
    err,
    errLn,

    -- * Exceptions
    tryIO,
    handleExceptT,
    syncIO
    ) where

import Control.Applicative (Applicative, pure, (<$>))
import Control.Exception (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)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
import Data.Monoid (Monoid(mempty, mappend))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup
#endif
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.IO (stderr)

import qualified Control.Exception as Exception
import qualified Data.Text.IO

-- | Fold an 'ExceptT' by providing one continuation for each constructor
exceptT :: Monad m => (a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT :: forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT a -> m c
f b -> m c
g (ExceptT m (Either a b)
m) = m (Either a b)
m m (Either a b) -> (Either a b -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either a b
z -> case Either a b
z of
    Left  a
a -> a -> m c
f a
a
    Right b
b -> b -> m c
g b
b
{-# INLINEABLE exceptT #-}

-- | Transform the left and right value
bimapExceptT :: Functor m => (e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT :: forall (m :: * -> *) e f a b.
Functor m =>
(e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT e -> f
f a -> b
g (ExceptT m (Either e a)
m) = m (Either f b) -> ExceptT f m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((Either e a -> Either f b) -> m (Either e a) -> m (Either f b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either e a -> Either f b
h m (Either e a)
m)
  where
    h :: Either e a -> Either f b
h (Left e
e)  = f -> Either f b
forall a b. a -> Either a b
Left  (e -> f
f e
e)
    h (Right a
a) = b -> Either f b
forall a b. b -> Either a b
Right (a -> b
g a
a)
{-# INLINEABLE bimapExceptT #-}

-- | Upgrade an 'Either' to an 'ExceptT'
hoistEither :: Monad m => Either e a -> ExceptT e m a
hoistEither :: forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (Either e a -> m (Either e a)) -> Either e a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> m (Either e a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINEABLE hoistEither #-}

{- $conversion
    Use these functions to convert between 'Maybe', 'Either', 'MaybeT', and
    'ExceptT'.
-}
-- | Suppress the 'Left' value of an 'Either'
hush :: Either a b -> Maybe b
hush :: forall a b. Either a b -> Maybe b
hush = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just

-- | Suppress the 'Left' value of an 'ExceptT'
hushT :: (Monad m) => ExceptT a m b -> MaybeT m b
hushT :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> MaybeT m b
hushT = m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b)
-> (ExceptT a m b -> m (Maybe b)) -> ExceptT a m b -> MaybeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a b -> Maybe b) -> m (Either a b) -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either a b -> Maybe b
forall a b. Either a b -> Maybe b
hush (m (Either a b) -> m (Maybe b))
-> (ExceptT a m b -> m (Either a b))
-> ExceptT a m b
-> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT a m b -> m (Either a b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | Tag the 'Nothing' value of a 'Maybe'
note :: a -> Maybe b -> Either a b
note :: forall a b. a -> Maybe b -> Either a b
note a
a = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
a) b -> Either a b
forall a b. b -> Either a b
Right

-- | Tag the 'Nothing' value of a 'MaybeT'
noteT :: (Monad m) => a -> MaybeT m b -> ExceptT a m b
noteT :: forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT a
a = m (Either a b) -> ExceptT a m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either a b) -> ExceptT a m b)
-> (MaybeT m b -> m (Either a b)) -> MaybeT m b -> ExceptT a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe b -> Either a b) -> m (Maybe b) -> m (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a -> Maybe b -> Either a b
forall a b. a -> Maybe b -> Either a b
note a
a) (m (Maybe b) -> m (Either a b))
-> (MaybeT m b -> m (Maybe b)) -> MaybeT m b -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

-- | Lift a 'Maybe' to the 'MaybeT' monad
hoistMaybe :: (Monad m) => Maybe b -> MaybeT m b
hoistMaybe :: forall (m :: * -> *) b. Monad m => Maybe b -> MaybeT m b
hoistMaybe = m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b)
-> (Maybe b -> m (Maybe b)) -> Maybe b -> MaybeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Convert a 'Maybe' value into the 'ExceptT' monad
(??) :: Applicative m => Maybe a -> e -> ExceptT e m a
?? :: forall (m :: * -> *) a e.
Applicative m =>
Maybe a -> e -> ExceptT e m a
(??) Maybe a
a e
e = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Maybe a -> Either e a
forall a b. a -> Maybe b -> Either a b
note e
e Maybe a
a)

-- | Convert an applicative 'Maybe' value into the 'ExceptT' monad
(!?) :: Applicative m => m (Maybe a) -> e -> ExceptT e m a
!? :: forall (m :: * -> *) a e.
Applicative m =>
m (Maybe a) -> e -> ExceptT e m a
(!?) m (Maybe a)
a e
e = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (e -> Maybe a -> Either e a
forall a b. a -> Maybe b -> Either a b
note e
e (Maybe a -> Either e a) -> m (Maybe a) -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
a)

-- | An infix form of 'fromMaybe' with arguments flipped.
(?:) :: Maybe a -> a -> a
Maybe a
maybeA ?: :: forall a. Maybe a -> a -> a
?: a
b = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
b Maybe a
maybeA
{-# INLINABLE (?:) #-}

infixr 0 ?:

{-| Convert a 'Maybe' value into the 'ExceptT' monad

    Named version of ('??') with arguments flipped
-}
failWith :: Applicative m => e -> Maybe a -> ExceptT e m a
failWith :: forall (m :: * -> *) e a.
Applicative m =>
e -> Maybe a -> ExceptT e m a
failWith e
e Maybe a
a = Maybe a
a Maybe a -> e -> ExceptT e m a
forall (m :: * -> *) a e.
Applicative m =>
Maybe a -> e -> ExceptT e m a
?? e
e

{- | Convert an applicative 'Maybe' value into the 'ExceptT' monad

    Named version of ('!?') with arguments flipped
-}
failWithM :: Applicative m => e -> m (Maybe a) -> ExceptT e m a
failWithM :: forall (m :: * -> *) e a.
Applicative m =>
e -> m (Maybe a) -> ExceptT e m a
failWithM e
e m (Maybe a)
a = m (Maybe a)
a m (Maybe a) -> e -> ExceptT e m a
forall (m :: * -> *) a e.
Applicative m =>
m (Maybe a) -> e -> ExceptT e m a
!? e
e

{- | Case analysis for the 'Bool' type.

   > bool a b c == if c then b else a
-}
bool :: a -> a -> Bool -> a
bool :: forall a. a -> a -> Bool -> a
bool a
a a
b = \Bool
c -> if Bool
c then a
b else a
a
{-# INLINABLE bool #-}

{-| Case analysis for 'MaybeT'

    Use the first argument if the 'MaybeT' computation fails, otherwise apply
    the function to the successful result.
-}
maybeT :: Monad m => m b -> (a -> m b) -> MaybeT m a -> m b
maybeT :: forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> MaybeT m a -> m b
maybeT m b
mb a -> m b
kb (MaybeT m (Maybe a)
ma) = m (Maybe a)
ma m (Maybe a) -> (Maybe a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
mb a -> m b
kb

-- | Analogous to 'Just' and equivalent to 'return'
just :: (Monad m) => a -> MaybeT m a
just :: forall (m :: * -> *) a. Monad m => a -> MaybeT m a
just a
a = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a))

-- | Analogous to 'Nothing' and equivalent to 'mzero'
nothing :: (Monad m) => MaybeT m a
nothing :: forall (m :: * -> *) a. Monad m => MaybeT m a
nothing = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)

-- | Analogous to 'Data.Maybe.isJust', but for 'MaybeT'
isJustT :: (Monad m) => MaybeT m a -> m Bool
isJustT :: forall (m :: * -> *) a. Monad m => MaybeT m a -> m Bool
isJustT = m Bool -> (a -> m Bool) -> MaybeT m a -> m Bool
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> MaybeT m a -> m b
maybeT (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (\a
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
{-# INLINABLE isJustT #-}

-- | Analogous to 'Data.Maybe.isNothing', but for 'MaybeT'
isNothingT :: (Monad m) => MaybeT m a -> m Bool
isNothingT :: forall (m :: * -> *) a. Monad m => MaybeT m a -> m Bool
isNothingT = m Bool -> (a -> m Bool) -> MaybeT m a -> m Bool
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> MaybeT m a -> m b
maybeT (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\a
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
{-# INLINABLE isNothingT #-}

-- | Returns whether argument is a 'Left'
isLeft :: Either a b -> Bool
isLeft :: forall a b. Either a b -> Bool
isLeft = (a -> Bool) -> (b -> Bool) -> Either a b -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | Returns whether argument is a 'Right'
isRight :: Either a b -> Bool
isRight :: forall a b. Either a b -> Bool
isRight = (a -> Bool) -> (b -> Bool) -> Either a b -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True)

{- | 'fmap' specialized to 'Either', given a name symmetric to
     'Data.EitherR.fmapL'
-}
fmapR :: (a -> b) -> Either l a -> Either l b
fmapR :: forall a b l. (a -> b) -> Either l a -> Either l b
fmapR = (a -> b) -> Either l a -> Either l b
forall a b. (a -> b) -> Either l a -> Either l b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

{-| Run multiple 'Either' computations and succeed if all of them succeed

    'mappend's all successes or failures
-}
newtype AllE e r = AllE { forall e r. AllE e r -> Either e r
runAllE :: Either e r }

#if MIN_VERSION_base(4,9,0)
instance (Semigroup e, Semigroup r) => Semigroup (AllE e r) where
    AllE (Right r
x) <> :: AllE e r -> AllE e r -> AllE e r
<> AllE (Right r
y) = Either e r -> AllE e r
forall e r. Either e r -> AllE e r
AllE (r -> Either e r
forall a b. b -> Either a b
Right (r
x r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
y))
    AllE (Right r
_) <> AllE (Left  e
y) = Either e r -> AllE e r
forall e r. Either e r -> AllE e r
AllE (e -> Either e r
forall a b. a -> Either a b
Left e
y)
    AllE (Left  e
x) <> AllE (Right r
_) = Either e r -> AllE e r
forall e r. Either e r -> AllE e r
AllE (e -> Either e r
forall a b. a -> Either a b
Left e
x)
    AllE (Left  e
x) <> AllE (Left  e
y) = Either e r -> AllE e r
forall e r. Either e r -> AllE e r
AllE (e -> Either e r
forall a b. a -> Either a b
Left  (e
x e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
y))
#endif

instance (Monoid e, Monoid r) => Monoid (AllE e r) where
    mempty :: AllE e r
mempty = Either e r -> AllE e r
forall e r. Either e r -> AllE e r
AllE (r -> Either e r
forall a b. b -> Either a b
Right r
forall a. Monoid a => a
mempty)
#if !(MIN_VERSION_base(4,11,0))
    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))
#endif

{-| Run multiple 'Either' computations and succeed if any of them succeed

    'mappend's all successes or failures
-}
newtype AnyE e r = AnyE { forall e r. AnyE e r -> Either e r
runAnyE :: Either e r }

#if MIN_VERSION_base(4,9,0)
instance (Semigroup e, Semigroup r) => Semigroup (AnyE e r) where
    AnyE (Right r
x) <> :: AnyE e r -> AnyE e r -> AnyE e r
<> AnyE (Right r
y) = Either e r -> AnyE e r
forall e r. Either e r -> AnyE e r
AnyE (r -> Either e r
forall a b. b -> Either a b
Right (r
x r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
y))
    AnyE (Right r
x) <> AnyE (Left  e
_) = Either e r -> AnyE e r
forall e r. Either e r -> AnyE e r
AnyE (r -> Either e r
forall a b. b -> Either a b
Right r
x)
    AnyE (Left  e
_) <> AnyE (Right r
y) = Either e r -> AnyE e r
forall e r. Either e r -> AnyE e r
AnyE (r -> Either e r
forall a b. b -> Either a b
Right r
y)
    AnyE (Left  e
x) <> AnyE (Left  e
y) = Either e r -> AnyE e r
forall e r. Either e r -> AnyE e r
AnyE (e -> Either e r
forall a b. a -> Either a b
Left  (e
x e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
y))
#endif

instance (Monoid e, Monoid r) => Monoid (AnyE e r) where
    mempty :: AnyE e r
mempty = Either e r -> AnyE e r
forall e r. Either e r -> AnyE e r
AnyE (r -> Either e r
forall a b. b -> Either a b
Right r
forall a. Monoid a => a
mempty)
#if !(MIN_VERSION_base(4,11,0))
    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))
#endif

-- | Analogous to 'isLeft', but for 'ExceptT'
isLeftT :: (Monad m) => ExceptT a m b -> m Bool
isLeftT :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> m Bool
isLeftT = (a -> m Bool) -> (b -> m Bool) -> ExceptT a m b -> m Bool
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT (\a
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\b
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
{-# INLINABLE isLeftT #-}

-- | Analogous to 'isRight', but for 'ExceptT'
isRightT :: (Monad m) => ExceptT a m b -> m Bool
isRightT :: forall (m :: * -> *) a b. Monad m => ExceptT a m b -> m Bool
isRightT = (a -> m Bool) -> (b -> m Bool) -> ExceptT a m b -> m Bool
forall (m :: * -> *) a c b.
Monad m =>
(a -> m c) -> (b -> m c) -> ExceptT a m b -> m c
exceptT (\a
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (\b
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
{-# INLINABLE isRightT #-}

{- | 'fmap' specialized to 'ExceptT', given a name symmetric to
     'Data.EitherR.fmapLT'
-}
fmapRT :: (Monad m) => (a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT :: forall (m :: * -> *) a b l.
Monad m =>
(a -> b) -> ExceptT l m a -> ExceptT l m b
fmapRT = (a -> b) -> ExceptT l m a -> ExceptT l m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

-- | Write a string to standard error
err :: Text -> IO ()
err :: Text -> IO ()
err = Handle -> Text -> IO ()
Data.Text.IO.hPutStr Handle
stderr

-- | Write a string with a newline to standard error
errLn :: Text -> IO ()
errLn :: Text -> IO ()
errLn = Handle -> Text -> IO ()
Data.Text.IO.hPutStrLn Handle
stderr

-- | Catch 'IOException's and convert them to the 'ExceptT' monad
tryIO :: MonadIO m => IO a -> ExceptT IOException m a
tryIO :: forall (m :: * -> *) a.
MonadIO m =>
IO a -> ExceptT IOException m a
tryIO = m (Either IOException a) -> ExceptT IOException m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either IOException a) -> ExceptT IOException m a)
-> (IO a -> m (Either IOException a))
-> IO a
-> ExceptT IOException m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either IOException a) -> m (Either IOException a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException a) -> m (Either IOException a))
-> (IO a -> IO (Either IOException a))
-> IO a
-> m (Either IOException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try

-- | Run a monad action which may throw an exception in the `ExceptT` monad
handleExceptT :: (Exception e, Functor m, MonadCatch m) => (e -> x) -> m a -> ExceptT x m a
handleExceptT :: forall e (m :: * -> *) x a.
(Exception e, Functor m, MonadCatch m) =>
(e -> x) -> m a -> ExceptT x m a
handleExceptT e -> x
handler = (e -> x) -> (a -> a) -> ExceptT e m a -> ExceptT x m a
forall (m :: * -> *) e f a b.
Functor m =>
(e -> f) -> (a -> b) -> ExceptT e m a -> ExceptT f m b
bimapExceptT e -> x
handler a -> a
forall a. a -> a
id (ExceptT e m a -> ExceptT x m a)
-> (m a -> ExceptT e m a) -> m a -> ExceptT x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (m a -> m (Either e a)) -> m a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m (Either e a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try


{-| Catch all exceptions, except for asynchronous exceptions found in @base@
    and convert them to the 'ExceptT' monad
-}
syncIO :: MonadIO m => IO a -> ExceptT SomeException m a
syncIO :: forall (m :: * -> *) a.
MonadIO m =>
IO a -> ExceptT SomeException m a
syncIO = m (Either SomeException a) -> ExceptT SomeException m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either SomeException a) -> ExceptT SomeException m a)
-> (IO a -> m (Either SomeException a))
-> IO a
-> ExceptT SomeException m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either SomeException a) -> m (Either SomeException a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a) -> m (Either SomeException a))
-> (IO a -> IO (Either SomeException a))
-> IO a
-> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either SomeException a)
forall a. IO a -> IO (Either SomeException a)
trySync

trySync :: IO a -> IO (Either SomeException a)
trySync :: forall a. IO a -> IO (Either SomeException a)
trySync IO a
io = ((a -> Either SomeException a)
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right IO a
io) IO (Either SomeException a)
-> (SomeException -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exception.catch` \SomeException
e ->
  case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e of
    Just (Exception.SomeAsyncException e
_) -> SomeException -> IO (Either SomeException a)
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e
    Maybe SomeAsyncException
Nothing -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)