{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
{- | This module redefines some of the functions in "Control.Exception" to
work for more general monads built on top of 'IO'.
-}

module System.Console.Haskeline.MonadException(
    -- * The MonadException class
    MonadException(..),
    -- * Generalizations of Control.Exception
    catch,
    handle,
    catches,
    Handler(..),
    finally,
    throwIO,
    throwTo,
    bracket,
    -- * Helpers for defining \"wrapper\" functions
    liftIOOp,
    liftIOOp_,
    -- * Internal implementation
    RunIO(..),
    -- * Extensible Exceptions
    Exception,
    SomeException(..),
    E.IOException(),
    )
     where

import qualified Control.Exception as E
import Control.Exception (Exception,SomeException)
import Control.Monad(liftM, join)
import Control.Monad.IO.Class
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.RWS
import Control.Monad.Trans.Writer
import Control.Concurrent(ThreadId)

-- This approach is based on that of the monad-control package.
-- Since we want to use haskeline to bootstrap GHC, we reimplement
-- a simplified version here.  
-- Additionally, we avoid TypeFamilies (which are used in the latest version of
-- monad-control) so that we're still compatible with older versions of GHC.

-- | A 'RunIO' function takes a monadic action @m@ as input,
-- and outputs an IO action which performs the underlying impure part of @m@
-- and returns the ''pure'' part of @m@.
--
-- Note that @(RunIO return)@ is an incorrect implementation, since it does not
-- separate the pure and impure parts of the monadic action.  This module defines
-- implementations for several common monad transformers.
newtype RunIO m = RunIO (forall b . m b -> IO (m b))
-- Uses a newtype so we don't need RankNTypes.

-- | An instance of 'MonadException' is generally made up of monad transformers
-- layered on top of the IO monad.  
-- 
-- The 'controlIO' method enables us to \"lift\" a function that manages IO actions (such
-- as 'bracket' or 'catch') into a function that wraps arbitrary monadic actions.
class MonadIO m => MonadException m where
    controlIO :: (RunIO m -> IO (m a)) -> m a

