{-# 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(..)
, logLevelText
, readLogLevel
, pLogLevel
, pLogLevel_
, LogPolicy(..)
, logPolicyText
, readLogPolicy
, pLogPolicy
, pLogPolicy_
, LogLabel
, LogScope
, LoggerException(..)
, LogMessage(..)
, logMsg
, logMsgLevel
, logMsgScope
, logMsgTime
, LoggerBackend
, LogFunction
, LogFunctionIO
, LoggerCtx(..)
, LoggerCtxT
, runLoggerCtxT
, 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
data LogLevel
= Quiet
| Error
| Warn
| Info
| Debug
deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
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
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq LogLevel
Ord, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
maxBound :: LogLevel
$cmaxBound :: LogLevel
minBound :: LogLevel
$cminBound :: LogLevel
Bounded, Typeable, (forall x. LogLevel -> Rep LogLevel x)
-> (forall x. Rep LogLevel x -> LogLevel) -> Generic LogLevel
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 :: Text -> m LogLevel
readLogLevel Text
x = case Text -> Text
T.toLower Text
x of
Text
"quiet" → LogLevel -> m LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Quiet
Text
"error" → LogLevel -> m LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Error
Text
"warn" → LogLevel -> m LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Warn
Text
"info" → LogLevel -> m LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Info
Text
"debug" → LogLevel -> m LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
Debug
Text
e → e -> m LogLevel
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m LogLevel) -> e -> m LogLevel
forall a b. (a -> b) -> a -> b
$ e
"unexpected log level value: "
e -> e -> e
forall α. Monoid α => α -> α -> α
⊕ String -> e
forall a. IsString a => String -> a
fromString (Text -> String
forall a. Show a => a -> String
show Text
e)
e -> e -> e
forall α. Monoid α => α -> α -> α
⊕ e
", expected \"quiet\", \"error\", \"warn\", \"info\", or \"debug\""
logLevelText
∷ IsString a
⇒ LogLevel
→ a
logLevelText :: 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 (Text -> Value) -> (LogLevel -> Text) -> LogLevel -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ LogLevel -> Text
forall a. IsString a => LogLevel -> a
logLevelText
instance FromJSON LogLevel where
parseJSON :: Value -> Parser LogLevel
parseJSON = String -> (Text -> Parser LogLevel) -> Value -> Parser LogLevel
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LogLevel" ((Text -> Parser LogLevel) -> Value -> Parser LogLevel)
-> (Text -> Parser LogLevel) -> Value -> Parser LogLevel
forall a b. (a -> b) -> a -> b
$ (String -> Parser LogLevel)
-> (LogLevel -> Parser LogLevel)
-> Either String LogLevel
-> Parser LogLevel
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser LogLevel
forall (m :: * -> *) a. MonadFail m => String -> m a
fail LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String LogLevel -> Parser LogLevel)
-> (Text -> Either String LogLevel) -> Text -> Parser LogLevel
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> Either String LogLevel
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
""
pLogLevel_
∷ T.Text
→ O.Parser LogLevel
pLogLevel_ :: Text -> Parser LogLevel
pLogLevel_ Text
prefix = ReadM LogLevel -> Mod OptionFields LogLevel -> Parser LogLevel
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String LogLevel) -> ReadM LogLevel
forall a. (String -> Either String a) -> ReadM a
eitherReader (Text -> Either String LogLevel
forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogLevel
readLogLevel (Text -> Either String LogLevel)
-> (String -> Text) -> String -> Either String LogLevel
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
. String -> Text
T.pack))
(Mod OptionFields LogLevel -> Parser LogLevel)
-> Mod OptionFields LogLevel -> Parser LogLevel
forall a b. (a -> b) -> a -> b
% String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
T.unpack Text
prefix String -> ShowS
forall α. Monoid α => α -> α -> α
⊕ String
"log-level")
Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"quiet|error|warn|info|debug"
Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. String -> Mod f a
help String
"threshold for log messages"
data LogPolicy
= LogPolicyDiscard
| LogPolicyRaise
| LogPolicyBlock
deriving (Int -> LogPolicy -> ShowS
[LogPolicy] -> ShowS
LogPolicy -> String
(Int -> LogPolicy -> ShowS)
-> (LogPolicy -> String)
-> ([LogPolicy] -> ShowS)
-> Show LogPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogPolicy] -> ShowS
$cshowList :: [LogPolicy] -> ShowS
show :: LogPolicy -> String
$cshow :: LogPolicy -> String
showsPrec :: Int -> LogPolicy -> ShowS
$cshowsPrec :: Int -> LogPolicy -> ShowS
Show, ReadPrec [LogPolicy]
ReadPrec LogPolicy
Int -> ReadS LogPolicy
ReadS [LogPolicy]
(Int -> ReadS LogPolicy)
-> ReadS [LogPolicy]
-> ReadPrec LogPolicy
-> ReadPrec [LogPolicy]
-> Read 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
(LogPolicy -> LogPolicy -> Bool)
-> (LogPolicy -> LogPolicy -> Bool) -> Eq LogPolicy
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
Eq LogPolicy
-> (LogPolicy -> LogPolicy -> Ordering)
-> (LogPolicy -> LogPolicy -> Bool)
-> (LogPolicy -> LogPolicy -> Bool)
-> (LogPolicy -> LogPolicy -> Bool)
-> (LogPolicy -> LogPolicy -> Bool)
-> (LogPolicy -> LogPolicy -> LogPolicy)
-> (LogPolicy -> LogPolicy -> LogPolicy)
-> Ord 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
$cp1Ord :: Eq LogPolicy
Ord, LogPolicy
LogPolicy -> LogPolicy -> Bounded 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]
(LogPolicy -> LogPolicy)
-> (LogPolicy -> LogPolicy)
-> (Int -> LogPolicy)
-> (LogPolicy -> Int)
-> (LogPolicy -> [LogPolicy])
-> (LogPolicy -> LogPolicy -> [LogPolicy])
-> (LogPolicy -> LogPolicy -> [LogPolicy])
-> (LogPolicy -> LogPolicy -> LogPolicy -> [LogPolicy])
-> Enum 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. LogPolicy -> Rep LogPolicy x)
-> (forall x. Rep LogPolicy x -> LogPolicy) -> Generic LogPolicy
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 :: 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 :: Text -> m LogPolicy
readLogPolicy Text
x = case Text -> Text
T.toLower Text
x of
Text
"discard" → LogPolicy -> m LogPolicy
forall (m :: * -> *) a. Monad m => a -> m a
return LogPolicy
LogPolicyDiscard
Text
"raise" → LogPolicy -> m LogPolicy
forall (m :: * -> *) a. Monad m => a -> m a
return LogPolicy
LogPolicyRaise
Text
"block" → LogPolicy -> m LogPolicy
forall (m :: * -> *) a. Monad m => a -> m a
return LogPolicy
LogPolicyBlock
Text
e → e -> m LogPolicy
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(e -> m LogPolicy) -> e -> m LogPolicy
forall a b. (a -> b) -> a -> b
$ e
"invalid log policy value " e -> e -> e
forall α. Monoid α => α -> α -> α
⊕ String -> e
forall a. IsString a => String -> a
fromString (Text -> String
forall a. Show a => a -> String
show Text
e) e -> e -> e
forall α. Monoid α => α -> α -> α
⊕ e
";"
e -> e -> e
forall α. Monoid α => α -> α -> α
⊕ e
" the log policy value must be one of \"discard\", \"raise\", or \"block\""
instance ToJSON LogPolicy where
toJSON :: LogPolicy -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (LogPolicy -> Text) -> LogPolicy -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (LogPolicy -> Text
forall s. IsString s => LogPolicy -> s
logPolicyText ∷ LogPolicy → T.Text)
instance FromJSON LogPolicy where
parseJSON :: Value -> Parser LogPolicy
parseJSON = String -> (Text -> Parser LogPolicy) -> Value -> Parser LogPolicy
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LogPolicy" ((Text -> Parser LogPolicy) -> Value -> Parser LogPolicy)
-> (Text -> Parser LogPolicy) -> Value -> Parser LogPolicy
forall a b. (a -> b) -> a -> b
$ (String -> Parser LogPolicy)
-> (LogPolicy -> Parser LogPolicy)
-> Either String LogPolicy
-> Parser LogPolicy
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser LogPolicy
forall (m :: * -> *) a. MonadFail m => String -> m a
fail LogPolicy -> Parser LogPolicy
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String LogPolicy -> Parser LogPolicy)
-> (Text -> Either String LogPolicy) -> Text -> Parser LogPolicy
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> Either String LogPolicy
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
""
pLogPolicy_
∷ T.Text
→ O.Parser LogPolicy
pLogPolicy_ :: Text -> Parser LogPolicy
pLogPolicy_ Text
prefix = ReadM LogPolicy -> Mod OptionFields LogPolicy -> Parser LogPolicy
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String LogPolicy) -> ReadM LogPolicy
forall a. (String -> Either String a) -> ReadM a
eitherReader (Text -> Either String LogPolicy
forall e (m :: * -> *).
(MonadError e m, IsString e, Monoid e) =>
Text -> m LogPolicy
readLogPolicy (Text -> Either String LogPolicy)
-> (String -> Text) -> String -> Either String LogPolicy
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
. String -> Text
T.pack))
(Mod OptionFields LogPolicy -> Parser LogPolicy)
-> Mod OptionFields LogPolicy -> Parser LogPolicy
forall a b. (a -> b) -> a -> b
% String -> Mod OptionFields LogPolicy
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
T.unpack Text
prefix String -> ShowS
forall α. Monoid α => α -> α -> α
⊕ String
"log-policy")
Mod OptionFields LogPolicy
-> Mod OptionFields LogPolicy -> Mod OptionFields LogPolicy
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields LogPolicy
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"block|raise|discard"
Mod OptionFields LogPolicy
-> Mod OptionFields LogPolicy -> Mod OptionFields LogPolicy
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields LogPolicy
forall (f :: * -> *) a. String -> Mod f a
help String
"how to deal with a congested logging pipeline"
type LogLabel = (T.Text, T.Text)
type LogScope = [LogLabel]
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)
data LogMessage a = LogMessage
{ LogMessage a -> a
_logMsg ∷ !a
, LogMessage a -> LogLevel
_logMsgLevel ∷ !LogLevel
, LogMessage a -> LogScope
_logMsgScope ∷ !LogScope
, LogMessage a -> TimeSpec
_logMsgTime ∷ !TimeSpec
}
deriving (Int -> LogMessage a -> ShowS
[LogMessage a] -> ShowS
LogMessage a -> String
(Int -> LogMessage a -> ShowS)
-> (LogMessage a -> String)
-> ([LogMessage a] -> ShowS)
-> Show (LogMessage a)
forall a. Show a => Int -> LogMessage a -> ShowS
forall a. Show a => [LogMessage a] -> ShowS
forall a. Show a => LogMessage a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage a] -> ShowS
$cshowList :: forall a. Show a => [LogMessage a] -> ShowS
show :: LogMessage a -> String
$cshow :: forall a. Show a => LogMessage a -> String
showsPrec :: Int -> LogMessage a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LogMessage a -> ShowS
Show, ReadPrec [LogMessage a]
ReadPrec (LogMessage a)
Int -> ReadS (LogMessage a)
ReadS [LogMessage a]
(Int -> ReadS (LogMessage a))
-> ReadS [LogMessage a]
-> ReadPrec (LogMessage a)
-> ReadPrec [LogMessage a]
-> Read (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
(LogMessage a -> LogMessage a -> Bool)
-> (LogMessage a -> LogMessage a -> Bool) -> Eq (LogMessage a)
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, Eq (LogMessage a)
Eq (LogMessage a)
-> (LogMessage a -> LogMessage a -> Ordering)
-> (LogMessage a -> LogMessage a -> Bool)
-> (LogMessage a -> LogMessage a -> Bool)
-> (LogMessage a -> LogMessage a -> Bool)
-> (LogMessage a -> LogMessage a -> Bool)
-> (LogMessage a -> LogMessage a -> LogMessage a)
-> (LogMessage a -> LogMessage a -> LogMessage a)
-> Ord (LogMessage a)
LogMessage a -> LogMessage a -> Bool
LogMessage a -> LogMessage a -> Ordering
LogMessage a -> LogMessage a -> LogMessage a
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
$cp1Ord :: forall a. Ord a => Eq (LogMessage a)
Ord, Typeable, (forall x. LogMessage a -> Rep (LogMessage a) x)
-> (forall x. Rep (LogMessage a) x -> LogMessage a)
-> Generic (LogMessage a)
forall x. Rep (LogMessage a) x -> LogMessage a
forall x. LogMessage a -> Rep (LogMessage a) x
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 :: (a -> f b) -> LogMessage a -> f (LogMessage b)
logMsg = (LogMessage a -> a)
-> (LogMessage a -> b -> LogMessage b)
-> Lens (LogMessage a) (LogMessage b) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LogMessage a -> a
forall a. LogMessage a -> a
_logMsg ((LogMessage a -> b -> LogMessage b)
-> Lens (LogMessage a) (LogMessage b) a b)
-> (LogMessage a -> b -> LogMessage b)
-> Lens (LogMessage a) (LogMessage b) a b
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 :: (LogLevel -> f LogLevel) -> LogMessage a -> f (LogMessage a)
logMsgLevel = (LogMessage a -> LogLevel)
-> (LogMessage a -> LogLevel -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) LogLevel LogLevel
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LogMessage a -> LogLevel
forall a. LogMessage a -> LogLevel
_logMsgLevel ((LogMessage a -> LogLevel -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) LogLevel LogLevel)
-> (LogMessage a -> LogLevel -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) LogLevel LogLevel
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 :: (LogScope -> f LogScope) -> LogMessage a -> f (LogMessage a)
logMsgScope = (LogMessage a -> LogScope)
-> (LogMessage a -> LogScope -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) LogScope LogScope
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LogMessage a -> LogScope
forall a. LogMessage a -> LogScope
_logMsgScope ((LogMessage a -> LogScope -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) LogScope LogScope)
-> (LogMessage a -> LogScope -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) LogScope LogScope
forall a b. (a -> b) -> a -> b
$ \LogMessage a
a LogScope
b → LogMessage a
a { _logMsgScope :: LogScope
_logMsgScope = LogScope
b }
logMsgTime ∷ Lens' (LogMessage a) TimeSpec
logMsgTime :: (TimeSpec -> f TimeSpec) -> LogMessage a -> f (LogMessage a)
logMsgTime = (LogMessage a -> TimeSpec)
-> (LogMessage a -> TimeSpec -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) TimeSpec TimeSpec
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LogMessage a -> TimeSpec
forall a. LogMessage a -> TimeSpec
_logMsgTime ((LogMessage a -> TimeSpec -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) TimeSpec TimeSpec)
-> (LogMessage a -> TimeSpec -> LogMessage a)
-> Lens (LogMessage a) (LogMessage a) TimeSpec TimeSpec
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)
type LoggerBackend a = Either (LogMessage T.Text) (LogMessage a) → IO ()
type LogFunctionIO a = LogLevel → a → IO ()
type LogFunction a m = LogLevel → a → m ()
class Monad m ⇒ MonadLog a m | m → a where
logg ∷ LogFunction a m
withLevel ∷ LogLevel → m α → m α
withPolicy ∷ LogPolicy → m α → m α
localScope ∷ (LogScope → LogScope) → m α → m α
withLabel ∷ MonadLog a m ⇒ LogLabel → m α → m α
withLabel :: LogLabel -> m α -> m α
withLabel = (LogScope -> LogScope) -> m α -> m α
forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope ((LogScope -> LogScope) -> m α -> m α)
-> (LogLabel -> LogScope -> LogScope) -> LogLabel -> m α -> m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (:)
popLabel ∷ MonadLog a m ⇒ m α → m α
popLabel :: m α -> m α
popLabel = (LogScope -> LogScope) -> m α -> m α
forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope ((LogScope -> LogScope) -> m α -> m α)
-> (LogScope -> LogScope) -> m α -> m α
forall a b. (a -> b) -> a -> b
$ \case { [] → []; (LogLabel
_:LogScope
t) → LogScope
t }
clearScope ∷ MonadLog a m ⇒ m α → m α
clearScope :: m α -> m α
clearScope = (LogScope -> LogScope) -> m α -> m α
forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope ((LogScope -> LogScope) -> m α -> m α)
-> (LogScope -> LogScope) -> m α -> m α
forall a b. (a -> b) -> a -> b
$ LogScope -> LogScope -> LogScope
forall a b. a -> b -> a
const []
instance (Monoid σ, MonadLog a m) ⇒ MonadLog a (WriterT σ m) where
logg :: LogFunction a (WriterT σ m)
logg LogLevel
l = m () -> WriterT σ m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT σ m ()) -> (a -> m ()) -> a -> WriterT σ m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ LogFunction a m
forall a (m :: * -> *). MonadLog a m => LogFunction a m
logg LogLevel
l
withLevel :: LogLevel -> WriterT σ m α -> WriterT σ m α
withLevel LogLevel
level WriterT σ m α
inner = (Run (WriterT σ) -> m (α, σ)) -> WriterT σ m (α, σ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WriterT σ)
run → LogLevel -> m (α, σ) -> m (α, σ)
forall a (m :: * -> *) α. MonadLog a m => LogLevel -> m α -> m α
withLevel LogLevel
level (WriterT σ m α -> m (StT (WriterT σ) α)
Run (WriterT σ)
run WriterT σ m α
inner)) WriterT σ m (α, σ) -> ((α, σ) -> WriterT σ m α) -> WriterT σ m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (α, σ) -> WriterT σ m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (α, σ) -> WriterT σ m α)
-> ((α, σ) -> m (α, σ)) -> (α, σ) -> WriterT σ m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (α, σ) -> m (α, σ)
forall (m :: * -> *) a. Monad m => a -> m a
return
withPolicy :: LogPolicy -> WriterT σ m α -> WriterT σ m α
withPolicy LogPolicy
policy WriterT σ m α
inner = (Run (WriterT σ) -> m (α, σ)) -> WriterT σ m (α, σ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WriterT σ)
run → LogPolicy -> m (α, σ) -> m (α, σ)
forall a (m :: * -> *) α. MonadLog a m => LogPolicy -> m α -> m α
withPolicy LogPolicy
policy (WriterT σ m α -> m (StT (WriterT σ) α)
Run (WriterT σ)
run WriterT σ m α
inner)) WriterT σ m (α, σ) -> ((α, σ) -> WriterT σ m α) -> WriterT σ m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (α, σ) -> WriterT σ m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (α, σ) -> WriterT σ m α)
-> ((α, σ) -> m (α, σ)) -> (α, σ) -> WriterT σ m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (α, σ) -> m (α, σ)
forall (m :: * -> *) a. Monad m => a -> m a
return
localScope :: (LogScope -> LogScope) -> WriterT σ m α -> WriterT σ m α
localScope LogScope -> LogScope
f WriterT σ m α
inner = (Run (WriterT σ) -> m (α, σ)) -> WriterT σ m (α, σ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WriterT σ)
run → (LogScope -> LogScope) -> m (α, σ) -> m (α, σ)
forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope LogScope -> LogScope
f (WriterT σ m α -> m (StT (WriterT σ) α)
Run (WriterT σ)
run WriterT σ m α
inner)) WriterT σ m (α, σ) -> ((α, σ) -> WriterT σ m α) -> WriterT σ m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (α, σ) -> WriterT σ m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (α, σ) -> WriterT σ m α)
-> ((α, σ) -> m (α, σ)) -> (α, σ) -> WriterT σ m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (α, σ) -> m (α, σ)
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 = m () -> ExceptT ε m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT ε m ()) -> (a -> m ()) -> a -> ExceptT ε m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ LogFunction a m
forall a (m :: * -> *). MonadLog a m => LogFunction a m
logg LogLevel
l
withLevel :: LogLevel -> ExceptT ε m α -> ExceptT ε m α
withLevel LogLevel
level ExceptT ε m α
inner = (Run (ExceptT ε) -> m (Either ε α)) -> ExceptT ε m (Either ε α)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (ExceptT ε)
run → LogLevel -> m (Either ε α) -> m (Either ε α)
forall a (m :: * -> *) α. MonadLog a m => LogLevel -> m α -> m α
withLevel LogLevel
level (ExceptT ε m α -> m (StT (ExceptT ε) α)
Run (ExceptT ε)
run ExceptT ε m α
inner)) ExceptT ε m (Either ε α)
-> (Either ε α -> ExceptT ε m α) -> ExceptT ε m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (Either ε α) -> ExceptT ε m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (Either ε α) -> ExceptT ε m α)
-> (Either ε α -> m (Either ε α)) -> Either ε α -> ExceptT ε m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Either ε α -> m (Either ε α)
forall (m :: * -> *) a. Monad m => a -> m a
return
withPolicy :: LogPolicy -> ExceptT ε m α -> ExceptT ε m α
withPolicy LogPolicy
policy ExceptT ε m α
inner = (Run (ExceptT ε) -> m (Either ε α)) -> ExceptT ε m (Either ε α)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (ExceptT ε)
run → LogPolicy -> m (Either ε α) -> m (Either ε α)
forall a (m :: * -> *) α. MonadLog a m => LogPolicy -> m α -> m α
withPolicy LogPolicy
policy (ExceptT ε m α -> m (StT (ExceptT ε) α)
Run (ExceptT ε)
run ExceptT ε m α
inner)) ExceptT ε m (Either ε α)
-> (Either ε α -> ExceptT ε m α) -> ExceptT ε m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (Either ε α) -> ExceptT ε m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (Either ε α) -> ExceptT ε m α)
-> (Either ε α -> m (Either ε α)) -> Either ε α -> ExceptT ε m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Either ε α -> m (Either ε α)
forall (m :: * -> *) a. Monad m => a -> m a
return
localScope :: (LogScope -> LogScope) -> ExceptT ε m α -> ExceptT ε m α
localScope LogScope -> LogScope
f ExceptT ε m α
inner = (Run (ExceptT ε) -> m (Either ε α)) -> ExceptT ε m (Either ε α)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (ExceptT ε)
run → (LogScope -> LogScope) -> m (Either ε α) -> m (Either ε α)
forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope LogScope -> LogScope
f (ExceptT ε m α -> m (StT (ExceptT ε) α)
Run (ExceptT ε)
run ExceptT ε m α
inner)) ExceptT ε m (Either ε α)
-> (Either ε α -> ExceptT ε m α) -> ExceptT ε m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (Either ε α) -> ExceptT ε m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (Either ε α) -> ExceptT ε m α)
-> (Either ε α -> m (Either ε α)) -> Either ε α -> ExceptT ε m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Either ε α -> m (Either ε α)
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 = m () -> StateT σ m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT σ m ()) -> (a -> m ()) -> a -> StateT σ m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ LogFunction a m
forall a (m :: * -> *). MonadLog a m => LogFunction a m
logg LogLevel
l
withLevel :: LogLevel -> StateT σ m α -> StateT σ m α
withLevel LogLevel
level StateT σ m α
inner = (Run (StateT σ) -> m (α, σ)) -> StateT σ m (α, σ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (StateT σ)
run → LogLevel -> m (α, σ) -> m (α, σ)
forall a (m :: * -> *) α. MonadLog a m => LogLevel -> m α -> m α
withLevel LogLevel
level (StateT σ m α -> m (StT (StateT σ) α)
Run (StateT σ)
run StateT σ m α
inner)) StateT σ m (α, σ) -> ((α, σ) -> StateT σ m α) -> StateT σ m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (α, σ) -> StateT σ m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (α, σ) -> StateT σ m α)
-> ((α, σ) -> m (α, σ)) -> (α, σ) -> StateT σ m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (α, σ) -> m (α, σ)
forall (m :: * -> *) a. Monad m => a -> m a
return
withPolicy :: LogPolicy -> StateT σ m α -> StateT σ m α
withPolicy LogPolicy
policy StateT σ m α
inner = (Run (StateT σ) -> m (α, σ)) -> StateT σ m (α, σ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (StateT σ)
run → LogPolicy -> m (α, σ) -> m (α, σ)
forall a (m :: * -> *) α. MonadLog a m => LogPolicy -> m α -> m α
withPolicy LogPolicy
policy (StateT σ m α -> m (StT (StateT σ) α)
Run (StateT σ)
run StateT σ m α
inner)) StateT σ m (α, σ) -> ((α, σ) -> StateT σ m α) -> StateT σ m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (α, σ) -> StateT σ m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (α, σ) -> StateT σ m α)
-> ((α, σ) -> m (α, σ)) -> (α, σ) -> StateT σ m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (α, σ) -> m (α, σ)
forall (m :: * -> *) a. Monad m => a -> m a
return
localScope :: (LogScope -> LogScope) -> StateT σ m α -> StateT σ m α
localScope LogScope -> LogScope
f StateT σ m α
inner = (Run (StateT σ) -> m (α, σ)) -> StateT σ m (α, σ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (StateT σ)
run → (LogScope -> LogScope) -> m (α, σ) -> m (α, σ)
forall a (m :: * -> *) α.
MonadLog a m =>
(LogScope -> LogScope) -> m α -> m α
localScope LogScope -> LogScope
f (StateT σ m α -> m (StT (StateT σ) α)
Run (StateT σ)
run StateT σ m α
inner)) StateT σ m (α, σ) -> ((α, σ) -> StateT σ m α) -> StateT σ m α
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= m (α, σ) -> StateT σ m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (α, σ) -> StateT σ m α)
-> ((α, σ) -> m (α, σ)) -> (α, σ) -> StateT σ m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (α, σ) -> m (α, σ)
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE logg #-}
{-# INLINE withLevel #-}
{-# INLINE withPolicy #-}
{-# INLINE localScope #-}
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 (ctx -> α) -> ctx -> α
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx -> (ctx -> ctx) -> ctx
forall a b. a -> (a -> b) -> b
& (LogLevel -> Identity LogLevel) -> ctx -> Identity ctx
forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogLevel
setLoggerLevel ((LogLevel -> Identity LogLevel) -> ctx -> Identity ctx)
-> LogLevel -> ctx -> ctx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel
level
{-# INLINE withLoggerLevel #-}
withLoggerLabel ∷ LogLabel → ctx → (ctx → α) → α
withLoggerLabel LogLabel
label ctx
ctx ctx -> α
f = ctx -> α
f (ctx -> α) -> ctx -> α
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx -> (ctx -> ctx) -> ctx
forall a b. a -> (a -> b) -> b
& (LogScope -> Identity LogScope) -> ctx -> Identity ctx
forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogScope
setLoggerScope ((LogScope -> Identity LogScope) -> ctx -> Identity ctx)
-> (LogScope -> LogScope) -> ctx -> ctx
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (:) LogLabel
label
{-# INLINE withLoggerLabel #-}
withLoggerPolicy ∷ LogPolicy → ctx → (ctx → α) → α
withLoggerPolicy LogPolicy
policy ctx
ctx ctx -> α
f = ctx -> α
f (ctx -> α) -> ctx -> α
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx -> (ctx -> ctx) -> ctx
forall a b. a -> (a -> b) -> b
& (LogPolicy -> Identity LogPolicy) -> ctx -> Identity ctx
forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogPolicy
setLoggerPolicy ((LogPolicy -> Identity LogPolicy) -> ctx -> Identity ctx)
-> LogPolicy -> ctx -> ctx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogPolicy
policy
{-# INLINE withLoggerPolicy #-}
newtype LoggerCtxT ctx m α = LoggerCtxT { LoggerCtxT ctx m α -> ReaderT ctx m α
unLoggerCtxT ∷ ReaderT ctx m α }
deriving (a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
(a -> b) -> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
(forall a b. (a -> b) -> LoggerCtxT ctx m a -> LoggerCtxT ctx m b)
-> (forall a b. a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a)
-> Functor (LoggerCtxT ctx m)
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
<$ :: 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 :: (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, Functor (LoggerCtxT ctx m)
a -> LoggerCtxT ctx m a
Functor (LoggerCtxT ctx m)
-> (forall a. a -> LoggerCtxT ctx m a)
-> (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 a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b)
-> (forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a)
-> Applicative (LoggerCtxT ctx m)
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m a
LoggerCtxT ctx m (a -> b)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b
(a -> b -> c)
-> LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> LoggerCtxT ctx m a
$cpure :: forall ctx (m :: * -> *) a.
Applicative m =>
a -> LoggerCtxT ctx m a
$cp1Applicative :: forall ctx (m :: * -> *).
Applicative m =>
Functor (LoggerCtxT ctx m)
Applicative, Applicative (LoggerCtxT ctx m)
a -> LoggerCtxT ctx m a
Applicative (LoggerCtxT ctx m)
-> (forall a b.
LoggerCtxT ctx m a
-> (a -> LoggerCtxT ctx m b) -> LoggerCtxT ctx m b)
-> (forall a b.
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b)
-> (forall a. a -> LoggerCtxT ctx m a)
-> Monad (LoggerCtxT ctx m)
LoggerCtxT ctx m a
-> (a -> LoggerCtxT ctx m b) -> LoggerCtxT ctx m b
LoggerCtxT ctx m a -> LoggerCtxT ctx m b -> LoggerCtxT ctx m b
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 :: a -> LoggerCtxT ctx m a
$creturn :: forall ctx (m :: * -> *) a. Monad m => a -> LoggerCtxT ctx m a
>> :: 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
>>= :: 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
$cp1Monad :: forall ctx (m :: * -> *). Monad m => Applicative (LoggerCtxT ctx m)
Monad, Monad (LoggerCtxT ctx m)
Monad (LoggerCtxT ctx m)
-> (forall a. IO a -> LoggerCtxT ctx m a)
-> MonadIO (LoggerCtxT ctx m)
IO a -> LoggerCtxT ctx m a
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 :: IO a -> LoggerCtxT ctx m a
$cliftIO :: forall ctx (m :: * -> *) a. MonadIO m => IO a -> LoggerCtxT ctx m a
$cp1MonadIO :: forall ctx (m :: * -> *). MonadIO m => Monad (LoggerCtxT ctx m)
MonadIO, m a -> LoggerCtxT ctx m a
(forall (m :: * -> *) a. Monad m => m a -> LoggerCtxT ctx m a)
-> MonadTrans (LoggerCtxT ctx)
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 :: 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, Monad (LoggerCtxT ctx m)
e -> LoggerCtxT ctx m a
Monad (LoggerCtxT ctx m)
-> (forall e a. Exception e => e -> LoggerCtxT ctx m a)
-> MonadThrow (LoggerCtxT ctx m)
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 :: e -> LoggerCtxT ctx m a
$cthrowM :: forall ctx (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LoggerCtxT ctx m a
$cp1MonadThrow :: forall ctx (m :: * -> *). MonadThrow m => Monad (LoggerCtxT ctx m)
MonadThrow, MonadThrow (LoggerCtxT ctx m)
MonadThrow (LoggerCtxT ctx m)
-> (forall e a.
Exception e =>
LoggerCtxT ctx m a
-> (e -> LoggerCtxT ctx m a) -> LoggerCtxT ctx m a)
-> MonadCatch (LoggerCtxT ctx m)
LoggerCtxT ctx m a
-> (e -> LoggerCtxT ctx m a) -> LoggerCtxT ctx m a
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 :: 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
$cp1MonadCatch :: forall ctx (m :: * -> *).
MonadCatch m =>
MonadThrow (LoggerCtxT ctx m)
MonadCatch, MonadCatch (LoggerCtxT ctx m)
MonadCatch (LoggerCtxT ctx m)
-> (forall b.
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
-> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b)
-> (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))
-> MonadMask (LoggerCtxT ctx m)
LoggerCtxT ctx m a
-> (a -> ExitCase b -> LoggerCtxT ctx m c)
-> (a -> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m (b, c)
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
-> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
((forall a. LoggerCtxT ctx m a -> LoggerCtxT ctx m a)
-> LoggerCtxT ctx m b)
-> LoggerCtxT ctx m b
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 :: 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 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 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
$cp1MonadMask :: forall ctx (m :: * -> *).
MonadMask m =>
MonadCatch (LoggerCtxT ctx m)
MonadMask)
instance MonadTransControl (LoggerCtxT ctx) where
type StT (LoggerCtxT ctx) a = StT (ReaderT ctx) a
liftWith :: (Run (LoggerCtxT ctx) -> m a) -> LoggerCtxT ctx m a
liftWith = (forall b. ReaderT ctx m b -> LoggerCtxT ctx m b)
-> (forall (o :: * -> *) b. LoggerCtxT ctx o b -> ReaderT ctx o b)
-> (RunDefault (LoggerCtxT ctx) (ReaderT ctx) -> m a)
-> LoggerCtxT ctx m a
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 b. ReaderT ctx m b -> LoggerCtxT ctx m b
forall ctx (m :: * -> *) α. ReaderT ctx m α -> LoggerCtxT ctx m α
LoggerCtxT forall ctx (m :: * -> *) α. LoggerCtxT ctx m α -> ReaderT ctx m α
forall (o :: * -> *) b. LoggerCtxT ctx o b -> ReaderT ctx o b
unLoggerCtxT
restoreT :: m (StT (LoggerCtxT ctx) a) -> LoggerCtxT ctx m a
restoreT = (ReaderT ctx m a -> LoggerCtxT ctx m a)
-> m (StT (ReaderT ctx) a) -> LoggerCtxT ctx m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
(t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT ReaderT ctx m a -> LoggerCtxT ctx m a
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 :: (RunInBase (LoggerCtxT ctx m) b -> b a) -> LoggerCtxT ctx m a
liftBaseWith = (RunInBase (LoggerCtxT ctx m) b -> b a) -> LoggerCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: StM (LoggerCtxT ctx m) a -> LoggerCtxT ctx m a
restoreM = StM (LoggerCtxT ctx m) a -> LoggerCtxT ctx m a
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 :: LoggerCtxT ctx m α -> ctx -> m α
runLoggerCtxT = ReaderT ctx m α -> ctx -> m α
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT ctx m α -> ctx -> m α)
-> (LoggerCtxT ctx m α -> ReaderT ctx m α)
-> LoggerCtxT ctx m α
-> ctx
-> m α
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ LoggerCtxT ctx m α -> ReaderT ctx m α
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 = LoggerCtxT ctx m ctx
forall r (m :: * -> *). MonadReader r m => m r
ask LoggerCtxT ctx m ctx
-> (ctx -> LoggerCtxT ctx m ()) -> LoggerCtxT ctx m ()
forall (m :: * -> *) α β. Monad m => m α -> (α -> m β) -> m β
≫= \ctx
ctx → IO () -> LoggerCtxT ctx m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ctx -> LogFunctionIO a
forall ctx msg.
(LoggerCtx ctx msg, Show msg, Typeable msg, NFData msg) =>
ctx -> LogFunctionIO msg
loggerFunIO ctx
ctx LogLevel
l a
m)
withLevel :: LogLevel -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
withLevel LogLevel
level = (ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α)
-> (ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
forall a b. (a -> b) -> a -> b
$ (LogLevel -> Identity LogLevel) -> ctx -> Identity ctx
forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogLevel
setLoggerLevel ((LogLevel -> Identity LogLevel) -> ctx -> Identity ctx)
-> LogLevel -> ctx -> ctx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel
level
withPolicy :: LogPolicy -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
withPolicy LogPolicy
policy = (ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α)
-> (ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
forall a b. (a -> b) -> a -> b
$ (LogPolicy -> Identity LogPolicy) -> ctx -> Identity ctx
forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogPolicy
setLoggerPolicy ((LogPolicy -> Identity LogPolicy) -> ctx -> Identity ctx)
-> LogPolicy -> ctx -> ctx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogPolicy
policy
localScope :: (LogScope -> LogScope) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
localScope LogScope -> LogScope
f = (ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α)
-> (ctx -> ctx) -> LoggerCtxT ctx m α -> LoggerCtxT ctx m α
forall a b. (a -> b) -> a -> b
$ (LogScope -> Identity LogScope) -> ctx -> Identity ctx
forall ctx msg. LoggerCtx ctx msg => Lens' ctx LogScope
setLoggerScope ((LogScope -> Identity LogScope) -> ctx -> Identity ctx)
-> (LogScope -> LogScope) -> ctx -> ctx
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 #-}