module Boots.Plugin.Logger(
HasLogger(..)
, LogConfig(..)
, LogFunc
, addTrace
, pluginLogger
, logInfo
, logDebug
, logWarn
, logError
, logOther
) where
import Boots.Internal
import Boots.Plugin.Salak
import Control.Monad
import Control.Monad.Logger.CallStack
import Control.Monad.Reader
import Data.Default
import Data.Text (Text, toLower, unpack)
import Data.Word
import Lens.Micro
import Lens.Micro.Extras
import Salak
import System.Log.FastLogger
class HasLogger cxt where
askLogger :: Lens' cxt LogFunc
instance HasLogger LogFunc where
askLogger = id
instance (MonadIO m, HasLogger cxt) => MonadLogger (Plugin cxt m) where
monadLoggerLog a b c d = do
LogFunc{..} <- asks (view askLogger)
liftIO $ logfunc a b c (toLogStr d)
instance (MonadIO m, HasLogger cxt) => MonadLogger (AppT cxt m) where
monadLoggerLog a b c d = do
LogFunc{..} <- asks (view askLogger)
liftIO $ logfunc a b c (toLogStr d)
instance Monad m => FromProp m LogLevel where
fromProp = readEnum (fromEnumProp.toLower)
where
fromEnumProp "debug" = Right LevelDebug
fromEnumProp "info" = Right LevelInfo
fromEnumProp "warn" = Right LevelWarn
fromEnumProp "error" = Right LevelError
fromEnumProp u = Left $ "unknown level: " ++ unpack u
{-# INLINE toStr #-}
toStr :: LogLevel -> LogStr
toStr LevelDebug = "DEBUG"
toStr LevelInfo = " INFO"
toStr LevelWarn = " WARN"
toStr LevelError = "ERROR"
toStr (LevelOther l) = toLogStr l
data LogConfig = LogConfig
{ bufferSize :: Word16
, file :: Maybe FilePath
, maxSize :: Word32
, rotateHistory :: Word16
, level :: IO LogLevel
}
instance Default LogConfig where
def = LogConfig 4096 Nothing 10485760 256 (return LevelInfo)
instance MonadIO m => FromProp m LogConfig where
fromProp = LogConfig
<$> "buffer-size" .?: bufferSize
<*> "file" .?: file
<*> "max-size" .?: maxSize
<*> "max-history" .?: rotateHistory
<*> "level" .?: level
data LogFunc = LogFunc
{ logfunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
, logend :: IO ()
}
newLogger :: Text -> LogConfig -> IO LogFunc
newLogger name LogConfig{..} = do
tc <- newTimeCache "%Y-%m-%d %T"
let ln = " [" <> toLogStr name <> "] "
ft = case file of
Just f -> LogFile (FileLogSpec f (toInteger maxSize) (fromIntegral rotateHistory)) $ fromIntegral bufferSize
_ -> LogStdout $ fromIntegral bufferSize
(l,close) <- newTimedFastLogger tc ft
return (LogFunc (toLogger ln l) close)
where
toLogger xn f Loc{..} _ ll s = do
lc <- level
when (lc <= ll) $ f $ \t ->
let locate = if ll /= LevelError then "" else " @" <> toLogStr loc_filename <> toLogStr (show loc_start)
in toLogStr t <> " " <> toStr ll <> xn <> toLogStr loc_module <> locate <> " - " <> s <> "\n"
addTrace :: Text -> LogFunc -> LogFunc
addTrace trace lf = lf { logfunc = \a b c d -> let p = "[" <> toLogStr trace <> "] " in logfunc lf a b c (p <> d) }
pluginLogger
:: (MonadIO m, MonadCatch m, HasSalak cxt)
=> Text
-> Plugin cxt m LogFunc
pluginLogger name = do
lc <- require "logging"
bracketP (liftIO $ newLogger name lc) (\LogFunc{..} -> liftIO logend)