blob: 3d258f780300016c2a200a191bb821c5da7933f7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{-
FastAPI
No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)
OpenAPI Version: 3.1.0
FastAPI API version: 0.1.0
Generated by OpenAPI Generator (https://openapi-generator.tech)
-}
{-|
Module : G4fClient.LoggingKatip
Katip Logging functions
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module G4fClient.LoggingKatip where
import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Control.Monad.Trans.Reader as P
import qualified Data.Text as T
import qualified Lens.Micro as L
import qualified System.IO as IO
import Data.Text (Text)
import GHC.Exts (IsString(..))
import qualified Katip as LG
-- * Type Aliases (for compatibility)
-- | Runs a Katip logging block with the Log environment
type LogExecWithContext = forall m a. P.MonadIO m =>
LogContext -> LogExec m a
-- | A Katip logging block
type LogExec m a = LG.KatipT m a -> m a
-- | A Katip Log environment
type LogContext = LG.LogEnv
-- | A Katip Log severity
type LogLevel = LG.Severity
-- * default logger
-- | the default log environment
initLogContext :: IO LogContext
initLogContext = LG.initLogEnv "G4fClient" "dev"
-- | Runs a Katip logging block with the Log environment
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext = LG.runKatipT
-- * stdout logger
-- | Runs a Katip logging block with the Log environment
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec = runDefaultLogExecWithContext
-- | A Katip Log environment which targets stdout
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext cxt = do
handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stdout (LG.permitItem LG.InfoS) LG.V2
LG.registerScribe "stdout" handleScribe LG.defaultScribeSettings cxt
-- * stderr logger
-- | Runs a Katip logging block with the Log environment
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec = runDefaultLogExecWithContext
-- | A Katip Log environment which targets stderr
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext cxt = do
handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stderr (LG.permitItem LG.InfoS) LG.V2
LG.registerScribe "stderr" handleScribe LG.defaultScribeSettings cxt
-- * Null logger
-- | Disables Katip logging
runNullLogExec :: LogExecWithContext
runNullLogExec le (LG.KatipT f) = P.runReaderT f (L.set LG.logEnvScribes mempty le)
-- * Log Msg
-- | Log a katip message
_log :: (Applicative m, LG.Katip m) => Text -> LogLevel -> Text -> m ()
_log src level msg = do
LG.logMsg (fromString $ T.unpack src) level (LG.logStr msg)
-- * Log Exceptions
-- | re-throws exceptions after logging them
logExceptions
:: (LG.Katip m, E.MonadCatch m, Applicative m)
=> Text -> m a -> m a
logExceptions src =
E.handle
(\(e :: E.SomeException) -> do
_log src LG.ErrorS ((T.pack . show) e)
E.throw e)
-- * Log Level
levelInfo :: LogLevel
levelInfo = LG.InfoS
levelError :: LogLevel
levelError = LG.ErrorS
levelDebug :: LogLevel
levelDebug = LG.DebugS
|
