{-# LANGUAGE OverloadedStrings #-}
module EasyLogger.Push
( pushLogStr
, pushLogStrLn
) where
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
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
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
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
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)