{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Kubernetes.OpenAPI.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 LogExecWithContext = forall m. P.MonadIO m =>
LogContext -> LogExec m
type LogExec m = forall a. LG.KatipT m a -> m a
type LogContext = LG.LogEnv
type LogLevel = LG.Severity
initLogContext :: IO LogContext
initLogContext = LG.initLogEnv "Kubernetes.OpenAPI" "dev"
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext = LG.runKatipT
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec = runDefaultLogExecWithContext
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
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec = runDefaultLogExecWithContext
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
runNullLogExec :: LogExecWithContext
runNullLogExec le (LG.KatipT f) = P.runReaderT f (L.set LG.logEnvScribes mempty le)
_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)
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)
levelInfo :: LogLevel
levelInfo = LG.InfoS
levelError :: LogLevel
levelError = LG.ErrorS
levelDebug :: LogLevel
levelDebug = LG.DebugS