{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
module Control.Monad.Logger.Aeson.Internal
  ( -- * Disclaimer
    -- $disclaimer

    -- ** @Message@-related
    Message(..)
  , SeriesElem(..)
  , LoggedMessage(..)
  , threadContextStore
  , logCS
  , OutputOptions(..)
  , defaultLogStrBS
  , defaultLogStrLBS
  , messageEncoding
  , messageSeries

    -- ** @LogItem@-related
  , LogItem(..)
  , logItemEncoding

    -- ** Encoding-related
  , pairsEncoding
  , pairsSeries
  , levelEncoding
  , locEncoding

    -- ** @monad-logger@ internals
  , mkLoggerLoc
  , locFromCS
  , isDefaultLoc

    -- ** Aeson compat
  , Key
  , KeyMap
  , emptyKeyMap
  , keyMapFromList
  , keyMapToList
  , keyMapInsert
  , keyMapUnion
  ) where

import Context (Store)
import Control.Applicative (Applicative(liftA2))
import Control.Monad.Logger (Loc(..), LogLevel(..), MonadLogger(..), ToLogStr(..), LogSource)
import Data.Aeson (KeyValue((.=)), Value(Object), (.:), (.:?), Encoding, FromJSON, ToJSON)
import Data.Aeson.Encoding.Internal (Series(..))
import Data.Aeson.Types (Pair, Parser)
import Data.String (IsString)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import GHC.Stack (SrcLoc(..), CallStack, getCallStack)
import qualified Context
import qualified Control.Monad.Logger as Logger
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Maybe as Maybe
import qualified Data.String as String
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Text.Encoding.Error as Text.Encoding.Error
import qualified System.IO.Unsafe as IO.Unsafe

#if MIN_VERSION_fast_logger(3,0,1)
import System.Log.FastLogger.Internal (LogStr(..))
#else
import System.Log.FastLogger (LogStr, fromLogStr)
#endif

#if MIN_VERSION_aeson(2, 0, 0)
import Data.Aeson.Key (Key)
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as AesonCompat
#else
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as AesonCompat
type Key = Text
type KeyMap v = HashMap Key v
#endif

emptyKeyMap :: KeyMap v
emptyKeyMap :: KeyMap v
emptyKeyMap = KeyMap v
forall v. KeyMap v
AesonCompat.empty

keyMapFromList :: [(Key, v)] -> KeyMap v
keyMapFromList :: [(Key, v)] -> KeyMap v
keyMapFromList = [(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
AesonCompat.fromList

keyMapToList :: KeyMap v -> [(Key, v)]
keyMapToList :: KeyMap v -> [(Key, v)]
keyMapToList = KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
AesonCompat.toList

keyMapInsert :: Key -> v -> KeyMap v -> KeyMap v
keyMapInsert :: Key -> v -> KeyMap v -> KeyMap v
keyMapInsert = Key -> v -> KeyMap v -> KeyMap v
forall v. Key -> v -> KeyMap v -> KeyMap v
AesonCompat.insert

keyMapUnion :: KeyMap v -> KeyMap v -> KeyMap v
keyMapUnion :: KeyMap v -> KeyMap v -> KeyMap v
keyMapUnion = KeyMap v -> KeyMap v -> KeyMap v
forall v. KeyMap v -> KeyMap v -> KeyMap v
AesonCompat.union

-- | A single key-value pair, where the value is encoded JSON. This is a more
-- restricted version of 'Series': a 'SeriesElem' is intended to encapsulate
-- exactly one key-value pair, whereas a 'Series' encapsulates zero or more
-- key-value pairs. 'SeriesElem' values can be created via '(.=)' from @aeson@.
--
-- While a 'SeriesElem' most often will map to a single pair, note that a
-- 'Semigroup' instance is available for performance's sake. The 'Semigroup'
-- instance is useful when multiple pairs are grouped together and then shared
-- across multiple logging calls. In that case, the cost of combining the pairs
-- in the group must only be paid once.
--
-- @since 0.3.0.0
newtype SeriesElem = UnsafeSeriesElem
  { SeriesElem -> Series
unSeriesElem :: Series
  }

-- | @since 0.3.0.0
deriving newtype instance KeyValue SeriesElem
-- | @since 0.3.1.0
deriving newtype instance Semigroup SeriesElem

-- | This type is the Haskell representation of each JSON log message produced
-- by this library.
--
-- While we never interact with this type directly when logging messages with
-- @monad-logger-aeson@, we may wish to use this type if we are
-- parsing/processing log files generated by this library.
--
-- @since 0.1.0.0
data LoggedMessage = LoggedMessage
  { LoggedMessage -> UTCTime
loggedMessageTimestamp :: UTCTime
  , LoggedMessage -> LogLevel
loggedMessageLevel :: LogLevel
  , LoggedMessage -> Maybe Loc
loggedMessageLoc :: Maybe Loc
  , LoggedMessage -> Maybe LogSource
loggedMessageLogSource :: Maybe LogSource
  , LoggedMessage -> KeyMap Value
loggedMessageThreadContext :: KeyMap Value
  , LoggedMessage -> LogSource
loggedMessageText :: Text
  , LoggedMessage -> KeyMap Value
loggedMessageMeta :: KeyMap Value
  } deriving stock (LoggedMessage -> LoggedMessage -> Bool
(LoggedMessage -> LoggedMessage -> Bool)
-> (LoggedMessage -> LoggedMessage -> Bool) -> Eq LoggedMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoggedMessage -> LoggedMessage -> Bool
$c/= :: LoggedMessage -> LoggedMessage -> Bool
== :: LoggedMessage -> LoggedMessage -> Bool
$c== :: LoggedMessage -> LoggedMessage -> Bool
Eq, (forall x. LoggedMessage -> Rep LoggedMessage x)
-> (forall x. Rep LoggedMessage x -> LoggedMessage)
-> Generic LoggedMessage
forall x. Rep LoggedMessage x -> LoggedMessage
forall x. LoggedMessage -> Rep LoggedMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoggedMessage x -> LoggedMessage
$cfrom :: forall x. LoggedMessage -> Rep LoggedMessage x
Generic, Eq LoggedMessage
Eq LoggedMessage
-> (LoggedMessage -> LoggedMessage -> Ordering)
-> (LoggedMessage -> LoggedMessage -> Bool)
-> (LoggedMessage -> LoggedMessage -> Bool)
-> (LoggedMessage -> LoggedMessage -> Bool)
-> (LoggedMessage -> LoggedMessage -> Bool)
-> (LoggedMessage -> LoggedMessage -> LoggedMessage)
-> (LoggedMessage -> LoggedMessage -> LoggedMessage)
-> Ord LoggedMessage
LoggedMessage -> LoggedMessage -> Bool
LoggedMessage -> LoggedMessage -> Ordering
LoggedMessage -> LoggedMessage -> LoggedMessage
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
min :: LoggedMessage -> LoggedMessage -> LoggedMessage
$cmin :: LoggedMessage -> LoggedMessage -> LoggedMessage
max :: LoggedMessage -> LoggedMessage -> LoggedMessage
$cmax :: LoggedMessage -> LoggedMessage -> LoggedMessage
>= :: LoggedMessage -> LoggedMessage -> Bool
$c>= :: LoggedMessage -> LoggedMessage -> Bool
> :: LoggedMessage -> LoggedMessage -> Bool
$c> :: LoggedMessage -> LoggedMessage -> Bool
<= :: LoggedMessage -> LoggedMessage -> Bool
$c<= :: LoggedMessage -> LoggedMessage -> Bool
< :: LoggedMessage -> LoggedMessage -> Bool
$c< :: LoggedMessage -> LoggedMessage -> Bool
compare :: LoggedMessage -> LoggedMessage -> Ordering
$ccompare :: LoggedMessage -> LoggedMessage -> Ordering
$cp1Ord :: Eq LoggedMessage
Ord, Int -> LoggedMessage -> ShowS
[LoggedMessage] -> ShowS
LoggedMessage -> String
(Int -> LoggedMessage -> ShowS)
-> (LoggedMessage -> String)
-> ([LoggedMessage] -> ShowS)
-> Show LoggedMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoggedMessage] -> ShowS
$cshowList :: [LoggedMessage] -> ShowS
show :: LoggedMessage -> String
$cshow :: LoggedMessage -> String
showsPrec :: Int -> LoggedMessage -> ShowS
$cshowsPrec :: Int -> LoggedMessage -> ShowS
Show)

instance FromJSON LoggedMessage where
  parseJSON :: Value -> Parser LoggedMessage
parseJSON = String
-> (KeyMap Value -> Parser LoggedMessage)
-> Value
-> Parser LoggedMessage
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
Aeson.withObject String
"LoggedMessage" ((KeyMap Value -> Parser LoggedMessage)
 -> Value -> Parser LoggedMessage)
-> (KeyMap Value -> Parser LoggedMessage)
-> Value
-> Parser LoggedMessage
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
obj -> do
    UTCTime
loggedMessageTimestamp <- KeyMap Value
obj KeyMap Value -> Key -> Parser UTCTime
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"time"
    LogLevel
loggedMessageLevel <- (LogSource -> LogLevel) -> Parser LogSource -> Parser LogLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LogSource -> LogLevel
logLevelFromText (Parser LogSource -> Parser LogLevel)
-> Parser LogSource -> Parser LogLevel
forall a b. (a -> b) -> a -> b
$ KeyMap Value
obj KeyMap Value -> Key -> Parser LogSource
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"level"
    Maybe Loc
loggedMessageLoc <- Maybe Value -> Parser (Maybe Loc)
parseLoc (Maybe Value -> Parser (Maybe Loc))
-> Parser (Maybe Value) -> Parser (Maybe Loc)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KeyMap Value
obj KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"location"
    Maybe LogSource
loggedMessageLogSource <- KeyMap Value
obj KeyMap Value -> Key -> Parser (Maybe LogSource)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"source"
    KeyMap Value
loggedMessageThreadContext <- Maybe Value -> Parser (KeyMap Value)
parsePairs (Maybe Value -> Parser (KeyMap Value))
-> Parser (Maybe Value) -> Parser (KeyMap Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KeyMap Value
obj KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"context"
    (LogSource
loggedMessageText, KeyMap Value
loggedMessageMeta) <- Value -> Parser (LogSource, KeyMap Value)
parseMessage (Value -> Parser (LogSource, KeyMap Value))
-> Parser Value -> Parser (LogSource, KeyMap Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KeyMap Value
obj KeyMap Value -> Key -> Parser Value
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"message"
    LoggedMessage -> Parser LoggedMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggedMessage :: UTCTime
-> LogLevel
-> Maybe Loc
-> Maybe LogSource
-> KeyMap Value
-> LogSource
-> KeyMap Value
-> LoggedMessage
LoggedMessage
      { UTCTime
loggedMessageTimestamp :: UTCTime
loggedMessageTimestamp :: UTCTime
loggedMessageTimestamp
      , LogLevel
loggedMessageLevel :: LogLevel
loggedMessageLevel :: LogLevel
loggedMessageLevel
      , Maybe Loc
loggedMessageLoc :: Maybe Loc
loggedMessageLoc :: Maybe Loc
loggedMessageLoc
      , Maybe LogSource
loggedMessageLogSource :: Maybe LogSource
loggedMessageLogSource :: Maybe LogSource
loggedMessageLogSource
      , KeyMap Value
loggedMessageThreadContext :: KeyMap Value
loggedMessageThreadContext :: KeyMap Value
loggedMessageThreadContext
      , LogSource
loggedMessageText :: LogSource
loggedMessageText :: LogSource
loggedMessageText
      , KeyMap Value
loggedMessageMeta :: KeyMap Value
loggedMessageMeta :: KeyMap Value
loggedMessageMeta
      }
    where
    logLevelFromText :: Text -> LogLevel
    logLevelFromText :: LogSource -> LogLevel
logLevelFromText = \case
      LogSource
"debug" -> LogLevel
LevelDebug
      LogSource
"info" -> LogLevel
LevelInfo
      LogSource
"warn" -> LogLevel
LevelWarn
      LogSource
"error" -> LogLevel
LevelError
      LogSource
other -> LogSource -> LogLevel
LevelOther LogSource
other

    parseLoc :: Maybe Value -> Parser (Maybe Loc)
    parseLoc :: Maybe Value -> Parser (Maybe Loc)
parseLoc =
      (Value -> Parser Loc) -> Maybe Value -> Parser (Maybe Loc)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Value -> Parser Loc) -> Maybe Value -> Parser (Maybe Loc))
-> (Value -> Parser Loc) -> Maybe Value -> Parser (Maybe Loc)
forall a b. (a -> b) -> a -> b
$ String -> (KeyMap Value -> Parser Loc) -> Value -> Parser Loc
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Loc" ((KeyMap Value -> Parser Loc) -> Value -> Parser Loc)
-> (KeyMap Value -> Parser Loc) -> Value -> Parser Loc
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
obj ->
        String -> String -> String -> CharPos -> CharPos -> Loc
Loc
          (String -> String -> String -> CharPos -> CharPos -> Loc)
-> Parser String
-> Parser (String -> String -> CharPos -> CharPos -> Loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
obj KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"file"
          Parser (String -> String -> CharPos -> CharPos -> Loc)
-> Parser String -> Parser (String -> CharPos -> CharPos -> Loc)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
obj KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"package"
          Parser (String -> CharPos -> CharPos -> Loc)
-> Parser String -> Parser (CharPos -> CharPos -> Loc)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
obj KeyMap Value -> Key -> Parser String
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"module"
          Parser (CharPos -> CharPos -> Loc)
-> Parser CharPos -> Parser (CharPos -> Loc)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int -> Int -> CharPos)
-> Parser Int -> Parser Int -> Parser CharPos
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (KeyMap Value
obj KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"line") (KeyMap Value
obj KeyMap Value -> Key -> Parser Int
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"char"))
          Parser (CharPos -> Loc) -> Parser CharPos -> Parser Loc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CharPos -> Parser CharPos
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0)

    parsePairs :: Maybe Value -> Parser (KeyMap Value)
    parsePairs :: Maybe Value -> Parser (KeyMap Value)
