module B9.B9Logging
( Logger(..)
, CommandIO
, LoggerReader
, withLogger
, b9Log
, traceL
, dbgL
, infoL
, errorL
, errorExitL
) where
import B9.B9Config
import B9.B9Error
import Control.Eff
import Control.Eff.Reader.Lazy
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM)
import Data.Maybe
import Data.Time.Clock
import Data.Time.Format
import qualified System.IO as SysIO
import Text.Printf
newtype Logger = MkLogger
{ logFileHandle :: Maybe SysIO.Handle
}
type LoggerReader = Reader Logger
withLogger ::
(MonadBaseControl IO (Eff e), MonadIO (Eff e), Member B9ConfigReader e) => Eff (LoggerReader ': e) a -> Eff e a
withLogger action = do
lf <- _logFile <$> getB9Config
effState <-
liftBaseWith $ \runInIO ->
let fInIO = runInIO . flip runReader action . MkLogger
in maybe (fInIO Nothing) (\logf -> SysIO.withFile logf SysIO.AppendMode (fInIO . Just)) lf
restoreM effState
type CommandIO e = (MonadBaseControl IO (Eff e), MonadIO (Eff e), Member LoggerReader e, Member B9ConfigReader e)
traceL :: CommandIO e => String -> Eff e ()
traceL = b9Log LogTrace
dbgL :: CommandIO e => String -> Eff e ()
dbgL = b9Log LogDebug
infoL :: CommandIO e => String -> Eff e ()
infoL = b9Log LogInfo
errorL :: CommandIO e => String -> Eff e ()
errorL = b9Log LogError
errorExitL :: (CommandIO e, Member ExcB9 e) => String -> Eff e a
errorExitL e = b9Log LogError e >> throwB9Error e
b9Log :: CommandIO e => LogLevel -> String -> Eff e ()
b9Log level msg = do
lv <- getLogVerbosity
lfh <- logFileHandle <$> ask
liftIO $ logImpl lv lfh level msg
logImpl :: Maybe LogLevel -> Maybe SysIO.Handle -> LogLevel -> String -> IO ()
logImpl minLevel mh level msg = do
lm <- formatLogMsg level msg
when (isJust minLevel && level >= fromJust minLevel) (putStr lm)
when (isJust mh) $ do
SysIO.hPutStr (fromJust mh) lm
SysIO.hFlush (fromJust mh)
formatLogMsg :: LogLevel -> String -> IO String
formatLogMsg l msg = do
u <- getCurrentTime
let time = formatTime defaultTimeLocale "%H:%M:%S" u
return $ unlines $ printf "[%s] %s - %s" (printLevel l) time <$> lines msg
printLevel :: LogLevel -> String
printLevel l =
case l of
LogNothing -> "NOTHING"
LogError -> " ERROR "
LogInfo -> " INFO "
LogDebug -> " DEBUG "
LogTrace -> " TRACE "