{-|
Module      : Control.Monad.Logger.Prefix
Description : Short description
Copyright   : (c) Seller Labs, 2016
License     : Apache 2.0
Maintainer  : matt@sellerlabs.com
Stability   : experimental
Portability : POSIX

This module exports the 'LogPrefixT' monad transfomer. This transformer adds
a given prefix to a 'MonadLogger' context, allowing you to make your logs a bit
more greppable without including much boilerplate. The prefixes can be nested
easily.

The function 'prefixLogs' is the most convenient way to use the library. All you
have to do is use the function to add the prefix, and it Just Works. Here's an
example:

@
someLoggingFunction :: MonadLogger m => m ()
someLoggingFunction = do
    $(logDebug) "No prefix here"
    "foo" \`prefixLogs\` do
        $(logDebug) "There's a [foo] there!
        "bar" \`prefixLogs\` do
            $(logDebug) "Now there's a [foo] *and* a [bar]"
@
-}

{-# language CPP #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Control.Monad.Logger.Prefix
    ( -- * LogPrefixT
      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


-- | This function runs the underlying 'MonadLogger' instance with a prefix
-- using the 'LogPrefixT' transformer.
--
-- >>> :set -XOverloadedStrings
-- >>> let l = logDebugN "bar"
-- >>> runStdoutLoggingT (prefixLogs "foo" (logDebugN "bar\n"))
-- [Debug] [foo] bar
-- ...
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`

-- | 'LogPrefixT' is a monad transformer that prepends a bit of text to each
-- logging action in the current 'MonadLogger' context. The internals are
-- currently implemented as a wrapper around 'ReaderT' 'LogStr'.
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)