{-
   Kubernetes

   No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)

   OpenAPI Version: 3.0.1
   Kubernetes API version: release-1.16
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Kubernetes.OpenAPI.LoggingKatip
Katip Logging functions
-}

{-# 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 Aliases (for compatibility)

-- | Runs a Katip logging block with the Log environment
type LogExecWithContext = forall m. P.MonadIO m =>
                                    LogContext -> LogExec m

-- | A Katip logging block
type LogExec m = forall 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 :: IO LogContext
initLogContext = Namespace -> Environment -> IO LogContext
LG.initLogEnv Namespace
"Kubernetes.OpenAPI" Environment
"dev"

-- | Runs a Katip logging block with the Log environment
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext :: LogContext -> LogExec m
runDefaultLogExecWithContext = LogContext -> KatipT m a -> m a
forall (m :: * -> *) a. LogContext -> KatipT m a -> m a
LG.runKatipT

-- * stdout logger

-- | Runs a Katip logging block with the Log environment
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec :: LogContext -> LogExec m
stdoutLoggingExec = LogContext -> KatipT m a -> m a
LogExecWithContext
runDefaultLogExecWithContext

-- | A Katip Log environment which targets stdout
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext LogContext
cxt = do
    Scribe
handleScribe <- ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
LG.mkHandleScribe ColorStrategy
LG.ColorIfTerminal Handle
IO.stdout (Severity -> Item a -> IO Bool
forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool
LG.permitItem Severity
LG.InfoS) Verbosity
LG.V2
    Text -> Scribe -> ScribeSettings -> LogContext -> IO LogContext
LG.registerScribe Text
"stdout" Scribe
handleScribe ScribeSettings
LG.defaultScribeSettings LogContext
cxt

-- * stderr logger

-- | Runs a Katip logging block with the Log environment
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec :: LogContext -> LogExec m
stderrLoggingExec = LogContext -> KatipT m a -> m a
LogExecWithContext
runDefaultLogExecWithContext

-- | A Katip Log environment which targets stderr
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext LogContext
cxt = do
    Scribe
handleScribe <- ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
LG.mkHandleScribe ColorStrategy
LG.ColorIfTerminal Handle
IO.stderr (Severity -> Item a -> IO Bool
forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool
LG.permitItem Severity
LG.InfoS) Verbosity
LG.V2
    Text -> Scribe -> ScribeSettings -> LogContext -> IO LogContext
LG.registerScribe Text
"stderr" Scribe
handleScribe ScribeSettings
LG.defaultScribeSettings LogContext
cxt

-- * Null logger

-- | Disables Katip logging
runNullLogExec :: LogExecWithContext
runNullLogExec :: LogContext -> LogExec m
runNullLogExec LogContext
le (LG.KatipT ReaderT LogContext m a
f) = ReaderT LogContext m a -> LogContext -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
P.runReaderT ReaderT LogContext m a
f (ASetter
  LogContext
  LogContext
  (Map Text ScribeHandle)
  (Map Text ScribeHandle)
-> Map Text ScribeHandle -> LogContext -> LogContext
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  LogContext
  LogContext
  (Map Text ScribeHandle)
  (Map Text ScribeHandle)
Lens' LogContext (Map Text ScribeHandle)
LG.logEnvScribes Map Text ScribeHandle
forall a. Monoid a => a
mempty LogContext
le)

-- * Log Msg

-- | Log a katip message
_log :: (Applicative m, LG.Katip m) => Text -> LogLevel -> Text -> m ()
_log :: Text -> Severity -> Text -> m ()
_log Text
src Severity
level Text
msg = do
  Namespace -> Severity -> LogStr -> m ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Namespace -> Severity -> LogStr -> m ()
LG.logMsg (String -> Namespace
forall a. IsString a => String -> a
fromString (String -> Namespace) -> String -> Namespace
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src) Severity
level (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
LG.logStr Text
msg)

-- * Log Exceptions

-- | re-throws exceptions after logging them
logExceptions
  :: (LG.Katip m, E.MonadCatch m, Applicative m)
  => Text -> m a -> m a
logExceptions :: Text -> m a -> m a
logExceptions Text
src =
  (SomeException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle
    (\(SomeException
e :: E.SomeException) -> do
       Text -> Severity -> Text -> m ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> Severity -> Text -> m ()
_log Text
src Severity
LG.ErrorS ((String -> Text
T.pack (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) SomeException
e)
       SomeException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throw SomeException
e)

-- * Log Level

levelInfo :: LogLevel
levelInfo :: Severity
levelInfo = Severity
LG.InfoS

levelError :: LogLevel
levelError :: Severity
levelError = Severity
LG.ErrorS

levelDebug :: LogLevel
levelDebug :: Severity
levelDebug = Severity
LG.DebugS