{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}
module Foundation.Monad.Exception
( MonadThrow(..)
, MonadCatch(..)
, MonadBracket(..)
) where
import Basement.Compat.Base
import qualified Control.Exception as E
class Monad m => MonadThrow m where
throw :: Exception e => e -> m a
class MonadThrow m => MonadCatch m where
catch :: Exception e => m a -> (e -> m a) -> m a
class MonadCatch m => MonadBracket m where
generalBracket
:: m a
-> (a -> b -> m ignored1)
-> (a -> E.SomeException -> m ignored2)
-> (a -> m b)
-> m b
instance MonadThrow IO where
throw :: e -> IO a
throw = e -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
instance MonadCatch IO where
catch :: IO a -> (e -> IO a) -> IO a
catch = IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
instance MonadBracket IO where
generalBracket :: IO a
-> (a -> b -> IO ignored1)
-> (a -> SomeException -> IO ignored2)
-> (a -> IO b)
-> IO b
generalBracket IO a
acquire a -> b -> IO ignored1
onSuccess a -> SomeException -> IO ignored2
onException a -> IO b
inner = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
a
x <- IO a
acquire
Either SomeException b
res1 <- IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO b -> IO (Either SomeException b))
-> IO b -> IO (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ IO b -> IO b
forall a. IO a -> IO a
restore (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> IO b
inner a
x
case Either SomeException b
res1 of
Left (SomeException
e1 :: E.SomeException) -> do
IO () -> IO ()
forall a. IO a -> IO a
E.uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ignored2 -> ()) -> IO ignored2 -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> ignored2 -> ()
forall a b. a -> b -> a
const ()) (a -> SomeException -> IO ignored2
onException a
x SomeException
e1) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
(\(SomeException
_ :: E.SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
SomeException -> IO b
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e1
Right b
y -> do
ignored1
_ <- a -> b -> IO ignored1
onSuccess a
x b
y
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
y