{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Control.Monad.Logger.Aeson
  ( -- * Synopsis
    -- $synopsis

    -- * Types
    Message(..)
  , SeriesElem
  , LoggedMessage(..)

    -- * Logging functions
    -- ** Implicit call stack, no @LogSource@
  , logDebug
  , logInfo
  , logWarn
  , logError
  , logOther
    -- ** Explicit call stack, no @LogSource@
  , logDebugCS
  , logInfoCS
  , logWarnCS
  , logErrorCS
  , logOtherCS
    -- ** Implicit call stack, with @LogSource@
  , logDebugNS
  , logInfoNS
  , logWarnNS
  , logErrorNS
  , logOtherNS
    -- ** Convenience aliases
  , logDebugN
  , logInfoN
  , logWarnN
  , logErrorN
  , logOtherN

    -- ** Thread context
  , withThreadContext
  , myThreadContext

    -- * @LoggingT@ runners
  , runFileLoggingT
  , runHandleLoggingT
  , runStdoutLoggingT
  , runStderrLoggingT
  , runFastLoggingT

    -- * Utilities for defining our own loggers
  , defaultOutput
  , handleOutput
  , fastLoggerOutput
  , defaultOutputWith
  , defaultOutputOptions
  , OutputOptions
  , outputIncludeThreadId
  , outputBaseThreadContext
  , defaultLogStr
  , defaultHandleFromLevel

    -- * Re-exports from @aeson@
  , (.=)

    -- * Re-exports from @monad-logger@
  , module Log
  ) where

-- N.B. This import is not grouped with the others as this makes it easier to
-- cross-reference with this module's exports.
import Control.Monad.Logger as Log hiding
  ( logDebug
  , logInfo
  , logWarn
  , logError
  , logOther
  , logDebugCS
  , logInfoCS
  , logWarnCS
  , logErrorCS
  , logOtherCS
  , logWithoutLoc -- No re-export, as the 'log*NS' here use call stack for loc
  , logDebugN
  , logInfoN
  , logWarnN
  , logErrorN
  , logOtherN
  , logDebugNS
  , logInfoNS
  , logWarnNS
  , logErrorNS
  , logOtherNS
  , runFileLoggingT
  , runStderrLoggingT
  , runStdoutLoggingT
#if MIN_VERSION_monad_logger(0,3,36)
  , defaultOutput
#endif
  , defaultLogStr
  )

import Control.Monad.Catch (MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Logger.Aeson.Internal
  ( LoggedMessage(..), Message(..), OutputOptions(..), KeyMap, SeriesElem
  )
import Data.Aeson (KeyValue((.=)), Value(String))
import Data.Aeson.Types (Pair)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Stack (CallStack, HasCallStack, callStack)
import System.IO
  ( BufferMode(LineBuffering), IOMode(AppendMode), Handle, hClose, hSetBuffering, openFile, stderr
  , stdout
  )
import System.Log.FastLogger (LoggerSet)
import qualified Context
import qualified Control.Concurrent as Concurrent
import qualified Control.Monad.Catch as Catch
import qualified Control.Monad.Logger.Aeson.Internal as Internal
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Text as Text
import qualified Data.Time as Time
import qualified System.Log.FastLogger as FastLogger

-- | Logs a 'Message' with the location provided by an implicit 'CallStack'.
--
-- @since 0.1.0.0
logDebug :: (HasCallStack, MonadLogger m) => Message -> m ()
logDebug :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logDebugCS HasCallStack => CallStack
callStack

-- | See 'logDebug'
--
-- @since 0.1.0.0
logInfo :: (HasCallStack, MonadLogger m) => Message -> m ()
logInfo :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logInfoCS HasCallStack => CallStack
callStack

-- | See 'logDebug'
--
-- @since 0.1.0.0
logWarn :: (HasCallStack, MonadLogger m) => Message -> m ()
logWarn :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logWarnCS HasCallStack => CallStack
callStack

-- | See 'logDebug'
--
-- @since 0.1.0.0
logError :: (HasCallStack, MonadLogger m) => Message -> m ()
logError :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logErrorCS HasCallStack => CallStack
callStack

-- | See 'logDebug'
--
-- @since 0.1.0.0
logOther :: (HasCallStack, MonadLogger m) => LogLevel -> Message -> m ()
logOther :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogLevel -> Message -> m ()
logOther = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogLevel -> Message -> m ()
logOtherCS HasCallStack => CallStack
callStack

-- | Logs a 'Message' with location given by 'CallStack'.
--
-- @since 0.1.0.0
logDebugCS :: (MonadLogger m) => CallStack -> Message -> m ()
logDebugCS :: forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logDebugCS CallStack
cs Message
msg = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS CallStack
cs LogSource
"" LogLevel
LevelDebug Message
msg

-- | See 'logDebugCS'
--
-- @since 0.1.0.0
logInfoCS :: (MonadLogger m) => CallStack -> Message -> m ()
logInfoCS :: forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logInfoCS CallStack
cs Message
msg = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS CallStack
cs LogSource
"" LogLevel
LevelInfo Message
msg

-- | See 'logDebugCS'
--
-- @since 0.1.0.0
logWarnCS :: (MonadLogger m) => CallStack -> Message -> m ()
logWarnCS :: forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logWarnCS CallStack
cs Message
msg = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS CallStack
cs LogSource
"" LogLevel
LevelWarn Message
msg

-- | See 'logDebugCS'
--
-- @since 0.1.0.0
logOtherCS :: (MonadLogger m) => CallStack -> LogLevel -> Message -> m ()
logOtherCS :: forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogLevel -> Message -> m ()
logOtherCS CallStack
cs LogLevel
lvl Message
msg = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS CallStack
cs LogSource
"" LogLevel
lvl Message
msg

-- | See 'logDebugCS'
--
-- @since 0.1.0.0
logErrorCS :: (MonadLogger m) => CallStack -> Message -> m ()
logErrorCS :: forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logErrorCS CallStack
cs Message
msg = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS CallStack
cs LogSource
"" LogLevel
LevelError Message
msg

-- | See 'logDebug'.
--
-- This is an alias for 'logDebug' and is provided mainly for symmetry with
-- @monad-logger@.
--
-- @since 0.4.0.0
logDebugN :: (HasCallStack, MonadLogger m) => Message -> m ()
logDebugN :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebugN = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logDebugCS HasCallStack => CallStack
callStack

-- | See 'logDebugN'
--
-- @since 0.4.0.0
logInfoN :: (HasCallStack, MonadLogger m) => Message -> m ()
logInfoN :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfoN = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logInfoCS HasCallStack => CallStack
callStack

-- | See 'logDebugN'
--
-- @since 0.4.0.0
logWarnN :: (HasCallStack, MonadLogger m) => Message -> m ()
logWarnN :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarnN = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logWarnCS HasCallStack => CallStack
callStack

-- | See 'logDebugN'
--
-- @since 0.4.0.0
logErrorN :: (HasCallStack, MonadLogger m) => Message -> m ()
logErrorN :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logErrorN = forall (m :: * -> *). MonadLogger m => CallStack -> Message -> m ()
logErrorCS HasCallStack => CallStack
callStack

-- | See 'logDebugN'
--
-- @since 0.4.0.0
logOtherN :: (HasCallStack, MonadLogger m) => LogLevel -> Message -> m ()
logOtherN :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogLevel -> Message -> m ()
logOtherN = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogLevel -> Message -> m ()
logOtherCS HasCallStack => CallStack
callStack

-- | See 'logDebugCS'
--
-- @since 0.1.0.0
logDebugNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
logDebugNS :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogSource -> Message -> m ()
logDebugNS LogSource
src = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS HasCallStack => CallStack
callStack LogSource
src LogLevel
LevelDebug

-- | See 'logDebugNS'
--
-- @since 0.1.0.0
logInfoNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
logInfoNS :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogSource -> Message -> m ()
logInfoNS LogSource
src = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS HasCallStack => CallStack
callStack LogSource
src LogLevel
LevelInfo

-- | See 'logDebugNS'
--
-- @since 0.1.0.0
logWarnNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
logWarnNS :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogSource -> Message -> m ()
logWarnNS LogSource
src = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS HasCallStack => CallStack
callStack LogSource
src LogLevel
LevelWarn

-- | See 'logDebugNS'
--
-- @since 0.1.0.0
logErrorNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
logErrorNS :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogSource -> Message -> m ()
logErrorNS LogSource
src = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS HasCallStack => CallStack
callStack LogSource
src LogLevel
LevelError

-- | See 'logDebugNS'
--
-- @since 0.1.0.0
logOtherNS :: (HasCallStack, MonadLogger m) => LogSource -> LogLevel -> Message -> m ()
logOtherNS :: forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
LogSource -> LogLevel -> Message -> m ()
logOtherNS = forall (m :: * -> *).
MonadLogger m =>
CallStack -> LogSource -> LogLevel -> Message -> m ()
Internal.logCS HasCallStack => CallStack
callStack

-- | This function lets us register structured, contextual info for the duration
-- of the provided action. All messages logged within the provided action will
-- automatically include this contextual info. This function is thread-safe, as
-- the contextual info is scoped to the calling thread only.
--
-- This function is additive: if we nest calls to it, each nested call will add
-- to the existing thread context. In the case of overlapping keys, the nested
-- call's 'Pair' value(s) will win. Whenever the inner action completes, the
-- thread context is rolled back to its value set in the enclosing action.
--
-- If we wish to include the existing thread context from one thread in another
-- thread, we must register the thread context explicitly on that other thread.
-- 'myThreadContext' can be leveraged in this case.
--
-- Registering thread context for messages can be useful in many scenarios. One
-- particularly apt scenario is in @wai@ middlewares. We can generate an ID for
-- each incoming request then include it in the thread context. Now all messages
-- subsequently logged from our endpoint handler will automatically include that
-- request ID:
--
-- > import Control.Monad.Logger.Aeson ((.=), withThreadContext)
-- > import Network.Wai (Middleware)
-- > import qualified Data.UUID.V4 as UUID
-- >
-- > addRequestId :: Middleware
-- > addRequestId app = \request sendResponse -> do
-- >   uuid <- UUID.nextRandom
-- >   withThreadContext ["requestId" .= uuid] do
-- >     app request sendResponse
--
-- If we're coming from a Java background, it may be helpful for us to draw
-- parallels between this function and @log4j2@'s @ThreadContext@ (or perhaps
-- @log4j@'s @MDC@). They all enable the same thing: setting some thread-local
-- info that will be automatically pulled into each logged message.
--
-- @since 0.1.0.0
withThreadContext :: (MonadIO m, MonadMask m) => [Pair] -> m a -> m a
withThreadContext :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext [Pair]
pairs =
  forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> (ctx -> ctx) -> m a -> m a
Context.adjust Store (KeyMap Value)
Internal.threadContextStore forall a b. (a -> b) -> a -> b
$ \KeyMap Value
pairsMap ->
    forall v. KeyMap v -> KeyMap v -> KeyMap v
Internal.keyMapUnion (forall v. [(Key, v)] -> KeyMap v
Internal.keyMapFromList [Pair]
pairs) KeyMap Value
pairsMap

-- | This function lets us retrieve the calling thread's thread context. For
-- more detail, we can consult the docs for 'withThreadContext'.
--
-- Note that even though the type signature lists 'MonadThrow' as a required
-- constraint, the library guarantees that 'myThreadContext' will never throw.
--
-- @since 0.1.0.0
myThreadContext :: (MonadIO m, MonadThrow m) => m (KeyMap Value)
myThreadContext :: forall (m :: * -> *). (MonadIO m, MonadThrow m) => m (KeyMap Value)
myThreadContext = do
  forall (m :: * -> *) ctx.
(MonadIO m, MonadThrow m) =>
Store ctx -> m ctx
Context.mine Store (KeyMap Value)
Internal.threadContextStore

-- | Run a block using a 'MonadLogger' instance which appends to the specified
-- file.
--
-- Note that this differs from the @monad-logger@ version in its constraints.
-- We use the @exceptions@ package's 'MonadMask' here for bracketing, rather
-- than @monad-control@.
--
-- @since 0.1.0.0
runFileLoggingT :: (MonadIO m, MonadMask m) => FilePath -> LoggingT m a -> m a
runFileLoggingT :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> LoggingT m a -> m a
runFileLoggingT FilePath
filePath LoggingT m a
action =
  forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Catch.bracket (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
filePath IOMode
AppendMode) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose) forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
    forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
action forall a b. (a -> b) -> a -> b
$ Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
h

-- | Run a block using a 'MonadLogger' instance which prints to 'stderr'.
--
-- @since 0.1.0.0
runStderrLoggingT :: LoggingT m a -> m a
runStderrLoggingT :: forall (m :: * -> *) a. LoggingT m a -> m a
runStderrLoggingT = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
stderr)

