{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

#ifndef MIN_VERSION_transformers
#define MIN_VERSION_transformers(x,y,z) 1
#endif

#ifndef MIN_VERSION_mtl
#define MIN_VERSION_mtl(x,y,z) 1
#endif

--------------------------------------------------------------------
-- |
-- Copyright   :  (C) Edward Kmett 2013-2015, (c) Google Inc. 2012
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- This module supplies a \'pure\' monad transformer that can be used for
-- mock-testing code that throws exceptions, so long as those exceptions
-- are always thrown with 'throwM'.
--
-- Do not mix 'CatchT' with 'IO'. Choose one or the other for the
-- bottom of your transformer stack!
--------------------------------------------------------------------

module Control.Monad.Catch.Pure (
    -- * Transformer
    -- $transformer
    CatchT(..), Catch
  , runCatch
  , mapCatchT

  -- * Typeclass
  -- $mtl
  , module Control.Monad.Catch
  ) where

#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706)
import Prelude hiding (foldr)
#else
import Prelude hiding (catch, foldr)
#endif

import Control.Applicative
import Control.Monad.Catch
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad (MonadPlus(..), ap, liftM)
import Control.Monad.Reader (MonadReader(..))
import Control.Monad.RWS (MonadRWS)
import Control.Monad.State (MonadState(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Writer (MonadWriter(..))
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Monoid (Monoid(..))
#endif
import Data.Functor.Identity
import Data.Traversable as Traversable

------------------------------------------------------------------------------
-- $mtl
-- The mtl style typeclass
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- $transformer
-- The @transformers@-style monad transfomer
------------------------------------------------------------------------------

-- | Add 'Exception' handling abilities to a 'Monad'.
--
-- This should /never/ be used in combination with 'IO'. Think of 'CatchT'
-- as an alternative base monad for use with mocking code that solely throws
-- exceptions via 'throwM'.
--
-- Note: that 'IO' monad has these abilities already, so stacking 'CatchT' on top
-- of it does not add any value and can possibly be confusing:
--
-- >>> (error "Hello!" :: IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e)
-- Hello!
--
-- >>> runCatchT $ (error "Hello!" :: CatchT IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e)
-- *** Exception: Hello!
--
-- >>> runCatchT $ (throwM (ErrorCall "Hello!") :: CatchT IO ()) `catch` (\(e :: ErrorCall) -> liftIO $ print e)
-- Hello!

newtype CatchT m a = CatchT { CatchT m a -> m (Either SomeException a)
runCatchT :: m (Either SomeException a) }

type Catch = CatchT Identity

runCatch :: Catch a -> Either SomeException a
runCatch :: Catch a -> Either SomeException a
runCatch = Identity (Either SomeException a) -> Either SomeException a
forall a. Identity a -> a
runIdentity (Identity (Either SomeException a) -> Either SomeException a)
-> (Catch a -> Identity (Either SomeException a))
-> Catch a
-> Either SomeException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Catch a -> Identity (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT

instance Monad m => Functor (CatchT m) where
  fmap :: (a -> b) -> CatchT m a -> CatchT m b
fmap a -> b
f (CatchT m (Either SomeException a)
m) = m (Either SomeException b) -> CatchT m b
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT ((Either SomeException a -> Either SomeException b)
-> m (Either SomeException a) -> m (Either SomeException b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b) -> Either SomeException a -> Either SomeException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) m (Either SomeException a)
m)

instance Monad m => Applicative (CatchT m) where
  pure :: a -> CatchT m a
pure a
a = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a))
  <*> :: CatchT m (a -> b) -> CatchT m a -> CatchT m b
(<*>) = CatchT m (a -> b) -> CatchT m a -> CatchT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (CatchT m) where
  return :: a -> CatchT m a
return = a -> CatchT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  CatchT m (Either SomeException a)
m >>= :: CatchT m a -> (a -> CatchT m b) -> CatchT m b
>>= a -> CatchT m b
k = m (Either SomeException b) -> CatchT m b
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException b) -> CatchT m b)
-> m (Either SomeException b) -> CatchT m b
forall a b. (a -> b) -> a -> b
$ m (Either SomeException a)
m m (Either SomeException a)
-> (Either SomeException a -> m (Either SomeException b))
-> m (Either SomeException b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either SomeException a
ea -> case Either SomeException a
ea of
    Left SomeException
e -> Either SomeException b -> m (Either SomeException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException b
forall a b. a -> Either a b
Left SomeException
e)
    Right a
a -> CatchT m b -> m (Either SomeException b)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (a -> CatchT m b
k a
a)
#if !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
#endif

instance Monad m => Fail.MonadFail (CatchT m) where
  fail :: String -> CatchT m a
fail = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> (String -> m (Either SomeException a)) -> String -> CatchT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> (String -> Either SomeException a)
-> String
-> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> Either SomeException a)
-> (String -> SomeException) -> String -> Either SomeException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (IOError -> SomeException)
-> (String -> IOError) -> String -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError

