Push.hs

{-# LANGUAGE OverloadedStrings #-}
module EasyLogger.Push
    ( pushLogStr
    , pushLogStrLn
    ) where


-- import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)
-- import System.Log.FastLogger.Types (TimeFormat, FormattedTime)
import           Control.Concurrent
import           Data.Array            (bounds, (!))
import           Data.IORef
import           Foreign.Marshal.Alloc (allocaBytes)
import           GHC.IO.FD

import           EasyLogger.LoggerSet
import           EasyLogger.LogStr


-- | Writing a log message to the corresponding buffer.
--   If the buffer becomes full, the log messages in the buffer
--   are written to its corresponding file, stdout, or stderr.
pushLogStr :: LoggerSet -> LogStr -> IO ()
pushLogStr (LoggerSet _ fdref arr flush) logmsg = do
    (i, _) <- myThreadId >>= threadCapability
    -- The number of capability could be dynamically changed.
    -- So, let's check the upper boundary of the array.
    let u = snd $ bounds arr
        lim = u + 1
        j | i < lim   = i
          | otherwise = i `mod` lim
    let logger = arr ! j
    pushLog fdref logger logmsg
    flush


-- | Same as 'pushLogStr' but also appends a newline.
pushLogStrLn :: LoggerSet -> LogStr -> IO ()
pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> "\n")

pushLog :: IORef FD -> Logger -> LogStr -> IO ()
pushLog fdref logger@(Logger size mbuf ref) nlogmsg@(LogStr nlen nbuilder)
  | nlen > size = do
      flushLog fdref logger
      -- Make sure we have a large enough buffer to hold the entire
      -- contents, thereby allowing for a single write system call and
      -- avoiding interleaving. This does not address the possibility
      -- of write not writing the entire buffer at once.
      allocaBytes nlen $ \buf -> withMVar mbuf $ \_ ->
        toBufIOWith buf nlen (write fdref) nbuilder
  | otherwise = do
    mmsg <- atomicModifyIORef' ref checkBuf
    case mmsg of
        Nothing  -> return ()
        Just msg -> withMVar mbuf $ \buf -> writeLogStr fdref buf size msg
  where
    checkBuf ologmsg@(LogStr olen _)
      | size < olen + nlen = (nlogmsg, Just ologmsg)
      | otherwise          = (ologmsg <> nlogmsg, Nothing)