-- | Run a block using a 'MonadLogger' instance which prints to 'stdout'.
--
-- @since 0.1.0.0
runStdoutLoggingT :: LoggingT m a -> m a
runStdoutLoggingT :: forall (m :: * -> *) a. LoggingT m a -> m a
runStdoutLoggingT = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
stdout)

-- | Run a block using a 'MonadLogger' instance which prints to a 'Handle'
-- determined by the log message's 'LogLevel'.
--
-- A common use case for this function is to log warn\/error messages to 'stderr'
-- and debug\/info messages to 'stdout' in CLIs/tools (see
-- 'defaultHandleFromLevel').
--
-- @since 0.1.0.0
runHandleLoggingT :: (LogLevel -> Handle) -> LoggingT m a -> m a
runHandleLoggingT :: forall (m :: * -> *) a. (LogLevel -> Handle) -> LoggingT m a -> m a
runHandleLoggingT = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogLevel -> Handle)
-> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
handleOutput

-- | Run a block using a 'MonadLogger' instance which appends to the specified
-- 'LoggerSet'.
--
-- @since 0.1.0.0
runFastLoggingT :: LoggerSet -> LoggingT m a -> m a
runFastLoggingT :: forall (m :: * -> *) a. LoggerSet -> LoggingT m a -> m a
runFastLoggingT LoggerSet
loggerSet = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (LoggerSet -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
fastLoggerOutput LoggerSet
loggerSet)

