{-# language CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Logger.Prefix
(
LogPrefixT()
, prefixLogs
, module Export
) where
import Control.Applicative
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Logger as Export
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource
import Control.Monad.Writer
import Control.Monad.IO.Unlift
import Data.Text (Text)
import Prelude
prefixLogs :: Text -> LogPrefixT m a -> m a
prefixLogs :: Text -> LogPrefixT m a -> m a
prefixLogs Text
prefix =
(ReaderT LogStr m a -> LogStr -> m a)
-> LogStr -> ReaderT LogStr m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT LogStr m a -> LogStr -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Text -> LogStr) -> Text -> LogStr
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"[", Text
prefix, Text
"] "]) (ReaderT LogStr m a -> m a)
-> (LogPrefixT m a -> ReaderT LogStr m a) -> LogPrefixT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogPrefixT m a -> ReaderT LogStr m a
forall (m :: * -> *) a. LogPrefixT m a -> ReaderT LogStr m a
runLogPrefixT
infixr 5 `prefixLogs`
newtype LogPrefixT m a = LogPrefixT { LogPrefixT m a -> ReaderT LogStr m a
runLogPrefixT :: ReaderT LogStr m a }
deriving
(a -> LogPrefixT m b -> LogPrefixT m a
(a -> b) -> LogPrefixT m a -> LogPrefixT m b
(forall a b. (a -> b) -> LogPrefixT m a -> LogPrefixT m b)
-> (forall a b. a -> LogPrefixT m b -> LogPrefixT m a)
-> Functor (LogPrefixT m)
forall a b. a -> LogPrefixT m b -> LogPrefixT m a
forall a b. (a -> b) -> LogPrefixT m a -> LogPrefixT m b
forall (m :: * -> *) a b.
Functor m =>
a -> LogPrefixT m b -> LogPrefixT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LogPrefixT m a -> LogPrefixT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LogPrefixT m b -> LogPrefixT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> LogPrefixT m b -> LogPrefixT m a
fmap :: (a -> b) -> LogPrefixT m a -> LogPrefixT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LogPrefixT m a -> LogPrefixT m b
Functor, Functor (LogPrefixT m)
a -> LogPrefixT m a
Functor (LogPrefixT m)
-> (forall a. a -> LogPrefixT m a)
-> (forall a b.
LogPrefixT m (a -> b) -> LogPrefixT m a -> LogPrefixT m b)
-> (forall a b c.
(a -> b -> c)
-> LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m c)
-> (forall a b. LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b)
-> (forall a b. LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m a)
-> Applicative (LogPrefixT m)
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m a
LogPrefixT m (a -> b) -> LogPrefixT m a -> LogPrefixT m b
(a -> b -> c) -> LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m c
forall a. a -> LogPrefixT m a
forall a b. LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m a
forall a b. LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
forall a b.
LogPrefixT m (a -> b) -> LogPrefixT m a -> LogPrefixT m b
forall a b c.
(a -> b -> c) -> LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (LogPrefixT m)
forall (m :: * -> *) a. Applicative m => a -> LogPrefixT m a
forall (m :: * -> *) a b.
Applicative m =>
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m a
forall (m :: * -> *) a b.
Applicative m =>
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
forall (m :: * -> *) a b.
Applicative m =>
LogPrefixT m (a -> b) -> LogPrefixT m a -> LogPrefixT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m c
<* :: LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m a
*> :: LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
liftA2 :: (a -> b -> c) -> LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m c
<*> :: LogPrefixT m (a -> b) -> LogPrefixT m a -> LogPrefixT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
LogPrefixT m (a -> b) -> LogPrefixT m a -> LogPrefixT m b
pure :: a -> LogPrefixT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> LogPrefixT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (LogPrefixT m)
Applicative, Applicative (LogPrefixT m)
a -> LogPrefixT m a
Applicative (LogPrefixT m)
-> (forall a b.
LogPrefixT m a -> (a -> LogPrefixT m b) -> LogPrefixT m b)
-> (forall a b. LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b)
-> (forall a. a -> LogPrefixT m a)
-> Monad (LogPrefixT m)
LogPrefixT m a -> (a -> LogPrefixT m b) -> LogPrefixT m b
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
forall a. a -> LogPrefixT m a
forall a b. LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
forall a b.
LogPrefixT m a -> (a -> LogPrefixT m b) -> LogPrefixT m b
forall (m :: * -> *). Monad m => Applicative (LogPrefixT m)
forall (m :: * -> *) a. Monad m => a -> LogPrefixT m a
forall (m :: * -> *) a b.
Monad m =>
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
forall (m :: * -> *) a b.
Monad m =>
LogPrefixT m a -> (a -> LogPrefixT m b) -> LogPrefixT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LogPrefixT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LogPrefixT m a
>> :: LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LogPrefixT m a -> LogPrefixT m b -> LogPrefixT m b
>>= :: LogPrefixT m a -> (a -> LogPrefixT m b) -> LogPrefixT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LogPrefixT m a -> (a -> LogPrefixT m b) -> LogPrefixT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (LogPrefixT m)
Monad, m a -> LogPrefixT m a
(forall (m :: * -> *) a. Monad m => m a -> LogPrefixT m a)
-> MonadTrans LogPrefixT
forall (m :: * -> *) a. Monad m => m a -> LogPrefixT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> LogPrefixT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> LogPrefixT m a
MonadTrans, Monad (LogPrefixT m)
Monad (LogPrefixT m)
-> (forall a. IO a -> LogPrefixT m a) -> MonadIO (LogPrefixT m)
IO a -> LogPrefixT m a
forall a. IO a -> LogPrefixT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (LogPrefixT m)
forall (m :: * -> *) a. MonadIO m => IO a -> LogPrefixT m a
liftIO :: IO a -> LogPrefixT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LogPrefixT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (LogPrefixT m)
MonadIO, Monad (LogPrefixT m)
e -> LogPrefixT m a
Monad (LogPrefixT m)
-> (forall e a. Exception e => e -> LogPrefixT m a)
-> MonadThrow (LogPrefixT m)
forall e a. Exception e => e -> LogPrefixT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (LogPrefixT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LogPrefixT m a
throwM :: e -> LogPrefixT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LogPrefixT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (LogPrefixT m)
MonadThrow, MonadThrow (LogPrefixT m)
MonadThrow (LogPrefixT m)
-> (forall e a.
Exception e =>
LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a)
-> MonadCatch (LogPrefixT m)
LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a
forall e a.
Exception e =>
LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (LogPrefixT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a
catch :: LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (LogPrefixT m)
MonadCatch, MonadCatch (LogPrefixT m)
MonadCatch (LogPrefixT m)
-> (forall b.
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b)
-> (forall b.
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b)
-> (forall a b c.
LogPrefixT m a
-> (a -> ExitCase b -> LogPrefixT m c)
-> (a -> LogPrefixT m b)
-> LogPrefixT m (b, c))
-> MonadMask (LogPrefixT m)
LogPrefixT m a
-> (a -> ExitCase b -> LogPrefixT m c)
-> (a -> LogPrefixT m b)
-> LogPrefixT m (b, c)
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
forall b.
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
forall a b c.
LogPrefixT m a
-> (a -> ExitCase b -> LogPrefixT m c)
-> (a -> LogPrefixT m b)
-> LogPrefixT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (LogPrefixT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
forall (m :: * -> *) a b c.
MonadMask m =>
LogPrefixT m a
-> (a -> ExitCase b -> LogPrefixT m c)
-> (a -> LogPrefixT m b)
-> LogPrefixT m (b, c)
generalBracket :: LogPrefixT m a
-> (a -> ExitCase b -> LogPrefixT m c)
-> (a -> LogPrefixT m b)
-> LogPrefixT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
LogPrefixT m a
-> (a -> ExitCase b -> LogPrefixT m c)
-> (a -> LogPrefixT m b)
-> LogPrefixT m (b, c)
uninterruptibleMask :: ((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
mask :: ((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. LogPrefixT m a -> LogPrefixT m a) -> LogPrefixT m b)
-> LogPrefixT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (LogPrefixT m)
MonadMask)
instance MonadLogger m => MonadLogger (LogPrefixT m) where
monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> LogPrefixT m ()
monadLoggerLog Loc
loc Text
src LogLevel
lvl msg
msg = ReaderT LogStr m () -> LogPrefixT m ()
forall (m :: * -> *) a. ReaderT LogStr m a -> LogPrefixT m a
LogPrefixT (ReaderT LogStr m () -> LogPrefixT m ())
-> ReaderT LogStr m () -> LogPrefixT m ()
forall a b. (a -> b) -> a -> b
$ (LogStr -> m ()) -> ReaderT LogStr m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LogStr -> m ()) -> ReaderT LogStr m ())
-> (LogStr -> m ()) -> ReaderT LogStr m ()
forall a b. (a -> b) -> a -> b
$ \LogStr
prefix ->
Loc -> Text -> LogLevel -> LogStr -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog Loc
loc Text
src LogLevel
lvl (LogStr -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr LogStr
prefix LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg)
instance MonadBase b m => MonadBase b (LogPrefixT m) where
liftBase :: b α -> LogPrefixT m α
liftBase = m α -> LogPrefixT m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> LogPrefixT m α) -> (b α -> m α) -> b α -> LogPrefixT m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadBaseControl b m => MonadBaseControl b (LogPrefixT m) where
type StM (LogPrefixT m) a = StM m a
liftBaseWith :: (RunInBase (LogPrefixT m) b -> b a) -> LogPrefixT m a
liftBaseWith RunInBase (LogPrefixT m) b -> b a
f = ReaderT LogStr m a -> LogPrefixT m a
forall (m :: * -> *) a. ReaderT LogStr m a -> LogPrefixT m a
LogPrefixT (ReaderT LogStr m a -> LogPrefixT m a)
-> ReaderT LogStr m a -> LogPrefixT m a
forall a b. (a -> b) -> a -> b
$ (LogStr -> m a) -> ReaderT LogStr m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LogStr -> m a) -> ReaderT LogStr m a)
-> (LogStr -> m a) -> ReaderT LogStr m a
forall a b. (a -> b) -> a -> b
$ \LogStr
reader' ->
(RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInBase ->
RunInBase (LogPrefixT m) b -> b a
f (RunInBase (LogPrefixT m) b -> b a)
-> RunInBase (LogPrefixT m) b -> b a
forall a b. (a -> b) -> a -> b
$ m a -> b (StM m a)
RunInBase m b
runInBase (m a -> b (StM m a))
-> (LogPrefixT m a -> m a) -> LogPrefixT m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(LogPrefixT ReaderT LogStr m a
r) -> ReaderT LogStr m a -> LogStr -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT LogStr m a
r LogStr
reader')
restoreM :: StM (LogPrefixT m) a -> LogPrefixT m a
restoreM = ReaderT LogStr m a -> LogPrefixT m a
forall (m :: * -> *) a. ReaderT LogStr m a -> LogPrefixT m a
LogPrefixT (ReaderT LogStr m a -> LogPrefixT m a)
-> (StM m a -> ReaderT LogStr m a) -> StM m a -> LogPrefixT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogStr -> m a) -> ReaderT LogStr m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LogStr -> m a) -> ReaderT LogStr m a)
-> (StM m a -> LogStr -> m a) -> StM m a -> ReaderT LogStr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> LogStr -> m a
forall a b. a -> b -> a
const (m a -> LogStr -> m a)
-> (StM m a -> m a) -> StM m a -> LogStr -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
instance MonadReader r m => MonadReader r (LogPrefixT m) where
ask :: LogPrefixT m r
ask = m r -> LogPrefixT m r
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 :: (r -> r) -> LogPrefixT m a -> LogPrefixT m a
local = (m a -> m a) -> LogPrefixT m a -> LogPrefixT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> LogPrefixT m a -> LogPrefixT n b
mapLogPrefixT ((m a -> m a) -> LogPrefixT m a -> LogPrefixT m a)
-> ((r -> r) -> m a -> m a)
-> (r -> r)
-> LogPrefixT m a
-> LogPrefixT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
instance MonadState s m => MonadState s (LogPrefixT m) where
get :: LogPrefixT m s
get = m s -> LogPrefixT 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 -> LogPrefixT m ()
put = m () -> LogPrefixT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> LogPrefixT m ()) -> (s -> m ()) -> s -> LogPrefixT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance MonadError e m => MonadError e (LogPrefixT m) where
throwError :: e -> LogPrefixT m a
throwError = m a -> LogPrefixT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LogPrefixT m a) -> (e -> m a) -> e -> LogPrefixT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: LogPrefixT m a -> (e -> LogPrefixT m a) -> LogPrefixT m a
catchError LogPrefixT m a
err e -> LogPrefixT m a
k = ReaderT LogStr m a -> LogPrefixT m a
forall (m :: * -> *) a. ReaderT LogStr m a -> LogPrefixT m a
LogPrefixT
(ReaderT LogStr m a -> LogPrefixT m a)
-> ReaderT LogStr m a -> LogPrefixT m a
forall a b. (a -> b) -> a -> b
$ (LogStr -> m a) -> ReaderT LogStr m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
((LogStr -> m a) -> ReaderT LogStr m a)
-> (LogStr -> m a) -> ReaderT LogStr m a
forall a b. (a -> b) -> a -> b
$ \LogStr
prfx -> ReaderT LogStr m a -> LogStr -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LogPrefixT m a -> ReaderT LogStr m a
forall (m :: * -> *) a. LogPrefixT m a -> ReaderT LogStr m a
runLogPrefixT LogPrefixT m a
err) LogStr
prfx
m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError`
\e
e -> ReaderT LogStr m a -> LogStr -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LogPrefixT m a -> ReaderT LogStr m a
forall (m :: * -> *) a. LogPrefixT m a -> ReaderT LogStr m a
runLogPrefixT (e -> LogPrefixT m a
k e
e)) LogStr
prfx
instance MonadWriter w m => MonadWriter w (LogPrefixT m) where
tell :: w -> LogPrefixT m ()
tell = m () -> LogPrefixT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> LogPrefixT m ()) -> (w -> m ()) -> w -> LogPrefixT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: LogPrefixT m a -> LogPrefixT m (a, w)
listen = (m a -> m (a, w)) -> LogPrefixT m a -> LogPrefixT m (a, w)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> LogPrefixT m a -> LogPrefixT n b
mapLogPrefixT m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
pass :: LogPrefixT m (a, w -> w) -> LogPrefixT m a
pass = (m (a, w -> w) -> m a)
-> LogPrefixT m (a, w -> w) -> LogPrefixT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> LogPrefixT m a -> LogPrefixT n b
mapLogPrefixT m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass
instance MonadResource m => MonadResource (LogPrefixT m) where
liftResourceT :: ResourceT IO a -> LogPrefixT m a
liftResourceT = m a -> LogPrefixT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LogPrefixT m a)
-> (ResourceT IO a -> m a) -> ResourceT IO a -> LogPrefixT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO a -> m a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT
instance MonadUnliftIO m => MonadUnliftIO (LogPrefixT m) where
#if MIN_VERSION_unliftio_core(0,2,0)
#else
{-# INLINE askUnliftIO #-}
askUnliftIO = LogPrefixT. ReaderT $ \r ->
withUnliftIO $ \u ->
return (UnliftIO (unliftIO u . flip runReaderT r . runLogPrefixT))
#endif
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. LogPrefixT m a -> IO a) -> IO b) -> LogPrefixT m b
withRunInIO (forall a. LogPrefixT m a -> IO a) -> IO b
inner =
ReaderT LogStr m b -> LogPrefixT m b
forall (m :: * -> *) a. ReaderT LogStr m a -> LogPrefixT m a
LogPrefixT(ReaderT LogStr m b -> LogPrefixT m b)
-> ((LogStr -> m b) -> ReaderT LogStr m b)
-> (LogStr -> m b)
-> LogPrefixT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogStr -> m b) -> ReaderT LogStr m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LogStr -> m b) -> LogPrefixT m b)
-> (LogStr -> m b) -> LogPrefixT m b
forall a b. (a -> b) -> a -> b
$ \LogStr
r ->
((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
(forall a. LogPrefixT m a -> IO a) -> IO b
inner (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> (LogPrefixT m a -> m a) -> LogPrefixT m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT LogStr m a -> LogStr -> m a)
-> LogStr -> ReaderT LogStr m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT LogStr m a -> LogStr -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LogStr
r (ReaderT LogStr m a -> m a)
-> (LogPrefixT m a -> ReaderT LogStr m a) -> LogPrefixT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogPrefixT m a -> ReaderT LogStr m a
forall (m :: * -> *) a. LogPrefixT m a -> ReaderT LogStr m a
runLogPrefixT)
mapLogPrefixT :: (m a -> n b) -> LogPrefixT m a -> LogPrefixT n b
mapLogPrefixT :: (m a -> n b) -> LogPrefixT m a -> LogPrefixT n b
mapLogPrefixT m a -> n b
f LogPrefixT m a
rfn =
ReaderT LogStr n b -> LogPrefixT n b
forall (m :: * -> *) a. ReaderT LogStr m a -> LogPrefixT m a
LogPrefixT (ReaderT LogStr n b -> LogPrefixT n b)
-> ((LogStr -> n b) -> ReaderT LogStr n b)
-> (LogStr -> n b)
-> LogPrefixT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogStr -> n b) -> ReaderT LogStr n b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LogStr -> n b) -> LogPrefixT n b)
-> (LogStr -> n b) -> LogPrefixT n b
forall a b. (a -> b) -> a -> b
$ m a -> n b
f (m a -> n b) -> (LogStr -> m a) -> LogStr -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT LogStr m a -> LogStr -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LogPrefixT m a -> ReaderT LogStr m a
forall (m :: * -> *) a. LogPrefixT m a -> ReaderT LogStr m a
runLogPrefixT LogPrefixT m a
rfn)