forked from loafle/openapi-generator-original
d928617b69
* change strictFields cli option default to True; * use katip logging; add cli-option for monad-logger * fix date parsing * remove package.yaml
118 lines
3.0 KiB
Plaintext
118 lines
3.0 KiB
Plaintext
{-|
|
|
Module : {{title}}.Logging
|
|
monad-logger Logging functions
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module {{title}}.Logging where
|
|
|
|
import Data.Text (Text)
|
|
|
|
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.Monoid ((<>))
|
|
|
|
import qualified Control.Monad.Logger as LG
|
|
|
|
-- * Type Aliases (for compatability)
|
|
|
|
-- | Runs a monad-logger block with the filter predicate
|
|
type LogExecWithContext = forall m. P.MonadIO m =>
|
|
LogContext -> LogExec m
|
|
|
|
-- | A monad-logger block
|
|
type LogExec m = forall 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 = pure infoLevelFilter
|
|
|
|
-- | Runs a monad-logger block with the filter predicate
|
|
runDefaultLogExecWithContext :: LogExecWithContext
|
|
runDefaultLogExecWithContext = runNullLogExec
|
|
|
|
-- * stdout logger
|
|
|
|
-- | Runs a monad-logger block targeting stdout, with the filter predicate
|
|
stdoutLoggingExec :: LogExecWithContext
|
|
stdoutLoggingExec cxt = LG.runStdoutLoggingT . LG.filterLogger cxt
|
|
|
|
-- | @pure@
|
|
stdoutLoggingContext :: LogContext -> IO LogContext
|
|
stdoutLoggingContext = pure
|
|
|
|
-- * stderr logger
|
|
|
|
-- | Runs a monad-logger block targeting stderr, with the filter predicate
|
|
stderrLoggingExec :: LogExecWithContext
|
|
stderrLoggingExec cxt = LG.runStderrLoggingT . LG.filterLogger cxt
|
|
|
|
-- | @pure@
|
|
stderrLoggingContext :: LogContext -> IO LogContext
|
|
stderrLoggingContext = pure
|
|
|
|
-- * Null logger
|
|
|
|
-- | Disables monad-logger logging
|
|
runNullLogExec :: LogExecWithContext
|
|
runNullLogExec = const (`LG.runLoggingT` nullLogger)
|
|
|
|
-- | monad-logger which does nothing
|
|
nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()
|
|
nullLogger _ _ _ _ = return ()
|
|
|
|
-- * Log Msg
|
|
|
|
-- | Log a message using the current time
|
|
_log :: (P.MonadIO m, LG.MonadLogger m) => Text -> LG.LogLevel -> Text -> m ()
|
|
_log src level msg = do
|
|
now <- P.liftIO (formatTimeLog <$> TI.getCurrentTime)
|
|
LG.logOtherNS ("{{title}}." <> src) level ("[" <> now <> "] " <> msg)
|
|
where
|
|
formatTimeLog =
|
|
T.pack . TI.formatTime TI.defaultTimeLocale "%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 src =
|
|
E.handle
|
|
(\(e :: E.SomeException) -> do
|
|
_log src LG.LevelError ((T.pack . show) e)
|
|
E.throw e)
|
|
|
|
-- * Log Level
|
|
|
|
levelInfo :: LogLevel
|
|
levelInfo = LG.LevelInfo
|
|
|
|
levelError :: LogLevel
|
|
levelError = LG.LevelError
|
|
|
|
levelDebug :: LogLevel
|
|
levelDebug = LG.LevelDebug
|
|
|
|
-- * Level Filter
|
|
|
|
minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool
|
|
minLevelFilter l _ l' = l' >= l
|
|
|
|
infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool
|
|
infoLevelFilter = minLevelFilter LG.LevelInfo
|