{-# LANGUAGE OverloadedStrings #-}

-- | The worker's own structured JSON logging: its level, its destination, and the
-- context every message carries. Application-level job logging belongs on
-- 'Arbiter.Core.Job.Types.ObservabilityHooks'.
module Arbiter.Worker.Logger
  ( -- * Log Configuration
    LogConfig (..)
  , LogDestination (..)
  , defaultLogConfig
  , silentLogConfig

    -- * Log Levels
  , LogLevel (..)

    -- * Emitting
  , tryLog
  , warnEx
  , recoveryLevel
  , hubLogFor

    -- * Repeat suppression
  , FailureGate
  , newFailureGate
  , reportOutcome
  , tryReported
  , FailureGates
  , newFailureGates
  , tryReportedOn

    -- * Re-exports for structured context
  , Pair
  , (.=)
  ) where

import Arbiter.Core.Exceptions (displayEx)
import Arbiter.Core.FailureGate
  ( FailureGate
  , clearFailure
  , defaultFailureRepeatInterval
  , holdFailure
  , newFailureGate
  )
import Arbiter.Core.Listen (HubLog (..))
import Control.Exception (finally)
import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger qualified as ML
import Control.Monad.Logger.Aeson ((.=))
import Control.Monad.Logger.Aeson qualified as MLA
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types (Pair)
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Time (NominalDiffTime)
import System.Log.FastLogger (LoggerSet)
import UnliftIO (MonadUnliftIO, SomeException, tryAny)

-- | Log severity levels.
data LogLevel
  = Debug
  | Info
  | Warning
  | Error
  deriving stock (LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
$cminBound :: LogLevel
minBound :: LogLevel
$cmaxBound :: LogLevel
maxBound :: LogLevel
Bounded, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
pred :: LogLevel -> LogLevel
$ctoEnum :: Int -> LogLevel
toEnum :: Int -> LogLevel
$cfromEnum :: LogLevel -> Int
fromEnum :: LogLevel -> Int
$cenumFrom :: LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
Enum, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel =>
(LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$c< :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LogLevel
readsPrec :: Int -> ReadS LogLevel
$creadList :: ReadS [LogLevel]
readList :: ReadS [LogLevel]
$creadPrec :: ReadPrec LogLevel
readPrec :: ReadPrec LogLevel
$creadListPrec :: ReadPrec [LogLevel]
readListPrec :: ReadPrec [LogLevel]
Read, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show)

-- | Where Arbiter writes log output.
data LogDestination
  = -- | Log to stdout (default)
    LogStdout
  | -- | Log to stderr
    LogStderr
  | -- | Log to a custom fast-logger 'LoggerSet'
    LogFastLogger LoggerSet
  | -- | Log to a user-provided callback. The callback receives the 'LogLevel',
    -- the plain message 'Text', and all structured context as @['Pair']@
    -- such as job information and additional context. Use this callback to
    -- send Arbiter logs to an application logging system.
    --
    -- @
    -- let cb level msg ctx = myLogger level msg ctx
    -- in defaultLogConfig { logDestination = LogCallback cb }
    -- @
    LogCallback (LogLevel -> Text -> [Pair] -> IO ())
  | -- | Emit every message to both destinations, the first one before the second.
    LogTee LogDestination LogDestination
  | -- | Discard all logs (silent mode)
    LogDiscard

-- | How the worker emits its own logs.
data LogConfig = LogConfig
  { LogConfig -> LogLevel
minLogLevel :: LogLevel
  -- ^ Minimum severity to emit. Messages below this level are dropped.
  -- Default: 'Info'.
  , LogConfig -> LogDestination
logDestination :: LogDestination
  -- ^ Where to write logs. Default: 'LogStdout'.
  , LogConfig -> IO [Pair]
additionalContext :: IO [Pair]
  -- ^ Context merged into every message, read at log time. Default: @pure []@.
  , LogConfig -> [Pair]
identityContext :: [Pair]
  -- ^ The library's pool and worker pairs. 'additionalContext' wins on a
  -- collision. Default: @[]@.
  , LogConfig -> NominalDiffTime
failureRepeatInterval :: NominalDiffTime
  -- ^ How often a standing failure says so again. Default: 60s.
  }

-- | Default log configuration: Info level to stdout, no additional context.
defaultLogConfig :: LogConfig
defaultLogConfig :: LogConfig
defaultLogConfig =
  LogConfig
    { minLogLevel :: LogLevel
minLogLevel = LogLevel
Info
    , logDestination :: LogDestination
logDestination = LogDestination
LogStdout
    , additionalContext :: IO [Pair]
additionalContext = [Pair] -> IO [Pair]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    , identityContext :: [Pair]
identityContext = []
    , failureRepeatInterval :: NominalDiffTime
failureRepeatInterval = NominalDiffTime
defaultFailureRepeatInterval
    }

-- | Silent log configuration: discards all logs.
silentLogConfig :: LogConfig
silentLogConfig :: LogConfig
silentLogConfig = LogConfig
defaultLogConfig {logDestination = LogDiscard}

-- | Log a message, swallowing any exceptions from the logging infrastructure.
tryLog :: (MonadUnliftIO m) => LogConfig -> LogLevel -> Text -> m ()
tryLog :: forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
cfg LogLevel
level Text
msg = m (Either SomeException ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either SomeException ()) -> m ())
-> (IO () -> m (Either SomeException ())) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (Either SomeException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (m () -> m (Either SomeException ()))
-> (IO () -> m ()) -> IO () -> m (Either SomeException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogConfig -> LogLevel -> Text -> IO ()
logMessage LogConfig
cfg LogLevel
level Text
msg

-- | 'tryLog' an exception at 'Warning' under @label@.
warnEx :: (MonadUnliftIO m) => LogConfig -> Text -> SomeException -> m ()
warnEx :: forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> Text -> SomeException -> m ()
warnEx LogConfig
logCfg Text
label SomeException
exception = LogConfig -> LogLevel -> Text -> m ()
forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
logCfg LogLevel
Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
displayEx SomeException
exception

-- | Log an attempt only when it changes the gate. @subject@ reads with both
-- failed and recovered.
reportOutcome
  :: (MonadUnliftIO m)
  => LogConfig
  -> LogLevel
  -> FailureGate
  -> Text
  -> Either SomeException a
  -> m ()
reportOutcome :: forall (m :: * -> *) a.
MonadUnliftIO m =>
LogConfig
-> LogLevel
-> FailureGate
-> Text
-> Either SomeException a
-> m ()
reportOutcome LogConfig
cfg LogLevel
level FailureGate
gate Text
subject = \case
  Left SomeException
exception ->
    let failure :: Text
failure = SomeException -> Text
displayEx SomeException
exception
     in FailureGate -> NominalDiffTime -> Text -> m Bool
forall (m :: * -> *).
MonadIO m =>
FailureGate -> NominalDiffTime -> Text -> m Bool
holdFailure FailureGate
gate (LogConfig -> NominalDiffTime
failureRepeatInterval LogConfig
cfg) Text
failure
          m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
worth -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
worth (LogConfig -> LogLevel -> Text -> m ()
forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
cfg LogLevel
level (Text
subject Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
failure))
  Right a
_ ->
    FailureGate -> m Bool
forall (m :: * -> *). MonadIO m => FailureGate -> m Bool
clearFailure FailureGate
gate
      m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
recovered -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recovered (LogConfig -> LogLevel -> Text -> m ()
forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
cfg (LogConfig -> LogLevel -> LogLevel
recoveryLevel LogConfig
cfg LogLevel
level) (Text
subject Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" recovered"))

-- | Hub loggers over @cfg@. The hub's own events drop the 'identityContext'.
hubLogFor :: LogConfig -> HubLog
hubLogFor :: LogConfig -> HubLog
hubLogFor LogConfig
cfg =
  HubLog
    { hubRecovered :: Text -> IO ()
hubRecovered = LogConfig -> LogLevel -> Text -> IO ()
forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
shared (LogConfig -> LogLevel -> LogLevel
recoveryLevel LogConfig
cfg LogLevel
Error)
    , hubWarn :: Text -> IO ()
hubWarn = LogConfig -> LogLevel -> Text -> IO ()
forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
cfg LogLevel
Warning
    , hubError :: Text -> IO ()
hubError = LogConfig -> LogLevel -> Text -> IO ()
forall (m :: * -> *).
MonadUnliftIO m =>
LogConfig -> LogLevel -> Text -> m ()
tryLog LogConfig
shared LogLevel
Error
    , hubRepeatInterval :: NominalDiffTime
hubRepeatInterval = LogConfig -> NominalDiffTime
failureRepeatInterval LogConfig
cfg
    }
  where
    shared :: LogConfig
shared = LogConfig
cfg {identityContext = []}

-- | The gentlest level a recovery can take and still reach a log that showed
-- the failure.
recoveryLevel :: LogConfig -> LogLevel -> LogLevel
recoveryLevel :: LogConfig -> LogLevel -> LogLevel
recoveryLevel LogConfig
cfg LogLevel
level = LogLevel -> LogLevel -> LogLevel
forall a. Ord a => a -> a -> a
min LogLevel
level (LogLevel -> LogLevel -> LogLevel
forall a. Ord a => a -> a -> a
max LogLevel
Info (LogConfig -> LogLevel
minLogLevel LogConfig
cfg))

-- | Gates addressed by subject. Every subject holds its gate for the life of the store.
newtype FailureGates = FailureGates (IORef (Map Text FailureGate))

-- | An empty gate store.
newFailureGates :: (MonadIO m) => m FailureGates
newFailureGates :: forall (m :: * -> *). MonadIO m => m FailureGates
newFailureGates = IORef (Map Text FailureGate) -> FailureGates
FailureGates (IORef (Map Text FailureGate) -> FailureGates)
-> m (IORef (Map Text FailureGate)) -> m FailureGates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IORef (Map Text FailureGate))
-> m (IORef (Map Text FailureGate))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Map Text FailureGate -> IO (IORef (Map Text FailureGate))
forall a. a -> IO (IORef a)
newIORef Map Text FailureGate
forall k a. Map k a
Map.empty)

-- | 'tryReported' against the gate @subject@ names, created on first use.
tryReportedOn
  :: (MonadUnliftIO m)
  => LogConfig
  -> LogLevel
  -> FailureGates
  -> Text
  -> m a
  -> m (Either SomeException a)
tryReportedOn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
LogConfig
-> LogLevel
-> FailureGates
-> Text
-> m a
-> m (Either SomeException a)
tryReportedOn LogConfig
cfg LogLevel
level FailureGates
gates Text
subject m a
action = do
  gate <- FailureGates -> Text -> m FailureGate
forall (m :: * -> *).
MonadIO m =>
FailureGates -> Text -> m FailureGate
gateFor FailureGates
gates Text
subject
  tryReported cfg level gate subject action

-- | The gate @subject@ names, adding one when it is new.
gateFor :: (MonadIO m) => FailureGates -> Text -> m FailureGate
gateFor :: forall (m :: * -> *).
MonadIO m =>
FailureGates -> Text -> m FailureGate
gateFor (FailureGates IORef (Map Text FailureGate)
ref) Text
subject =
  IO (Maybe FailureGate) -> m (Maybe FailureGate)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> Map Text FailureGate -> Maybe FailureGate
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
subject (Map Text FailureGate -> Maybe FailureGate)
-> IO (Map Text FailureGate) -> IO (Maybe FailureGate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map Text FailureGate) -> IO (Map Text FailureGate)
forall a. IORef a -> IO a
readIORef IORef (Map Text FailureGate)
ref) m (Maybe FailureGate)
-> (Maybe FailureGate -> m FailureGate) -> m FailureGate
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m FailureGate
-> (FailureGate -> m FailureGate)
-> Maybe FailureGate
-> m FailureGate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m FailureGate
add FailureGate -> m FailureGate
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    add :: m FailureGate
add = do
      gate <- m FailureGate
