{-# 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 -> Int -> MVar Buffer -> Logger -> LogStr -> IO ()
pushLog IORef FD
fdref Int
size MVar Buffer
mbuf logger :: Logger
logger@(Logger 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 -> Int -> MVar Buffer -> Logger -> IO ()
flushLog IORef FD
fdref Int
size MVar Buffer
mbuf 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 a. a -> IO a
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)
flushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> IO ()
flushLog :: IORef FD -> Int -> MVar Buffer -> Logger -> IO ()
flushLog IORef FD
fdref Int
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 -> Int -> LogStr -> IO ()
writeLogStr IORef FD
fdref Buffer
buf Int
size LogStr
logmsg
writeLogStr :: IORef FD
-> Buffer
-> BufSize
-> LogStr
-> IO ()
writeLogStr :: IORef FD -> Buffer -> Int -> LogStr -> IO ()
writeLogStr IORef FD
fdref Buffer
buf Int
size (LogStr Int
len Builder
builder)
| Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeLogStr"
| Bool
otherwise = Buffer -> Int -> (Buffer -> Int -> IO ()) -> Builder -> IO ()
toBufIOWith Buffer
buf Int
size (IORef FD -> Buffer -> Int -> IO ()
write IORef FD
fdref) Builder
builder
write :: IORef FD -> Buffer -> Int -> IO ()
write :: IORef FD -> Buffer -> Int -> IO ()
write IORef FD
fdref Buffer
buf Int
len' = Buffer -> Int -> IO ()
loop Buffer
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len')
where
loop :: Buffer -> Int -> IO ()
loop Buffer
bf Int
len = do
Int
written <- IORef FD -> Buffer -> Int -> IO Int
writeRawBufferPtr2FD IORef FD
fdref Buffer
bf Int
len
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
written Bool -> Bool -> Bool
&& Int
written Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Buffer -> Int -> IO ()
loop (Buffer
bf Buffer -> Int -> Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
written) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
written)