\subsection{Cardano.BM.Backend.LogBuffer}
\label{module:Cardano.BM.Backend.LogBuffer}

%if style == newcode
\begin{code}
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Cardano.BM.Backend.LogBuffer
    ( LogBuffer
    , readBuffer
    , effectuate
    , realize
    , unrealize
    ) where

import           Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_,
                     newMVar)
import           Data.Aeson (FromJSON)
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.IO as TIO
import           System.IO (stderr)

import           Cardano.BM.Data.Backend (BackendKind (LogBufferBK),
                     IsBackend (..), IsEffectuator (..))
import           Cardano.BM.Data.LogItem (LOContent (..), LoggerName,
                     LogObject (..))

\end{code}
%endif

\subsubsection{Structure of LogBuffer}\label{code:LogBuffer}\index{LogBuffer}
\begin{code}
newtype LogBuffer a = LogBuffer
    { LogBuffer a -> LogBufferMVar a
getLogBuf :: LogBufferMVar a }

type LogBufferMVar a = MVar (LogBufferInternal a)

data LogBufferInternal a = LogBufferInternal
    { LogBufferInternal a -> LogBufferMap a
logBuffer :: !(LogBufferMap a)
    }

\end{code}

\subsubsection{Relation from log context name to log item}
We keep the latest |LogObject| from a log context in a |HashMap|.
\begin{code}
type LogBufferMap a = HM.HashMap LoggerName (LogObject a)

\end{code}

\subsubsection{Read out the latest |LogObject|s}
Returns a list of the maps keys and values.
And, resets the map.
\begin{code}
readBuffer :: LogBuffer a -> IO [(LoggerName, LogObject a)]
readBuffer :: LogBuffer a -> IO [(LoggerName, LogObject a)]
readBuffer LogBuffer a
buffer =
    MVar (LogBufferInternal a)
-> (LogBufferInternal a
    -> IO (LogBufferInternal a, [(LoggerName, LogObject a)]))
-> IO [(LoggerName, LogObject a)]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (LogBuffer a -> MVar (LogBufferInternal a)
forall a. LogBuffer a -> LogBufferMVar a
getLogBuf LogBuffer a
buffer) ((LogBufferInternal a
  -> IO (LogBufferInternal a, [(LoggerName, LogObject a)]))
 -> IO [(LoggerName, LogObject a)])
-> (LogBufferInternal a
    -> IO (LogBufferInternal a, [(LoggerName, LogObject a)]))
-> IO [(LoggerName, LogObject a)]
forall a b. (a -> b) -> a -> b
$ \LogBufferInternal a
currentBuffer -> do
        let !l :: [(LoggerName, LogObject a)]
l = HashMap LoggerName (LogObject a) -> [(LoggerName, LogObject a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap LoggerName (LogObject a) -> [(LoggerName, LogObject a)])
-> HashMap LoggerName (LogObject a) -> [(LoggerName, LogObject a)]
forall a b. (a -> b) -> a -> b
$ LogBufferInternal a -> HashMap LoggerName (LogObject a)
forall a. LogBufferInternal a -> LogBufferMap a
logBuffer LogBufferInternal a
currentBuffer
        (LogBufferInternal a, [(LoggerName, LogObject a)])
-> IO (LogBufferInternal a, [(LoggerName, LogObject a)])
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap LoggerName (LogObject a) -> LogBufferInternal a
forall a. LogBufferMap a -> LogBufferInternal a
LogBufferInternal HashMap LoggerName (LogObject a)
forall k v. HashMap k v
HM.empty, [(LoggerName, LogObject a)]
l)

\end{code}

\subsubsection{LogBuffer is an effectuator}\index{LogBuffer!instance of IsEffectuator}
Function |effectuate| is called to pass in a |LogObject| for log buffering.
\begin{code}
instance IsEffectuator LogBuffer a where
    effectuate :: LogBuffer a -> LogObject a -> IO ()
effectuate LogBuffer a
buffer lo :: LogObject a
lo@(LogObject LoggerName
loname LOMeta
_lometa (LogValue LoggerName
lvname Measurable
_lvalue)) =
        MVar (LogBufferInternal a)