parsePairs = \case
      Maybe Value
Nothing -> KeyMap Value -> Parser (KeyMap Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
forall a. Monoid a => a
mempty
      Just Value
value -> ((KeyMap Value -> Parser (KeyMap Value))
 -> Value -> Parser (KeyMap Value))
-> Value
-> (KeyMap Value -> Parser (KeyMap Value))
-> Parser (KeyMap Value)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (KeyMap Value -> Parser (KeyMap Value))
-> Value
-> Parser (KeyMap Value)
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
Aeson.withObject String
"[Pair]") Value
value ((KeyMap Value -> Parser (KeyMap Value)) -> Parser (KeyMap Value))
-> (KeyMap Value -> Parser (KeyMap Value)) -> Parser (KeyMap Value)
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
obj -> do
        KeyMap Value -> Parser (KeyMap Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
obj

    parseMessage :: Value -> Parser (Text, KeyMap Value)
    parseMessage :: Value -> Parser (LogSource, KeyMap Value)
parseMessage = String
-> (KeyMap Value -> Parser (LogSource, KeyMap Value))
-> Value
-> Parser (LogSource, KeyMap Value)
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Message" ((KeyMap Value -> Parser (LogSource, KeyMap Value))
 -> Value -> Parser (LogSource, KeyMap Value))
