{-
   Gitea API

   This documentation describes the Gitea API.

   OpenAPI Version: 3.0.1
   Gitea API API version: 1.23.1
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Gitea.LoggingMonadLogger
monad-logger Logging functions
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Gitea.LoggingMonadLogger where

import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Data.Text as T
import qualified Data.Time as TI

import Data.Text (Text)

import qualified Control.Monad.Logger as LG

-- * Type Aliases (for compatibility)

-- | Runs a monad-logger  block with the filter predicate
type LogExecWithContext = forall m a. P.MonadIO m =>
                                      LogContext -> LogExec m a

-- | A monad-logger block
type LogExec m a = LG.LoggingT m a -> m a

-- | A monad-logger filter predicate
type LogContext = LG.LogSource -> LG.LogLevel -> Bool

-- | A monad-logger log level
type LogLevel = LG.LogLevel

-- * default logger

-- | the default log environment
initLogContext :: IO LogContext
initLogContext :: IO LogContext
initLogContext = LogContext -> IO LogContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogContext
infoLevelFilter

-- | Runs a monad-logger block with the filter predicate
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext = LogContext -> LogExec m a
LogExecWithContext
runNullLogExec

-- * stdout logger

-- | Runs a monad-logger block targeting stdout, with the filter predicate
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec LogContext
cxt = LoggingT m a -> m a
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
LG.runStdoutLoggingT (LoggingT m a -> m a)
-> (LoggingT m a -> LoggingT m a) -> LoggingT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogContext -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a. LogContext -> LoggingT m a -> LoggingT m a
LG.filterLogger LogContext
cxt

-- | @pure@
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext = LogContext -> IO LogContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- * stderr logger

-- | Runs a monad-logger block targeting stderr, with the filter predicate
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec LogContext
cxt = LoggingT m a -> m a
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
LG.runStderrLoggingT (LoggingT m a -> m a)
-> (LoggingT m a -> LoggingT m a) -> LoggingT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogContext -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a. LogContext -> LoggingT m a -> LoggingT m a
LG.filterLogger LogContext
cxt

-- | @pure@
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext = LogContext -> IO LogContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- * Null logger

-- | Disables monad-logger logging
runNullLogExec :: LogExecWithContext
runNullLogExec :: LogExecWithContext
runNullLogExec = LogExec m a -> LogContext -> LogExec m a
forall a b. a -> b -> a
const (LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
`LG.runLoggingT` Loc -> LogSource -> LogLevel -> LogStr -> IO ()
nullLogger)

-- | monad-logger which does nothing
nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()
nullLogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
nullLogger Loc
_ LogSource
_ LogLevel
_ LogStr
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Log Msg

-- | Log a message using the current time
_log :: (P.MonadIO m, LG.MonadLogger m) => Text -> LG.LogLevel -> Text -> m ()
_log :: forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
LogSource -> LogLevel -> LogSource -> m ()
_log LogSource
src LogLevel
level LogSource
msg = do
  now <- IO LogSource -> m LogSource
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (UTCTime -> LogSource
formatTimeLog (UTCTime -> LogSource) -> IO UTCTime -> IO LogSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
TI.getCurrentTime)
  LG.logOtherNS ("Gitea." <> src) level ("[" <> now <> "] " <> msg)
 where
  formatTimeLog :: UTCTime -> LogSource
formatTimeLog =
    String -> LogSource
T.pack (String -> LogSource)
-> (UTCTime -> String) -> UTCTime -> LogSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
TI.formatTime TimeLocale
TI.defaultTimeLocale String
"%Y-%m-%dT%H:%M:%S%Z"

-- * Log Exceptions

-- | re-throws exceptions after logging them
logExceptions
   :: (LG.MonadLogger m, E.MonadCatch m, P.MonadIO m)
   => Text -> m a -> m a
logExceptions :: forall (m :: * -> *) a.
(MonadLogger m, MonadCatch m, MonadIO m) =>
LogSource -> m a -> m a
logExceptions LogSource
src =
   (SomeException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle
     (\(SomeException
e :: E.SomeException) -> do
        LogSource -> LogLevel -> LogSource -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
LogSource -> LogLevel -> LogSource -> m ()
_log LogSource
src LogLevel
LG.LevelError ((String -> LogSource
T.pack (String -> LogSource)
-> (SomeException -> String) -> SomeException -> LogSource
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.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
E.throw SomeException
e)

-- * Log Level

levelInfo :: LogLevel
levelInfo :: LogLevel
levelInfo = LogLevel
LG.LevelInfo

levelError :: LogLevel
levelError :: LogLevel
levelError = LogLevel
LG.LevelError

levelDebug :: LogLevel
levelDebug :: LogLevel
levelDebug = LogLevel
LG.LevelDebug

-- * Level Filter

minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool
minLevelFilter :: LogLevel -> LogContext
minLevelFilter LogLevel
l LogSource
_ LogLevel
l' = LogLevel
l' LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
l

infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool
infoLevelFilter :: LogContext
infoLevelFilter = LogLevel -> LogContext
minLevelFilter LogLevel
LG.LevelInfo