{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Control.Monad.Exception.Instances where
import Control.Monad.Cont (MonadCont(..))
import Control.Monad.Exception (ExceptionT(..),
runExceptionT)
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Writer.Class (MonadWriter(..))
import Control.Monad.Trans.Class (MonadTrans(..))
instance (MonadCont m) => MonadCont (ExceptionT m) where
callCC :: forall a b.
((a -> ExceptionT m b) -> ExceptionT m a) -> ExceptionT m a
callCC (a -> ExceptionT m b) -> ExceptionT m a
f = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$
((Either SomeException a -> m (Either SomeException b))
-> m (Either SomeException a))
-> m (Either SomeException a)
forall a b. ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((Either SomeException a -> m (Either SomeException b))
-> m (Either SomeException a))
-> m (Either SomeException a))
-> ((Either SomeException a -> m (Either SomeException b))
-> m (Either SomeException a))
-> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ \Either SomeException a -> m (Either SomeException b)
c ->
ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ((a -> ExceptionT m b) -> ExceptionT m a
f (\a
a -> m (Either SomeException b) -> ExceptionT m b
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException b) -> ExceptionT m b)
-> m (Either SomeException b) -> ExceptionT m b
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException b)
c (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)))
instance (MonadRWS r w s m) => MonadRWS r w s (ExceptionT m)
instance (MonadReader r m) => MonadReader r (ExceptionT m) where
ask :: ExceptionT m r
ask = m r -> ExceptionT m r
forall (m :: * -> *) a. Monad m => m a -> ExceptionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (r -> r) -> ExceptionT m a -> ExceptionT m a
local r -> r
f ExceptionT m a
m = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ (r -> r)
-> m (Either SomeException a) -> m (Either SomeException a)
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m)
instance (MonadState s m) => MonadState s (ExceptionT m) where
get :: ExceptionT m s
get = m s -> ExceptionT m s
forall (m :: * -> *) a. Monad m => m a -> ExceptionT m a
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 -> ExceptionT m ()
put = m () -> ExceptionT m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptionT m ()) -> (s -> m ()) -> s -> ExceptionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance (MonadWriter w m) => MonadWriter w (ExceptionT m) where
tell :: w -> ExceptionT m ()
tell = m () -> ExceptionT m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptionT m ()) -> (w -> m ()) -> w -> ExceptionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: forall a. ExceptionT m a -> ExceptionT m (a, w)
listen ExceptionT m a
m = m (Either SomeException (a, w)) -> ExceptionT m (a, w)
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException (a, w)) -> ExceptionT m (a, w))
-> m (Either SomeException (a, w)) -> ExceptionT m (a, w)
forall a b. (a -> b) -> a -> b
$ do
(Either SomeException a
a, w
w) <- m (Either SomeException a) -> m (Either SomeException a, w)
forall a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m)
case Either SomeException a
a of
Left SomeException
l -> Either SomeException (a, w) -> m (Either SomeException (a, w))
forall a. a -> m a
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
$ SomeException -> Either SomeException (a, w)
forall a b. a -> Either a b
Left SomeException
l
Right a
r -> Either SomeException (a, w) -> m (Either SomeException (a, w))
forall a. a -> m a
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, w) -> Either SomeException (a, w)
forall a b. b -> Either a b
Right (a
r, w
w)
pass :: forall a. ExceptionT m (a, w -> w) -> ExceptionT m a
pass ExceptionT m (a, w -> w)
m = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ m (Either SomeException a, w -> w) -> m (Either SomeException a)
forall a. m (a, w -> w) -> m 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 <- ExceptionT m (a, w -> w) -> m (Either SomeException (a, w -> w))
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m (a, w -> w)
m
case Either SomeException (a, w -> w)
a of
Left SomeException
l -> (Either SomeException a, w -> w)
-> m (Either SomeException a, w -> w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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) -> (Either SomeException a, w -> w)
-> m (Either SomeException a, w -> w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
r, w -> w
f)