{-| Canned loggers to avoid reinventing the wheel every time. -}

module Gargantext.System.Logging.Loggers (
    ioStdLogger
  , IOStdLogger -- opaque, you can't build it directly, use 'ioStdLogger'
  , _iosl_log_level
  , _iosl_destroy
  , _iosl_log_msg
  , _iosl_log_txt
  , monadicStdLogger
  , _msl_log_level
  , _msl_destroy
  , _msl_log_msg
  , _msl_log_txt
  , MonadicStdLogger
  ) where

import Control.Monad
import Control.Monad.IO.Class
import Data.Text qualified as T
import Data.Time
import Gargantext.Core.Config
import Gargantext.System.Logging.Types
import Prelude
import System.Log.FastLogger qualified as FL

data IOStdLogger =
  IOStdLogger { _iosl_log_level :: LogLevel
              , _iosl_destroy   :: IO ()
              , _iosl_log_msg   :: LogLevel -> String -> IO ()
              , _iosl_log_txt   :: LogLevel -> T.Text -> IO ()
              }

ioStdLogger :: LogConfig -> IO IOStdLogger
ioStdLogger LogConfig{..} = do
  let minLvl = _lc_log_level
  let log_msg lvl msg = do
        t <- getCurrentTime
        when (lvl >= minLvl) $ do
          let pfx = "[" <> show t <> "] [" <> show lvl <> "] "
          putStrLn $ pfx <> msg
  pure $ IOStdLogger
    { _iosl_log_level = minLvl
    , _iosl_destroy   = pure ()
    , _iosl_log_msg   = log_msg
    , _iosl_log_txt = \lvl msg -> log_msg lvl (T.unpack msg)
    }

-- | A monadic standard logger powered by fast-logger underneath.
data MonadicStdLogger payload m =
  MonadicStdLogger { _msl_log_level :: LogLevel
                   , _msl_loggers   :: [FL.LoggerSet]
                   , _msl_destroy   :: m ()
                   , _msl_log_msg   :: LogLevel -> payload -> m ()
                   , _msl_log_txt   :: LogLevel -> T.Text -> m ()
                   }

monadicStdLogger :: MonadIO m => LogConfig -> IO (MonadicStdLogger FL.LogStr m)
monadicStdLogger LogConfig{..} = do
  let minLvl = _lc_log_level
  stdout_logger <- FL.newStderrLoggerSet FL.defaultBufSize
  let log_msg lvl msg = liftIO $ do
        t <- getCurrentTime
        when (lvl >= minLvl) $ do
          let pfx = "[" <> show t <> "] [" <> show lvl <> "] "
          FL.pushLogStrLn stdout_logger $ FL.toLogStr pfx <> msg
  pure $ MonadicStdLogger
    { _msl_log_level = minLvl
    , _msl_loggers   = [stdout_logger]
    , _msl_destroy   = liftIO $ FL.rmLoggerSet stdout_logger
    , _msl_log_msg   = log_msg
    , _msl_log_txt   = \lvl msg -> log_msg lvl (FL.toLogStr $ T.unpack msg)
    }