-- Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com>
-- Copyright (c) 2014-2015 PivotCloud, Inc.
--
-- System.Logger.Types
--
-- Please feel free to contact us at licensing@pivotmail.com with any
-- contributions, additions, or other feedback; we would love to hear from
-- you.
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may
-- not use this file except in compliance with the License. You may obtain a
-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations
-- under the License.

-- |
-- Module: System.Logger.Types
-- Description: Basic Types of Yet Another Logger
-- Copyright:
--     Copyright (c) 2016-2020 Lars Kuhtz <lakuhtz@gmail.com>
--     Copyright (c) 2014-2015 PivotCloud, Inc.
-- License: Apache License, Version 2.0
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--

{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnicodeSyntax #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module System.Logger.Types
(
-- * LogLevel
  LogLevel(..)
, logLevelText
, readLogLevel
, pLogLevel
, pLogLevel_

-- * LogPolicy
, LogPolicy(..)
, logPolicyText
, readLogPolicy
, pLogPolicy
, pLogPolicy_

-- * LogLabel
, LogLabel
, LogScope

-- * Logger Exception
, LoggerException(..)

-- * Logger Backend
, LogMessage(..)
, logMsg
, logMsgLevel
, logMsgScope
, logMsgTime
, LoggerBackend

-- * Logger Frontend
, LogFunction
, LogFunctionIO

-- * LoggerCtx
, LoggerCtx(..)
, LoggerCtxT
, runLoggerCtxT

-- * MonadLog
, MonadLog(..)
, withLabel
, clearScope
, popLabel

) where

import Configuration.Utils hiding (Lens, Lens', Error)

import Control.DeepSeq
import Control.Exception
import Control.Monad.Base
import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Unicode

import Data.Monoid.Unicode
import Data.String
import qualified Data.Text as T
import Data.Typeable
import Data.Void

import GHC.Generics

import Lens.Micro

import qualified Options.Applicative as O

import Prelude.Unicode

import System.Clock

-- -------------------------------------------------------------------------- --
-- Log-Level

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

instance NFData LogLevel

readLogLevel
    ∷ (MonadError e m, IsString e, Monoid e)
    ⇒ T.Text
    → m LogLevel
readLogLevel :: forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogLevel
readLogLevel Text
x = case Text -> Text
T.toLower Text
x of
    Text
"quiet" → forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Quiet
    Text
"error" → forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Error
    Text
"warn" → forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Warn
    Text
"info" → forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Info
    Text
"debug" → forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Debug
    Text
e → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ e
"unexpected log level value: "
        forall α. Monoid α => α -> α -> α
⊕ forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Text
e)
        forall α. Monoid α => α -> α -> α
⊕ e
", expected \"quiet\", \"error\", \"warn\", \"info\", or \"debug\""

logLevelText
    ∷ IsString a
    ⇒ LogLevel
    → a
logLevelText :: forall a. IsString a => LogLevel -> a
logLevelText LogLevel
Quiet = a
"quiet"
logLevelText LogLevel
Error = a
"error"
logLevelText LogLevel
Warn = a
"warn"
logLevelText LogLevel
Info = a
"info"
logLevelText LogLevel
Debug = a
"debug"

instance ToJSON LogLevel where
    toJSON :: LogLevel -> Value
toJSON = Text -> Value
String forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. IsString a => LogLevel -> a
logLevelText

instance FromJSON LogLevel where
    parseJSON :: Value -> Parser LogLevel
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"LogLevel" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogLevel
readLogLevel

pLogLevel ∷ O.Parser LogLevel
pLogLevel :: Parser LogLevel
pLogLevel = Text -> Parser LogLevel
pLogLevel_ Text
""

-- | A version of 'pLogLevel' that takes a prefix for the command line
-- option.
--
-- @since 0.2
--
pLogLevel_
    ∷ T.Text
        -- ^ prefix for the command line options.
    → O.Parser LogLevel
pLogLevel_ :: Text -> Parser LogLevel
pLogLevel_ Text
prefix = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader (forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogLevel
readLogLevel forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
. [Char] -> Text
T.pack))
    forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long (Text -> [Char]
T.unpack Text
prefix forall α. Monoid α => α -> α -> α
⊕ [Char]
"log-level")
    forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"quiet|error|warn|info|debug"
    forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"threshold for log messages"

-- -------------------------------------------------------------------------- --
-- Log Policy