-> (LogBufferInternal a -> IO (LogBufferInternal a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (LogBuffer a -> MVar (LogBufferInternal a)
forall a. LogBuffer a -> LogBufferMVar a
getLogBuf LogBuffer a
buffer) ((LogBufferInternal a -> IO (LogBufferInternal a)) -> IO ())
-> (LogBufferInternal a -> IO (LogBufferInternal a)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LogBufferInternal a
currentBuffer ->
            LogBufferInternal a -> IO (LogBufferInternal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LogBufferInternal a -> IO (LogBufferInternal a))
-> LogBufferInternal a -> IO (LogBufferInternal a)
forall a b. (a -> b) -> a -> b
$! LogBufferMap a -> LogBufferInternal a
forall a. LogBufferMap a -> LogBufferInternal a
LogBufferInternal (LogBufferMap a -> LogBufferInternal a)
-> LogBufferMap a -> LogBufferInternal a
forall a b. (a -> b) -> a -> b
$ LoggerName -> LogObject a -> LogBufferMap a -> LogBufferMap a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (LoggerName
"#buffered." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
loname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
lvname) LogObject a
lo (LogBufferMap a -> LogBufferMap a)
-> LogBufferMap a -> LogBufferMap a
forall a b. (a -> b) -> a -> b
$ LogBufferInternal a -> LogBufferMap a
forall a. LogBufferInternal a -> LogBufferMap a
logBuffer LogBufferInternal a
currentBuffer
    effectuate LogBuffer a
buffer lo :: LogObject a
lo@(LogObject LoggerName
loname LOMeta
_lometa LOContent a
_logitem) =
        MVar (LogBufferInternal a)
-> (LogBufferInternal a -> IO (LogBufferInternal a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (LogBuffer a -> MVar (LogBufferInternal a)
forall a. LogBuffer a -> LogBufferMVar a
getLogBuf LogBuffer a
buffer) ((LogBufferInternal a -> IO (LogBufferInternal a)) -> IO ())
-> (LogBufferInternal a -> IO (LogBufferInternal a)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LogBufferInternal a
currentBuffer ->
            LogBufferInternal a -> IO (LogBufferInternal a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LogBufferInternal a -> IO (LogBufferInternal a))
-> LogBufferInternal a -> IO (LogBufferInternal a)
forall a b. (a -> b) -> a -> b
$! LogBufferMap a -> LogBufferInternal a
forall a. LogBufferMap a -> LogBufferInternal a
LogBufferInternal (LogBufferMap a -> LogBufferInternal a)
-> LogBufferMap a -> LogBufferInternal a
forall a b. (a -> b) -> a -> b
$ LoggerName -> LogObject a -> LogBufferMap a -> LogBufferMap a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (LoggerName
"#buffered." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
loname) LogObject a
lo (LogBufferMap a -> LogBufferMap a)
-> LogBufferMap a -> LogBufferMap a
forall a b. (a -> b) -> a -> b
$ LogBufferInternal a -> LogBufferMap a
forall a. LogBufferInternal a -> LogBufferMap a
logBuffer LogBufferInternal a
currentBuffer

    handleOverflow :: LogBuffer a -> IO ()
handleOverflow LogBuffer a
_ = Handle -> LoggerName -> IO ()
TIO.hPutStrLn Handle
stderr LoggerName
"Notice: overflow in LogBuffer, dropping log items!"

\end{code}

\subsubsection{|LogBuffer| implements |Backend| functions}\index{LogBuffer!instance of IsBackend}

|LogBuffer| is an |IsBackend|
\begin{code}
instance FromJSON a => IsBackend LogBuffer a where
    bekind :: LogBuffer a -> BackendKind
bekind LogBuffer a
_ = BackendKind
LogBufferBK

    realize :: Configuration -> IO (LogBuffer a)
realize Configuration
_ =
        let emptyBuffer :: LogBufferInternal a
emptyBuffer = LogBufferMap a -> LogBufferInternal a
forall a. LogBufferMap a -> LogBufferInternal a
LogBufferInternal LogBufferMap a
forall k v. HashMap k v
HM.empty
        in
        LogBufferMVar a -> LogBuffer a
forall a. LogBufferMVar a -> LogBuffer a
LogBuffer (LogBufferMVar a -> LogBuffer a)
-> IO (LogBufferMVar a) -> IO (LogBuffer a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogBufferInternal a -> IO (LogBufferMVar a)
forall a. a -> IO (MVar a)
newMVar LogBufferInternal a
forall a. LogBufferInternal a
emptyBuffer

    unrealize :: LogBuffer a -> IO ()
unrealize LogBuffer a
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

\end{code}