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

import Data.Aeson
import Prelude
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 :: (Logger -> IO r) -> IO r
withBulkStdOutLogger :: (Logger -> IO r) -> IO r
withBulkStdOutLogger act :: Logger -> IO r
act = do
  Logger
logger <- Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger
mkBulkLogger "stdout-bulk"
    (\msgs :: [LogMessage]
msgs -> do
        (LogMessage -> IO ()) -> [LogMessage] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn (Text -> IO ()) -> (LogMessage -> Text) -> LogMessage -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> LogMessage -> Text
showLogMessage Maybe UTCTime
forall a. Maybe a
Nothing) [LogMessage]
msgs
        Handle -> IO ()
hFlush Handle
stdout
    ) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Logger -> (Logger -> IO r) -> IO r
forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger Logger -> IO 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 :: (Logger -> IO r) -> IO r
withBulkJsonStdOutLogger :: (Logger -> IO r) -> IO r
withBulkJsonStdOutLogger act :: Logger -> IO r
act = do
  Logger
logger <- Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger
mkBulkLogger "stdout-bulk-json"
    (\msgs :: [LogMessage]
msgs -> do
        (LogMessage -> IO ()) -> [LogMessage] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> IO ()
BSL.putStrLn (ByteString -> IO ())
-> (LogMessage -> ByteString) -> LogMessage -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encode) [LogMessage]
msgs
        Handle -> IO ()
hFlush Handle
stdout
    ) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Logger -> (Logger -> IO r) -> IO r
forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger Logger -> IO r
act