-- | A default implementation of the action that backs the 'monadLoggerLog'
-- function. It accepts a file handle as the first argument and will log
-- incoming 'LogStr' values wrapped in the JSON structure prescribed by this
-- library.
--
-- This is used in the definition of 'runStdoutLoggingT' and
-- 'runStderrLoggingT':
--
-- @
-- 'runStdoutLoggingT' :: 'LoggingT' m a -> m a
-- 'runStdoutLoggingT' = 'flip' 'runLoggingT' ('defaultOutput' 'stdout')
-- @
--
-- We can instead use 'defaultOutputWith' if we need more control of the output.
--
-- @since 0.1.0.0
defaultOutput
  :: Handle
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> IO ()
defaultOutput :: Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
handle = (LogLevel -> Handle)
-> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
handleOutput (forall a b. a -> b -> a
const Handle
handle)

-- | Given an output action for log messages, this function will produce the
-- default recommended 'OutputOptions'.
--
-- Specific options can be overriden via record update syntax using
-- 'outputIncludeThreadId', 'outputBaseThreadContext', and friends.
--
-- @since 0.1.0.0
defaultOutputOptions :: (LogLevel -> BS8.ByteString -> IO ()) -> OutputOptions
defaultOutputOptions :: (LogLevel -> ByteString -> IO ()) -> OutputOptions
defaultOutputOptions LogLevel -> ByteString -> IO ()
outputAction =
  OutputOptions
    { LogLevel -> ByteString -> IO ()
outputAction :: LogLevel -> ByteString -> IO ()
outputAction :: LogLevel -> ByteString -> IO ()
outputAction
    , outputIncludeThreadId :: Bool
outputIncludeThreadId = Bool
False
    , outputBaseThreadContext :: [Pair]
outputBaseThreadContext = []
    }