instance MonadFix m => MonadFix (CatchT m) where
  mfix :: (a -> CatchT m a) -> CatchT m a
mfix a -> CatchT m a
f = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ (Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((Either SomeException a -> m (Either SomeException a))
 -> m (Either SomeException a))
-> (Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ \Either SomeException a
a -> CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT m a -> m (Either SomeException a))
-> CatchT m a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ a -> CatchT m a
f (a -> CatchT m a) -> a -> CatchT m a
forall a b. (a -> b) -> a -> b
$ case Either SomeException a
a of
    Right a
r -> a
r
    Either SomeException a
_       -> String -> a
forall a. HasCallStack => String -> a
error String
"empty mfix argument"

instance Foldable m => Foldable (CatchT m) where
  foldMap :: (a -> m) -> CatchT m a -> m
foldMap a -> m
f (CatchT m (Either SomeException a)
m) = (Either SomeException a -> m) -> m (Either SomeException a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Either SomeException a -> m
forall p t a. Monoid p => (t -> p) -> Either a t -> p
foldMapEither a -> m
f) m (Either SomeException a)
m where
    foldMapEither :: (t -> p) -> Either a t -> p
foldMapEither t -> p
g (Right t
a) = t -> p
g t
a
    foldMapEither t -> p
_ (Left a
_) = p
forall a. Monoid a => a
mempty

instance (Monad m, Traversable m) => Traversable (CatchT m) where
  traverse :: (a -> f b) -> CatchT m a -> f (CatchT m b)
traverse a -> f b
f (CatchT m (Either SomeException a)
m) = m (Either SomeException b) -> CatchT m b
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException b) -> CatchT m b)
-> f (m (Either SomeException b)) -> f (CatchT m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either SomeException a -> f (Either SomeException b))
-> m (Either SomeException a) -> f (m (Either SomeException b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse ((a -> f b) -> Either SomeException a -> f (Either SomeException b)
forall (f :: * -> *) t b a.
Applicative f =>
(t -> f b) -> Either a t -> f (Either a b)
traverseEither a -> f b
f) m (Either SomeException a)
m where
    traverseEither :: (t -> f b) -> Either a t -> f (Either a b)
traverseEither t -> f b
g (Right t
a) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f b
g t
a
    traverseEither t -> f b
_ (Left a
e) = Either a b -> f (Either a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a b
forall a b. a -> Either a b
Left a
e)

instance Monad m => Alternative (CatchT m) where
  empty :: CatchT m a
empty = CatchT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: CatchT m a -> CatchT m a -> CatchT m a
(<|>) = CatchT m a -> CatchT m a -> CatchT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad m => MonadPlus (CatchT m) where
  mzero :: CatchT m a
mzero = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> Either SomeException a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> Either SomeException a)
-> SomeException -> Either SomeException a
forall a b. (a -> b) -> a -> b
$ IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (IOError -> SomeException) -> IOError -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
""
  mplus :: CatchT m a -> CatchT m a -> CatchT m a
mplus (CatchT m (Either SomeException a)
m) (CatchT m (Either SomeException a)
n) = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ m (Either SomeException a)
m m (Either SomeException a)
-> (Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either SomeException a
ea -> case Either SomeException a
ea of
    Left SomeException
_ -> m (Either SomeException a)
n
    Right a
a -> Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)

instance MonadTrans CatchT where
  lift :: m a -> CatchT m a
lift m a
m = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ do
    a
a <- m a
m
    Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> Either SomeException a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ a -> Either SomeException a
forall a b. b -> Either a b
Right a
a

instance MonadIO m => MonadIO (CatchT m) where
  liftIO :: IO a -> CatchT m a
liftIO IO a
m = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ do
    a
a <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
    Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> Either SomeException a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ a -> Either SomeException a
forall a b. b -> Either a b
Right a
a

instance Monad m => MonadThrow (CatchT m) where
  throwM :: e -> CatchT m a
throwM = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> (e -> m (Either SomeException a)) -> e -> CatchT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> (e -> Either SomeException a) -> e -> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> Either SomeException a)
-> (e -> SomeException) -> e -> Either SomeException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException
instance Monad m => MonadCatch (CatchT m) where
  catch :: CatchT m a -> (e -> CatchT m a) -> CatchT m a