-- | Policy that determines how the case of a congested logging
-- pipeline is addressed.
--
data LogPolicy
    = LogPolicyDiscard
    | LogPolicyRaise
    | LogPolicyBlock
    deriving (Int -> LogPolicy -> ShowS
[LogPolicy] -> ShowS
LogPolicy -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogPolicy] -> ShowS
$cshowList :: [LogPolicy] -> ShowS
show :: LogPolicy -> [Char]
$cshow :: LogPolicy -> [Char]
showsPrec :: Int -> LogPolicy -> ShowS
$cshowsPrec :: Int -> LogPolicy -> ShowS
Show, ReadPrec [LogPolicy]
ReadPrec LogPolicy
Int -> ReadS LogPolicy
ReadS [LogPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogPolicy]
$creadListPrec :: ReadPrec [LogPolicy]
readPrec :: ReadPrec LogPolicy
$creadPrec :: ReadPrec LogPolicy
readList :: ReadS [LogPolicy]
$creadList :: ReadS [LogPolicy]
readsPrec :: Int -> ReadS LogPolicy
$creadsPrec :: Int -> ReadS LogPolicy
Read, LogPolicy -> LogPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogPolicy -> LogPolicy -> Bool
$c/= :: LogPolicy -> LogPolicy -> Bool
== :: LogPolicy -> LogPolicy -> Bool
$c== :: LogPolicy -> LogPolicy -> Bool
Eq, Eq LogPolicy
LogPolicy -> LogPolicy -> Bool
LogPolicy -> LogPolicy -> Ordering
LogPolicy -> LogPolicy -> LogPolicy
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 :: LogPolicy -> LogPolicy -> LogPolicy
$cmin :: LogPolicy -> LogPolicy -> LogPolicy
max :: LogPolicy -> LogPolicy -> LogPolicy
$cmax :: LogPolicy -> LogPolicy -> LogPolicy
>= :: LogPolicy -> LogPolicy -> Bool
$c>= :: LogPolicy -> LogPolicy -> Bool
> :: LogPolicy -> LogPolicy -> Bool
$c> :: LogPolicy -> LogPolicy -> Bool
<= :: LogPolicy -> LogPolicy -> Bool
$c<= :: LogPolicy -> LogPolicy -> Bool
< :: LogPolicy -> LogPolicy -> Bool
$c< :: LogPolicy -> LogPolicy -> Bool
compare :: LogPolicy -> LogPolicy -> Ordering
$ccompare :: LogPolicy -> LogPolicy -> Ordering
Ord, LogPolicy
forall a. a -> a -> Bounded a
maxBound :: LogPolicy
$cmaxBound :: LogPolicy
minBound :: LogPolicy
$cminBound :: LogPolicy
Bounded, Int -> LogPolicy
LogPolicy -> Int
LogPolicy -> [LogPolicy]
LogPolicy -> LogPolicy
LogPolicy -> LogPolicy -> [LogPolicy]
LogPolicy -> LogPolicy -> LogPolicy -> [LogPolicy]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogPolicy -> LogPolicy -> LogPolicy -> [LogPolicy]
$cenumFromThenTo :: LogPolicy -> LogPolicy -> LogPolicy -> [LogPolicy]
enumFromTo :: LogPolicy -> LogPolicy -> [LogPolicy]
$cenumFromTo :: LogPolicy -> LogPolicy -> [LogPolicy]
enumFromThen :: LogPolicy -> LogPolicy -> [LogPolicy]
$cenumFromThen :: LogPolicy -> LogPolicy -> [LogPolicy]
enumFrom :: LogPolicy -> [LogPolicy]
$cenumFrom :: LogPolicy -> [LogPolicy]
fromEnum :: LogPolicy -> Int
$cfromEnum :: LogPolicy -> Int
toEnum :: Int -> LogPolicy
$ctoEnum :: Int -> LogPolicy
pred :: LogPolicy -> LogPolicy
$cpred :: LogPolicy -> LogPolicy
succ :: LogPolicy -> LogPolicy
$csucc :: LogPolicy -> LogPolicy
Enum, Typeable, forall x. Rep LogPolicy x -> LogPolicy
forall x. LogPolicy -> Rep LogPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogPolicy x -> LogPolicy
$cfrom :: forall x. LogPolicy -> Rep LogPolicy x
Generic)

instance NFData LogPolicy

logPolicyText ∷ IsString s ⇒ LogPolicy → s
logPolicyText :: forall s. IsString s => LogPolicy -> s
logPolicyText LogPolicy
LogPolicyDiscard = s
"discard"
logPolicyText LogPolicy
LogPolicyRaise = s
"raise"
logPolicyText LogPolicy
LogPolicyBlock = s
"block"

readLogPolicy
    ∷ (MonadError e m, IsString e, Monoid e)
    ⇒ T.Text
    → m LogPolicy
readLogPolicy :: forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogPolicy
readLogPolicy Text
x = case Text -> Text
T.toLower Text
x of
    Text
"discard" → forall (m :: * -> *) a. Monad m => a -> m a
return LogPolicy
LogPolicyDiscard
    Text
"raise" → forall (m :: * -> *) a. Monad m => a -> m a
return LogPolicy
LogPolicyRaise
    Text
"block" → forall (m :: * -> *) a. Monad m => a -> m a
return LogPolicy
LogPolicyBlock
    Text
e → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        forall a b. (a -> b) -> a -> b
$ e
"invalid log policy value " forall α. Monoid α => α -> α -> α
⊕ forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Text
e) forall α. Monoid α => α -> α -> α
⊕ e
";"
        forall α. Monoid α => α -> α -> α
⊕ e
" the log policy value must be one of \"discard\", \"raise\", or \"block\""

instance ToJSON LogPolicy where
    toJSON :: LogPolicy -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (forall s. IsString s => LogPolicy -> s
logPolicyText ∷ LogPolicy → T.Text)

instance FromJSON LogPolicy where
    parseJSON :: Value -> Parser LogPolicy
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"LogPolicy" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogPolicy
readLogPolicy

pLogPolicy ∷ O.Parser LogPolicy
pLogPolicy :: Parser LogPolicy
pLogPolicy = Text -> Parser LogPolicy
pLogPolicy_ Text
""

-- | A version of 'pLogPolicy' that takes a prefix for the
-- command line option.
--
-- @since 0.2
--
pLogPolicy_
    ∷ T.Text
        -- ^ prefix for the command line options.
    → O.Parser LogPolicy
pLogPolicy_ :: Text -> Parser LogPolicy
pLogPolicy_ Text
prefix = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader (forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogPolicy
readLogPolicy forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
. [Char] -> Text
T.pack))
    forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long (Text -> [Char]
T.unpack Text
prefix forall α. Monoid α => α -> α -> α
⊕ [Char]
"log-policy")
    forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"block|raise|discard"
    forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"how to deal with a congested logging pipeline"

-- -------------------------------------------------------------------------- --
-- Log-Label

type LogLabel = (T.Text, T.Text)
type LogScope = [LogLabel]

-- -------------------------------------------------------------------------- --
-- Logger Exception

-- | Exceptions that are thrown by the logger
--
-- ['QueueFullException'] thrown when the queue is full and the logger policy
--     is set to throw exceptions on a full queue
--
-- ['BackendTerminatedException'] a backend can throw this exception to force
--     the logger immediately
--
-- ['BackendTooManyExceptions'] thrown when the backend has thrown unexpected
--     exceptions more than 'loggerConfigExceptionLimit' times
--
-- @since 0.2
--
data LoggerException a where
    QueueFullException ∷ LogMessage a → LoggerException a
    BackendTerminatedException ∷ SomeException → LoggerException Void
    BackendTooManyExceptions ∷ [SomeException] → LoggerException Void
    deriving (Typeable)

deriving instance Show a ⇒ Show (LoggerException a)
instance (Typeable a, Show a) ⇒ Exception (LoggerException a)

-- -------------------------------------------------------------------------- --
-- Backend

