    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    -------------------------------------------
    -- |
    -- Module      : Lumberjack
    -- Copyright   : (c) Galois Inc. 2020
    -- Maintainer  : kquick@galois.com
    -- Stability   : experimental
    -- Portability : POSIX
    --
    -- This module defines a general logging facility that can be used to
    -- output log messages to various targets.
    --
    -- The 'LogAction' is the fundamental operation that decides how to
    -- log a provided message.
    --
    -- Code wishing to output a logged message simply uses the LogAction
    -- object:
    --
    -- > writeLog action msg
    --
    -- For convenience, the LogAction can be stored in the local operating
    -- monad context, from which it can be retrieved (and modified).  A
    -- monad which can supply a LogAction is a member of the HasLog class,
    -- and the 'writeLogM' function will automatically retrieve the
    -- LogAction from the monad and write to it:
    --
    -- > writeLogM msg
    --
    -- LogActions can be combined via Semigroup operations (<>) and the
    -- resulting LogAction will perform both actions with each message.
    -- The Monoidal mempty LogAction simply does nothing.  For example,
    -- logging to both a file and stdout can be done by @logToFile <>
    -- logToStdout@.
    --
    -- LogActions are also Contravariant (and Divisible and Decidable) to
    -- allow easy conversion of a LogAction for the base message type into
    -- a LogAction for a different message type (or types) that can be
    -- converted to (and combined into) the base message type.
    -------------------------------------------

    module Lumberjack
      ( -- * Interface for Logging
        LogAction(..)
      , HasLog(..)
      , LoggingMonad(..)
      , writeLogM
        -- * Logging Utilities
        --
        -- The following utility functions can be used to adjust or wrap
        -- LogActions to provide additional functionality.
      , safeLogAction
      , logFilter
        -- * LogMessage rich logging type
        -- $richMsgType
      , Severity(..)
      , LogType(..)
      , LogMessage(..)
      , msgWith
      , WithLog
      , withLogTag
      , addLogActionTime
        -- ** Output formatting for LogMessage
        -- $richMsgFormatting
      , cvtLogMessageToPlainText
      , cvtLogMessageToANSITermText
        -- * Helpers and convenience functions
        -- $helpers
      , (|#)
      , logFunctionCall, logFunctionCallM
      , logProgress, logProgressM
      , tshow
      , defaultGetIOLogAction
      )
    where

    import           Control.Monad (when)
    import qualified Control.Monad.Catch as X
    import           Control.Monad.IO.Class
    import           Data.Functor.Contravariant
    import           Data.Functor.Contravariant.Divisible
    import           Data.Monoid hiding ( (<>) )
    import           Data.Semigroup
    import           Data.Text ( Text, pack, empty )
    import qualified Data.Text as T
    import qualified Data.Text.IO as TIO
    import qualified Prettyprinter as PP
    import qualified Prettyprinter.Render.Terminal as PP_Term
    import qualified Prettyprinter.Render.Text as PP_Text
    import           Data.Time.Clock ( UTCTime(..), getCurrentTime, diffUTCTime )
    import           Data.Time.Format ( defaultTimeLocale, formatTime )
    import           Data.Void
    import           System.IO ( stderr )

    import           Prelude

    -- ----------------------------------------------------------------------

    -- * Interface for Logging

    -- | The LogAction holds the ability to log a message of type @msg@
    -- (the second parameter) via a monad @m@ (the first parameter).
    --
    -- LogActions are semigroup and monoid combineable, which results in
    -- both LogActions being taken (or no action in the case of mempty),
    -- and contravariant to allow the msg to be modified via function
    -- prior to being logged (as well as Divisible and Decidable).
    newtype LogAction m msg = LogAction { forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog :: msg -> m () }

    instance Applicative m => Semigroup (LogAction m a) where
      LogAction a -> m ()
    a1 <> :: LogAction m a -> LogAction m a -> LogAction m a
    <> LogAction a -> m ()
    a2 = (a -> m ()) -> LogAction m a
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> a -> m ()
    a1 a
    a m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> a -> m ()
    a2 a
    a

    instance Applicative m => Monoid (LogAction m a) where
      mappend :: LogAction m a -> LogAction m a -> LogAction m a
    mappend = LogAction m a -> LogAction m a -> LogAction m a
    forall a. Semigroup a => a -> a -> a
    (<>)
      mempty :: LogAction m a
    mempty = (a -> m ()) -> LogAction m a
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    instance Contravariant (LogAction m) where
      contramap :: forall a' a. (a' -> a) -> LogAction m a -> LogAction m a'
    contramap a' -> a
    f (LogAction a -> m ()
    a) = (a' -> m ()) -> LogAction m a'
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a' -> m ()) -> LogAction m a') -> (a' -> m ()) -> LogAction m a'
    forall a b. (a -> b) -> a -> b
    $ a -> m ()
    a (a -> m ()) -> (a' -> a) -> a' -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a' -> a
    f

    instance (Applicative m) => Divisible (LogAction m) where
      conquer :: forall a. LogAction m a
    conquer = (a -> m ()) -> LogAction m a
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      divide :: forall a b c.
    (a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a
    divide a -> (b, c)
    splitf LogAction m b
    lLog LogAction m c
    rLog = (a -> m ()) -> LogAction m a
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
    forall a b. (a -> b) -> a -> b
    $ \a
    i ->
        let (b
    l, c
    r) = a -> (b, c)
    splitf a
    i
            ll :: m ()
    ll = LogAction m b -> b -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m b
    lLog b
    l
            rl :: m ()
    rl = LogAction m c -> c -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m c
    rLog c
    r
        in m ()
    ll m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> m ()
    rl

    instance (Applicative m) => Decidable (LogAction m) where
      lose :: forall a. (a -> Void) -> LogAction m a
    lose a -> Void
    f = (a -> m ()) -> LogAction m a
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> Void -> m ()
    forall a. Void -> a
    absurd (a -> Void
    f a
    a)
      choose :: forall a b c.
    (a -> Either b c)
    -> LogAction m b -> LogAction m c -> LogAction m a
    choose a -> Either b c
    split LogAction m b
    l LogAction m c
    r = (a -> m ()) -> LogAction m a
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
    forall a b. (a -> b) -> a -> b
    $ (b -> m ()) -> (c -> m ()) -> Either b c -> m ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (LogAction m b -> b -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m b
    l) (LogAction m c -> c -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m c
    r) (Either b c -> m ()) -> (a -> Either b c) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either b c
    split

    -- | Any monad which will support retrieving a LogAction from the
    -- Monad's environment should support the 'HasLog' class.
    class Monad m => HasLog msg m where
      getLogAction :: m (LogAction m msg)

    -- | This type is a Constraint that should be applied to any client
    -- function that will perform logging in a monad context.  The @msg@
    -- is the type of message that will be logged, and the @m@ is the
    -- monad under which the logging is performed.
    type WithLog msg m = ({- X.MonadCatch m, -} HasLog msg m)

    -- | An instance of the 'LoggingMonad' class can be defined for the
    -- base monadic logging action to allow adjusting that logging action.
    -- This class can only be instantiated (and only needs to be
    -- instantiated) for the base message type; all other message types
    -- will use contramapping to convert their message type to the
    -- 'LoggingMonad' base message type.
    class (Monad m, HasLog msg m) => LoggingMonad msg m where
      adjustLogAction :: (forall k. LogAction k msg -> LogAction k msg) -> m a -> m a

    -- | This obtains the 'LogAction' from the current monad's environment
    -- to use for outputting the log message.  Most code will use this function.
    writeLogM :: HasLog msg m => msg -> m ()
    writeLogM :: forall msg (m :: * -> *). HasLog msg m => msg -> m ()
    writeLogM msg
    m = m (LogAction m msg)
    forall msg (m :: * -> *). HasLog msg m => m (LogAction m msg)
    getLogAction m (LogAction m msg) -> (LogAction m msg -> 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
    >>= (LogAction m msg -> msg -> m ()) -> msg -> LogAction m msg -> m ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip LogAction m msg -> msg -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog msg
    m

    ----------------------------------------------------------------------
    -- * Logging Utilities

    -- | Ensures that the LogAction does not fail if the logging operation
    -- itself throws an exception (the exception is ignored).
    safeLogAction :: X.MonadCatch m => LogAction m msg -> LogAction m msg
    safeLogAction :: forall (m :: * -> *) msg.
    MonadCatch m =>
    LogAction m msg -> LogAction m msg
    safeLogAction LogAction m msg
    a = (msg -> m ()) -> LogAction m msg
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((msg -> m ()) -> LogAction m msg)
    -> (msg -> m ()) -> LogAction m msg
    forall a b. (a -> b) -> a -> b
    $ \msg
    m -> m () -> (SomeException -> m ()) -> m ()
    forall e a. Exception e => m a -> (e -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadCatch m, Exception e) =>
    m a -> (e -> m a) -> m a
    X.catch (LogAction m msg -> msg -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m msg
    a msg
    m) (\(SomeException
    _ex :: X.SomeException) -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    -- | The logFilter can be used on a LogAction to determine which
    -- messages the LogAction should be invoked for (only those for which
    -- the filter function returns True).
    logFilter :: Applicative m => (msg -> Bool) -> LogAction m msg -> LogAction m msg
    logFilter :: forall (m :: * -> *) msg.
    Applicative m =>
    (msg -> Bool) -> LogAction m msg -> LogAction m msg
    logFilter msg -> Bool
    f (LogAction msg -> m ()
    l) = (msg -> m ()) -> LogAction m msg
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((msg -> m ()) -> LogAction m msg)
    -> (msg -> m ()) -> LogAction m msg
    forall a b. (a -> b) -> a -> b
    $ \msg
    m -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (msg -> Bool
    f msg
    m) (msg -> m ()
    l msg
    m)

    ----------------------------------------------------------------------
    -- * LogMessage rich logging type

    -- $richMsgType
    --
    -- This is an enhanced message type for the LogAction, containing
    -- various auxiliary information associated with the log message.
    -- While "Lumberjack" can be used with other message types, this
    -- message type should provide support for most of the common logging
    -- auxiliary data and can therefore be used "out of the box".

    -- | The Severity indicates the relative importance of the logging
    -- message.  This can be useful for filtering log messages.
    data Severity = Debug | Info | Warning | Error deriving (Eq Severity
    Eq Severity
    -> (Severity -> Severity -> Ordering)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Severity)
    -> (Severity -> Severity -> Severity)
    -> Ord Severity
    Severity -> Severity -> Bool
    Severity -> Severity -> Ordering
    Severity -> Severity -> Severity
    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 :: Severity -> Severity -> Ordering
    compare :: Severity -> Severity -> Ordering
    $c< :: Severity -> Severity -> Bool
    < :: Severity -> Severity -> Bool
    $c<= :: Severity -> Severity -> Bool
    <= :: Severity -> Severity -> Bool
    $c> :: Severity -> Severity -> Bool
    > :: Severity -> Severity -> Bool
    $c>= :: Severity -> Severity -> Bool
    >= :: Severity -> Severity -> Bool
    $cmax :: Severity -> Severity -> Severity
    max :: Severity -> Severity -> Severity
    $cmin :: Severity -> Severity -> Severity
    min :: Severity -> Severity -> Severity
    Ord, Severity -> Severity -> Bool
    (Severity -> Severity -> Bool)
    -> (Severity -> Severity -> Bool) -> Eq Severity
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Severity -> Severity -> Bool
    == :: Severity -> Severity -> Bool
    $c/= :: Severity -> Severity -> Bool
    /= :: Severity -> Severity -> Bool
    Eq, Int -> Severity -> ShowS
    [Severity] -> ShowS
    Severity -> String
    (Int -> Severity -> ShowS)
    -> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Severity -> ShowS
    showsPrec :: Int -> Severity -> ShowS
    $cshow :: Severity -> String
    show :: Severity -> String
    $cshowList :: [Severity] -> ShowS
    showList :: [Severity] -> ShowS
    Show)

    -- | The LogType indicates what type of message this is.  These are
    -- printed on the log line and can be used for filtering different
    -- types of log messages.
    data LogType = Progress | FuncEntry | FuncExit | MiscLog | UserOp
      deriving (LogType -> LogType -> Bool
    (LogType -> LogType -> Bool)
    -> (LogType -> LogType -> Bool) -> Eq LogType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LogType -> LogType -> Bool
    == :: LogType -> LogType -> Bool
    $c/= :: LogType -> LogType -> Bool
    /= :: LogType -> LogType -> Bool
    Eq, Int -> LogType -> ShowS
    [LogType] -> ShowS
    LogType -> String
    (Int -> LogType -> ShowS)
    -> (LogType -> String) -> ([LogType] -> ShowS) -> Show LogType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LogType -> ShowS
    showsPrec :: Int -> LogType -> ShowS
    $cshow :: LogType -> String
    show :: LogType -> String
    $cshowList :: [LogType] -> ShowS
    showList :: [LogType] -> ShowS
    Show)

    -- | Each logged output is described by a LogMessage object.
    data LogMessage = LogMessage { LogMessage -> LogType
    logType :: LogType
                                 , LogMessage -> Severity
    logLevel :: Severity
                                 , LogMessage -> UTCTime
    logTime :: UTCTime
                                 , LogMessage -> [(Text, Text)]
    logTags :: [(Text, Text)]
                                 , LogMessage -> Text
    logText :: Text
                                 }

    instance Semigroup LogMessage where
      LogMessage
    a <> :: LogMessage -> LogMessage -> LogMessage
    <> LogMessage
    b = LogMessage { logType :: LogType
    logType = if LogMessage -> LogType
    logType LogMessage
    a LogType -> LogType -> Bool
    forall a. Eq a => a -> a -> Bool
    == LogType
    MiscLog then LogMessage -> LogType
    logType LogMessage
    b else LogMessage -> LogType
    logType LogMessage
    a
                          , logLevel :: Severity
    logLevel = Severity -> Severity -> Severity
    forall a. Ord a => a -> a -> a
    max (LogMessage -> Severity
    logLevel LogMessage
    a) (LogMessage -> Severity
    logLevel LogMessage
    b)
                          , logTime :: UTCTime
    logTime = UTCTime -> UTCTime -> UTCTime
    forall a. Ord a => a -> a -> a
    max (LogMessage -> UTCTime
    logTime LogMessage
    a) (LogMessage -> UTCTime
    logTime LogMessage
    b)
                          , logTags :: [(Text, Text)]
    logTags = LogMessage -> [(Text, Text)]
    logTags LogMessage
    a [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <> LogMessage -> [(Text, Text)]
    logTags LogMessage
    b
                          , logText :: Text
    logText = case (Text -> Bool
    T.null (LogMessage -> Text
    logText LogMessage
    a), Text -> Bool
    T.null (LogMessage -> Text
    logText LogMessage
    b)) of
                                      (Bool
    False, Bool
    False) -> LogMessage -> Text
    logText LogMessage
    a Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "; " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> LogMessage -> Text
    logText LogMessage
    b
                                      (Bool
    True, Bool
    False) -> LogMessage -> Text
    logText LogMessage
    b
                                      (Bool, Bool)
    _ -> LogMessage -> Text
    logText LogMessage
    a
                          }

    instance Monoid LogMessage where
      mempty :: LogMessage
    mempty = LogType
    -> Severity -> UTCTime -> [(Text, Text)] -> Text -> LogMessage
    LogMessage LogType
    MiscLog Severity
    Debug (Day -> DiffTime -> UTCTime
    UTCTime (Int -> Day
    forall a. Enum a => Int -> a
    toEnum Int
    0) (Int -> DiffTime
    forall a. Enum a => Int -> a
    toEnum Int
    0)) [] Text
    empty
      mappend :: LogMessage -> LogMessage -> LogMessage
    mappend = LogMessage -> LogMessage -> LogMessage
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Helper routine to return an empty LogMessage, whose fields can
    -- then be updated.
    msgWith :: LogMessage
    msgWith :: LogMessage
    msgWith = LogMessage
    forall a. Monoid a => a
    mempty

    -- | This operator is a convenient infix operator for logging a Text
    -- message.  This is especially useful when used in conjunction with
    -- the @OverloadedStrings@ language pragma:
    --
    --   >>> warning|# "This is your last warning"
    --   >>> error|# "Failure has occurred"

    (|#) :: (LogMessage -> a) -> Text -> a
    LogMessage -> a
    o |# :: forall a. (LogMessage -> a) -> Text -> a
    |# Text
    t = LogMessage -> a
    o (LogMessage
    msgWith { logText :: Text
    logText = Text
    t })
    infixr 0 |#

    -- | Add the current timestamp to the LogMessage being logged
    addLogActionTime :: MonadIO m => LogAction m LogMessage -> LogAction m LogMessage
    addLogActionTime :: forall (m :: * -> *).
    MonadIO m =>
    LogAction m LogMessage -> LogAction m LogMessage
    addLogActionTime LogAction m LogMessage
    a = (LogMessage -> m ()) -> LogAction m LogMessage
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((LogMessage -> m ()) -> LogAction m LogMessage)
    -> (LogMessage -> m ()) -> LogAction m LogMessage
    forall a b. (a -> b) -> a -> b
    $ \LogMessage
    m -> do UTCTime
    t <- IO UTCTime -> m UTCTime
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
                                              LogAction m LogMessage -> LogMessage -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m LogMessage
    a (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ LogMessage
    m LogMessage -> LogMessage -> LogMessage
    forall a. Semigroup a => a -> a -> a
    <> LogMessage
    forall a. Monoid a => a
    mempty { logTime :: UTCTime
    logTime = UTCTime
    t }

    -- | Log messages can have any number of key/value tags applied to
    -- them.  This function establishes a new key/value tag pair that will
    -- be in effect for the monadic operation passed as the third
    -- argument.
    -- withLogTag tname tval op = local (adjustLogAction $ addLogTag tname tval) op
    withLogTag :: (LoggingMonad LogMessage m) => Text -> Text -> m a -> m a
    withLogTag :: forall (m :: * -> *) a.
    LoggingMonad LogMessage m =>
    Text -> Text -> m a -> m a
    withLogTag Text
    tname Text
    tval m a
    op =
        let tagmsg :: LogMessage
    tagmsg = LogMessage
    forall a. Monoid a => a
    mempty { logTags :: [(Text, Text)]
    logTags = [(Text
    tname, Text
    tval)] }
        in ((forall (k :: * -> *).
     LogAction k LogMessage -> LogAction k LogMessage)
    -> m a -> m a
    forall a.
    (forall (k :: * -> *).
     LogAction k LogMessage -> LogAction k LogMessage)
    -> m a -> m a
    forall msg (m :: * -> *) a.
    LoggingMonad msg m =>
    (forall (k :: * -> *). LogAction k msg -> LogAction k msg)
    -> m a -> m a
    adjustLogAction ((forall (k :: * -> *).
      LogAction k LogMessage -> LogAction k LogMessage)
     -> m a -> m a)
    -> (forall (k :: * -> *).
        LogAction k LogMessage -> LogAction k LogMessage)
    -> m a
    -> m a
    forall a b. (a -> b) -> a -> b
    $ (LogMessage -> LogMessage)
    -> LogAction k LogMessage -> LogAction k LogMessage
    forall a' a. (a' -> a) -> LogAction k a -> LogAction k a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (LogMessage
    tagmsg LogMessage -> LogMessage -> LogMessage
    forall a. Semigroup a => a -> a -> a
    <>)) m a
    op

    -- ----------------------------------------------------------------------
    -- * Output formatting for LogMessage

    -- $richMsgFormatting
    --
    -- When the 'LogMessage' logging type is used, "Lumberjack" provides a
    -- standard set of output formatting functions.  The output uses the
    -- prettyprinter package to generate 'Prettyprinter.Doc' output with
    -- annotations specifying the type of markup to be applied to various
    -- portions of the output.
    --
    -- There are multiple rendering functions that can be supplied as
    -- contramap converters to the base 'LogAction'.  One rendering
    -- function outputs a log message in plain text, while the other uses
    -- the prettyprinter-ansi-terminal package to generate various ANSI
    -- highlighting and color codes for writing enhanced output to a TTY.

    -- | Normal LogMessage formatting uses prettyprinter output with a
    -- 'PrettyLogAnn' annotation type which assigns different annotations
    -- to different parts of the log message.  This is achieved by calling
    -- 'prettyLogMessage'.
    --
    -- Alternatively, the 'Prettyprinter.Pretty' class @pretty@ method can
    -- be used to get log message formatting for generic annotation types,
    -- but the different parts of the message will not be distinguished
    -- via annotation values.
    data PrettyLogAnn = AnnLogType LogType
                      | AnnSeverity Severity
                      | AnnTime
                      | AnnTimeMinSec
                      | AnnTag
                      | AnnTagVal

    -- Use prettyLogType instead
    instance PP.Pretty LogType where pretty :: forall ann. LogType -> Doc ann
    pretty = LogType -> Doc ann
    forall ann. LogType -> Doc ann
    anyPrettyLogType

    anyPrettyLogType :: LogType -> PP.Doc ann
    anyPrettyLogType :: forall ann. LogType -> Doc ann
    anyPrettyLogType LogType
    Progress  = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "progress" :: Text)
    anyPrettyLogType LogType
    FuncEntry = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "entered" :: Text)
    anyPrettyLogType LogType
    FuncExit  = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "completed" :: Text)
    anyPrettyLogType LogType
    UserOp    = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "User-Op" :: Text)
    anyPrettyLogType LogType
    MiscLog   = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "misc" :: Text)

    prettyLogType :: LogType -> PP.Doc PrettyLogAnn
    prettyLogType :: LogType -> Doc PrettyLogAnn
    prettyLogType LogType
    t = PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate (LogType -> PrettyLogAnn
    AnnLogType LogType
    t) (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ LogType -> Doc PrettyLogAnn
    forall ann. LogType -> Doc ann
    anyPrettyLogType LogType
    t

    -- Use prettySev instead
    instance PP.Pretty Severity where pretty :: forall ann. Severity -> Doc ann
    pretty = Severity -> Doc ann
    forall ann. Severity -> Doc ann
    anyPrettySev

    anyPrettySev :: Severity -> PP.Doc ann
    anyPrettySev :: forall ann. Severity -> Doc ann
    anyPrettySev Severity
    Error   = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "ERR " :: Text)
    anyPrettySev Severity
    Warning = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "Warn" :: Text)
    anyPrettySev Severity
    Info    = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "I   " :: Text)
    anyPrettySev Severity
    Debug   = Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty (Text
    "Dbg " :: Text)

    prettySev :: Severity -> PP.Doc PrettyLogAnn
    prettySev :: Severity -> Doc PrettyLogAnn
    prettySev Severity
    s = PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate (Severity -> PrettyLogAnn
    AnnSeverity Severity
    s) (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ Severity -> Doc PrettyLogAnn
    forall ann. Severity -> Doc ann
    anyPrettySev Severity
    s

    -- Use prettyTime instead
    instance PP.Pretty UTCTime where
      pretty :: forall ann. UTCTime -> Doc ann
    pretty UTCTime
    t = [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    PP.hcat [ String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%Z-%F:%H:" UTCTime
    t)
                         , String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%M:%S" UTCTime
    t)
                         , String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    4 (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    ".%q" UTCTime
    t))
                         ]

    prettyTime :: UTCTime -> PP.Doc PrettyLogAnn
    prettyTime :: UTCTime -> Doc PrettyLogAnn
    prettyTime UTCTime
    t =
      if UTCTime
    t UTCTime -> UTCTime -> Bool
    forall a. Eq a => a -> a -> Bool
    == Day -> DiffTime -> UTCTime
    UTCTime (Int -> Day
    forall a. Enum a => Int -> a
    toEnum Int
    0) (Int -> DiffTime
    forall a. Enum a => Int -> a
    toEnum Int
    0)
      then PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate PrettyLogAnn
    AnnTime (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ Doc PrettyLogAnn
    forall ann. Doc ann
    PP.emptyDoc
      else [Doc PrettyLogAnn] -> Doc PrettyLogAnn
    forall ann. [Doc ann] -> Doc ann
    PP.hcat
           [ PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate PrettyLogAnn
    AnnTime (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ String -> Doc PrettyLogAnn
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%Z-%F_%H:" UTCTime
    t)
           , PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate PrettyLogAnn
    AnnTimeMinSec (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ String -> Doc PrettyLogAnn
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%M:%S" UTCTime
    t)
           , PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate PrettyLogAnn
    AnnTime (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ String -> Doc PrettyLogAnn
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    4 (TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    ".%q" UTCTime
    t))
           ]

    anyPrettyTags :: [(Text, Text)] -> PP.Doc ann
    anyPrettyTags :: forall ann. [(Text, Text)] -> Doc ann
    anyPrettyTags =
      let anyPrettyTag :: (a, a) -> Doc ann
    anyPrettyTag (a
    tag, a
    val) = Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    PP.group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
    forall a b. (a -> b) -> a -> b
    $ [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    PP.cat [ a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty a
    tag
                                                      , Doc ann
    forall ann. Doc ann
    PP.equals
                                                      , a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty a
    val
                                                      ]
      in (Doc ann -> (Text, Text) -> Doc ann)
    -> Doc ann -> [(Text, Text)] -> Doc ann
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Doc ann
    acc (Text, Text)
    tagval -> Doc ann
    acc Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    PP.<+> ((Text, Text) -> Doc ann
    forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
    anyPrettyTag (Text, Text)
    tagval)) Doc ann
    forall a. Monoid a => a
    mempty

    prettyTags :: [(Text, Text)] -> PP.Doc PrettyLogAnn
    prettyTags :: [(Text, Text)] -> Doc PrettyLogAnn
    prettyTags =
      let ppTag :: (a, a) -> Doc PrettyLogAnn
    ppTag (a
    tag, a
    val) = Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. Doc ann -> Doc ann
    PP.group (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ [Doc PrettyLogAnn] -> Doc PrettyLogAnn
    forall ann. [Doc ann] -> Doc ann
    PP.hcat [ PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate PrettyLogAnn
    AnnTag (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ a -> Doc PrettyLogAnn
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty a
    tag
                                                , Doc PrettyLogAnn
    forall ann. Doc ann
    PP.equals
                                                , PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. ann -> Doc ann -> Doc ann
    PP.annotate PrettyLogAnn
    AnnTagVal (Doc PrettyLogAnn -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall a b. (a -> b) -> a -> b
    $ a -> Doc PrettyLogAnn
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty a
    val
                                                ]
      in (Doc PrettyLogAnn -> (Text, Text) -> Doc PrettyLogAnn)
    -> Doc PrettyLogAnn -> [(Text, Text)] -> Doc PrettyLogAnn
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Doc PrettyLogAnn
    acc (Text, Text)
    tagval -> Doc PrettyLogAnn
    acc Doc PrettyLogAnn -> Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. Doc ann -> Doc ann -> Doc ann
    PP.<+> ((Text, Text) -> Doc PrettyLogAnn
    forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Doc PrettyLogAnn
    ppTag (Text, Text)
    tagval)) Doc PrettyLogAnn
    forall a. Monoid a => a
    mempty

    -- | Format the log message with annotation values designating the
    -- different portions of the pretty-printed value.
    --
    -- The 'Prettyprinter.Pretty' class @pretty@ method can be used for
    -- generic annotations, but this yields less information for output
    -- management.
    prettyLogMessage :: LogMessage -> PP.Doc PrettyLogAnn
    prettyLogMessage :: LogMessage -> Doc PrettyLogAnn
    prettyLogMessage (LogMessage {[(Text, Text)]
    Text
    UTCTime
    LogType
    Severity
    logType :: LogMessage -> LogType
    logLevel :: LogMessage -> Severity
    logTime :: LogMessage -> UTCTime
    logTags :: LogMessage -> [(Text, Text)]
    logText :: LogMessage -> Text
    logType :: LogType
    logLevel :: Severity
    logTime :: UTCTime
    logTags :: [(Text, Text)]
    logText :: Text
    ..}) = [Doc PrettyLogAnn] -> Doc PrettyLogAnn
    forall ann. [Doc ann] -> Doc ann
    PP.hsep [ UTCTime -> Doc PrettyLogAnn
    prettyTime UTCTime
    logTime
                                                 , Severity -> Doc PrettyLogAnn
    prettySev Severity
    logLevel
                                                 , Doc PrettyLogAnn -> Doc PrettyLogAnn
    forall ann. Doc ann -> Doc ann
    PP.brackets (LogType -> Doc PrettyLogAnn
    prettyLogType LogType
    logType)
                                                 , [(Text, Text)] -> Doc PrettyLogAnn
    prettyTags [(Text, Text)]
    logTags
                                                 , Text -> Doc PrettyLogAnn
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty Text
    logText
                                                 ]

    instance PP.Pretty LogMessage where
      pretty :: forall ann. LogMessage -> Doc ann
    pretty (LogMessage {[(Text, Text)]
    Text
    UTCTime
    LogType
    Severity
    logType :: LogMessage -> LogType
    logLevel :: LogMessage -> Severity
    logTime :: LogMessage -> UTCTime
    logTags :: LogMessage -> [(Text, Text)]
    logText :: LogMessage -> Text
    logType :: LogType
    logLevel :: Severity
    logTime :: UTCTime
    logTags :: [(Text, Text)]
    logText :: Text
    ..}) = [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    PP.hsep [ UTCTime -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. UTCTime -> Doc ann
    PP.pretty UTCTime
    logTime
                                         , Severity -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Severity -> Doc ann
    PP.pretty Severity
    logLevel
                                         , Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    PP.brackets (LogType -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. LogType -> Doc ann
    PP.pretty LogType
    logType)
                                         , [(Text, Text)] -> Doc ann
    forall ann. [(Text, Text)] -> Doc ann
    anyPrettyTags [(Text, Text)]
    logTags
                                         , Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Text -> Doc ann
    PP.pretty Text
    logText
                                         ]

    -- | The 'termStyle' converts the LogMessage annotations into ANSI
    -- terminal styles to add colors and other effects such as bolding to
    -- various portions of log messages (for use with
    -- prettyprinter-ansi-terminal).
    termStyle :: PrettyLogAnn -> PP_Term.AnsiStyle
    termStyle :: PrettyLogAnn -> AnsiStyle
    termStyle (AnnLogType LogType
    Progress)  = Color -> AnsiStyle
    PP_Term.colorDull Color
    PP_Term.Green
    termStyle (AnnLogType LogType
    FuncEntry) = Color -> AnsiStyle
    PP_Term.colorDull Color
    PP_Term.Magenta
    termStyle (AnnLogType LogType
    FuncExit)  = Color -> AnsiStyle
    PP_Term.colorDull Color
    PP_Term.Cyan
    termStyle (AnnLogType LogType
    UserOp)    = AnsiStyle
    PP_Term.bold AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Color -> AnsiStyle
    PP_Term.color Color
    PP_Term.Green
    termStyle (AnnLogType LogType
    MiscLog)   = AnsiStyle
    forall a. Monoid a => a
    mempty
    termStyle (AnnSeverity Severity
    Error)   = AnsiStyle
    PP_Term.bold AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Color -> AnsiStyle
    PP_Term.color Color
    PP_Term.Red AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Color -> AnsiStyle
    PP_Term.bgColor Color
    PP_Term.Yellow
    termStyle (AnnSeverity Severity
    Warning) = AnsiStyle
    PP_Term.bold AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Color -> AnsiStyle
    PP_Term.colorDull Color
    PP_Term.Red
    termStyle (AnnSeverity Severity
    Info)    = AnsiStyle
    forall a. Monoid a => a
    mempty
    termStyle (AnnSeverity Severity
    Debug)   = Color -> AnsiStyle
    PP_Term.color Color
    PP_Term.Blue
    termStyle PrettyLogAnn
    AnnTime       = AnsiStyle
    forall a. Monoid a => a
    mempty
    termStyle PrettyLogAnn
    AnnTimeMinSec = Color -> AnsiStyle
    PP_Term.color Color
    PP_Term.White AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> AnsiStyle
    PP_Term.bold
    termStyle PrettyLogAnn
    AnnTag    = Color -> AnsiStyle
    PP_Term.color Color
    PP_Term.Black AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> AnsiStyle
    PP_Term.bold
    termStyle PrettyLogAnn
    AnnTagVal = Color -> AnsiStyle
    PP_Term.color Color
    PP_Term.Black AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> AnsiStyle
    PP_Term.bold

    -- | Standard 'LogMessage' rendering function to convert a
    -- 'LogMessage' into 'Text' with ANSI terminal colors and bolding and
    -- other styling.  This can be used as the default converter for a
    -- logger (via contramap).
    cvtLogMessageToANSITermText :: LogMessage -> Text
    cvtLogMessageToANSITermText :: LogMessage -> Text
    cvtLogMessageToANSITermText = SimpleDocStream AnsiStyle -> Text
    PP_Term.renderStrict (SimpleDocStream AnsiStyle -> Text)
    -> (LogMessage -> SimpleDocStream AnsiStyle) -> LogMessage -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                  (PrettyLogAnn -> AnsiStyle)
    -> SimpleDocStream PrettyLogAnn -> SimpleDocStream AnsiStyle
    forall ann ann'.
    (ann -> ann') -> SimpleDocStream ann -> SimpleDocStream ann'
    PP.reAnnotateS PrettyLogAnn -> AnsiStyle
    termStyle (SimpleDocStream PrettyLogAnn -> SimpleDocStream AnsiStyle)
    -> (LogMessage -> SimpleDocStream PrettyLogAnn)
    -> LogMessage
    -> SimpleDocStream AnsiStyle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                  LayoutOptions -> Doc PrettyLogAnn -> SimpleDocStream PrettyLogAnn
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
    PP.layoutSmart LayoutOptions
    PP.defaultLayoutOptions (Doc PrettyLogAnn -> SimpleDocStream PrettyLogAnn)
    -> (LogMessage -> Doc PrettyLogAnn)
    -> LogMessage
    -> SimpleDocStream PrettyLogAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                  LogMessage -> Doc PrettyLogAnn
    prettyLogMessage

    -- | Standard 'LogMessage' rendering function for converting a
    -- 'LogMessage' into plain 'Text' (no colors or other highlighting).
    -- This can be used as the default converter for a logger (via
    -- contramap).
    cvtLogMessageToPlainText :: LogMessage -> Text
    cvtLogMessageToPlainText :: LogMessage -> Text
    cvtLogMessageToPlainText = SimpleDocStream PrettyLogAnn -> Text
    forall ann. SimpleDocStream ann -> Text
    PP_Text.renderStrict (SimpleDocStream PrettyLogAnn -> Text)
    -> (LogMessage -> SimpleDocStream PrettyLogAnn)
    -> LogMessage
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                               LayoutOptions -> Doc PrettyLogAnn -> SimpleDocStream PrettyLogAnn
    forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
    PP.layoutSmart LayoutOptions
    PP.defaultLayoutOptions (Doc PrettyLogAnn -> SimpleDocStream PrettyLogAnn)
    -> (LogMessage -> Doc PrettyLogAnn)
    -> LogMessage
    -> SimpleDocStream PrettyLogAnn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                               LogMessage -> Doc PrettyLogAnn
    prettyLogMessage

    -- ----------------------------------------------------------------------
    -- * Helpers and convenience functions

    -- $helpers
    -- These functions are not part of the core Logging implementation,
    -- but can be useful to clients to perform common or default
    -- operations.

    -- | A wrapper for a function call that will call the provided
    -- 'LogAction' with a 'Debug' log on entry to the function and an
    -- 'Info' log on exit from the function.  The total amount of time
    -- taken during execution of the function will be included in the exit
    -- log message.  No strictness is applied to the invoked monadic
    -- operation, so the time taken may be misleading.  Like
    -- 'logFunctionCallM' but needs an explicit 'LogAction' whereas
    -- 'logFunctionCallM' will retrieve the 'LogAction' from the current
    -- monadic context.
    logFunctionCall :: (MonadIO m) => LogAction m LogMessage -> Text -> m a -> m a
    logFunctionCall :: forall (m :: * -> *) a.
    MonadIO m =>
    LogAction m LogMessage -> Text -> m a -> m a
    logFunctionCall = (LogMessage -> m ()) -> Text -> m a -> m a
    forall (m :: * -> *) a.
    MonadIO m =>
    (LogMessage -> m ()) -> Text -> m a -> m a
    logFunctionCallWith ((LogMessage -> m ()) -> Text -> m a -> m a)
    -> (LogAction m LogMessage -> LogMessage -> m ())
    -> LogAction m LogMessage
    -> Text
    -> m a
    -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogAction m LogMessage -> LogMessage -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog

    -- | A wrapper for a monadic function call that will 'Debug' log on
    -- entry to and 'Info' log on exit from the function.  The exit log
    -- will also note the total amount of time taken during execution of
    -- the function.  Be advised that no strictness is applied to the
    -- internal monadic operation, so the time taken may be misleading.
    logFunctionCallM :: (MonadIO m, WithLog LogMessage m) => Text -> m a -> m a
    logFunctionCallM :: forall (m :: * -> *) a.
    (MonadIO m, WithLog LogMessage m) =>
    Text -> m a -> m a
    logFunctionCallM = (LogMessage -> m ()) -> Text -> m a -> m a
    forall (m :: * -> *) a.
    MonadIO m =>
    (LogMessage -> m ()) -> Text -> m a -> m a
    logFunctionCallWith LogMessage -> m ()
    forall msg (m :: * -> *). HasLog msg m => msg -> m ()
    writeLogM

    -- | Internal function implementing the body for 'logFunctionCall' or
    -- 'logFunctionCallM'
    logFunctionCallWith :: (MonadIO m) => (LogMessage -> m ()) -> Text -> m a -> m a
    logFunctionCallWith :: forall (m :: * -> *) a.
    MonadIO m =>
    (LogMessage -> m ()) -> Text -> m a -> m a
    logFunctionCallWith LogMessage -> m ()
    logger Text
    fName m a
    f =
      do LogMessage -> m ()
    logger (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ LogMessage
    msgWith { logType :: LogType
    logType = LogType
    FuncEntry, logText :: Text
    logText = Text
    fName }
         UTCTime
    t <- IO UTCTime -> m UTCTime
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
         a
    r <- m a
    f
         UTCTime
    t' <- IO UTCTime -> m UTCTime
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
         let dt :: NominalDiffTime
    dt = UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    t' UTCTime
    t
         LogMessage -> m ()
    logger (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ LogMessage
    msgWith { logType :: LogType
    logType = LogType
    FuncExit, logLevel :: Severity
    logLevel = Severity
    Info
                          , logText :: Text
    logText = Text
    fName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ", executed for " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    pack (NominalDiffTime -> String
    forall a. Show a => a -> String
    show NominalDiffTime
    dt) }
         a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r

    -- | Called to output a log message to indicate that some progress in
    -- the current activity has been made.
    logProgress :: (MonadIO m) => LogAction m LogMessage -> Text -> m ()
    logProgress :: forall (m :: * -> *).
    MonadIO m =>
    LogAction m LogMessage -> Text -> m ()
    logProgress LogAction m LogMessage
    action Text
    txt = LogAction m LogMessage -> LogMessage -> m ()
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
    writeLog LogAction m LogMessage
    action (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ LogMessage
    msgWith { logLevel :: Severity
    logLevel = Severity
    Info, logType :: LogType
    logType = LogType
    Progress, logText :: Text
    logText = Text
    txt }

    -- | Called to output a log message within a 'HasLog' monad to indicate
    -- that some progress in the current activity has been made.
    logProgressM :: (MonadIO m, WithLog LogMessage m) => Text -> m ()
    logProgressM :: forall (m :: * -> *).
    (MonadIO m, WithLog LogMessage m) =>
    Text -> m ()
    logProgressM Text
    txt = LogMessage -> m ()
    forall msg (m :: * -> *). HasLog msg m => msg -> m ()
    writeLogM (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ LogMessage
    msgWith { logLevel :: Severity
    logLevel = Severity
    Info, logType :: LogType
    logType = LogType
    Progress, logText :: Text
    logText = Text
    txt }

    -- | This is a helper function.  The LogMessage normally wants a Text,
    -- but show delivers a String, so 'tshow' can be used to get the
    -- needed format.
    tshow :: (Show a) => a -> Text
    tshow :: forall a. Show a => a -> Text
    tshow = String -> Text
    pack (String -> Text) -> (a -> String) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    -- | When using a simple IO monad, there is no ability to store a
    -- LogAction in the base monad.  The client can specify a specific
    -- HasLog instance for IO that is appropriate to that client, and that
    -- HasLog can optionally use the 'defaultGetIOLogAction' as the
    -- 'getLogAction' implementation to log pretty messages with ANSI
    -- styling to stdout.
    --
    --  > instance HasLog Env Text IO where
    --  >     getLogAction = return defaultGetIOLogAction
    --
    defaultGetIOLogAction :: MonadIO m => LogAction m T.Text
    defaultGetIOLogAction :: forall (m :: * -> *). MonadIO m => LogAction m Text
    defaultGetIOLogAction = (Text -> m ()) -> LogAction m Text
    forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
    LogAction ((Text -> m ()) -> LogAction m Text)
    -> (Text -> m ()) -> LogAction m Text
    forall a b. (a -> b) -> a -> b
    $ IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Handle -> Text -> IO ()
    TIO.hPutStrLn Handle
    stderr