-- | This module contains instances of MonadThrow, MonadCatch, MonadMsk type classes for
-- LoggingT monad transformer defined in the heavy-logger package.
--
module System.Log.Heavy.Instances.Throw where

import Control.Monad.Reader
import Control.Monad.Catch 
import System.Log.Heavy

instance MonadThrow m => MonadThrow (LoggingT m) where
  throwM :: e -> LoggingT m a
throwM e
e = ReaderT LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT (ReaderT LoggingTState m a -> LoggingT m a)
-> ReaderT LoggingTState m a -> LoggingT m a
forall a b. (a -> b) -> a -> b
$ m a -> ReaderT LoggingTState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT LoggingTState m a)
-> m a -> ReaderT LoggingTState m a
forall a b. (a -> b) -> a -> b
$ e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e

instance MonadCatch m => MonadCatch (LoggingT m) where
  catch :: LoggingT m a -> (e -> LoggingT m a) -> LoggingT m a
catch (LoggingT (ReaderT LoggingTState -> m a
m)) e -> LoggingT m a
c = ReaderT LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT (ReaderT LoggingTState m a -> LoggingT m a)
-> ReaderT LoggingTState m a -> LoggingT m a
forall a b. (a -> b) -> a -> b
$ (LoggingTState -> m a) -> ReaderT LoggingTState m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LoggingTState -> m a) -> ReaderT LoggingTState m a)
-> (LoggingTState -> m a) -> ReaderT LoggingTState m a
forall a b. (a -> b) -> a -> b
$ \LoggingTState
r -> LoggingTState -> m a
m LoggingTState
r m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> LoggingT m a -> LoggingTState -> m a
forall (m :: * -> *) a. LoggingT m a -> LoggingTState -> m a
runLoggingT (e -> LoggingT m a
c e
e) LoggingTState
r

instance MonadMask m => MonadMask (LoggingT m) where
  mask :: ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> LoggingT m b
mask (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a = ReaderT LoggingTState m b -> LoggingT m b
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT (ReaderT LoggingTState m b -> LoggingT m b)
-> ReaderT LoggingTState m b -> LoggingT m b
forall a b. (a -> b) -> a -> b
$ (LoggingTState -> m b) -> ReaderT LoggingTState m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LoggingTState -> m b) -> ReaderT LoggingTState m b)
-> (LoggingTState -> m b) -> ReaderT LoggingTState m b
forall a b. (a -> b) -> a -> b
$ \LoggingTState
lts -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> LoggingT m b -> LoggingTState -> m b
forall (m :: * -> *) a. LoggingT m a -> LoggingTState -> m a
runLoggingT ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
q m a -> m a
forall a. m a -> m a
u) LoggingTState
lts
    where q :: (m a -> m a) -> LoggingT m a -> LoggingT m a
          q :: (m a -> m a) -> LoggingT m a -> LoggingT m a
q m a -> m a
u (LoggingT (ReaderT LoggingTState -> m a
b)) = ReaderT LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT ((LoggingTState -> m a) -> ReaderT LoggingTState m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
u (m a -> m a) -> (LoggingTState -> m a) -> LoggingTState -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingTState -> m a
b))

  uninterruptibleMask :: ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> LoggingT m b
uninterruptibleMask (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a = ReaderT LoggingTState m b -> LoggingT m b
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT (ReaderT LoggingTState m b -> LoggingT m b)
-> ReaderT LoggingTState m b -> LoggingT m b
forall a b. (a -> b) -> a -> b
$ (LoggingTState -> m b) -> ReaderT LoggingTState m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LoggingTState -> m b) -> ReaderT LoggingTState m b)
-> (LoggingTState -> m b) -> ReaderT LoggingTState m b
forall a b. (a -> b) -> a -> b
$ \LoggingTState
lts -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> LoggingT m b -> LoggingTState -> m b
forall (m :: * -> *) a. LoggingT m a -> LoggingTState -> m a
runLoggingT ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
q m a -> m a
forall a. m a -> m a
u) LoggingTState
lts
    where q :: (m a -> m a) -> LoggingT m a -> LoggingT m a
          q :: (m a -> m a) -> LoggingT m a -> LoggingT m a
q m a -> m a
u (LoggingT (ReaderT LoggingTState -> m a
b)) = ReaderT LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT ((LoggingTState -> m a) -> ReaderT LoggingTState m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
u (m a -> m a) -> (LoggingTState -> m a) -> LoggingTState -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingTState -> m a
b))