-- | The Internal log message type.
--
-- The type parameter @a@ is expected to provide intances
-- of 'Show', 'Typeable', and 'NFData'.
--
-- If we need to support different backends, we may consider
-- including the backend here...
--
data LogMessage a = LogMessage
    { forall a. LogMessage a -> a
_logMsg ∷ !a
    , forall a. LogMessage a -> LogLevel
_logMsgLevel ∷ !LogLevel
    , forall a. LogMessage a -> LogScope
_logMsgScope ∷ !LogScope
        -- ^ efficiency of this depends on whether this is shared
        -- between log messsages. Usually this should be just a pointer to
        -- a shared list.
    , forall a. LogMessage a -> TimeSpec
_logMsgTime ∷ !TimeSpec
        -- ^ a POSIX timestamp
        --
        -- UTC seconds elapsed since UNIX Epoch as returned by @clock_gettime@
        -- on the respective system. NOTE that POSIX is ambigious with regard
        -- to treatment of leap seconds, and some implementations may actually
        -- return TAI.
        --
        -- @since 0.2
    }
    deriving (Int -> LogMessage a -> ShowS
forall a. Show a => Int -> LogMessage a -> ShowS
forall a. Show a => [LogMessage a] -> ShowS
forall a. Show a => LogMessage a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage a] -> ShowS
$cshowList :: forall a. Show a => [LogMessage a] -> ShowS
show :: LogMessage a -> [Char]
$cshow :: forall a. Show a => LogMessage a -> [Char]
showsPrec :: Int -> LogMessage a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LogMessage a -> ShowS
Show, ReadPrec [LogMessage a]
ReadPrec (LogMessage a)
ReadS [LogMessage a]
forall a. Read a => ReadPrec [LogMessage a]
forall a. Read a => ReadPrec (LogMessage a)
forall a. Read a => Int -> ReadS (LogMessage a)
forall a. Read a => ReadS [LogMessage a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogMessage a]
$creadListPrec :: forall a. Read a => ReadPrec [LogMessage a]
readPrec :: ReadPrec (LogMessage a)
$creadPrec :: forall a. Read a => ReadPrec (LogMessage a)
readList :: ReadS [LogMessage a]
$creadList :: forall a. Read a => ReadS [LogMessage a]
readsPrec :: Int -> ReadS (LogMessage a)
$creadsPrec :: forall a. Read a => Int -> ReadS (LogMessage a)
Read, LogMessage a -> LogMessage a -> Bool
forall a. Eq a => LogMessage a -> LogMessage a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessage a -> LogMessage a -> Bool
$c/= :: forall a. Eq a => LogMessage a -> LogMessage a -> Bool
== :: LogMessage a -> LogMessage a -> Bool
$c== :: forall a. Eq a => LogMessage a -> LogMessage a -> Bool
Eq, LogMessage a -> LogMessage a -> Bool
LogMessage a -> LogMessage a -> Ordering
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
forall {a}. Ord a => Eq (LogMessage a)
forall a. Ord a => LogMessage a -> LogMessage a -> Bool
forall a. Ord a => LogMessage a -> LogMessage a -> Ordering
forall a. Ord a => LogMessage a -> LogMessage a -> LogMessage a
min :: LogMessage a -> LogMessage a -> LogMessage a
$cmin :: forall a. Ord a => LogMessage a -> LogMessage a -> LogMessage a
max :: LogMessage a -> LogMessage a -> LogMessage a
$cmax :: forall a. Ord a => LogMessage a -> LogMessage a -> LogMessage a
>= :: LogMessage a -> LogMessage a -> Bool
$c>= :: forall a. Ord a => LogMessage a -> LogMessage a -> Bool
> :: LogMessage a -> LogMessage a -> Bool
$c> :: forall a. Ord a => LogMessage a -> LogMessage a -> Bool
<= :: LogMessage a -> LogMessage a -> Bool
$c<= :: forall a. Ord a => LogMessage a -> LogMessage a -> Bool
< :: LogMessage a -> LogMessage a -> Bool
$c< :: forall a. Ord a => LogMessage a -> LogMessage a -> Bool
compare :: LogMessage a -> LogMessage a -> Ordering
$ccompare :: forall a. Ord a => LogMessage a -> LogMessage a -> Ordering
Ord, Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LogMessage a) x -> LogMessage a
forall a x. LogMessage a -> Rep (LogMessage a) x
$cto :: forall a x. Rep (LogMessage a) x -> LogMessage a
$cfrom :: forall a x. LogMessage a -> Rep (LogMessage a) x
Generic)

logMsg ∷ Lens (LogMessage a) (LogMessage b) a b
logMsg :: forall a b. Lens (LogMessage a) (LogMessage b) a b
logMsg = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. LogMessage a -> a
_logMsg forall a b. (a -> b) -> a -> b
$ \LogMessage a
a b
b → LogMessage a
a { _logMsg :: b
_logMsg = b
b }

logMsgLevel ∷ Lens' (LogMessage a) LogLevel
logMsgLevel :: forall a. Lens' (LogMessage a) LogLevel
logMsgLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. LogMessage a -> LogLevel
_logMsgLevel forall a b. (a -> b) -> a -> b
$ \LogMessage a
a LogLevel
b → LogMessage a
a { _logMsgLevel :: LogLevel
_logMsgLevel = LogLevel
b }

logMsgScope ∷ Lens' (LogMessage a) LogScope
logMsgScope :: forall a. Lens' (LogMessage a) LogScope
logMsgScope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. LogMessage a -> LogScope
_logMsgScope forall a b. (a -> b) -> a -> b
$ \LogMessage a
a LogScope
b → LogMessage a
a { _logMsgScope :: LogScope
_logMsgScope = LogScope
b }

-- | @since 0.2
--
logMsgTime ∷ Lens' (LogMessage a) TimeSpec
logMsgTime :: forall a. Lens' (LogMessage a) TimeSpec
logMsgTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. LogMessage a -> TimeSpec
_logMsgTime forall a b. (a -> b) -> a -> b
$ \LogMessage a
a TimeSpec
b → LogMessage a
a { _logMsgTime :: TimeSpec
_logMsgTime = TimeSpec
b }

instance NFData TimeSpec
instance NFData a ⇒ NFData (LogMessage a)

-- | This is given to logger when it is created. It formats and delivers
-- individual log messages synchronously. The backend is called once for each
-- log message (that meets the required log level).
--
-- The type parameter @a@ is expected to provide instances for 'Show'
-- 'Typeable', and 'NFData'.
--
-- The 'Left' values of the argument allows the generation of log messages that
-- are independent of the parameter @a@. The motivation for this is reporting
-- issues in Logging system itself, like a full logger queue or providing
-- statistics about the fill level of the queue. There may be other uses of
-- this, too.
--
-- Backends that can fail are encouraged (but not forced) to take into account
-- the 'LogPolicy' that is effective for a message. For instance, a backend may
-- implement a reasonable retry logic for each message and then raise a
-- 'BackendTerminatedException' in case the policy is 'LogPolicyBlock' or
-- 'LogPolicyRaise' (thus causing the logger to exit immediately) and raise
-- some other exception otherwise (thus discarding the message without causing
-- the logger to not exit immediately). In addition a backend might retry
-- harder in case of 'LogPolicyBlock'.
--
-- TODO there may be scenarios where chunked processing is beneficial. While
-- this can be done in a closure of this function, more direct support might
-- be desirable.
--
type LoggerBackend a = Either (LogMessage T.Text) (LogMessage a) → IO ()

