-- | Bulk stdout logging back-end.
module Log.Backend.StandardOutput.Bulk
  ( withBulkStdOutLogger
  , withBulkJsonStdOutLogger
  ) where

import Control.Monad.IO.Unlift
import Data.Aeson
import System.IO (hFlush, stdout)
import qualified Data.Text.IO as T
import qualified Data.ByteString.Lazy.Char8 as BSL

import Log.Data
import Log.Logger
import Log.Internal.Logger

-- | Create an asynchronouis logger thread that prints messages to standard
-- output once per second for the duration of the given action. Flushes 'stdout'
-- on each bulk write.
withBulkStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r
withBulkStdOutLogger :: forall (m :: * -> *) r. MonadUnliftIO m => (Logger -> m r) -> m r
withBulkStdOutLogger Logger -> m r
act = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
unlift -> do
  Logger
logger <- Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger
mkBulkLogger Text
"stdout-bulk"
    (\[LogMessage]
msgs -> do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> LogMessage -> Text
showLogMessage forall a. Maybe a
Nothing) [LogMessage]
msgs
        Handle -> IO ()
hFlush Handle
stdout
    ) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger (forall a. m a -> IO a
unlift forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> m r
act)

-- | Create a bulk logger that prints messages in the JSON format to standard
-- output once per second for the duration of the given action. Flushes 'stdout'
-- on each bulk write.
withBulkJsonStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r
withBulkJsonStdOutLogger :: forall (m :: * -> *) r. MonadUnliftIO m => (Logger -> m r) -> m r
withBulkJsonStdOutLogger Logger -> m r
act = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
unlift -> do
  Logger
logger <- Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger
mkBulkLogger Text
"stdout-bulk-json"
    (\[LogMessage]
msgs -> do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> IO ()
BSL.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode) [LogMessage]
msgs
        Handle -> IO ()
hFlush Handle
stdout
    ) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger (forall a. m a -> IO a
unlift forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> m r
act)