catch (CatchT m (Either SomeException a)
m) e -> CatchT m a
c = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ m (Either SomeException a)
m m (Either SomeException a)
-> (Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either SomeException a
ea -> case Either SomeException a
ea of
    Left SomeException
e -> case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
      Just e
e' -> CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (e -> CatchT m a
c e
e')
      Maybe e
Nothing -> Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)
    Right a
a -> Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)
-- | Note: This instance is only valid if the underlying monad has a single
-- exit point!
--
-- For example, @IO@ or @Either@ would be invalid base monads, but
-- @Reader@ or @State@ would be acceptable.
instance Monad m => MonadMask (CatchT m) where
  mask :: ((forall a. CatchT m a -> CatchT m a) -> CatchT m b) -> CatchT m b
mask (forall a. CatchT m a -> CatchT m a) -> CatchT m b
a = (forall a. CatchT m a -> CatchT m a) -> CatchT m b
a forall a. a -> a
forall a. CatchT m a -> CatchT m a
id
  uninterruptibleMask :: ((forall a. CatchT m a -> CatchT m a) -> CatchT m b) -> CatchT m b
uninterruptibleMask (forall a. CatchT m a -> CatchT m a) -> CatchT m b
a = (forall a. CatchT m a -> CatchT m a) -> CatchT m b
a forall a. a -> a
forall a. CatchT m a -> CatchT m a
id
  generalBracket :: CatchT m a
-> (a -> ExitCase b -> CatchT m c)
-> (a -> CatchT m b)
-> CatchT m (b, c)
generalBracket CatchT m a
acquire a -> ExitCase b -> CatchT m c
release a -> CatchT m b
use = m (Either SomeException (b, c)) -> CatchT m (b, c)
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException (b, c)) -> CatchT m (b, c))
-> m (Either SomeException (b, c)) -> CatchT m (b, c)
forall a b. (a -> b) -> a -> b
$ do
    Either SomeException a
eresource <- CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT CatchT m a
acquire
    case Either SomeException a
eresource of
      Left SomeException
e -> Either SomeException (b, c) -> m (Either SomeException (b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException (b, c) -> m (Either SomeException (b, c)))
-> Either SomeException (b, c) -> m (Either SomeException (b, c))
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException (b, c)
forall a b. a -> Either a b
Left SomeException
e
      Right a
resource -> do
        Either SomeException b
eb <- CatchT m b -> m (Either SomeException b)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (a -> CatchT m b
use a
resource)
        case Either SomeException b
eb of
          Left SomeException
e -> CatchT m (b, c) -> m (Either SomeException (b, c))
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT m (b, c) -> m (Either SomeException (b, c)))
-> CatchT m (b, c) -> m (Either SomeException (b, c))
forall a b. (a -> b) -> a -> b
$ do
            c
_ <- a -> ExitCase b -> CatchT m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)
            SomeException -> CatchT m (b, c)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e
          Right b
b -> CatchT m (b, c) -> m (Either SomeException (b, c))
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT m (b, c) -> m (Either SomeException (b, c)))
-> CatchT m (b, c) -> m (Either SomeException (b, c))
forall a b. (a -> b) -> a -> b
$ do
            c
c <- a -> ExitCase b -> CatchT m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)
            (b, c) -> CatchT m (b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)

instance MonadState s m => MonadState s (CatchT m) where
  get :: CatchT m s
get = m s -> CatchT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> CatchT m ()
put = m () -> CatchT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CatchT m ()) -> (s -> m ()) -> s -> CatchT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
#if MIN_VERSION_mtl(2,1,0)
  state :: (s -> (a, s)) -> CatchT m a
state = m a -> CatchT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CatchT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> CatchT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
#endif

instance MonadReader e m => MonadReader e (CatchT m) where
  ask :: CatchT m e