-- -------------------------------------------------------------------------- --
-- Frontend

-- | This function is provided by the logger.
--
type LogFunctionIO a = LogLevel → a → IO ()
type LogFunction a m = LogLevel → a → m ()

-- -------------------------------------------------------------------------- --
-- MonadLog

class Monad m ⇒ MonadLog a m | m → a where

    -- | Log a message.
    --
    logg ∷ LogFunction a m

    -- | Run the inner computation with the given 'LogLevel'
    withLevel ∷ LogLevel → m α → m α

    -- | Run the inner computation with the given 'LogPolicy'.
    withPolicy ∷ LogPolicy → m α → m α

    -- | Run the inner computation with a modified 'LogScope'.
    --
    -- @since 0.1
    --
    localScope ∷ (LogScope → LogScope) → m α → m α

-- | Append a 'LogLabel' to the current 'LogScope' when executing the
-- inner computation. The 'LogScope' of the outer computation is unchanged.
--
-- @since 0.1
--
withLabel ∷ MonadLog a m ⇒ LogLabel → m α → m α
withLabel :: forall a (m :: * -> *) α.
MonadLog a m =>
(Text, Text) -> m α -> m α
withLabel = forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (:)

-- | Remove the last 'LogLabel' from the current 'LogScope' when
-- executing the inner computation. The 'LogScope' of the outer
-- computation is unchanged.
--
-- @since 0.1
--
popLabel ∷ MonadLog a m ⇒ m α → m α
popLabel :: forall a (m :: * -> *) α. MonadLog a m => m α -> m α
popLabel = forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope forall a b. (a -> b) -> a -> b
$ \case { [] → []; ((Text, Text)
_:LogScope
t) → LogScope
t }

-- | Executing the inner computation with an empty 'LogScope'. The
-- 'LogScope' of the outer computation is unchanged.
--
-- @since 0.1
--
clearScope ∷ MonadLog a m ⇒ m α → m α
clearScope :: forall a (m :: * -> *) α. MonadLog a m => m α -> m α
clearScope = forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const []