-- | This function is a lower-level helper for implementing the action that
-- backs the 'monadLoggerLog' function.
--
-- We should generally prefer 'defaultOutput' over this function, but this
-- function is available if we do need more control over our output.
--
-- @since 0.1.0.0
defaultOutputWith
  :: OutputOptions
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> IO ()
defaultOutputWith :: OutputOptions -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutputWith OutputOptions
outputOptions Loc
location LogSource
logSource LogLevel
logLevel LogStr
msg = do
  UTCTime
now <- IO UTCTime
Time.getCurrentTime
  LogSource
threadIdText <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> LogSource
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) IO ThreadId
Concurrent.myThreadId
  KeyMap Value
threadContext <- forall (m :: * -> *) ctx a.
(MonadIO m, MonadThrow m) =>
Store ctx -> (ctx -> a) -> m a
Context.mines Store (KeyMap Value)
Internal.threadContextStore forall a b. (a -> b) -> a -> b
$ \KeyMap Value
hashMap ->
    ( if Bool
outputIncludeThreadId then
        forall v. Key -> v -> KeyMap v -> KeyMap v
Internal.keyMapInsert Key
"tid" forall a b. (a -> b) -> a -> b
$ LogSource -> Value
String LogSource
threadIdText
      else
        forall a. a -> a
id
    ) forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> KeyMap v -> KeyMap v
