\subsection{Cardano.BM.Backend.ProcessQueue}
\label{module:Cardano.BM.Backend.ProcessQueue}
%if style == newcode
\begin{code}
module Cardano.BM.Backend.ProcessQueue
( processQueue
) where
import Control.Concurrent.STM (atomically, retry)
import qualified Control.Concurrent.STM.TBQueue as TBQ
import Control.Monad (when)
import Cardano.BM.Data.LogItem
\end{code}
%endif
\subsubsection{Read TBQueue in batches}
\begin{code}
processQueue
:: TBQ.TBQueue (Maybe (LogObject a))
-> (LogObject a -> b -> IO b)
-> b
-> (b -> IO ())
-> IO ()
processQueue :: TBQueue (Maybe (LogObject a))
-> (LogObject a -> b -> IO b) -> b -> (b -> IO ()) -> IO ()
processQueue TBQueue (Maybe (LogObject a))
tbqueue LogObject a -> b -> IO b
proc b
state b -> IO ()
terminate = do
[Maybe (LogObject a)]
items <- STM [Maybe (LogObject a)] -> IO [Maybe (LogObject a)]
forall a. STM a -> IO a
atomically (STM [Maybe (LogObject a)] -> IO [Maybe (LogObject a)])
-> STM [Maybe (LogObject a)] -> IO [Maybe (LogObject a)]
forall a b. (a -> b) -> a -> b
$ do
[Maybe (LogObject a)]
list <- TBQueue (Maybe (LogObject a)) -> STM [Maybe (LogObject a)]
forall a. TBQueue a -> STM [a]
TBQ.flushTBQueue TBQueue (Maybe (LogObject a))
tbqueue
Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Maybe (LogObject a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe (LogObject a)]
list) STM ()
forall a. STM a
retry
[Maybe (LogObject a)] -> STM [Maybe (LogObject a)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe (LogObject a)]
list
b -> [Maybe (LogObject a)] -> IO ()
processItems b
state [Maybe (LogObject a)]
items
where
processItems :: b -> [Maybe (LogObject a)] -> IO ()
processItems b
s [] = TBQueue (Maybe (LogObject a))
-> (LogObject a -> b -> IO b) -> b -> (b -> IO ()) -> IO ()
forall a b.
TBQueue (Maybe (LogObject a))
-> (LogObject a -> b -> IO b) -> b -> (b -> IO ()) -> IO ()
processQueue TBQueue (Maybe (LogObject a))
tbqueue LogObject a -> b -> IO b
proc b
s b -> IO ()
terminate
processItems b
s ((Just LogObject a
lo):[Maybe (LogObject a)]
is) = LogObject a -> b -> IO b
proc LogObject a
lo b
s IO b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
s' -> b -> [Maybe (LogObject a)] -> IO ()
processItems b
s' [Maybe (LogObject a)]
is
processItems b
s (Maybe (LogObject a)
Nothing :[Maybe (LogObject a)]
_ ) = b -> IO ()
terminate b
s
\end{code}