{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Exception.Enclosed
(
catchAny
, handleAny
, tryAny
, catchDeep
, catchAnyDeep
, handleAnyDeep
, tryDeep
, tryAnyDeep
, catchIO
, handleIO
, tryIO
, asIOException
, asSomeException
) where
import Prelude
import Control.Concurrent (forkIOWithUnmask)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
import Control.Exception
import Control.Monad (liftM)
import Control.Monad.Base (liftBase)
import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM)
import Control.DeepSeq (NFData, ($!!))
import qualified Control.Exception.Lifted
catchAny :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a
catchAny :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> (SomeException -> m a) -> m a
catchAny m a
action SomeException -> m a
onE = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either SomeException a)
tryAny m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> m a
onE forall (m :: * -> *) a. Monad m => a -> m a
return
handleAny :: MonadBaseControl IO m => (SomeException -> m a) -> m a -> m a
handleAny :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
(SomeException -> m a) -> m a -> m a
handleAny = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> (SomeException -> m a) -> m a
catchAny
tryAny :: MonadBaseControl IO m => m a -> m (Either SomeException a)
tryAny :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either SomeException a)
tryAny m a
m =
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m IO
runInIO -> forall a. IO a -> IO (Either SomeException a)
tryAnyIO (RunInBase m IO
runInIO m a
m)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)
where
tryAnyIO :: IO a -> IO (Either SomeException a)
tryAnyIO :: forall a. IO a -> IO (Either SomeException a)
tryAnyIO IO a
action = do
MVar (Either SomeException a)
result <- forall a. IO (MVar a)
newEmptyMVar
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask (\forall a. IO a -> IO a
restore -> forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. IO a -> IO a
restore IO a
action) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException a)
result))
(\ThreadId
t -> forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
t AsyncException
ThreadKilled)
(\ThreadId
_ -> forall a. Int -> IO a -> IO a
retryCount Int
10 (forall a. MVar a -> IO a
readMVar MVar (Either SomeException a)
result))
retryCount :: Int -> IO a -> IO a
retryCount :: forall a. Int -> IO a -> IO a
retryCount Int
cnt0 IO a
action =
Int -> IO a
loop Int
cnt0
where
loop :: Int -> IO a
loop Int
0 = IO a
action
loop Int
cnt = IO a
action forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Control.Exception.catch`
\BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar -> Int -> IO a
loop (Int
cnt forall a. Num a => a -> a -> a
- Int
1)
catchDeep :: (Exception e, NFData a, MonadBaseControl IO m) => m a -> (e -> m a) -> m a
catchDeep :: forall e a (m :: * -> *).
(Exception e, NFData a, MonadBaseControl IO m) =>
m a -> (e -> m a) -> m a
catchDeep m a
action e -> m a
onE = forall e a (m :: * -> *).
(Exception e, NFData a, MonadBaseControl IO m) =>
m a -> m (Either e a)
tryDeep m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
onE forall (m :: * -> *) a. Monad m => a -> m a
return
catchAnyDeep :: (NFData a, MonadBaseControl IO m) => m a -> (SomeException -> m a) -> m a
catchAnyDeep :: forall a (m :: * -> *).
(NFData a, MonadBaseControl IO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep m a
action SomeException -> m a
onE = forall a (m :: * -> *).
(NFData a, MonadBaseControl IO m) =>
m a -> m (Either SomeException a)
tryAnyDeep m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> m a
onE forall (m :: * -> *) a. Monad m => a -> m a
return
handleAnyDeep :: (NFData a, MonadBaseControl IO m) => (SomeException -> m a) -> m a -> m a
handleAnyDeep :: forall a (m :: * -> *).
(NFData a, MonadBaseControl IO m) =>
(SomeException -> m a) -> m a -> m a
handleAnyDeep = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *).
(NFData a, MonadBaseControl IO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep
tryDeep :: (Exception e, NFData a, MonadBaseControl IO m)
=> m a
-> m (Either e a)
tryDeep :: forall e a (m :: * -> *).
(Exception e, NFData a, MonadBaseControl IO m) =>
m a -> m (Either e a)
tryDeep m a
m = forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
Control.Exception.Lifted.try forall a b. (a -> b) -> a -> b
$ do
a
x <- m a
m
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. NFData a => (a -> b) -> a -> b
$!! a
x
tryAnyDeep :: (NFData a, MonadBaseControl IO m)
=> m a
-> m (Either SomeException a)
tryAnyDeep :: forall a (m :: * -> *).
(NFData a, MonadBaseControl IO m) =>
m a -> m (Either SomeException a)
tryAnyDeep m a
m = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ do
a
x <- m a
m
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. NFData a => (a -> b) -> a -> b
$!! a
x
catchIO :: MonadBaseControl IO m => m a -> (IOException -> m a) -> m a
catchIO :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> (IOException -> m a) -> m a
catchIO = forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
Control.Exception.Lifted.catch
handleIO :: MonadBaseControl IO m => (IOException -> m a) -> m a -> m a
handleIO :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IOException -> m a) -> m a -> m a
handleIO = forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
(e -> m a) -> m a -> m a
Control.Exception.Lifted.handle
tryIO :: MonadBaseControl IO m => m a -> m (Either IOException a)
tryIO :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either IOException a)
tryIO = forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
Control.Exception.Lifted.try
asSomeException :: SomeException -> SomeException
asSomeException :: SomeException -> SomeException
asSomeException = forall a. a -> a
id
asIOException :: IOException -> IOException
asIOException :: IOException -> IOException
asIOException = forall a. a -> a
id