{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
module System.Log.FastLogger.Logger (
Logger(..)
, newLogger
, pushLog
, flushLog
) where
import Control.Concurrent (MVar, withMVar)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (plusPtr)
import System.Log.FastLogger.FileIO
import System.Log.FastLogger.IO
import System.Log.FastLogger.Imports
import System.Log.FastLogger.LogStr
newtype Logger = Logger (IORef LogStr)
newLogger :: IO Logger
newLogger :: IO Logger
newLogger = IORef LogStr -> Logger
Logger (IORef LogStr -> Logger) -> IO (IORef LogStr) -> IO Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogStr -> IO (IORef LogStr)
forall a. a -> IO (IORef a)
newIORef LogStr
forall a. Monoid a => a
mempty
pushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> LogStr -> IO ()
pushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> LogStr -> IO ()
pushLog IORef FD
fdref BufSize
size MVar Buffer
mbuf logger :: Logger
logger@(Logger IORef LogStr
ref) nlogmsg :: LogStr
nlogmsg@(LogStr BufSize
nlen Builder
nbuilder)
| BufSize
nlen BufSize -> BufSize -> Bool
forall a. Ord a => a -> a -> Bool
> BufSize
size = do
IORef FD -> BufSize -> MVar Buffer -> Logger -> IO ()
flushLog IORef FD
fdref BufSize
size MVar Buffer
mbuf Logger
logger
BufSize -> (Buffer -> IO ()) -> IO ()
forall a b. BufSize -> (Ptr a -> IO b) -> IO b
allocaBytes BufSize
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
-> BufSize -> (Buffer -> BufSize -> IO ()) -> Builder -> IO ()
toBufIOWith Buffer
buf BufSize
nlen (IORef FD -> Buffer -> BufSize -> 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 -> BufSize -> LogStr -> IO ()
writeLogStr IORef FD
fdref Buffer
buf BufSize
size LogStr
msg
where
checkBuf :: LogStr -> (LogStr, Maybe LogStr)
checkBuf ologmsg :: LogStr
ologmsg@(LogStr BufSize
olen Builder
_)
| BufSize
size BufSize -> BufSize -> Bool
forall a. Ord a => a -> a -> Bool
< BufSize
olen BufSize -> BufSize -> BufSize
forall a. Num a => a -> a -> a
+ BufSize
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)
flushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> IO ()
flushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> IO ()
flushLog IORef FD
fdref BufSize
size MVar Buffer
mbuf (Logger IORef LogStr
lref) = do
LogStr
logmsg <- IORef LogStr -> (LogStr -> (LogStr, LogStr)) -> IO LogStr
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef LogStr
lref (\LogStr
old -> (LogStr
forall a. Monoid a => a
mempty, LogStr
old))
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 -> BufSize -> LogStr -> IO ()
writeLogStr IORef FD
fdref Buffer
buf BufSize
size LogStr
logmsg
writeLogStr :: IORef FD
-> Buffer
-> BufSize
-> LogStr
-> IO ()
writeLogStr :: IORef FD -> Buffer -> BufSize -> LogStr -> IO ()
writeLogStr IORef FD
fdref Buffer
buf BufSize
size (LogStr BufSize
len Builder
builder)
| BufSize
size BufSize -> BufSize -> Bool
forall a. Ord a => a -> a -> Bool
< BufSize
len = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeLogStr"
| Bool
otherwise = Buffer
-> BufSize -> (Buffer -> BufSize -> IO ()) -> Builder -> IO ()
toBufIOWith Buffer
buf BufSize
size (IORef FD -> Buffer -> BufSize -> IO ()
write IORef FD
fdref) Builder
builder
write :: IORef FD -> Buffer -> Int -> IO ()
write :: IORef FD -> Buffer -> BufSize -> IO ()
write IORef FD
fdref Buffer
buf BufSize
len' = Buffer -> BufSize -> IO ()
loop Buffer
buf (BufSize -> BufSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral BufSize
len')
where
loop :: Buffer -> BufSize -> IO ()
loop Buffer
bf BufSize
len = do
BufSize
written <- IORef FD -> Buffer -> BufSize -> IO BufSize
writeRawBufferPtr2FD IORef FD
fdref Buffer
bf BufSize
len
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufSize
0 BufSize -> BufSize -> Bool
forall a. Ord a => a -> a -> Bool
<= BufSize
written Bool -> Bool -> Bool
&& BufSize
written BufSize -> BufSize -> Bool
forall a. Ord a => a -> a -> Bool
< BufSize
len) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Buffer -> BufSize -> IO ()
loop (Buffer
bf Buffer -> BufSize -> Buffer
forall a b. Ptr a -> BufSize -> Ptr b
`plusPtr` BufSize -> BufSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral BufSize
written) (BufSize
len BufSize -> BufSize -> BufSize
forall a. Num a => a -> a -> a
- BufSize
written)