{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Pinboard.Logging
( withStdoutLogging
, withStderrLogging
, withNoLogging
, logNST
, logOnException
, runLogOnException
, nullLogger
, runNullLoggingT
, errorLevelFilter
, infoLevelFilter
, debugLevelFilter
) where
import Control.Monad.IO.Class
import Control.Monad.Logger
import UnliftIO
import Data.Time
import Data.Text as T
import Pinboard.Types
import Data.Monoid
withStdoutLogging :: PinboardConfig -> PinboardConfig
withStdoutLogging :: PinboardConfig -> PinboardConfig
withStdoutLogging PinboardConfig
p =
PinboardConfig
p
{ execLoggingT :: ExecLoggingT
execLoggingT = ExecLoggingT
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT
}
withStderrLogging :: PinboardConfig -> PinboardConfig
withStderrLogging :: PinboardConfig -> PinboardConfig
withStderrLogging PinboardConfig
p =
PinboardConfig
p
{ execLoggingT :: ExecLoggingT
execLoggingT = ExecLoggingT
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStderrLoggingT
}
withNoLogging :: PinboardConfig -> PinboardConfig
withNoLogging :: PinboardConfig -> PinboardConfig
withNoLogging PinboardConfig
p =
PinboardConfig
p
{ execLoggingT :: ExecLoggingT
execLoggingT = ExecLoggingT
forall (m :: * -> *) a. LoggingT m a -> m a
runNullLoggingT
}
logOnException
:: (MonadLogger m, MonadUnliftIO m)
=> T.Text -> m a -> m a
logOnException :: Text -> m a -> m a
logOnException Text
src =
(SomeException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle
(\(SomeException
e :: SomeException) -> do
LogLevel -> Text -> Text -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
LogLevel -> Text -> Text -> m ()
logNST LogLevel
LevelError Text
src (SomeException -> Text
forall a. Show a => a -> Text
toText SomeException
e)
SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
e)
runLogOnException
:: MonadUnliftIO m
=> T.Text -> PinboardConfig -> LoggingT m a -> m a
runLogOnException :: Text -> PinboardConfig -> LoggingT m a -> m a
runLogOnException Text
logSrc PinboardConfig
config = PinboardConfig -> ExecLoggingT
runConfigLoggingT PinboardConfig
config (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
. Text -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m) =>
Text -> m a -> m a
logOnException Text
logSrc
logNST
:: (MonadIO m, MonadLogger m)
=> LogLevel -> Text -> Text -> m ()
logNST :: LogLevel -> Text -> Text -> m ()
logNST LogLevel
l Text
s Text
t =
IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UTCTime -> Text
forall a. Show a => a -> Text
toText (UTCTime -> Text) -> IO UTCTime -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime) m Text -> (Text -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\Text
time -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *).
MonadLogger m =>
Text -> LogLevel -> Text -> m ()
logOtherNS (Text
"[pinboard/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") LogLevel
l (Text
"@(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
time Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
nullLogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
nullLogger :: Loc -> Text -> LogLevel -> LogStr -> IO ()
nullLogger Loc
_ Text
_ LogLevel
_ LogStr
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runNullLoggingT :: LoggingT m a -> m a
runNullLoggingT :: LoggingT m a -> m a
runNullLoggingT = (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
`runLoggingT` Loc -> Text -> LogLevel -> LogStr -> IO ()
nullLogger)
errorLevelFilter :: LogSource -> LogLevel -> Bool
errorLevelFilter :: Text -> LogLevel -> Bool
errorLevelFilter = LogLevel -> Text -> LogLevel -> Bool
minLevelFilter LogLevel
LevelError
infoLevelFilter :: LogSource -> LogLevel -> Bool
infoLevelFilter :: Text -> LogLevel -> Bool
infoLevelFilter = LogLevel -> Text -> LogLevel -> Bool
minLevelFilter LogLevel
LevelInfo
debugLevelFilter :: LogSource -> LogLevel -> Bool
debugLevelFilter :: Text -> LogLevel -> Bool
debugLevelFilter = LogLevel -> Text -> LogLevel -> Bool
minLevelFilter LogLevel
LevelDebug
minLevelFilter :: LogLevel -> LogSource -> LogLevel -> Bool
minLevelFilter :: LogLevel -> Text -> LogLevel -> Bool
minLevelFilter LogLevel
l Text
_ LogLevel
l' = LogLevel
l' LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
l
toText
:: Show a
=> a -> Text
toText :: a -> Text
toText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show