-- | Lift a IO operation
-- 
-- > wrap :: (a -> IO b) -> IO b
-- 
-- to a more general monadic operation
-- 
-- > liftIOOp wrap :: MonadException m => (a -> m b) -> m b
--
-- For example: 
--
-- @
--  'liftIOOp' ('System.IO.withFile' f m) :: MonadException m => (Handle -> m r) -> m r
--  'liftIOOp' 'Foreign.Marshal.Alloc.alloca' :: (MonadException m, Storable a) => (Ptr a -> m b) -> m b
--  'liftIOOp' (`Foreign.ForeignPtr.withForeignPtr` fp) :: MonadException m => (Ptr a -> m b) -> m b
-- @
liftIOOp :: MonadException m => ((a -> IO (m b)) -> IO (m c)) -> (a -> m b) -> m c
liftIOOp :: ((a -> IO (m b)) -> IO (m c)) -> (a -> m b) -> m c
liftIOOp f :: (a -> IO (m b)) -> IO (m c)
f g :: a -> m b
g = (RunIO m -> IO (m c)) -> m c
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m c)) -> m c) -> (RunIO m -> IO (m c)) -> m c
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> (a -> IO (m b)) -> IO (m c)
f (m b -> IO (m b)
forall b. m b -> IO (m b)
run (m b -> IO (m b)) -> (a -> m b) -> a -> IO (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
g)

-- | Lift an IO operation
-- 
-- > wrap :: IO a -> IO a
-- 
-- to a more general monadic operation
-- 
-- > liftIOOp_ wrap :: MonadException m => m a -> m a
liftIOOp_ :: MonadException m => (IO (m a) -> IO (m a)) -> m a -> m a
liftIOOp_ :: (IO (m a) -> IO (m a)) -> m a -> m a
liftIOOp_ f :: IO (m a) -> IO (m a)
f act :: m a
act = (RunIO m -> IO (m a)) -> m a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m a)) -> m a) -> (RunIO m -> IO (m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> IO (m a) -> IO (m a)
f (m a -> IO (m a)
forall b. m b -> IO (m b)
run m a
act)


catch :: (MonadException m, E.Exception e) => m a -> (e -> m a) -> m a
catch :: m a -> (e -> m a) -> m a
catch act :: m a
act handler :: e -> m a
handler = (RunIO m -> IO (m a)) -> m a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m a)) -> m a) -> (RunIO m -> IO (m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> IO (m a) -> (e -> IO (m a)) -> IO (m a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
                                                    (m a -> IO (m a)
forall b. m b -> IO (m b)
run m a
act)
                                                    (m a -> IO (m a)
forall b. m b -> IO (m b)
run (m a -> IO (m a)) -> (e -> m a) -> e -> IO (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
handler)

handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m a
handle :: (e -> m a) -> m a -> m a
handle = (m a -> (e -> m a) -> m a) -> (e -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catch
 
catches :: (MonadException m) => m a -> [Handler m a] -> m a
catches :: m a -> [Handler m a] -> m a
catches act :: m a
act handlers :: [Handler m a]
handlers = (RunIO m -> IO (m a)) -> m a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m a)) -> m a) -> (RunIO m -> IO (m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) ->
                           let catchesHandler :: SomeException -> IO (m a)
catchesHandler e :: SomeException
e = (Handler m a -> IO (m a) -> IO (m a))
-> IO (m a) -> [Handler m a] -> IO (m a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Handler m a -> IO (m a) -> IO (m a)
forall a. Handler m a -> IO (m a) -> IO (m a)
tryHandler (SomeException -> IO (m a)
forall a e. Exception e => e -> a
E.throw SomeException
e) [Handler m a]
handlers
                                   where tryHandler :: Handler m a -> IO (m a) -> IO (m a)
tryHandler (Handler handler :: e -> m a
handler) res :: IO (m a)
res =
                                             case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
e of
                                               Just e' :: e
e' -> m a -> IO (m a)
forall b. m b -> IO (m b)
run (m a -> IO (m a)) -> m a -> IO (m a)
forall a b. (a -> b) -> a -> b
$ e -> m a
handler e
e'
                                               Nothing -> IO (m a)
res
                           in IO (m a) -> (SomeException -> IO (m a)) -> IO (m a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (m a -> IO (m a)
forall b. m b -> IO (m b)
run m a
act) SomeException -> IO (m a)
catchesHandler

data Handler m a = forall e . Exception e => Handler (e -> m a)


bracket :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m c
bracket :: m a -> (a -> m b) -> (a -> m c) -> m c
bracket before :: m a
before after :: a -> m b
after thing :: a -> m c
thing 
    = (RunIO m -> IO (m c)) -> m c
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m c)) -> m c) -> (RunIO m -> IO (m c)) -> m c
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> IO (m a) -> (m a -> IO (m b)) -> (m a -> IO (m c)) -> IO (m c)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
                                    (m a -> IO (m a)
forall b. m b -> IO (m b)
run m a
before)
                                    (\m :: m a
m -> m b -> IO (m b)
forall b. m b -> IO (m b)
run (m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
after))
                                    (\m :: m a
m -> m c -> IO (m c)
forall b. m b -> IO (m b)
run (m a
m m a -> (a -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m c
thing))

finally :: MonadException m => m a -> m b -> m a
finally :: m a -> m b -> m a
finally thing :: m a
thing ender :: m b
ender = (RunIO m -> IO (m a)) -> m a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m a)) -> m a) -> (RunIO m -> IO (m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> IO (m a) -> IO (m b) -> IO (m a)
forall a b. IO a -> IO b -> IO a
E.finally (m a -> IO (m a)
forall b. m b -> IO (m b)
run m a
thing) (m b -> IO (m b)
forall b. m b -> IO (m b)
run m b
ender)

throwIO :: (MonadIO m, Exception e) => e -> m a
throwIO :: e -> m a
throwIO = 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

throwTo :: (MonadIO m, Exception e) => ThreadId -> e -> m ()
throwTo :: ThreadId -> e -> m ()
throwTo tid :: ThreadId
tid = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (e -> IO ()) -> e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> e -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
E.throwTo ThreadId
tid

----------
-- Instances of MonadException.
-- Since implementations of this class are non-obvious to a casual user,
-- we provide instances for nearly everything in the transformers package.

instance MonadException IO where
    controlIO :: (RunIO IO -> IO (IO a)) -> IO a
controlIO f :: RunIO IO -> IO (IO a)
f = IO (IO a) -> IO a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO a) -> IO a) -> IO (IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ RunIO IO -> IO (IO a)
f ((forall b. IO b -> IO (IO b)) -> RunIO IO
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((b -> IO b) -> IO b -> IO (IO b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return))
    -- Note: it's crucial that we use "liftM return" instead of "return" here.
    -- For example, in "finally thing end", this ensures that "end" will always run, 
    -- regardless of whether an mzero occurred inside of "thing".

instance MonadException m => MonadException (ReaderT r m) where
    controlIO :: (RunIO (ReaderT r m) -> IO (ReaderT r m a)) -> ReaderT r m a
controlIO f :: RunIO (ReaderT r m) -> IO (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
r -> (RunIO m -> IO (m a)) -> m a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m a)) -> m a) -> (RunIO m -> IO (m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (ReaderT r m)
run' = (forall b. ReaderT r m b -> IO (ReaderT r m b))
-> RunIO (ReaderT r m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m b -> ReaderT r m b) -> IO (m b) -> IO (ReaderT r m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b)
-> (m b -> r -> m b) -> m b -> ReaderT r m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> r -> m b
forall a b. a -> b -> a
const) (IO (m b) -> IO (ReaderT r m b))
-> (ReaderT r m b -> IO (m b))
-> ReaderT r m b
-> IO (ReaderT r m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> IO (m b)
forall b. m b -> IO (m b)
run (m b -> IO (m b))
-> (ReaderT r m b -> m b) -> ReaderT r m b -> IO (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT r m b -> r -> m b) -> r -> ReaderT r m b -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT r
r)
                    in (ReaderT r m a -> m a) -> IO (ReaderT r m a) -> IO (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT r
r) (IO (ReaderT r m a) -> IO (m a)) -> IO (ReaderT r m a) -> IO (m a)
forall a b. (a -> b) -> a -> b
$ RunIO (ReaderT r m) -> IO (ReaderT r m a)
f RunIO (ReaderT r m)
run'

instance MonadException m => MonadException (StateT s m) where
    controlIO :: (RunIO (StateT s m) -> IO (StateT s m a)) -> StateT s m a
controlIO f :: RunIO (StateT s m) -> IO (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
s -> (RunIO m -> IO (m (a, s))) -> m (a, s)
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m (a, s))) -> m (a, s))
-> (RunIO m -> IO (m (a, s))) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (StateT s m)
run' = (forall b. StateT s m b -> IO (StateT s m b)) -> RunIO (StateT s m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m (b, s) -> StateT s m b) -> IO (m (b, s)) -> IO (StateT s m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (m (b, s) -> s -> m (b, s)) -> m (b, s) -> StateT s m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (b, s) -> s -> m (b, s)
forall a b. a -> b -> a
const) (IO (m (b, s)) -> IO (StateT s m b))
-> (StateT s m b -> IO (m (b, s)))
-> StateT s m b
-> IO (StateT s m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (b, s) -> IO (m (b, s))
forall b. m b -> IO (m b)
run (m (b, s) -> IO (m (b, s)))
-> (StateT s m b -> m (b, s)) -> StateT s m b -> IO (m (b, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT s m b -> s -> m (b, s)) -> s -> StateT s m b -> m (b, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT s
s)
                    in (StateT s m a -> m (a, s)) -> IO (StateT s m a) -> IO (m (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StateT s m a -> s -> m (a, s)) -> s -> StateT s m a -> m (a, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT s
s) (IO (StateT s m a) -> IO (m (a, s)))
-> IO (StateT s m a) -> IO (m (a, s))
forall a b. (a -> b) -> a -> b
$ RunIO (StateT s m) -> IO (StateT s m a)
f RunIO (StateT s m)
run'

instance MonadException m => MonadException (MaybeT m) where
    controlIO :: (RunIO (MaybeT m) -> IO (MaybeT m a)) -> MaybeT m a
controlIO f :: RunIO (MaybeT m) -> IO (MaybeT m a)
f = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ (RunIO m -> IO (m (Maybe a))) -> m (Maybe a)
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m (Maybe a))) -> m (Maybe a))
-> (RunIO m -> IO (m (Maybe a))) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (MaybeT m)
run' = (forall b. MaybeT m b -> IO (MaybeT m b)) -> RunIO (MaybeT m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m (Maybe b) -> MaybeT m b) -> IO (m (Maybe b)) -> IO (MaybeT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (m (Maybe b)) -> IO (MaybeT m b))
-> (MaybeT m b -> IO (m (Maybe b)))
-> MaybeT m b
-> IO (MaybeT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe b) -> IO (m (Maybe b))
forall b. m b -> IO (m b)
run (m (Maybe b) -> IO (m (Maybe b)))
-> (MaybeT m b -> m (Maybe b)) -> MaybeT m b -> IO (m (Maybe 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)
                    in (MaybeT m a -> m (Maybe a)) -> IO (MaybeT m a) -> IO (m (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (IO (MaybeT m a) -> IO (m (Maybe a)))
-> IO (MaybeT m a) -> IO (m (Maybe a))
forall a b. (a -> b) -> a -> b
$ RunIO (MaybeT m) -> IO (MaybeT m a)
f RunIO (MaybeT m)
run' 

instance (MonadException m, Error e) => MonadException (ErrorT e m) where
    controlIO :: (RunIO (ErrorT e m) -> IO (ErrorT e m a)) -> ErrorT e m a
controlIO f :: RunIO (ErrorT e m) -> IO (ErrorT e m a)
f = m (Either e a) -> ErrorT e m a
forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e a) -> ErrorT e m a) -> m (Either e a) -> ErrorT e m a
forall a b. (a -> b) -> a -> b
$ (RunIO m -> IO (m (Either e a))) -> m (Either e a)
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m (Either e a))) -> m (Either e a))
-> (RunIO m -> IO (m (Either e a))) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (ErrorT e m)
run' = (forall b. ErrorT e m b -> IO (ErrorT e m b)) -> RunIO (ErrorT e m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m (Either e b) -> ErrorT e m b)
-> IO (m (Either e b)) -> IO (ErrorT e m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Either e b) -> ErrorT e m b
forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (IO (m (Either e b)) -> IO (ErrorT e m b))
-> (ErrorT e m b -> IO (m (Either e b)))
-> ErrorT e m b
-> IO (ErrorT e m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either e b) -> IO (m (Either e b))
forall b. m b -> IO (m b)
run (m (Either e b) -> IO (m (Either e b)))
-> (ErrorT e m b -> m (Either e b))
-> ErrorT e m b
-> IO (m (Either e b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorT e m b -> m (Either e b)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT)
                    in (ErrorT e m a -> m (Either e a))
-> IO (ErrorT e m a) -> IO (m (Either e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorT e m a -> m (Either e a)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (IO (ErrorT e m a) -> IO (m (Either e a)))
-> IO (ErrorT e m a) -> IO (m (Either e a))
forall a b. (a -> b) -> a -> b
$ RunIO (ErrorT e m) -> IO (ErrorT e m a)
f RunIO (ErrorT e m)
forall e. RunIO (ErrorT e m)
run'

instance MonadException m => MonadException (ListT m) where
    controlIO :: (RunIO (ListT m) -> IO (ListT m a)) -> ListT m a
controlIO f :: RunIO (ListT m) -> IO (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
$ (RunIO m -> IO (m [a])) -> m [a]
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m [a])) -> m [a])
-> (RunIO m -> IO (m [a])) -> m [a]
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (ListT m)
run' = (forall b. ListT m b -> IO (ListT m b)) -> RunIO (ListT m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m [b] -> ListT m b) -> IO (m [b]) -> IO (ListT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m [b] -> ListT m b
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (IO (m [b]) -> IO (ListT m b))
-> (ListT m b -> IO (m [b])) -> ListT m b -> IO (ListT m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m [b] -> IO (m [b])
forall b. m b -> IO (m b)
run (m [b] -> IO (m [b]))
-> (ListT m b -> m [b]) -> ListT m b -> IO (m [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m b -> m [b]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT)
                    in (ListT m a -> m [a]) -> IO (ListT m a) -> IO (m [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (IO (ListT m a) -> IO (m [a])) -> IO (ListT m a) -> IO (m [a])
forall a b. (a -> b) -> a -> b
$ RunIO (ListT m) -> IO (ListT m a)
f RunIO (ListT m)
run'

instance (Monoid w, MonadException m) => MonadException (WriterT w m) where
    controlIO :: (RunIO (WriterT w m) -> IO (WriterT w m a)) -> WriterT w m a
controlIO f :: RunIO (WriterT w m) -> IO (WriterT w m a)
f = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (RunIO m -> IO (m (a, w))) -> m (a, w)
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m (a, w))) -> m (a, w))
-> (RunIO m -> IO (m (a, w))) -> m (a, w)
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (WriterT w m)
run' = (forall b. WriterT w m b -> IO (WriterT w m b))
-> RunIO (WriterT w m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m (b, w) -> WriterT w m b) -> IO (m (b, w)) -> IO (WriterT w m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (IO (m (b, w)) -> IO (WriterT w m b))
-> (WriterT w m b -> IO (m (b, w)))
-> WriterT w m b
-> IO (WriterT w m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (b, w) -> IO (m (b, w))
forall b. m b -> IO (m b)
run (m (b, w) -> IO (m (b, w)))
-> (WriterT w m b -> m (b, w)) -> WriterT w m b -> IO (m (b, w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT)
                    in (WriterT w m a -> m (a, w)) -> IO (WriterT w m a) -> IO (m (a, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (IO (WriterT w m a) -> IO (m (a, w)))
-> IO (WriterT w m a) -> IO (m (a, w))
forall a b. (a -> b) -> a -> b
$ RunIO (WriterT w m) -> IO (WriterT w m a)
f RunIO (WriterT w m)
forall w. RunIO (WriterT w m)
run'

instance (Monoid w, MonadException m) => MonadException (RWST r w s m) where
    controlIO :: (RunIO (RWST r w s m) -> IO (RWST r w s m a)) -> RWST r w s m a
controlIO f :: RunIO (RWST r w s m) -> IO (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
r s :: s
s -> (RunIO m -> IO (m (a, s, w))) -> m (a, s, w)
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
controlIO ((RunIO m -> IO (m (a, s, w))) -> m (a, s, w))
-> (RunIO m -> IO (m (a, s, w))) -> m (a, s, w)
forall a b. (a -> b) -> a -> b
$ \(RunIO run :: forall b. m b -> IO (m b)
run) -> let
                    run' :: RunIO (RWST r w s m)
run' = (forall b. RWST r w s m b -> IO (RWST r w s m b))
-> RunIO (RWST r w s m)
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
RunIO ((m (b, s, w) -> RWST r w s m b)
-> IO (m (b, s, w)) -> IO (RWST r w s m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\act :: m (b, s, w)
act -> (r -> s -> m (b, s, w)) -> RWST r w s m b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST (\_ _ -> m (b, s, w)
act))
                                    (IO (m (b, s, w)) -> IO (RWST r w s m b))
-> (RWST r w s m b -> IO (m (b, s, w)))
-> RWST r w s m b
-> IO (RWST r w s m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (b, s, w) -> IO (m (b, s, w))
forall b. m b -> IO (m b)
run (m (b, s, w) -> IO (m (b, s, w)))
-> (RWST r w s m b -> m (b, s, w))
-> RWST r w s m b
-> IO (m (b, s, w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\m :: RWST r w s m b
m -> RWST r w s m b -> r -> s -> m (b, 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 b
m r
r s
s))
                    in (RWST r w s m a -> m (a, s, w))
-> IO (RWST r w s m a) -> IO (m (a, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\m :: RWST r w s m a
m -> 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) (IO (RWST r w s m a) -> IO (m (a, s, w)))
-> IO (RWST r w s m a) -> IO (m (a, s, w))
forall a b. (a -> b) -> a -> b
$ RunIO (RWST r w s m) -> IO (RWST r w s m a)
f RunIO (RWST r w s m)
forall w. RunIO (RWST r w s m)
run'

deriving instance MonadException m => MonadException (IdentityT m)