{-
-- Not sure if this instance is a good idea
instance (Show a, Typeable a, NFData a, MonadIO m, LoggerCtx ctx a, MonadReader ctx m) ⇒ MonadLog a m where
    logg l m = ask ≫= \ctx → liftIO (loggerFunIO ctx l m)
    withLevel level = local $ setLoggerLevel .~ level
    withPolicy policy = local $ setLoggerPolicy .~ policy
    localScope = local ∘ over setLoggerScope

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withPolicy #-}
    {-# INLINE localScope #-}

-- Not sure if this instance is a good idea
instance MonadLog a m ⇒ MonadLog a (ReaderT σ m) where
    logg l = lift ∘ logg l
    withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return
    withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return
    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withPolicy #-}
    {-# INLINE localScope #-}
-}

instance (Monoid σ, MonadLog a m) ⇒ MonadLog a (WriterT σ m) where
    logg :: LogFunction a (WriterT σ m)
logg LogLevel
l = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a (m :: * -> *). MonadLog a m => LogFunction a m
logg LogLevel
l
    withLevel :: forall α. LogLevel -> WriterT σ m α -> WriterT σ m α
withLevel LogLevel
level WriterT σ m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WriterT σ)
run → forall a (m :: * -> *) α. MonadLog a m => LogLevel -> m α -> m α
withLevel LogLevel
level (Run (WriterT σ)
run WriterT σ m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return
    withPolicy :: forall α. LogPolicy -> WriterT σ m α -> WriterT σ m α
withPolicy LogPolicy
policy WriterT σ m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WriterT σ)
run → forall a (m :: * -> *) α. MonadLog a m => LogPolicy -> m α -> m α
withPolicy LogPolicy
policy (Run (WriterT σ)
run WriterT σ m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return
    localScope :: forall α. (LogScope -> LogScope) -> WriterT σ m α -> WriterT σ m α
localScope LogScope -> LogScope
f WriterT σ m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WriterT σ)
run → forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope LogScope -> LogScope
f (Run (WriterT σ)
run WriterT σ m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withPolicy #-}
    {-# INLINE localScope #-}

instance (MonadLog a m) ⇒ MonadLog a (ExceptT ε m) where
    logg :: LogFunction a (ExceptT ε m)
logg LogLevel
l = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a (m :: * -> *). MonadLog a m => LogFunction a m
logg LogLevel
l
    withLevel :: forall α. LogLevel -> ExceptT ε m α -> ExceptT ε m α
withLevel LogLevel
level ExceptT ε m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (ExceptT ε)
run → forall a (m :: * -> *) α. MonadLog a m => LogLevel -> m α -> m α
withLevel LogLevel
level (Run (ExceptT ε)
run ExceptT ε m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return
    withPolicy :: forall α. LogPolicy -> ExceptT ε m α -> ExceptT ε m α
withPolicy LogPolicy
policy ExceptT ε m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (ExceptT ε)
run → forall a (m :: * -> *) α. MonadLog a m => LogPolicy -> m α -> m α
withPolicy LogPolicy
policy (Run (ExceptT ε)
run ExceptT ε m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return
    localScope :: forall α. (LogScope -> LogScope) -> ExceptT ε m α -> ExceptT ε m α
localScope LogScope -> LogScope
f ExceptT ε m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (ExceptT ε)
run → forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope LogScope -> LogScope
f (Run (ExceptT ε)
run ExceptT ε m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withPolicy #-}
    {-# INLINE localScope #-}

instance (MonadLog a m) ⇒ MonadLog a (StateT σ m) where
    logg :: LogFunction a (StateT σ m)
logg LogLevel
l = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a (m :: * -> *). MonadLog a m => LogFunction a m
logg LogLevel
l
    withLevel :: forall α. LogLevel -> StateT σ m α -> StateT σ m α
withLevel LogLevel
level StateT σ m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (StateT σ)
run → forall a (m :: * -> *) α. MonadLog a m => LogLevel -> m α -> m α
withLevel LogLevel
level (Run (StateT σ)
run StateT σ m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return
    withPolicy :: forall α. LogPolicy -> StateT σ m α -> StateT σ m α
withPolicy LogPolicy
policy StateT σ m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (StateT σ)
run → forall a (m :: * -> *) α. MonadLog a m => LogPolicy -> m α -> m α
withPolicy LogPolicy
policy (Run (StateT σ)
run StateT σ m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return
    localScope :: forall α. (LogScope -> LogScope) -> StateT σ m α -> StateT σ m α
localScope LogScope -> LogScope
f StateT σ m α
inner = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (StateT σ)
run → forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope LogScope -> LogScope
f (Run (StateT σ)
run StateT σ m α
inner)) forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) a. Monad m => a -> m a
return

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withPolicy #-}
    {-# INLINE localScope #-}

{-
-- Uses @OverlappingInstances@ to lift MonadLog in all transformers with an
-- instance for 'MonadTransControl'.
--
-- It would be really cool if this would work
--
instance (MonadLog a m, MonadTransControl t, Monad n, n ~ (t m)) ⇒ MonadLog a n where
    logg l = lift ∘ logg l
    withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return
    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return
    withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withLabel #-}
    {-# INLINE withPolicy #-}
-}

-- -------------------------------------------------------------------------- --
-- Logger Context

-- | Abstraction of a logger context that can be used without dependening on
-- a specific monadic context.
--
-- The 'loggerFunIO' incorporates a 'LoggerBackend'. An instance of a 'LoggerCtx'
-- is free to use a hard coded 'LoggerBackend' or to be usable with different
-- 'LoggerBackend' functions. The latter is recommended but not required.
--
-- You don't have to provide an instance of this for your logger. Instead you
-- may just provide an instance of 'MonadLog' directly.
--
-- If this doesn't fit your needs you may use a newtype wrapper and define
-- your own instances.
--
class LoggerCtx ctx msg | ctx → msg where
    loggerFunIO
        ∷ (Show msg, Typeable msg, NFData msg)
        ⇒ ctx
        → LogFunctionIO msg

    setLoggerLevel ∷ Lens' ctx LogLevel
    setLoggerScope ∷ Lens' ctx LogScope
    setLoggerPolicy ∷ Lens' ctx LogPolicy

    withLoggerLevel ∷ LogLevel → ctx → (ctx → α) → α
    withLoggerLevel LogLevel
level ctx
ctx ctx -> α
f = ctx -> α
f forall a b. (a -> b) -> a -> b
$ ctx
ctx forall a b. a -> (a -> b) -> b
& forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogLevel
setLoggerLevel forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel
level
    {-# INLINE withLoggerLevel #-}

    withLoggerLabel ∷ LogLabel → ctx → (ctx → α) → α
    withLoggerLabel (Text, Text)
label ctx
ctx ctx -> α
f = ctx -> α
f forall a b. (a -> b) -> a -> b
$ ctx
ctx forall a b. a -> (a -> b) -> b
& forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogScope
setLoggerScope forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (:) (Text, Text)
label
    {-# INLINE withLoggerLabel #-}

    withLoggerPolicy ∷ LogPolicy → ctx → (ctx → α) → α
    withLoggerPolicy LogPolicy
policy ctx
ctx ctx -> α
f = ctx -> α
f forall a b. (a -> b) -> a -> b
$ ctx
ctx forall a b. a -> (a -> b) -> b
& forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogPolicy
setLoggerPolicy forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogPolicy
policy
    {-# INLINE withLoggerPolicy #-}

newtype LoggerCtxT ctx m α = LoggerCtxT { forall ctx (m :: * -> *) α. LoggerCtxT ctx m α -> ReaderT ctx m α
unLoggerCtxT ∷ ReaderT ctx m α }
    deriving (forall a b. a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
forall a b. (a -> b) -> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
forall ctx (m :: * -> *) a b.
Functor m =>
a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
forall ctx (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
$c<$ :: forall ctx (m :: * -> *) a b.
Functor m =>
a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
fmap :: forall a b. (a -> b) -> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
$cfmap :: forall ctx (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
Functor, forall a. a -> LoggerCtxT ctx m a
forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
forall a b.
LoggerCtxT ctx m (a -> b)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
forall a b c.
(a -> b -> c)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m c
forall {ctx} {m :: * -> *}.
Applicative m =>
Functor (LoggerCtxT ctx m)
forall ctx (m :: * -> *) a.
Applicative m =>
a -> LoggerCtxT ctx m a
forall ctx (m :: * -> *) a b.
Applicative m =>
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
forall ctx (m :: * -> *) a b.
Applicative m =>
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
forall ctx (m :: * -> *) a b.
Applicative m =>
LoggerCtxT ctx m (a -> b)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
forall ctx (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
$c<* :: forall ctx (m :: * -> *) a b.
Applicative m =>
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
*> :: forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
$c*> :: forall ctx (m :: * -> *) a b.
Applicative m =>
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
liftA2 :: forall a b c.
(a -> b -> c)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m c
$cliftA2 :: forall ctx (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m c
<*> :: forall a b.
LoggerCtxT ctx m (a -> b)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
$c<*> :: forall ctx (m :: * -> *) a b.
Applicative m =>
LoggerCtxT ctx m (a -> b)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
pure :: forall a. a -> LoggerCtxT ctx m a
$cpure :: forall ctx (m :: * -> *) a.
Applicative m =>
a -> LoggerCtxT ctx m a
Applicative, forall a. a -> LoggerCtxT ctx m a
forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
forall a b.
LoggerCtxT ctx m a
-> (a -> LoggerCtxT ctx m b) -> LoggerCtxT ctx m b
forall {ctx} {m :: * -> *}.
Monad m =>
Applicative (LoggerCtxT ctx m)
forall ctx (m :: * -> *) a. Monad m => a -> LoggerCtxT ctx m a
forall ctx (m :: * -> *) a b.
Monad m =>
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
forall ctx (m :: * -> *) a b.
Monad m =>
LoggerCtxT ctx m a
-> (a -> LoggerCtxT ctx m b) -> LoggerCtxT ctx m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> LoggerCtxT ctx m a
$creturn :: forall ctx (m :: * -> *) a. Monad m => a -> LoggerCtxT ctx m a
>> :: forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
$c>> :: forall ctx (m :: * -> *) a b.
Monad m =>
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
>>= :: forall a b.
LoggerCtxT ctx m a
-> (a -> LoggerCtxT ctx m b) -> LoggerCtxT ctx m b
$c>>= :: forall ctx (m :: * -> *) a b.
Monad m =>
LoggerCtxT ctx m a
-> (a -> LoggerCtxT ctx m b) -> LoggerCtxT ctx m b
Monad, forall a. IO a -> LoggerCtxT ctx m a
forall {ctx} {m :: * -> *}. MonadIO m => Monad (LoggerCtxT ctx m)
forall ctx (m :: * -> *) a. MonadIO m => IO a -> LoggerCtxT ctx m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> LoggerCtxT ctx m a
$cliftIO :: forall ctx (m :: * -> *) a. MonadIO m => IO a -> LoggerCtxT ctx m a
MonadIO, forall ctx (m :: * -> *) a. Monad m => m a -> LoggerCtxT ctx m a
forall (m :: * -> *) a. Monad m => m a -> LoggerCtxT ctx m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> LoggerCtxT ctx m a
$clift :: forall ctx (m :: * -> *) a. Monad m => m a -> LoggerCtxT ctx m a
MonadTrans, MonadReader ctx, MonadError a, MonadState a, MonadWriter a, MonadBase a, forall e a. Exception e => e -> LoggerCtxT ctx m a
forall {ctx} {m :: * -> *}.
MonadThrow m =>
Monad (LoggerCtxT ctx m)
forall ctx (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LoggerCtxT ctx m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> LoggerCtxT ctx m a
$cthrowM :: forall ctx (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LoggerCtxT ctx m a
MonadThrow, forall e a.
Exception e =>
LoggerCtxT ctx m a
-> (e -> LoggerCtxT ctx m a) -> LoggerCtxT ctx m a
forall {ctx} {m :: * -> *}.
MonadCatch m =>
MonadThrow (LoggerCtxT ctx m)
forall ctx (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LoggerCtxT ctx m a
-> (e -> LoggerCtxT ctx m a) -> LoggerCtxT ctx m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
LoggerCtxT ctx m a
-> (e -> LoggerCtxT ctx m a) -> LoggerCtxT ctx m a
$ccatch :: forall ctx (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LoggerCtxT ctx m a
-> (e -> LoggerCtxT ctx m a) -> LoggerCtxT ctx m a
MonadCatch, forall b.
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
 -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
forall a b c.
LoggerCtxT ctx m a
-> (a -> ExitCase b -> LoggerCtxT ctx m c)
-> (a -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m (b, c)
forall {ctx} {m :: * -> *}.
MonadMask m =>
MonadCatch (LoggerCtxT ctx m)
forall ctx (m :: * -> *) b.
MonadMask m =>
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
 -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
forall ctx (m :: * -> *) a b c.
MonadMask m =>
LoggerCtxT ctx m a
-> (a -> ExitCase b -> LoggerCtxT ctx m c)
-> (a -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
LoggerCtxT ctx m a
-> (a -> ExitCase b -> LoggerCtxT ctx m c)
-> (a -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m (b, c)
$cgeneralBracket :: forall ctx (m :: * -> *) a b c.
MonadMask m =>
LoggerCtxT ctx m a
-> (a -> ExitCase b -> LoggerCtxT ctx m c)
-> (a -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m (b, c)
uninterruptibleMask :: forall b.
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
 -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
$cuninterruptibleMask :: forall ctx (m :: * -> *) b.
MonadMask m =>
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
 -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
mask :: forall b.
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
 -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
$cmask :: forall ctx (m :: * -> *) b.
MonadMask m =>
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
 -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
MonadMask)

instance MonadTransControl (LoggerCtxT ctx) where
    type StT (LoggerCtxT ctx) a = StT (ReaderT ctx) a
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (LoggerCtxT ctx) -> m a) -> LoggerCtxT ctx m a
liftWith = forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall ctx (m :: * -> *) α. ReaderT ctx m α -> LoggerCtxT ctx m α
LoggerCtxT forall ctx (m :: * -> *) α. LoggerCtxT ctx m α -> ReaderT ctx m α
unLoggerCtxT
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (LoggerCtxT ctx) a) -> LoggerCtxT ctx m a
restoreT = forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT forall ctx (m :: * -> *) α. ReaderT ctx m α -> LoggerCtxT ctx m α
LoggerCtxT
    {-# INLINE liftWith #-}
    {-# INLINE restoreT #-}

instance MonadBaseControl b m ⇒ MonadBaseControl b (LoggerCtxT ctx m) where
    type StM (LoggerCtxT ctx m) a = ComposeSt (LoggerCtxT ctx) m a
    liftBaseWith :: forall a.
(RunInBase (LoggerCtxT ctx m) b -> b a) -> LoggerCtxT ctx m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: forall a. StM (LoggerCtxT ctx m) a -> LoggerCtxT ctx m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
    {-# INLINE liftBaseWith #-}
    {-# INLINE restoreM #-}

runLoggerCtxT
    ∷ LoggerCtxT ctx m α
    → ctx
    → m α
runLoggerCtxT :: forall ctx (m :: * -> *) α. LoggerCtxT ctx m α -> ctx -> m α
runLoggerCtxT = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall ctx (m :: * -> *) α. LoggerCtxT ctx m α -> ReaderT ctx m α
unLoggerCtxT
{-# INLINE runLoggerCtxT #-}

instance (Show a, Typeable a, NFData a, MonadIO m, LoggerCtx ctx a) ⇒ MonadLog a (LoggerCtxT ctx m) where
    logg :: LogFunction a (LoggerCtxT ctx m)
logg LogLevel
l a
m = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= \ctx
ctx → forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall ctx msg.
(LoggerCtx ctx msg, Show msg, Typeable msg, NFData msg) =>
ctx -> LogFunctionIO msg
loggerFunIO ctx
ctx LogLevel
l a
m)
    withLevel :: forall α. LogLevel -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
withLevel LogLevel
level = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogLevel
setLoggerLevel forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel
level
    withPolicy :: forall α. LogPolicy -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
withPolicy LogPolicy
policy = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogPolicy
setLoggerPolicy forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogPolicy
policy
    localScope :: forall α.
(LogScope -> LogScope) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
localScope LogScope -> LogScope
f = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogScope
setLoggerScope forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ LogScope -> LogScope
f

    {-# INLINE logg #-}
    {-# INLINE withLevel #-}
    {-# INLINE withPolicy #-}
    {-# INLINE localScope #-}