{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
module System.Logger
( withConsoleLogger
, withFileLogger
, module System.Logger.Types
, module System.Logger.Logger
, module System.Logger.Backend.Handle
, LogConfig(..)
, logConfigLogger
, logConfigBackend
, defaultLogConfig
, validateLogConfig
, pLogConfig
, pLogConfig_
) where
import Configuration.Utils hiding (Lens')
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import qualified Data.Text as T
import Data.Typeable
import GHC.Generics
import Lens.Micro
import Prelude.Unicode
import System.Logger.Backend.ColorOption
import System.Logger.Backend.Handle
import System.Logger.Logger
import System.Logger.Types
withConsoleLogger
∷ (MonadIO m, MonadBaseControl IO m)
⇒ LogLevel
→ LoggerT T.Text m α
→ m α
withConsoleLogger :: LogLevel -> LoggerT Text m α -> m α
withConsoleLogger LogLevel
level LoggerT Text m α
inner =
HandleBackendConfig -> (LoggerBackend Text -> m α) -> m α
forall (m :: * -> *) α.
(MonadIO m, MonadBaseControl IO m) =>
HandleBackendConfig -> (LoggerBackend Text -> m α) -> m α
withHandleBackend (LogConfig
config LogConfig
-> Getting HandleBackendConfig LogConfig HandleBackendConfig
-> HandleBackendConfig
forall s a. s -> Getting a s a -> a
^. Getting HandleBackendConfig LogConfig HandleBackendConfig
Lens' LogConfig HandleBackendConfig
logConfigBackend) ((LoggerBackend Text -> m α) -> m α)
-> (LoggerBackend Text -> m α) -> m α
forall a b. (a -> b) -> a -> b
$ \LoggerBackend Text
backend →
LoggerConfig -> LoggerBackend Text -> (Logger Text -> m α) -> m α
forall (μ :: * -> *) a α.
(MonadIO μ, MonadBaseControl IO μ) =>
LoggerConfig -> LoggerBackend a -> (Logger a -> μ α) -> μ α
withLogger (LogConfig
config LogConfig
-> Getting LoggerConfig LogConfig LoggerConfig -> LoggerConfig
forall s a. s -> Getting a s a -> a
^. Getting LoggerConfig LogConfig LoggerConfig
Lens' LogConfig LoggerConfig
logConfigLogger) LoggerBackend Text
backend ((Logger Text -> m α) -> m α) -> (Logger Text -> m α) -> m α
forall a b. (a -> b) -> a -> b
$ LoggerT Text m α -> Logger Text -> m α
forall a (m :: * -> *) α. LoggerT a m α -> Logger a -> m α
runLoggerT LoggerT Text m α
inner
where
config :: LogConfig
config = LogConfig
defaultLogConfig
LogConfig -> (LogConfig -> LogConfig) -> LogConfig
forall a b. a -> (a -> b) -> b
& (LoggerConfig -> Identity LoggerConfig)
-> LogConfig -> Identity LogConfig
Lens' LogConfig LoggerConfig
logConfigLogger ((LoggerConfig -> Identity LoggerConfig)
-> LogConfig -> Identity LogConfig)
-> ((LogLevel -> Identity LogLevel)
-> LoggerConfig -> Identity LoggerConfig)
-> (LogLevel -> Identity LogLevel)
-> LogConfig
-> Identity LogConfig
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (LogLevel -> Identity LogLevel)
-> LoggerConfig -> Identity LoggerConfig
Lens' LoggerConfig LogLevel
loggerConfigThreshold ((LogLevel -> Identity LogLevel)
-> LogConfig -> Identity LogConfig)
-> LogLevel -> LogConfig -> LogConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel
level
withFileLogger
∷ (MonadIO m, MonadBaseControl IO m)
⇒ FilePath
→ LogLevel
→ LoggerT T.Text m α
→ m α
withFileLogger :: FilePath -> LogLevel -> LoggerT Text m α -> m α
withFileLogger FilePath
f LogLevel
level LoggerT Text m α
inner =
HandleBackendConfig -> (LoggerBackend Text -> m α) -> m α
forall (m :: * -> *) α.
(MonadIO m, MonadBaseControl IO m) =>
HandleBackendConfig -> (LoggerBackend Text -> m α) -> m α
withHandleBackend (LogConfig
config LogConfig
-> Getting HandleBackendConfig LogConfig HandleBackendConfig
-> HandleBackendConfig
forall s a. s -> Getting a s a -> a
^. Getting HandleBackendConfig LogConfig HandleBackendConfig
Lens' LogConfig HandleBackendConfig
logConfigBackend) ((LoggerBackend Text -> m α) -> m α)
-> (LoggerBackend Text -> m α) -> m α
forall a b. (a -> b) -> a -> b
$ \LoggerBackend Text
backend →
LoggerConfig -> LoggerBackend Text -> (Logger Text -> m α) -> m α
forall (μ :: * -> *) a α.
(MonadIO μ, MonadBaseControl IO μ) =>
LoggerConfig -> LoggerBackend a -> (Logger a -> μ α) -> μ α
withLogger (LogConfig
config LogConfig
-> Getting LoggerConfig LogConfig LoggerConfig -> LoggerConfig
forall s a. s -> Getting a s a -> a
^. Getting LoggerConfig LogConfig LoggerConfig
Lens' LogConfig LoggerConfig
logConfigLogger) LoggerBackend Text
backend ((Logger Text -> m α) -> m α) -> (Logger Text -> m α) -> m α
forall a b. (a -> b) -> a -> b
$ LoggerT Text m α -> Logger Text -> m α
forall a (m :: * -> *) α. LoggerT a m α -> Logger a -> m α
runLoggerT LoggerT Text m α
inner
where
config :: LogConfig
config = LogConfig
defaultLogConfig
LogConfig -> (LogConfig -> LogConfig) -> LogConfig
forall a b. a -> (a -> b) -> b
& (LoggerConfig -> Identity LoggerConfig)
-> LogConfig -> Identity LogConfig
Lens' LogConfig LoggerConfig
logConfigLogger ((LoggerConfig -> Identity LoggerConfig)
-> LogConfig -> Identity LogConfig)
-> ((LogLevel -> Identity LogLevel)
-> LoggerConfig -> Identity LoggerConfig)
-> (LogLevel -> Identity LogLevel)
-> LogConfig
-> Identity LogConfig
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (LogLevel -> Identity LogLevel)
-> LoggerConfig -> Identity LoggerConfig
Lens' LoggerConfig LogLevel
loggerConfigThreshold ((LogLevel -> Identity LogLevel)
-> LogConfig -> Identity LogConfig)
-> LogLevel -> LogConfig -> LogConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel
level
LogConfig -> (LogConfig -> LogConfig) -> LogConfig
forall a b. a -> (a -> b) -> b
& (HandleBackendConfig -> Identity HandleBackendConfig)
-> LogConfig -> Identity LogConfig
Lens' LogConfig HandleBackendConfig
logConfigBackend ((HandleBackendConfig -> Identity HandleBackendConfig)
-> LogConfig -> Identity LogConfig)
-> ((ColorOption -> Identity ColorOption)
-> HandleBackendConfig -> Identity HandleBackendConfig)
-> (ColorOption -> Identity ColorOption)
-> LogConfig
-> Identity LogConfig
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (ColorOption -> Identity ColorOption)
-> HandleBackendConfig -> Identity HandleBackendConfig
Lens' HandleBackendConfig ColorOption
handleBackendConfigColor ((ColorOption -> Identity ColorOption)
-> LogConfig -> Identity LogConfig)
-> ColorOption -> LogConfig -> LogConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ColorOption
ColorFalse
LogConfig -> (LogConfig -> LogConfig) -> LogConfig
forall a b. a -> (a -> b) -> b
& (HandleBackendConfig -> Identity HandleBackendConfig)
-> LogConfig -> Identity LogConfig
Lens' LogConfig HandleBackendConfig
logConfigBackend ((HandleBackendConfig -> Identity HandleBackendConfig)
-> LogConfig -> Identity LogConfig)
-> ((LoggerHandleConfig -> Identity LoggerHandleConfig)
-> HandleBackendConfig -> Identity HandleBackendConfig)
-> (LoggerHandleConfig -> Identity LoggerHandleConfig)
-> LogConfig
-> Identity LogConfig
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (LoggerHandleConfig -> Identity LoggerHandleConfig)
-> HandleBackendConfig -> Identity HandleBackendConfig
Lens' HandleBackendConfig LoggerHandleConfig
handleBackendConfigHandle ((LoggerHandleConfig -> Identity LoggerHandleConfig)
-> LogConfig -> Identity LogConfig)
-> LoggerHandleConfig -> LogConfig -> LogConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> LoggerHandleConfig
FileHandle FilePath
f
data LogConfig = LogConfig
{ LogConfig -> LoggerConfig
_logConfigLogger ∷ !LoggerConfig
, LogConfig -> HandleBackendConfig
_logConfigBackend ∷ !HandleBackendConfig
}
deriving (Int -> LogConfig -> ShowS
[LogConfig] -> ShowS
LogConfig -> FilePath
(Int -> LogConfig -> ShowS)
-> (LogConfig -> FilePath)
-> ([LogConfig] -> ShowS)
-> Show LogConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LogConfig] -> ShowS
$cshowList :: [LogConfig] -> ShowS
show :: LogConfig -> FilePath
$cshow :: LogConfig -> FilePath
showsPrec :: Int -> LogConfig -> ShowS
$cshowsPrec :: Int -> LogConfig -> ShowS
Show, ReadPrec [LogConfig]
ReadPrec LogConfig
Int -> ReadS LogConfig
ReadS [LogConfig]
(Int -> ReadS LogConfig)
-> ReadS [LogConfig]
-> ReadPrec LogConfig
-> ReadPrec [LogConfig]
-> Read LogConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogConfig]
$creadListPrec :: ReadPrec [LogConfig]
readPrec :: ReadPrec LogConfig
$creadPrec :: ReadPrec LogConfig
readList :: ReadS [LogConfig]
$creadList :: ReadS [LogConfig]
readsPrec :: Int -> ReadS LogConfig
$creadsPrec :: Int -> ReadS LogConfig
Read, LogConfig -> LogConfig -> Bool
(LogConfig -> LogConfig -> Bool)
-> (LogConfig -> LogConfig -> Bool) -> Eq LogConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogConfig -> LogConfig -> Bool
$c/= :: LogConfig -> LogConfig -> Bool
== :: LogConfig -> LogConfig -> Bool
$c== :: LogConfig -> LogConfig -> Bool
Eq, Eq LogConfig
Eq LogConfig
-> (LogConfig -> LogConfig -> Ordering)
-> (LogConfig -> LogConfig -> Bool)
-> (LogConfig -> LogConfig -> Bool)
-> (LogConfig -> LogConfig -> Bool)
-> (LogConfig -> LogConfig -> Bool)
-> (LogConfig -> LogConfig -> LogConfig)
-> (LogConfig -> LogConfig -> LogConfig)
-> Ord LogConfig
LogConfig -> LogConfig -> Bool
LogConfig -> LogConfig -> Ordering
LogConfig -> LogConfig -> LogConfig
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 :: LogConfig -> LogConfig -> LogConfig
$cmin :: LogConfig -> LogConfig -> LogConfig
max :: LogConfig -> LogConfig -> LogConfig
$cmax :: LogConfig -> LogConfig -> LogConfig
>= :: LogConfig -> LogConfig -> Bool
$c>= :: LogConfig -> LogConfig -> Bool
> :: LogConfig -> LogConfig -> Bool
$c> :: LogConfig -> LogConfig -> Bool
<= :: LogConfig -> LogConfig -> Bool
$c<= :: LogConfig -> LogConfig -> Bool
< :: LogConfig -> LogConfig -> Bool
$c< :: LogConfig -> LogConfig -> Bool
compare :: LogConfig -> LogConfig -> Ordering
$ccompare :: LogConfig -> LogConfig -> Ordering
$cp1Ord :: Eq LogConfig
Ord, Typeable, (forall x. LogConfig -> Rep LogConfig x)
-> (forall x. Rep LogConfig x -> LogConfig) -> Generic LogConfig
forall x. Rep LogConfig x -> LogConfig
forall x. LogConfig -> Rep LogConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogConfig x -> LogConfig
$cfrom :: forall x. LogConfig -> Rep LogConfig x
Generic)
logConfigLogger ∷ Lens' LogConfig LoggerConfig
logConfigLogger :: (LoggerConfig -> f LoggerConfig) -> LogConfig -> f LogConfig
logConfigLogger = (LogConfig -> LoggerConfig)
-> (LogConfig -> LoggerConfig -> LogConfig)
-> Lens' LogConfig LoggerConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LogConfig -> LoggerConfig
_logConfigLogger ((LogConfig -> LoggerConfig -> LogConfig)
-> Lens' LogConfig LoggerConfig)
-> (LogConfig -> LoggerConfig -> LogConfig)
-> Lens' LogConfig LoggerConfig
forall a b. (a -> b) -> a -> b
$ \LogConfig
a LoggerConfig
b → LogConfig
a { _logConfigLogger :: LoggerConfig
_logConfigLogger = LoggerConfig
b }
logConfigBackend ∷ Lens' LogConfig HandleBackendConfig
logConfigBackend :: (HandleBackendConfig -> f HandleBackendConfig)
-> LogConfig -> f LogConfig
logConfigBackend = (LogConfig -> HandleBackendConfig)
-> (LogConfig -> HandleBackendConfig -> LogConfig)
-> Lens' LogConfig HandleBackendConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LogConfig -> HandleBackendConfig
_logConfigBackend ((LogConfig -> HandleBackendConfig -> LogConfig)
-> Lens' LogConfig HandleBackendConfig)
-> (LogConfig -> HandleBackendConfig -> LogConfig)
-> Lens' LogConfig HandleBackendConfig
forall a b. (a -> b) -> a -> b
$ \LogConfig
a HandleBackendConfig
b → LogConfig
a { _logConfigBackend :: HandleBackendConfig
_logConfigBackend = HandleBackendConfig
b }
defaultLogConfig ∷ LogConfig
defaultLogConfig :: LogConfig
defaultLogConfig = LogConfig :: LoggerConfig -> HandleBackendConfig -> LogConfig
LogConfig
{ _logConfigLogger :: LoggerConfig
_logConfigLogger = LoggerConfig
defaultLoggerConfig
, _logConfigBackend :: HandleBackendConfig
_logConfigBackend = HandleBackendConfig
defaultHandleBackendConfig
}
validateLogConfig ∷ ConfigValidation LogConfig []
validateLogConfig :: LogConfig -> m ()
validateLogConfig LogConfig{LoggerConfig
HandleBackendConfig
_logConfigBackend :: HandleBackendConfig
_logConfigLogger :: LoggerConfig
_logConfigBackend :: LogConfig -> HandleBackendConfig
_logConfigLogger :: LogConfig -> LoggerConfig
..} = do
LoggerConfig -> m ()
forall (λ :: * -> *). ConfigValidation LoggerConfig λ
validateLoggerConfig LoggerConfig
_logConfigLogger
HandleBackendConfig -> m ()
ConfigValidation HandleBackendConfig []
validateHandleBackendConfig HandleBackendConfig
_logConfigBackend
instance ToJSON LogConfig where
toJSON :: LogConfig -> Value
toJSON LogConfig{LoggerConfig
HandleBackendConfig
_logConfigBackend :: HandleBackendConfig
_logConfigLogger :: LoggerConfig
_logConfigBackend :: LogConfig -> HandleBackendConfig
_logConfigLogger :: LogConfig -> LoggerConfig
..} = [Pair] -> Value
object
[ Key
"logger" Key -> LoggerConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LoggerConfig
_logConfigLogger
, Key
"backend" Key -> HandleBackendConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HandleBackendConfig
_logConfigBackend
]
instance FromJSON (LogConfig → LogConfig) where
parseJSON :: Value -> Parser (LogConfig -> LogConfig)
parseJSON = FilePath
-> (Object -> Parser (LogConfig -> LogConfig))
-> Value
-> Parser (LogConfig -> LogConfig)
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"LogConfig" ((Object -> Parser (LogConfig -> LogConfig))
-> Value -> Parser (LogConfig -> LogConfig))
-> (Object -> Parser (LogConfig -> LogConfig))
-> Value
-> Parser (LogConfig -> LogConfig)
forall a b. (a -> b) -> a -> b
$ \Object
o → LogConfig -> LogConfig
forall a. a -> a
id
(LogConfig -> LogConfig)
-> Parser (LogConfig -> LogConfig)
-> Parser (LogConfig -> LogConfig)
forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' LogConfig LoggerConfig
logConfigLogger Lens' LogConfig LoggerConfig
-> Text -> Object -> Parser (LogConfig -> LogConfig)
forall b a.
FromJSON (b -> b) =>
Lens' a b -> Text -> Object -> Parser (a -> a)
%.: Text
"logger" (Object -> Parser (LogConfig -> LogConfig))
-> Object -> Parser (LogConfig -> LogConfig)
forall a b. (a -> b) -> a -> b
% Object
o
Parser (LogConfig -> LogConfig)
-> Parser (LogConfig -> LogConfig)
-> Parser (LogConfig -> LogConfig)
forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' LogConfig HandleBackendConfig
logConfigBackend Lens' LogConfig HandleBackendConfig
-> Text -> Object -> Parser (LogConfig -> LogConfig)
forall b a.
FromJSON (b -> b) =>
Lens' a b -> Text -> Object -> Parser (a -> a)
%.: Text
"backend" (Object -> Parser (LogConfig -> LogConfig))
-> Object -> Parser (LogConfig -> LogConfig)
forall a b. (a -> b) -> a -> b
% Object
o
pLogConfig ∷ MParser LogConfig
pLogConfig :: MParser LogConfig
pLogConfig = Text -> MParser LogConfig
pLogConfig_ Text
""
pLogConfig_
∷ T.Text
→ MParser LogConfig
pLogConfig_ :: Text -> MParser LogConfig
pLogConfig_ Text
prefix = LogConfig -> LogConfig
forall a. a -> a
id
(LogConfig -> LogConfig) -> MParser LogConfig -> MParser LogConfig
forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' LogConfig LoggerConfig
logConfigLogger Lens' LogConfig LoggerConfig
-> Parser (LoggerConfig -> LoggerConfig) -> MParser LogConfig
forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f (b -> b) -> f (a -> a)
%:: Text -> Parser (LoggerConfig -> LoggerConfig)
pLoggerConfig_ Text
prefix
MParser LogConfig -> MParser LogConfig -> MParser LogConfig
forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' LogConfig HandleBackendConfig
logConfigBackend Lens' LogConfig HandleBackendConfig
-> Parser (HandleBackendConfig -> HandleBackendConfig)
-> MParser LogConfig
forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f (b -> b) -> f (a -> a)
%:: Text -> Parser (HandleBackendConfig -> HandleBackendConfig)
pHandleBackendConfig_ Text
prefix