1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
{-# LANGUAGE RecordWildCards #-}
module System.Log.FastLogger.MultiLogger (
MultiLogger,
newMultiLogger,
) where
import Control.Concurrent (
MVar,
myThreadId,
newMVar,
takeMVar,
threadCapability,
withMVar,
)
import Data.Array (Array, bounds, listArray, (!))
import System.Log.FastLogger.FileIO
import System.Log.FastLogger.IO
import System.Log.FastLogger.Imports
import System.Log.FastLogger.LogStr
import System.Log.FastLogger.Write
----------------------------------------------------------------
newtype MLogger = MLogger
{ lgrRef :: IORef LogStr
}
-- | A scale but non-time-ordered logger.
data MultiLogger = MultiLogger
{ mlgrArray :: Array Int MLogger
, mlgrMBuffer :: MVar Buffer
, mlgrBufSize :: BufSize
, mlgrFdRef :: IORef FD
}
instance Loggers MultiLogger where
stopLoggers = System.Log.FastLogger.MultiLogger.stopLoggers
pushLog = System.Log.FastLogger.MultiLogger.pushLog
flushAllLog = System.Log.FastLogger.MultiLogger.flushAllLog
----------------------------------------------------------------
newMLogger :: IO MLogger
newMLogger = MLogger <$> newIORef mempty
-- | Creating `MultiLogger`.
-- The first argument is the number of the internal builders.
newMultiLogger :: Int -> BufSize -> IORef FD -> IO MultiLogger
newMultiLogger n bufsize fdref = do
mbuf <- getBuffer bufsize >>= newMVar
arr <- listArray (0, n - 1) <$> replicateM n newMLogger
return $
MultiLogger
{ mlgrArray = arr
, mlgrMBuffer = mbuf
, mlgrBufSize = bufsize
, mlgrFdRef = fdref
}
----------------------------------------------------------------
pushLog :: MultiLogger -> LogStr -> IO ()
pushLog ml@MultiLogger{..} 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 mlgrArray
lim = u + 1
j
| i < lim = i
| otherwise = i `mod` lim
let logger = mlgrArray ! j
pushLog' logger logmsg
where
pushLog' logger@MLogger{..} nlogmsg@(LogStr nlen _)
| nlen > mlgrBufSize = do
flushLog ml 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.
writeBigLogStr' ml nlogmsg
| otherwise = do
action <- atomicModifyIORef' lgrRef checkBuf
action
where
checkBuf ologmsg@(LogStr olen _)
| mlgrBufSize < olen + nlen = (nlogmsg, writeLogStr' ml ologmsg)
| otherwise = (ologmsg <> nlogmsg, return ())
----------------------------------------------------------------
flushAllLog :: MultiLogger -> IO ()
flushAllLog ml@MultiLogger{..} = do
let flushIt i = flushLog ml (mlgrArray ! i)
(l, u) = bounds mlgrArray
nums = [l .. u]
mapM_ flushIt nums
flushLog :: MultiLogger -> MLogger -> IO ()
flushLog ml MLogger{..} = do
-- If a special buffer is prepared for flusher, this MVar could
-- be removed. But such a code does not contribute logging speed
-- according to experiment. And even with the special buffer,
-- there is no grantee that this function is exclusively called
-- for a buffer. So, we use MVar here.
-- This is safe and speed penalty can be ignored.
old <- atomicModifyIORef' lgrRef (\old -> (mempty, old))
writeLogStr' ml old
----------------------------------------------------------------
stopLoggers :: MultiLogger -> IO ()
stopLoggers ml@MultiLogger{..} = do
System.Log.FastLogger.MultiLogger.flushAllLog ml
takeMVar mlgrMBuffer >>= freeBuffer
----------------------------------------------------------------
writeLogStr' :: MultiLogger -> LogStr -> IO ()
writeLogStr' MultiLogger{..} logstr =
withMVar mlgrMBuffer $ \buf -> writeLogStr buf mlgrFdRef logstr
writeBigLogStr' :: MultiLogger -> LogStr -> IO ()
writeBigLogStr' MultiLogger{..} logstr =
withMVar mlgrMBuffer $ \_ -> writeBigLogStr mlgrFdRef logstr
|
