{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables, MagicHash #-}
-- | Warning: this module is /deprecated/.
-- 
-- Please consider using the package
-- <http://hackage.haskell.org/package/exceptions exceptions>
-- instead, if possible.
-- 
-- The functions @block@ and @unblock@, which are part of the @MonadCatchIO@
-- class, have known problems. The IO instances of these functions, which are
-- provided by the base library, have been deprecated for some time, and have
-- been removed in base-4.7.
module Control.Monad.CatchIO
  (
    MonadCatchIO(..)
  , E.Exception(..)
  , throw
  , try, tryJust
  , Handler(..), catches
  -- * Utilities
  , bracket
  , bracket_
  , bracketOnError
  , finally
  , onException
  )

where

import           Prelude hiding ( catch )
import           Control.Applicative                          ((<$>))
import qualified Control.Exception.Extensible      as E

import           Control.Monad.IO.Class                       (MonadIO,liftIO)

import           Control.Monad.Trans.Cont                     (ContT(ContT)    ,runContT    ,mapContT    )
import           Control.Monad.Trans.Error                    (ErrorT          ,runErrorT   ,mapErrorT   ,Error)
import           Control.Monad.Trans.Identity                 (IdentityT       ,runIdentityT,mapIdentityT)
import           Control.Monad.Trans.List                     (ListT(ListT)    ,runListT    ,mapListT    )
import           Control.Monad.Trans.Maybe                    (MaybeT          ,runMaybeT   ,mapMaybeT   )
import           Control.Monad.Trans.RWS                      (RWST(RWST)      ,runRWST     ,mapRWST     )
import qualified Control.Monad.Trans.RWS.Strict    as Strict  (RWST(RWST)      ,runRWST     ,mapRWST     )
import           Control.Monad.Trans.Reader                   (ReaderT(ReaderT),runReaderT  ,mapReaderT  )
import           Control.Monad.Trans.State                    (StateT(StateT)  ,runStateT   ,mapStateT   )
import qualified Control.Monad.Trans.State.Strict  as Strict  (StateT(StateT)  ,runStateT   ,mapStateT   )
import           Control.Monad.Trans.Writer                   (WriterT         ,runWriterT  ,mapWriterT  )
import qualified Control.Monad.Trans.Writer.Strict as Strict  (WriterT         ,runWriterT  ,mapWriterT  )

import           Data.Monoid                                  (Monoid)

import           GHC.Base                                     (maskAsyncExceptions#)
import           GHC.IO                                       (unsafeUnmask,IO(IO))


class MonadIO m => MonadCatchIO m where
  -- | Generalized version of 'E.catch'
  catch   :: E.Exception e => m a -> (e -> m a) -> m a
  block   :: m a -> m a
  unblock :: m a -> m a


instance MonadCatchIO IO where
  catch :: forall e a. Exception e => 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
  block :: forall a. IO a -> IO a
block   = \ (IO State# RealWorld -> (# State# RealWorld, a #)
io) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a.
(State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
maskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #)
io
  unblock :: forall a. IO a -> IO a
unblock = IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask

-- | Warning: this instance is somewhat contentious.
-- 
-- In the same way that the @ErrorT e@ instance may fail to perform the final
-- action, due to the \"early exit\" behaviour of the monad, this instance
-- may perform the final action any number of times, due to the nonlinear
-- nature of the continuation monad.
-- 
-- See the mailing list message
-- <http://web.archiveorange.com/archive/v/nDNOvaYx1poDHZNlmlgh>
-- for an example of what can go wrong (freeing memory twice).
instance MonadCatchIO m => MonadCatchIO (ContT r m) where
  ContT r m a
m catch :: forall e a.
Exception e =>
ContT r m a -> (e -> ContT r m a) -> ContT r m a
`catch` e -> ContT r m a
f = ((a -> m r) -> m r) -> ContT r m a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
c -> ContT r m a -> (a -> m r) -> m r
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m a
m a -> m r
c m r -> (e -> m r) -> m r
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> ContT r m a -> (a -> m r) -> m r
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (e -> ContT r m a
f e
e) a -> m r
c
  block :: forall a. ContT r m a -> ContT r m a
block       = (m r -> m r) -> ContT r m a -> ContT r m a
forall {k} (m :: k -> *) (r :: k) a.
(m r -> m r) -> ContT r m a -> ContT r m a
mapContT m r -> m r
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. ContT r m a -> ContT r m a
unblock     = (m r -> m r) -> ContT r m a -> ContT r m a
forall {k} (m :: k -> *) (r :: k) a.
(m r -> m r) -> ContT r m a -> ContT r m a
mapContT m r -> m r
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

-- | Warning: this instance is somewhat contentious.
-- 
-- Note that in monads that fall under this instance (the most basic example
-- is @ErrorT e IO@), there are errors of two sorts:
-- 
-- 1. exceptions, (i.e., exceptional values in the underlying @IO@ monad);
-- 
-- 2. error values of type @e@, introduced by the @ErrorT e@ part of the monad.
-- 
-- The instance takes no special action to deal with errors of type 2.
-- In particular, 'bracket' will not perform its second argument, if
-- its third argument decides to \"exit early\" by throwing an error of type 2.
-- 
-- This may or may not be what you want.
-- 
-- See the mailing list thread starting with
-- <http://www.mail-archive.com/haskell-cafe@haskell.org/msg82859.html>
-- for some details.
instance (MonadCatchIO m, Error e) => MonadCatchIO (ErrorT e m) where
  ErrorT e m a
m catch :: forall e a.
Exception e =>
ErrorT e m a -> (e -> ErrorT e m a) -> ErrorT e m a
`catch` e -> ErrorT e m a
f = (m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT (\m (Either e a)
m' -> m (Either e a)
m' m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> ErrorT e m a -> m (Either e a)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (ErrorT e m a -> m (Either e a)) -> ErrorT e m a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> ErrorT e m a
f e
e) ErrorT e m a
m
  block :: forall a. ErrorT e m a -> ErrorT e m a
block       = (m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT m (Either e a) -> m (Either e a)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. ErrorT e m a -> ErrorT e m a
unblock     = (m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT m (Either e a) -> m (Either e a)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance (MonadCatchIO m) => MonadCatchIO (IdentityT m) where
  IdentityT m a
m catch :: forall e a.
Exception e =>
IdentityT m a -> (e -> IdentityT m a) -> IdentityT m a
`catch` e -> IdentityT m a
f = (m a -> m a) -> IdentityT m a -> IdentityT m a
forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT (\m a
m' -> m a
m' m a -> (e -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> IdentityT m a -> m a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT m a -> m a) -> IdentityT m a -> m a
forall a b. (a -> b) -> a -> b
$ e -> IdentityT m a
f e
e) IdentityT m a
m
  block :: forall a. IdentityT m a -> IdentityT m a
block       = (m a -> m a) -> IdentityT m a -> IdentityT m a
forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. IdentityT m a -> IdentityT m a
unblock     = (m a -> m a) -> IdentityT m a -> IdentityT m a
forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance MonadCatchIO m => MonadCatchIO (ListT m) where
  ListT m a
m catch :: forall e a.
Exception e =>
ListT m a -> (e -> ListT m a) -> ListT m a
`catch` e -> ListT m a
f = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a) -> m [a] -> ListT m a
forall a b. (a -> b) -> a -> b
$ ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
m m [a] -> (e -> m [a]) -> m [a]
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (e -> ListT m a
f e
e)
  block :: forall a. ListT m a -> ListT m a
block       = (m [a] -> m [a]) -> ListT m a -> ListT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m [a] -> n [b]) -> ListT m a -> ListT n b
mapListT m [a] -> m [a]
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. ListT m a -> ListT m a
unblock     = (m [a] -> m [a]) -> ListT m a -> ListT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m [a] -> n [b]) -> ListT m a -> ListT n b
mapListT m [a] -> m [a]
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance (MonadCatchIO m) => MonadCatchIO (MaybeT m) where
  MaybeT m a
m catch :: forall e a.
Exception e =>
MaybeT m a -> (e -> MaybeT m a) -> MaybeT m a
`catch` e -> MaybeT m a
f = (m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT (\m (Maybe a)
m' -> m (Maybe a)
m' m (Maybe a) -> (e -> m (Maybe a)) -> m (Maybe a)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m a -> m (Maybe a)) -> MaybeT m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ e -> MaybeT m a
f e
e) MaybeT m a
m
  block :: forall a. MaybeT m a -> MaybeT m a
block       = (m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT m (Maybe a) -> m (Maybe a)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. MaybeT m a -> MaybeT m a
unblock     = (m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT m (Maybe a) -> m (Maybe a)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance (Monoid w, MonadCatchIO m) => MonadCatchIO (RWST r w s m) where
  RWST r w s m a
m catch :: forall e a.
Exception e =>
RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
`catch` e -> RWST r w s m a
f = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r w s m a
m r
r s
s m (a, s, w) -> (e -> m (a, s, w)) -> m (a, s, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (e -> RWST r w s m a
f e
e) r
r s
s
  block :: forall a. RWST r w s m a -> RWST r w s m a
block       = (m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST m (a, s, w) -> m (a, s, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. RWST r w s m a -> RWST r w s m a
unblock     = (m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST m (a, s, w) -> m (a, s, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance (Monoid w, MonadCatchIO m) => MonadCatchIO (Strict.RWST r w s m) where
  RWST r w s m a
m catch :: forall e a.
Exception e =>
RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
`catch` e -> RWST r w s m a
f = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
m r
r s
s m (a, s, w) -> (e -> m (a, s, w)) -> m (a, s, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (e -> RWST r w s m a
f e
e) r
r s
s
  block :: forall a. RWST r w s m a -> RWST r w s m a
block       = (m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST m (a, s, w) -> m (a, s, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. RWST r w s m a -> RWST r w s m a
unblock     = (m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST m (a, s, w) -> m (a, s, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance MonadCatchIO m => MonadCatchIO (ReaderT r m) where
  ReaderT r m a
m catch :: forall e a.
Exception e =>
ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a
`catch` e -> ReaderT r m a
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
r -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r m a -> (e -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
f e
e) r
r
  block :: forall a. ReaderT r m a -> ReaderT r m a
block       = (m a -> m a) -> ReaderT r m a -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. ReaderT r m a -> ReaderT r m a
unblock     = (m a -> m a) -> ReaderT r m a -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance MonadCatchIO m => MonadCatchIO (StateT s m) where
  StateT s m a
m catch :: forall e a.
Exception e =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
`catch` e -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (e -> StateT s m a
f e
e) s
s
  block :: forall a. StateT s m a -> StateT s m a
block       = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (a, s) -> m (a, s)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. StateT s m a -> StateT s m a
unblock     = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (a, s) -> m (a, s)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance MonadCatchIO m => MonadCatchIO (Strict.StateT s m) where
  StateT s m a
m catch :: forall e a.
Exception e =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
`catch` e -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (e -> StateT s m a
f e
e) s
s
  block :: forall a. StateT s m a -> StateT s m a
block       = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT m (a, s) -> m (a, s)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. StateT s m a -> StateT s m a
unblock     = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT m (a, s) -> m (a, s)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance (Monoid w, MonadCatchIO m) => MonadCatchIO (WriterT w m) where
  WriterT w m a
m catch :: forall e a.
Exception e =>
WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
`catch` e -> WriterT w m a
f = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (\m (a, w)
m' -> m (a, w)
m' m (a, w) -> (e -> m (a, w)) -> m (a, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT w m a -> m (a, w)) -> WriterT w m a -> m (a, w)
forall a b. (a -> b) -> a -> b
$ e -> WriterT w m a
f e
e) WriterT w m a
m
  block :: forall a. WriterT w m a -> WriterT w m a
block       = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT m (a, w) -> m (a, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. WriterT w m a -> WriterT w m a
unblock     = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT m (a, w) -> m (a, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

instance (Monoid w, MonadCatchIO m) => MonadCatchIO (Strict.WriterT w m) where
  WriterT w m a
m catch :: forall e a.
Exception e =>
WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
`catch` e -> WriterT w m a
f = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT (\m (a, w)
m' -> m (a, w)
m' m (a, w) -> (e -> m (a, w)) -> m (a, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (WriterT w m a -> m (a, w)) -> WriterT w m a -> m (a, w)
forall a b. (a -> b) -> a -> b
$ e -> WriterT w m a
f e
e) WriterT w m a
m
  block :: forall a. WriterT w m a -> WriterT w m a
block       = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT m (a, w) -> m (a, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block
  unblock :: forall a. WriterT w m a -> WriterT w m a
unblock     = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT m (a, w) -> m (a, w)
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock

-- | Generalized version of 'E.throwIO'
throw :: (MonadIO m, E.Exception e) => e -> m a
throw :: forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throw = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
E.throwIO

-- | Generalized version of 'E.try'
try :: (MonadCatchIO m, Functor m, E.Exception e) => m a -> m (Either e a)
try :: forall (m :: * -> *) e a.
(MonadCatchIO m, Functor m, Exception e) =>
m a -> m (Either e a)
try m a
a = m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a) (Either e a -> m (Either e a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)

-- | Generalized version of 'E.tryJust'
tryJust :: (MonadCatchIO m, Functor m, E.Exception e)
        => (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: forall (m :: * -> *) e b a.
(MonadCatchIO m, Functor m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
p m a
a = do
  Either e a
r <- m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatchIO m, Functor m, Exception e) =>
m a -> m (Either e a)
try m a
a
  case Either e a
r of
    Right a
v -> Either b a -> m (Either b a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either b a
forall a b. b -> Either a b
Right a
v)
    Left  e
e -> case e -> Maybe b
p e
e of
      Maybe b
Nothing -> e -> m (Either b a)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throw e
e m (Either b a) -> m (Either b a) -> m (Either b a)
forall a. a -> a -> a
`asTypeOf` Either b a -> m (Either b a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either b a
forall a b. a -> Either a b
Left b
forall a. HasCallStack => a
undefined)
      Just b
b  -> Either b a -> m (Either b a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either b a
forall a b. a -> Either a b
Left b
b)

-- | Generalized version of 'E.Handler'
data Handler m a = forall e . E.Exception e => Handler (e -> m a)

-- | Generalized version of 'E.catches'
catches :: MonadCatchIO m => m a -> [Handler m a] -> m a
catches :: forall (m :: * -> *) a.
MonadCatchIO m =>
m a -> [Handler m a] -> m a
catches m a
a [Handler m a]
handlers = m a
a m a -> (SomeException -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> m a
handler where
  handler :: SomeException -> m a
handler SomeException
e = (Handler m a -> m a -> m a) -> m a -> [Handler m a] -> m a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Handler m a -> m a -> m a
forall {m :: * -> *} {a}. Handler m a -> m a -> m a
tryH (SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throw SomeException
e) [Handler m a]
handlers where
    tryH :: Handler m a -> m a -> m a
tryH (Handler e -> m a
h) m a
res = m a -> (e -> m a) -> Maybe e -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
res e -> m a
h (Maybe e -> m a) -> Maybe e -> m a
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
e

-- | Generalized version of 'E.bracket'
bracket :: MonadCatchIO m => m a -> (a -> m b) -> (a -> m c) -> m c
bracket :: forall (m :: * -> *) a b c.
MonadCatchIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before a -> m b
after a -> m c
thing = m c -> m c
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ do
  a
a <- m a
before
  c
r <- m c -> m c
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock (a -> m c
thing a
a) m c -> m b -> m c
forall (m :: * -> *) a b. MonadCatchIO m => m a -> m b -> m a
`onException` a -> m b
after a
a
  b
_ <- a -> m b
after a
a
  c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return c
r

-- | Generalized version of 'E.onException'
onException :: MonadCatchIO m => m a -> m b -> m a
onException :: forall (m :: * -> *) a b. MonadCatchIO m => m a -> m b -> m a
onException m a
a m b
onEx = m a
a m a -> (SomeException -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatchIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\ (SomeException
e :: E.SomeException) -> m b
onEx m b -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throw SomeException
e)

-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
bracket_ :: MonadCatchIO m
         => m a  -- ^ computation to run first (\"acquire resource\")
         -> m b  -- ^ computation to run last (\"release resource\")
         -> m c  -- ^ computation to run in-between
         -> m c  -- returns the value from the in-between computation
bracket_ :: forall (m :: * -> *) a b c.
MonadCatchIO m =>
m a -> m b -> m c -> m c
bracket_ m a
before m b
after m c
thing = m c -> m c
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ do
  a
_ <- m a
before
  c
r <- m c -> m c
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock m c
thing m c -> m b -> m c
forall (m :: * -> *) a b. MonadCatchIO m => m a -> m b -> m a
`onException` m b
after
  b
_ <- m b
after
  c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return c
r

-- | A specialised variant of 'bracket' with just a computation to run
-- afterward.
finally :: MonadCatchIO m
        => m a -- ^ computation to run first
        -> m b -- ^ computation to run afterward (even if an exception was
               -- raised)
        -> m a -- returns the value from the first computation
m a
thing finally :: forall (m :: * -> *) a b. MonadCatchIO m => m a -> m b -> m a
`finally` m b
after = m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ do
  a
r <- m a -> m a
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock m a
thing m a -> m b -> m a
forall (m :: * -> *) a b. MonadCatchIO m => m a -> m b -> m a
`onException` m b
after
  b
_ <- m b
after
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Like 'bracket', but only performs the final action if there was an
-- exception raised by the in-between computation.
bracketOnError :: MonadCatchIO m
               => m a        -- ^ computation to run first (\"acquire resource\")
               -> (a -> m b) -- ^ computation to run last (\"release resource\")
               -> (a -> m c) -- ^ computation to run in-between
               -> m c        -- returns the value from the in-between computation
bracketOnError :: forall (m :: * -> *) a b c.
MonadCatchIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before a -> m b
after a -> m c
thing = m c -> m c
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
block (m c -> m c) -> m c -> m c
forall a b. (a -> b) -> a -> b
$ do
  a
a <- m a
before
  m c -> m c
forall a. m a -> m a
forall (m :: * -> *) a. MonadCatchIO m => m a -> m a
unblock (a -> m c
thing a
a) m c -> m b -> m c
forall (m :: * -> *) a b. MonadCatchIO m => m a -> m b -> m a
`onException` a -> m b
after a
a