-> (KeyMap Value -> Parser (LogSource, KeyMap Value))
-> Value
-> Parser (LogSource, KeyMap Value)
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
obj ->
      (,) (LogSource -> KeyMap Value -> (LogSource, KeyMap Value))
-> Parser LogSource
-> Parser (KeyMap Value -> (LogSource, KeyMap Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
obj KeyMap Value -> Key -> Parser LogSource
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"text" Parser (KeyMap Value -> (LogSource, KeyMap Value))
-> Parser (KeyMap Value) -> Parser (LogSource, KeyMap Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Value -> Parser (KeyMap Value)
parsePairs (Maybe Value -> Parser (KeyMap Value))
-> Parser (Maybe Value) -> Parser (KeyMap Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KeyMap Value
obj KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"meta")

instance ToJSON LoggedMessage where
  toJSON :: LoggedMessage -> Value
toJSON LoggedMessage
loggedMessage =
    [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
      [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"time" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime
loggedMessageTimestamp
      , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"level" Key -> LogSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogLevel -> LogSource
logLevelToText LogLevel
loggedMessageLevel
      , case Maybe Loc
loggedMessageLoc of
          Maybe Loc
Nothing -> Maybe Pair
forall a. Maybe a
Nothing
          Just Loc
loc -> Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"location" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Loc -> Value
locToJSON Loc
loc
      , case Maybe LogSource
loggedMessageLogSource of
          Maybe LogSource
Nothing -> Maybe Pair
forall a. Maybe a
Nothing
          Just LogSource
logSource -> Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"source" Key -> LogSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogSource
logSource
      , if KeyMap Value
loggedMessageThreadContext KeyMap Value -> KeyMap Value -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMap Value
forall a. Monoid a => a
mempty then
          Maybe Pair
forall a. Maybe a
Nothing
        else
          Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"context" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= KeyMap Value -> Value
Object KeyMap Value
loggedMessageThreadContext
      , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
messageJSON
      ]
    where
    locToJSON :: Loc -> Value
    locToJSON :: Loc -> Value
locToJSON Loc
loc =
      [Pair] -> Value
Aeson.object
        [ Key
"package" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
loc_package
        , Key
"module" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
loc_module
        , Key
"file" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
loc_filename
        , Key
"line" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CharPos -> Int
forall a b. (a, b) -> a
fst CharPos
loc_start
        , Key
"char" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CharPos -> Int
forall a b. (a, b) -> b
snd CharPos
loc_start
        ]
      where
      Loc { String
loc_filename :: Loc -> String
loc_filename :: String
loc_filename, String
loc_package :: Loc -> String
loc_package :: String
loc_package, String
loc_module :: Loc -> String
loc_module :: String
loc_module, CharPos
loc_start :: Loc -> CharPos
loc_start :: CharPos
loc_start } = Loc
loc

    messageJSON :: Value
    messageJSON :: Value
messageJSON =
      [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
        [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"text" Key -> LogSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogSource
loggedMessageText
        , if KeyMap Value
loggedMessageMeta KeyMap Value -> KeyMap Value -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMap Value
forall a. Monoid a => a
mempty then
            Maybe Pair
forall a. Maybe a
Nothing
          else
            Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"meta" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= KeyMap Value -> Value
Object KeyMap Value
loggedMessageMeta
        ]

    LoggedMessage
      { UTCTime
loggedMessageTimestamp :: UTCTime
loggedMessageTimestamp :: LoggedMessage -> UTCTime
loggedMessageTimestamp
      , LogLevel
loggedMessageLevel :: LogLevel
loggedMessageLevel :: LoggedMessage -> LogLevel
loggedMessageLevel
      , Maybe Loc
loggedMessageLoc :: Maybe Loc
loggedMessageLoc :: LoggedMessage -> Maybe Loc
loggedMessageLoc
      , Maybe LogSource
loggedMessageLogSource :: Maybe LogSource
loggedMessageLogSource :: LoggedMessage -> Maybe LogSource
loggedMessageLogSource
      , KeyMap Value
loggedMessageThreadContext :: KeyMap Value
loggedMessageThreadContext :: LoggedMessage -> KeyMap Value
loggedMessageThreadContext
      , LogSource
loggedMessageText :: LogSource
loggedMessageText :: LoggedMessage -> LogSource
loggedMessageText
      , KeyMap Value
loggedMessageMeta :: KeyMap Value
loggedMessageMeta :: LoggedMessage -> KeyMap Value
loggedMessageMeta
      } = LoggedMessage
loggedMessage

  toEncoding :: LoggedMessage -> Encoding
toEncoding LoggedMessage
loggedMessage = LogItem -> Encoding
logItemEncoding LogItem
logItem
    where
    logItem :: LogItem
logItem =
      LogItem :: UTCTime
-> Loc
-> LogSource
-> LogLevel
-> KeyMap Value
-> Encoding
-> LogItem
LogItem
        { logItemTimestamp :: UTCTime
logItemTimestamp = UTCTime
loggedMessageTimestamp
        , logItemLoc :: Loc
logItemLoc = Loc -> Maybe Loc -> Loc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Loc
Logger.defaultLoc Maybe Loc
loggedMessageLoc
        , logItemLogSource :: LogSource
logItemLogSource = LogSource -> Maybe LogSource -> LogSource
forall a. a -> Maybe a -> a
Maybe.fromMaybe LogSource
"" Maybe LogSource
loggedMessageLogSource
        , logItemLevel :: LogLevel
logItemLevel = LogLevel
loggedMessageLevel
        , logItemThreadContext :: KeyMap Value
logItemThreadContext = KeyMap Value
loggedMessageThreadContext
        , logItemMessageEncoding :: Encoding
logItemMessageEncoding =
            Message -> Encoding
messageEncoding (Message -> Encoding) -> Message -> Encoding
forall a b. (a -> b) -> a -> b
$
              LogSource
loggedMessageText LogSource -> [SeriesElem] -> Message
:# KeyMap Value -> [SeriesElem]
keyMapToSeriesList KeyMap Value
loggedMessageMeta
        }

    keyMapToSeriesList :: KeyMap Value -> [SeriesElem]
    keyMapToSeriesList :: KeyMap Value -> [SeriesElem]
keyMapToSeriesList =
      (Pair -> SeriesElem) -> [Pair] -> [SeriesElem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Value -> SeriesElem) -> Pair -> SeriesElem
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> SeriesElem
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
(.=)) ([Pair] -> [SeriesElem])
-> (KeyMap Value -> [Pair]) -> KeyMap Value -> [SeriesElem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Value -> [Pair]
forall v. KeyMap v -> [(Key, v)]
keyMapToList

    LoggedMessage
      { UTCTime
loggedMessageTimestamp :: UTCTime
loggedMessageTimestamp :: LoggedMessage -> UTCTime
loggedMessageTimestamp
      , LogLevel
loggedMessageLevel :: LogLevel
loggedMessageLevel :: LoggedMessage -> LogLevel
loggedMessageLevel
      , Maybe Loc
loggedMessageLoc :: Maybe Loc
loggedMessageLoc :: LoggedMessage -> Maybe Loc
loggedMessageLoc
      , Maybe LogSource
loggedMessageLogSource :: Maybe LogSource
loggedMessageLogSource :: LoggedMessage -> Maybe LogSource
loggedMessageLogSource
      , KeyMap Value
loggedMessageThreadContext :: KeyMap Value
loggedMessageThreadContext :: LoggedMessage -> KeyMap Value
loggedMessageThreadContext
      , LogSource
loggedMessageText :: LogSource
loggedMessageText :: LoggedMessage -> LogSource
loggedMessageText
      , KeyMap Value
loggedMessageMeta :: KeyMap Value
loggedMessageMeta :: LoggedMessage -> KeyMap Value
loggedMessageMeta
      } = LoggedMessage
loggedMessage

-- | A 'Message' captures a textual component and a metadata component. The
-- metadata component is a list of 'SeriesElem' to support tacking on arbitrary
-- structured data to a log message.
--
-- With the @OverloadedStrings@ extension enabled, 'Message' values can be
-- constructed without metadata fairly conveniently, just as if we were using
-- 'Text' directly:
--
-- > logDebug "Some log message without metadata"
--
-- Metadata may be included in a 'Message' via the ':#' constructor:
--
-- @
-- 'Control.Monad.Logger.Aeson.logDebug' $ "Some log message with metadata" ':#'
--   [ "bloorp" '.=' (42 :: 'Int')
--   , "bonk" '.=' ("abc" :: 'Text')
--   ]
-- @
--
-- The mnemonic for the ':#' constructor is that the @#@ symbol is sometimes
-- referred to as a hash, a JSON object can be thought of as a hash map, and
-- so with @:#@ (and enough squinting), we are @cons@-ing a textual message onto
-- a JSON object. Yes, this mnemonic isn't well-typed, but hopefully it still
-- helps!
--
-- @since 0.1.0.0
data Message = Text :# [SeriesElem]
infixr 5 :#

instance IsString Message where
  fromString :: String -> Message
fromString String
string = String -> LogSource
Text.pack String
string LogSource -> [SeriesElem] -> Message
:# []

instance ToLogStr Message where
  toLogStr :: Message -> LogStr
toLogStr = ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr)
-> (Message -> ByteString) -> Message -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
forall a. Encoding' a -> ByteString
Aeson.encodingToLazyByteString (Encoding -> ByteString)
-> (Message -> Encoding) -> Message -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Encoding
messageEncoding

-- | Thread-safe, global 'Store' that captures the thread context of messages.
--
-- Note that there is a bit of somewhat unavoidable name-overloading here: this
-- binding is called 'threadContextStore' because it stores the thread context
-- (i.e. @ThreadContext@/@MDC@ from Java land) for messages. It also just so
-- happens that the 'Store' type comes from the @context@ package, which is a
-- package providing thread-indexed storage of arbitrary context values. Please
-- don't hate the player!
--
-- @since 0.1.0.0
threadContextStore :: Store (KeyMap Value)
threadContextStore :: Store (KeyMap Value)
threadContextStore =
  IO (Store (KeyMap Value)) -> Store (KeyMap Value)
forall a. IO a -> a
IO.Unsafe.unsafePerformIO
    (IO (Store (KeyMap Value)) -> Store (KeyMap Value))
-> IO (Store (KeyMap Value)) -> Store (KeyMap Value)
forall a b. (a -> b) -> a -> b
$ PropagationStrategy
-> Maybe (KeyMap Value) -> IO (Store (KeyMap Value))
forall (m :: * -> *) ctx.
MonadIO m =>
PropagationStrategy -> Maybe ctx -> m (Store ctx)
Context.newStore PropagationStrategy
Context.noPropagation
    (Maybe (KeyMap Value) -> IO (Store (KeyMap Value)))
-> Maybe (KeyMap Value) -> IO (Store (KeyMap Value))
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> Maybe (KeyMap Value)
forall a. a -> Maybe a
Just
    (KeyMap Value -> Maybe (KeyMap Value))
-> KeyMap Value -> Maybe (KeyMap Value)
forall a b. (a -> b) -> a -> b
$ KeyMap Value
forall v. KeyMap v
emptyKeyMap
{-# NOINLINE threadContextStore #-}

-- | 'OutputOptions' is for use with
-- 'Control.Monad.Logger.Aeson.defaultOutputWith' and enables us to configure
-- the JSON output produced by this library.
--
-- We can get a hold of a value of this type via
-- 'Control.Monad.Logger.Aeson.defaultOutputOptions'.
--
-- @since 0.1.0.0
data OutputOptions = OutputOptions
  { OutputOptions -> LogLevel -> ByteString -> IO ()
outputAction :: LogLevel -> BS8.ByteString -> IO ()
  , -- | Controls whether or not the thread ID is included in each log message's
    -- thread context.
    --
    -- Default: 'False'
    --
    -- @since 0.1.0.0
    OutputOptions -> Bool
outputIncludeThreadId :: Bool
  , -- | Allows for setting a "base" thread context, i.e. a set of 'Pair' that
    -- will always be present in log messages.
    --
    -- If we subsequently use 'Control.Monad.Logger.Aeson.withThreadContext' to
    -- register some thread context for our messages, if any of the keys in
    -- those 'Pair' values overlap with the "base" thread context, then the
    -- overlapped 'Pair' values in the "base" thread context will be overridden
    -- for the duration of the action provided to
    -- 'Control.Monad.Logger.Aeson.withThreadContext'.
    --
    -- Default: 'mempty'
    --
    -- @since 0.1.0.0
    OutputOptions -> [Pair]
outputBaseThreadContext :: [Pair]
  }

defaultLogStrBS
  :: UTCTime
  -> KeyMap Value
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> BS8.ByteString
defaultLogStrBS :: UTCTime
-> KeyMap Value
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> ByteString
defaultLogStrBS UTCTime
now KeyMap Value
threadContext Loc
loc LogSource
logSource LogLevel
logLevel LogStr
logStr =
  ByteString -> ByteString
LBS.toStrict
    (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ UTCTime
-> KeyMap Value
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> ByteString
defaultLogStrLBS UTCTime
now KeyMap Value
threadContext Loc
loc LogSource
logSource LogLevel
logLevel LogStr
logStr

defaultLogStrLBS
  :: UTCTime
  -> KeyMap Value
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> LBS8.ByteString
defaultLogStrLBS :: UTCTime
-> KeyMap Value
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> ByteString
defaultLogStrLBS UTCTime
now KeyMap Value
threadContext Loc
loc LogSource
logSource LogLevel
logLevel LogStr
logStr =
  Encoding -> ByteString
forall a. Encoding' a -> ByteString
Aeson.encodingToLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ LogItem -> Encoding
logItemEncoding LogItem
logItem
  where
  logItem :: LogItem
  logItem :: LogItem
logItem =
    case Int64 -> ByteString -> ByteString
LBS8.take Int64
9 ByteString
logStrLBS of
      ByteString
"{\"text\":\"" ->
        Encoding -> LogItem
mkLogItem
          (Encoding -> LogItem) -> Encoding -> LogItem
forall a b. (a -> b) -> a -> b
$ Builder -> Encoding
forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding
          (Builder -> Encoding) -> Builder -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
Builder.lazyByteString ByteString
logStrLBS
      ByteString
_ ->
        Encoding -> LogItem
mkLogItem
          (Encoding -> LogItem) -> Encoding -> LogItem
forall a b. (a -> b) -> a -> b
$ Message -> Encoding
messageEncoding
          (Message -> Encoding) -> Message -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> LogSource
decodeLenient ByteString
logStrLBS LogSource -> [SeriesElem] -> Message
:# []

  mkLogItem :: Encoding -> LogItem
  mkLogItem :: Encoding -> LogItem
mkLogItem Encoding
messageEnc =
    LogItem :: UTCTime
-> Loc
-> LogSource
-> LogLevel
-> KeyMap Value
-> Encoding
-> LogItem
LogItem
      { logItemTimestamp :: UTCTime
logItemTimestamp = UTCTime
now
      , logItemLoc :: Loc
logItemLoc = Loc
loc
      , logItemLogSource :: LogSource
logItemLogSource = LogSource
logSource
      , logItemLevel :: LogLevel
logItemLevel = LogLevel
logLevel
      , logItemThreadContext :: KeyMap Value
logItemThreadContext = KeyMap Value
threadContext
      , logItemMessageEncoding :: Encoding
logItemMessageEncoding = Encoding
messageEnc
      }

  decodeLenient :: ByteString -> LogSource
decodeLenient =
    OnDecodeError -> ByteString -> LogSource
Text.Encoding.decodeUtf8With OnDecodeError
Text.Encoding.Error.lenientDecode
      (ByteString -> LogSource)
-> (ByteString -> ByteString) -> ByteString -> LogSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict

  logStrLBS :: ByteString
logStrLBS = LogStr -> ByteString
logStrToLBS LogStr
logStr

logStrToLBS :: LogStr -> LBS.ByteString
logStrToLBS :: LogStr -> ByteString
logStrToLBS =
#if MIN_VERSION_fast_logger(3,0,1)
  -- Use (presumably) faster/better conversion if we have new enough fast-logger
  Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (LogStr -> Builder) -> LogStr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> Builder
unLogStr
   where
    unLogStr :: LogStr -> Builder
unLogStr (LogStr Int
_ Builder
builder) = Builder
builder
#else
  LBS.fromStrict . fromLogStr
#endif

logCS
  :: (MonadLogger m)
  => CallStack
  -> LogSource
  -> LogLevel
  -> Message
  -> m ()
logCS :: CallStack -> LogSource -> LogLevel -> Message -> m ()
logCS CallStack
cs LogSource
logSource LogLevel
logLevel Message
msg =
  Loc -> LogSource -> LogLevel -> LogStr -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> m ()
monadLoggerLog (CallStack -> Loc
locFromCS CallStack
cs) LogSource
logSource LogLevel
logLevel (LogStr -> m ()) -> LogStr -> m ()
forall a b. (a -> b) -> a -> b
$ Message -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Message
msg

data LogItem = LogItem
  { LogItem -> UTCTime
logItemTimestamp :: UTCTime
  , LogItem -> Loc
logItemLoc :: Loc
  , LogItem -> LogSource
logItemLogSource :: LogSource
  , LogItem -> LogLevel
logItemLevel :: LogLevel
  , LogItem -> KeyMap Value
logItemThreadContext :: KeyMap Value
  , LogItem -> Encoding
logItemMessageEncoding :: Encoding
  }

logItemEncoding :: LogItem -> Encoding
logItemEncoding :: LogItem -> Encoding
logItemEncoding LogItem
logItem =
  Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
    (String -> Encoding -> Series
Aeson.pairStr String
"time" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ UTCTime -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding UTCTime
logItemTimestamp)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (String -> Encoding -> Series
Aeson.pairStr String
"level" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ LogLevel -> Encoding
levelEncoding LogLevel
logItemLevel)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> ( if Loc -> Bool
isDefaultLoc Loc
logItemLoc then
             Series
forall a. Monoid a => a
mempty
           else
             String -> Encoding -> Series
Aeson.pairStr String
"location" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ Loc -> Encoding
locEncoding Loc
logItemLoc
         )
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> ( if LogSource -> Bool
Text.null LogSource
logItemLogSource then
             Series
forall a. Monoid a => a
mempty
           else
             String -> Encoding -> Series
Aeson.pairStr String
"source" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ LogSource -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding LogSource
logItemLogSource
         )
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> ( if KeyMap Value -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null KeyMap Value
logItemThreadContext then
             Series
forall a. Monoid a => a
mempty
           else
             String -> Encoding -> Series
Aeson.pairStr String
"context" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding KeyMap Value
logItemThreadContext
         )
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (String -> Encoding -> Series
Aeson.pairStr String
"message" Encoding
logItemMessageEncoding)
  where
  LogItem
    { UTCTime
logItemTimestamp :: UTCTime
logItemTimestamp :: LogItem -> UTCTime
logItemTimestamp
    , Loc
logItemLoc :: Loc
logItemLoc :: LogItem -> Loc
logItemLoc
    , LogSource
logItemLogSource :: LogSource
logItemLogSource :: LogItem -> LogSource
logItemLogSource
    , LogLevel
logItemLevel :: LogLevel
logItemLevel :: LogItem -> LogLevel
logItemLevel
    , KeyMap Value
logItemThreadContext :: KeyMap Value
logItemThreadContext :: LogItem -> KeyMap Value
logItemThreadContext
    , Encoding
logItemMessageEncoding :: Encoding
logItemMessageEncoding :: LogItem -> Encoding
logItemMessageEncoding
    } = LogItem
logItem

messageEncoding :: Message -> Encoding
messageEncoding :: Message -> Encoding
messageEncoding  = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> (Message -> Series) -> Message -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Series
messageSeries

messageSeries :: Message -> Series
messageSeries :: Message -> Series
messageSeries Message
message =
  Key
"text" Key -> LogSource -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogSource
messageText
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> ( if [SeriesElem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SeriesElem]
messageMeta then
           Series
forall a. Monoid a => a
mempty
         else
           String -> Encoding -> Series
Aeson.pairStr String
"meta" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (SeriesElem -> Series) -> [SeriesElem] -> Series
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SeriesElem -> Series
unSeriesElem [SeriesElem]
messageMeta
       )
  where
  LogSource
messageText :# [SeriesElem]
messageMeta = Message
message

pairsEncoding :: [Pair] -> Encoding
pairsEncoding :: [Pair] -> Encoding
pairsEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> ([Pair] -> Series) -> [Pair] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Series
pairsSeries

pairsSeries :: [Pair] -> Series
pairsSeries :: [Pair] -> Series
pairsSeries = [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> ([Pair] -> [Series]) -> [Pair] -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Series) -> [Pair] -> [Series]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Value -> Series) -> Pair -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
(.=))

levelEncoding :: LogLevel -> Encoding
levelEncoding :: LogLevel -> Encoding
levelEncoding = LogSource -> Encoding
forall a. LogSource -> Encoding' a
Aeson.text (LogSource -> Encoding)
-> (LogLevel -> LogSource) -> LogLevel -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> LogSource
logLevelToText

logLevelToText :: LogLevel -> Text
logLevelToText :: LogLevel -> LogSource
logLevelToText = \case
  LogLevel
LevelDebug -> LogSource
"debug"
  LogLevel
LevelInfo -> LogSource
"info"
  LogLevel
LevelWarn -> LogSource
"warn"
  LogLevel
LevelError -> LogSource
"error"
  LevelOther LogSource
otherLevel -> LogSource
otherLevel

locEncoding :: Loc -> Encoding
locEncoding :: Loc -> Encoding
locEncoding Loc
loc =
  Series -> Encoding
Aeson.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
    (String -> Encoding -> Series
Aeson.pairStr String
"package" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ String -> Encoding
forall a. String -> Encoding' a
Aeson.string String
loc_package)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (String -> Encoding -> Series
Aeson.pairStr String
"module" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ String -> Encoding
forall a. String -> Encoding' a
Aeson.string String
loc_module)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (String -> Encoding -> Series
Aeson.pairStr String
"file" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ String -> Encoding
forall a. String -> Encoding' a
Aeson.string String
loc_filename)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (String -> Encoding -> Series
Aeson.pairStr String
"line" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ Int -> Encoding
Aeson.int (Int -> Encoding) -> Int -> Encoding
forall a b. (a -> b) -> a -> b
$ CharPos -> Int
forall a b. (a, b) -> a
fst CharPos
loc_start)
      Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (String -> Encoding -> Series
Aeson.pairStr String
"char" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ Int -> Encoding
Aeson.int (Int -> Encoding) -> Int -> Encoding
forall a b. (a -> b) -> a -> b
$ CharPos -> Int
forall a b. (a, b) -> b
snd CharPos
loc_start)
  where
  Loc { String
loc_filename :: String
loc_filename :: Loc -> String
loc_filename, String
loc_package :: String
loc_package :: Loc -> String
loc_package, String
loc_module :: String
loc_module :: Loc -> String
loc_module, CharPos
loc_start :: CharPos
loc_start :: Loc -> CharPos
loc_start } = Loc
loc

-- | Not exported from 'monad-logger', so copied here.
mkLoggerLoc :: SrcLoc -> Loc
mkLoggerLoc :: SrcLoc -> Loc
mkLoggerLoc SrcLoc
loc =
  Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
Loc { loc_filename :: String
loc_filename = SrcLoc -> String
srcLocFile SrcLoc
loc
      , loc_package :: String
loc_package  = SrcLoc -> String
srcLocPackage SrcLoc
loc
      , loc_module :: String
loc_module   = SrcLoc -> String
srcLocModule SrcLoc
loc
      , loc_start :: CharPos
loc_start    = ( SrcLoc -> Int
srcLocStartLine SrcLoc
loc
                       , SrcLoc -> Int
srcLocStartCol SrcLoc
loc)
      , loc_end :: CharPos
loc_end      = ( SrcLoc -> Int
srcLocEndLine SrcLoc
loc
                       , SrcLoc -> Int
srcLocEndCol SrcLoc
loc)
      }

-- | Not exported from 'monad-logger', so copied here.
locFromCS :: CallStack -> Loc
locFromCS :: CallStack -> Loc
locFromCS CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
                 ((String
_, SrcLoc
loc):[(String, SrcLoc)]
_) -> SrcLoc -> Loc
mkLoggerLoc SrcLoc
loc
                 [(String, SrcLoc)]
_            -> Loc
Logger.defaultLoc

-- | Not exported from 'monad-logger', so copied here.
isDefaultLoc :: Loc -> Bool
isDefaultLoc :: Loc -> Bool
isDefaultLoc (Loc String
"<unknown>" String
"<unknown>" String
"<unknown>" (Int
0,Int
0) (Int
0,Int
0)) = Bool
True
isDefaultLoc Loc
_ = Bool
False

-- $disclaimer
--
-- In general, changes to this module will not be reflected in the library's
-- version updates. Direct use of this module should be done with care.