ask = m e -> CatchT m e
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m e
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (e -> e) -> CatchT m a -> CatchT m a
local e -> e
f (CatchT m (Either SomeException a)
m) = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT ((e -> e)
-> m (Either SomeException a) -> m (Either SomeException a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local e -> e
f m (Either SomeException a)
m)

instance MonadWriter w m => MonadWriter w (CatchT m) where
  tell :: w -> CatchT m ()
tell = m () -> CatchT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CatchT m ()) -> (w -> m ()) -> w -> CatchT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: CatchT m a -> CatchT m (a, w)
listen = (m (Either SomeException a) -> m (Either SomeException (a, w)))
-> CatchT m a -> CatchT m (a, w)
forall (m :: * -> *) a (n :: * -> *) b.
(m (Either SomeException a) -> n (Either SomeException b))
-> CatchT m a -> CatchT n b
mapCatchT ((m (Either SomeException a) -> m (Either SomeException (a, w)))
 -> CatchT m a -> CatchT m (a, w))
-> (m (Either SomeException a) -> m (Either SomeException (a, w)))
-> CatchT m a
-> CatchT m (a, w)
forall a b. (a -> b) -> a -> b
$ \ m (Either SomeException a)
m -> do
    (Either SomeException a
a, w
w) <- m (Either SomeException a) -> m (Either SomeException a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (Either SomeException a)
m
    Either SomeException (a, w) -> m (Either SomeException (a, w))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException (a, w) -> m (Either SomeException (a, w)))
-> Either SomeException (a, w) -> m (Either SomeException (a, w))
forall a b. (a -> b) -> a -> b
$! (a -> (a, w))
-> Either SomeException a -> Either SomeException (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ a
r -> (a
r, w
w)) Either SomeException a
a
  pass :: CatchT m (a, w -> w) -> CatchT m a
pass = (m (Either SomeException (a, w -> w))
 -> m (Either SomeException a))
-> CatchT m (a, w -> w) -> CatchT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Either SomeException a) -> n (Either SomeException b))
-> CatchT m a -> CatchT n b
mapCatchT ((m (Either SomeException (a, w -> w))
  -> m (Either SomeException a))
 -> CatchT m (a, w -> w) -> CatchT m a)
-> (m (Either SomeException (a, w -> w))
    -> m (Either SomeException a))
-> CatchT m (a, w -> w)
-> CatchT m a
forall a b. (a -> b) -> a -> b
$ \ m (Either SomeException (a, w -> w))
m -> m (Either SomeException a, w -> w) -> m (Either SomeException a)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (Either SomeException a, w -> w) -> m (Either SomeException a))
-> m (Either SomeException a, w -> w) -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ do
    Either SomeException (a, w -> w)
a <- m (Either SomeException (a, w -> w))
m
    (Either SomeException a, w -> w)
-> m (Either SomeException a, w -> w)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either SomeException a, w -> w)
 -> m (Either SomeException a, w -> w))
-> (Either SomeException a, w -> w)
-> m (Either SomeException a, w -> w)
forall a b. (a -> b) -> a -> b
$! case Either SomeException (a, w -> w)
a of
        Left  SomeException
l      -> (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left  SomeException
l, w -> w
forall a. a -> a
id)
        Right (a
r, w -> w
f) -> (a -> Either SomeException a
forall a b. b -> Either a b
Right a
r, w -> w
f)
#if MIN_VERSION_mtl(2,1,0)
  writer :: (a, w) -> CatchT m a
writer (a, w)
aw = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
aw)
#endif

instance MonadRWS r w s m => MonadRWS r w s (CatchT m)

-- | Map the unwrapped computation using the given function.
--
-- @'runCatchT' ('mapCatchT' f m) = f ('runCatchT' m)@
mapCatchT :: (m (Either SomeException a) -> n (Either SomeException b))
          -> CatchT m a
          -> CatchT n b
mapCatchT :: (m (Either SomeException a) -> n (Either SomeException b))
-> CatchT m a -> CatchT n b
mapCatchT m (Either SomeException a) -> n (Either SomeException b)
f CatchT m a
m = n (Either SomeException b) -> CatchT n b
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (n (Either SomeException b) -> CatchT n b)
-> n (Either SomeException b) -> CatchT n b
forall a b. (a -> b) -> a -> b
$ m (Either SomeException a) -> n (Either SomeException b)
f (CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT CatchT m a
m)