Internal.keyMapUnion KeyMap Value
hashMap forall a b. (a -> b) -> a -> b
$ KeyMap Value
baseThreadContextHashMap
  LogLevel -> ByteString -> IO ()
outputAction LogLevel
logLevel
    forall a b. (a -> b) -> a -> b
$ UTCTime
-> KeyMap Value
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> ByteString
Internal.defaultLogStrBS UTCTime
now KeyMap Value
threadContext Loc
location LogSource
logSource LogLevel
logLevel LogStr
msg
  where
  baseThreadContextHashMap :: KeyMap Value
baseThreadContextHashMap = forall v. [(Key, v)] -> KeyMap v
Internal.keyMapFromList [Pair]
outputBaseThreadContext
  OutputOptions
    { LogLevel -> ByteString -> IO ()
outputAction :: LogLevel -> ByteString -> IO ()
outputAction :: OutputOptions -> LogLevel -> ByteString -> IO ()
outputAction
    , Bool
outputIncludeThreadId :: Bool
outputIncludeThreadId :: OutputOptions -> Bool
outputIncludeThreadId
    , [Pair]
outputBaseThreadContext :: [Pair]
outputBaseThreadContext :: OutputOptions -> [Pair]
outputBaseThreadContext
    } = OutputOptions
outputOptions

-- | An implementation of the action that backs the 'monadLoggerLog' function,
-- where the 'Handle' destination for each log message is determined by the log
-- message's 'LogLevel'. This function will log incoming 'LogStr' values wrapped
-- in the JSON structure prescribed by this library.
--
-- This is used in the definition of 'runHandleLoggingT':
--
-- @
-- 'runHandleLoggingT' :: ('LogLevel' -> 'Handle') -> 'LoggingT' m a -> m a
-- 'runHandleLoggingT' = 'flip' 'runLoggingT' . 'handleOutput'
-- @
--
-- @since 0.1.0.0
handleOutput
  :: (LogLevel -> Handle)
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> IO ()
handleOutput :: (LogLevel -> Handle)
-> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
handleOutput LogLevel -> Handle
levelToHandle =
  OutputOptions -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutputWith forall a b. (a -> b) -> a -> b
$ (LogLevel -> ByteString -> IO ()) -> OutputOptions
defaultOutputOptions forall a b. (a -> b) -> a -> b
$ \LogLevel
logLevel ByteString
bytes -> do
    Handle -> ByteString -> IO ()
BS8.hPutStrLn (LogLevel -> Handle
levelToHandle LogLevel
logLevel) ByteString
bytes

-- | An implementation of the action that backs the 'monadLoggerLog' function,
-- where log messages are written to a provided 'LoggerSet'. This function will
-- log incoming 'LogStr' values wrapped in the JSON structure prescribed by this
-- library.
--
-- This is used in the definition of 'runFastLoggingT':
--
-- @
-- 'runFastLoggingT' :: 'LoggerSet' -> 'LoggingT' m a -> m a
-- 'runFastLoggingT' loggerSet = 'flip' 'runLoggingT' ('fastLoggerOutput' loggerSet)
-- @
--
-- @since 0.1.0.0
fastLoggerOutput
  :: LoggerSet
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> IO ()
fastLoggerOutput :: LoggerSet -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
fastLoggerOutput LoggerSet
loggerSet =
  OutputOptions -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
defaultOutputWith forall a b. (a -> b) -> a -> b
$ (LogLevel -> ByteString -> IO ()) -> OutputOptions
defaultOutputOptions forall a b. (a -> b) -> a -> b
$ \LogLevel
_logLevel ByteString
bytes -> do
    LoggerSet -> LogStr -> IO ()
