{-# 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 -> LogStr -> IO ()
pushLogStr (LoggerSet Maybe FilePath
_ IORef FD
fdref Array Int Logger
arr IO ()
flush) LogStr
logmsg = do
    (Int
i, Bool
_) <- IO ThreadId
myThreadId IO ThreadId -> (ThreadId -> IO (Int, Bool)) -> IO (Int, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ThreadId -> IO (Int, Bool)
threadCapability
    -- The number of capability could be dynamically changed.
    -- So, let's check the upper boundary of the array.
    let u :: Int
u = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array Int Logger -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Logger
arr
        lim :: Int
lim = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        j :: Int
j | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lim   = Int
i
          | Bool
otherwise = Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
lim
    let logger :: Logger
logger = Array Int Logger
arr Array Int Logger -> Int -> Logger
forall i e. Ix i => Array i e -> i -> e
! Int
j
    IORef FD -> Logger -> LogStr -> IO ()
pushLog IORef FD
fdref Logger
logger LogStr
logmsg
    IO ()
flush


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

pushLog :: IORef FD -> Logger -> LogStr -> IO ()
pushLog :: IORef FD -> Logger -> LogStr -> IO ()
pushLog IORef FD
fdref logger :: Logger
logger@(Logger Int
size MVar Buffer
mbuf IORef LogStr
ref) nlogmsg :: LogStr
nlogmsg@(LogStr Int
nlen Builder
nbuilder)
  | Int
nlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size = do
      IORef FD -> Logger -> IO ()
flushLog IORef FD
fdref Logger
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.
      Int -> (Buffer -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nlen ((Buffer -> IO ()) -> IO ()) -> (Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
buf -> MVar Buffer -> (Buffer -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Buffer
mbuf ((Buffer -> IO ()) -> IO ()) -> (Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
_ ->
        Buffer -> Int -> (Buffer -> Int -> IO ()) -> Builder -> IO ()
toBufIOWith Buffer
buf Int
nlen (IORef FD -> Buffer -> Int -> IO ()
write IORef FD
fdref) Builder
nbuilder
  | Bool
otherwise = do
    Maybe LogStr
mmsg <- IORef LogStr
-> (LogStr -> (LogStr, Maybe LogStr)) -> IO (Maybe LogStr)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef LogStr
ref LogStr -> (LogStr, Maybe LogStr)
checkBuf
    case Maybe LogStr
mmsg of
        Maybe LogStr
Nothing  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just LogStr
msg -> MVar Buffer -> (Buffer -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Buffer
mbuf ((Buffer -> IO ()) -> IO ()) -> (Buffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
buf -> IORef FD -> Buffer -> Int -> LogStr -> IO ()
writeLogStr IORef FD
fdref Buffer
buf Int
size LogStr
msg
  where
    checkBuf :: LogStr -> (LogStr, Maybe LogStr)
checkBuf ologmsg :: LogStr
ologmsg@(LogStr Int
olen Builder
_)
      | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
olen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nlen = (LogStr
nlogmsg, LogStr -> Maybe LogStr
forall a. a -> Maybe a
Just LogStr
ologmsg)
      | Bool
otherwise          = (LogStr
ologmsg LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
nlogmsg, Maybe LogStr
forall a. Maybe a
Nothing)