forall (m :: * -> *). MonadIO m => m FailureGate
newFailureGate
      liftIO . atomicModifyIORef' ref $ \Map Text FailureGate
gates ->
        (Map Text FailureGate, FailureGate)
-> (FailureGate -> (Map Text FailureGate, FailureGate))
-> Maybe FailureGate
-> (Map Text FailureGate, FailureGate)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> FailureGate -> Map Text FailureGate -> Map Text FailureGate
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
subject FailureGate
gate Map Text FailureGate
gates, FailureGate
gate) ((,) Map Text FailureGate
gates) (Text -> Map Text FailureGate -> Maybe FailureGate
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
subject Map Text FailureGate
gates)

-- | 'reportOutcome' over a run of @action@.
tryReported
  :: (MonadUnliftIO m)
  => LogConfig
  -> LogLevel
  -> FailureGate
  -> Text
  -> m a
  -> m (Either SomeException a)
tryReported :: forall (m :: * -> *) a.
MonadUnliftIO m =>
LogConfig
-> LogLevel
-> FailureGate
-> Text
-> m a
-> m (Either SomeException a)
tryReported LogConfig
cfg LogLevel
level FailureGate
gate Text
subject m a
action = do
  result <- m a -> m (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny m a
action
  result <$ reportOutcome cfg level gate subject result

logMessage :: LogConfig -> LogLevel -> Text -> IO ()
logMessage :: LogConfig -> LogLevel -> Text -> IO ()
logMessage LogConfig
config LogLevel
level Text
msg = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogConfig -> LogLevel
minLogLevel LogConfig
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  extraCtx <- LogConfig -> IO [Pair]
additionalContext LogConfig
config
  runWithDestination (logDestination config) (identityContext config <> extraCtx) level msg

runWithDestination :: LogDestination -> [Pair] -> LogLevel -> Text -> IO ()
runWithDestination :: LogDestination -> [Pair] -> LogLevel -> Text -> IO ()
runWithDestination LogDestination
dest [Pair]
ctx LogLevel
level Text
msg = case LogDestination
dest of
  LogDestination
LogStdout -> LoggingT IO () -> IO ()
forall (m :: * -> *) a. LoggingT m a -> m a
MLA.runStdoutLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
MLA.withThreadContext [Pair]
ctx (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
logAt LogLevel
level Text
msg
  LogDestination
LogStderr -> LoggingT IO () -> IO ()
forall (m :: * -> *) a. LoggingT m a -> m a
MLA.runStderrLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
MLA.withThreadContext [Pair]
ctx (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
logAt LogLevel
level Text
msg
  LogFastLogger LoggerSet
loggerSet -> LoggerSet -> LoggingT IO () -> IO ()
forall (m :: * -> *) a. LoggerSet -> LoggingT m a -> m a
MLA.runFastLoggingT LoggerSet
loggerSet (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
MLA.withThreadContext [Pair]
ctx (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
logAt LogLevel
level Text
msg
  LogCallback LogLevel -> Text -> [Pair] -> IO ()
callback -> do
    threadCtx <- KeyMap Value -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList (KeyMap Value -> [Pair]) -> IO (KeyMap Value) -> IO [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (KeyMap Value)
forall (m :: * -> *). (MonadIO m, MonadThrow m) => m (KeyMap Value)
MLA.myThreadContext
    callback level msg (threadCtx <> ctx)
  LogTee LogDestination
base LogDestination
extra ->
    LogDestination -> [Pair] -> LogLevel -> Text -> IO ()
runWithDestination LogDestination
base [Pair]
ctx LogLevel
level Text
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` LogDestination -> [Pair] -> LogLevel -> Text -> IO ()
runWithDestination LogDestination
extra [Pair]
ctx LogLevel
level Text
msg
  LogDestination
LogDiscard -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    logAt :: (ML.MonadLogger m) => LogLevel -> Text -> m ()
    logAt :: forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
logAt LogLevel
Debug = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
ML.logDebugN
    logAt LogLevel
Info = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
ML.logInfoN
    logAt LogLevel
Warning = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
ML.logWarnN
    logAt LogLevel
Error = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
ML.logErrorN