FastLogger.pushLogStrLn LoggerSet
loggerSet forall a b. (a -> b) -> a -> b
$ forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
bytes

-- | @since 0.1.0.0
defaultLogStr
  :: UTCTime
  -> KeyMap Value
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> LogStr
defaultLogStr :: UTCTime
-> KeyMap Value -> Loc -> LogSource -> LogLevel -> LogStr -> LogStr
defaultLogStr UTCTime
now KeyMap Value
threadContext Loc
loc LogSource
logSource LogLevel
logLevel LogStr
logStr =
  forall msg. ToLogStr msg => msg -> LogStr
toLogStr
    forall a b. (a -> b) -> a -> b
$ UTCTime
-> KeyMap Value
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> ByteString
Internal.defaultLogStrBS UTCTime
now KeyMap Value
threadContext Loc
loc LogSource
logSource LogLevel
logLevel LogStr
logStr

-- | This function maps the possible 'LogLevel' values to 'Handle' values.
-- Specifically, 'LevelDebug' and 'LevelInfo' map to 'stdout', while 'LevelWarn'
-- and 'LevelError' map to 'stderr'. The function is most useful for CLIs/tools
-- (see 'runHandleLoggingT').
--
-- The input function discriminating 'Text' is used to determine the 'Handle'
-- mapping for 'LevelOther'. For example, if we wish for all 'LevelOther'
-- messages to be logged to 'stderr', we can supply @(const stderr)@ as the
-- value for this input function.
--
-- @since 0.1.0.0
defaultHandleFromLevel :: (Text -> Handle) -> LogLevel -> Handle
defaultHandleFromLevel :: (LogSource -> Handle) -> LogLevel -> Handle
defaultHandleFromLevel LogSource -> Handle
otherLevelToHandle = \case
  LogLevel
LevelDebug -> Handle
stdout
  LogLevel
LevelInfo -> Handle
stdout
  LogLevel
LevelWarn -> Handle
stderr
  LogLevel
LevelError -> Handle
stderr
  LevelOther LogSource
otherLevel -> LogSource -> Handle
otherLevelToHandle LogSource
otherLevel

-- $synopsis
--
-- @monad-logger-aeson@ provides structured JSON logging using @monad-logger@'s
-- interface. Specifically, it is intended to be a (largely) drop-in replacement
-- for @monad-logger@'s "Control.Monad.Logger.CallStack" module.
--
-- In brief, this program:
--
-- > {-# LANGUAGE BlockArguments #-}
-- > {-# LANGUAGE OverloadedStrings #-}
-- > module Main
-- >   ( main
-- >   ) where
-- >
-- > import Control.Monad.Logger.Aeson
-- >
-- > doStuff :: (MonadLogger m) => Int -> m ()
-- > doStuff x = do
-- >   logDebug $ "Doing stuff" :# ["x" .= x]
-- >
-- > main :: IO ()
-- > main = do
-- >   runStdoutLoggingT do
-- >     doStuff 42
-- >     logInfo "Done"
--
-- Would produce this output (formatted for readability here with @jq@):
--
-- > {
-- >   "time": "2022-05-15T20:52:15.5559417Z",
-- >   "level": "debug",
-- >   "location": {
-- >     "package": "main",
-- >     "module": "Main",
-- >     "file": "app/readme-example.hs",
-- >     "line": 11,
-- >     "char": 3
-- >   },
-- >   "message": {
-- >     "text": "Doing stuff",
-- >     "meta": {
-- >       "x": 42
-- >     }
-- >   }
-- > }
-- > {
-- >   "time": "2022-05-15T20:52:15.5560448Z",
-- >   "level": "info",
-- >   "location": {
-- >     "package": "main",
-- >     "module": "Main",
-- >     "file": "app/readme-example.hs",
-- >     "line": 17,
-- >     "char": 5
-- >   },
-- >   "message": {
-- >     "text": "Done"
-- >   }
-- > }
--
-- For additional detail on the library, please see the remainder of these
-- Haddocks and the following external resources:
--
-- * [README](https://github.com/jship/monad-logger-aeson/blob/main/monad-logger-aeson/README.md)
-- * [Announcement blog post](https://jship.github.io/posts/2022-05-17-announcing-monad-logger-aeson/)