\subsection{Cardano.BM.Internal.ElidingTracer}
\label{code:Cardano.BM.Internal.ElidingTracer}

This module is marked \emph{internal} as its use is risky and should only be included
if one has tested the implemented instances thoroughly.

Disclaimer: Use at your own risk. Eliding of messages can result in the irrevocable removal
of traced values.

%if style == newcode
\begin{code}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}

module Cardano.BM.Internal.ElidingTracer
    (
      ElidingTracer (..)
    , defaultelidedreporting
    ) where

import           Control.Concurrent.MVar (MVar, newMVar, modifyMVar_)
import           Control.Monad (when)

import           Cardano.BM.Data.LogItem
import           Cardano.BM.Data.Aggregated (Measurable(PureI))
import           Cardano.BM.Data.Trace
import           Cardano.BM.Data.Tracer
import           Cardano.BM.Trace (traceNamedObject)

\end{code}
%endif

\subsubsection{Tracer transformer for eliding messages}
\label{code:ElidingTracer}\index{ElidingTracer}

The eliding tracer transformer depends on two predicates to decide on which
observable type eliding messages is active (\ref{doelide}), and whether two messages can be
considered equivalent and thus be elided (\ref{isEquivalent}).
\begin{code}

class ElidingTracer a where
\end{code}

This predicate is |True| for message types for which eliding is enabled. Needs to be
overwritten in instances of |ElidingTracer|.
\label{code:doelide}\index{ElidingTracer!doelide}
\begin{code}
  doelide :: a -> Bool
\end{code}

The predicate to determine if two messages are |equivalent|. This needs to be
overwritten in instances of |ElidingTracer|.
\label{code:isEquivalent}\index{ElidingTracer!isEquivalent}
\begin{code}
  isEquivalent :: a -> a -> Bool
\end{code}

Create a new state |MVar|.
\label{code:newstate}\index{ElidingTracer!newstate}
\begin{code}
  newstate :: IO (MVar (Maybe a, Integer))
  default newstate :: IO (MVar (Maybe a, Integer))
  newstate = (Maybe a, Integer) -> IO (MVar (Maybe a, Integer))
forall a. a -> IO (MVar a)
newMVar (Maybe a
forall a. Maybe a
Nothing, Integer
0)
\end{code}

Internal state transitions.
\label{code:starteliding}\index{ElidingTracer!starteliding}
\label{code:conteliding}\index{ElidingTracer!conteliding}
\label{code:stopeliding}\index{ElidingTracer!stopeliding}
\label{code:reportelided}\index{ElidingTracer!reportelided}
\begin{code}
  starteliding :: (ToObject t, Transformable t IO a)
               => TracingVerbosity -> Trace IO t
               -> a -> IO (Maybe a, Integer)
  default starteliding :: (ToObject t, Transformable t IO a)
                       => TracingVerbosity -> Trace IO t
                       -> a -> IO (Maybe a, Integer)
  starteliding TracingVerbosity
tverb Trace IO t
tr a
ev = do
    Tracer IO a -> a -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity -> Trace IO t -> Tracer IO a
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO t
tr) a
ev
    (Maybe a, Integer) -> IO (Maybe a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
ev, Integer
0)

  conteliding :: (ToObject t, Transformable t IO a)
              => TracingVerbosity -> Trace IO t
              -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
  default conteliding :: Transformable t IO a
                      => TracingVerbosity -> Trace IO t
                      -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
  conteliding TracingVerbosity
_tverb Trace IO t
_tr a
_ (Maybe a
Nothing, Integer
_count) = (Maybe a, Integer) -> IO (Maybe a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Integer
0)
  conteliding TracingVerbosity
_tverb Trace IO t
_tr a
ev (Maybe a
_old, Integer
count) = (Maybe a, Integer) -> IO (Maybe a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
ev, Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)

  stopeliding :: (ToObject t, Transformable t IO a)
              => TracingVerbosity -> Trace IO t
              -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
  default stopeliding :: (ToObject t, Transformable t IO a)
                      => TracingVerbosity -> Trace IO t
                      -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
  stopeliding TracingVerbosity
tverb Trace IO t
tr a
ev (Maybe a
Nothing, Integer
_count) = do
    Tracer IO a -> a -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity -> Trace IO t -> Tracer IO a
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO t
tr) a
ev
    (Maybe a, Integer) -> IO (Maybe a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Integer
0)
  stopeliding TracingVerbosity
tverb Trace IO t
tr a
ev (Just a
ev0, Integer
count) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
count Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$  -- report the number of elided messages
      TracingVerbosity -> Trace IO t -> a -> Integer -> IO ()
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity -> Trace IO t -> a -> Integer -> IO ()
reportelided TracingVerbosity
tverb Trace IO t
tr a
ev0 Integer
count
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
count Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$  -- output last elided message
      Tracer IO a -> a -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity -> Trace IO t -> Tracer IO a
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO t
tr) a
ev0
    Tracer IO a -> a -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity -> Trace IO t -> Tracer IO a
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO t
tr) a
ev
    (Maybe a, Integer) -> IO (Maybe a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Integer
0)

  reportelided :: (ToObject t, Transformable t IO a)
               => TracingVerbosity -> Trace IO t
               -> a -> Integer -> IO ()
  default reportelided :: (ToObject t, Transformable t IO a)
                       => TracingVerbosity -> Trace IO t
                       -> a -> Integer -> IO ()
  reportelided = TracingVerbosity -> Trace IO t -> a -> Integer -> IO ()
forall t a.
(ToObject t, Transformable t IO a) =>
TracingVerbosity -> Trace IO t -> a -> Integer -> IO ()
defaultelidedreporting

\end{code}

The transformer from a Tracer IO emph{a} to |Trace IO t| contains
the main logic of eliding messages.
\label{code:elideToLogObject}\index{ElidingTracer!elideToLogObject}
\begin{code}
  elideToLogObject
      :: (ToObject t, Transformable t IO a)
      => TracingVerbosity -> MVar (Maybe a, Integer)
      -> Trace IO t -> Tracer IO a
  default elideToLogObject
      :: (ToObject t, Transformable t IO a)
      => TracingVerbosity -> MVar (Maybe a, Integer)
      -> Trace IO t -> Tracer IO a
  elideToLogObject TracingVerbosity
tverb MVar (Maybe a, Integer)
mvar Trace IO t
tr = (a -> IO ()) -> Tracer IO a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((a -> IO ()) -> Tracer IO a) -> (a -> IO ()) -> Tracer IO a
forall a b. (a -> b) -> a -> b
$ \a
ev ->
    MVar (Maybe a, Integer)
-> ((Maybe a, Integer) -> IO (Maybe a, Integer)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe a, Integer)
mvar (((Maybe a, Integer) -> IO (Maybe a, Integer)) -> IO ())
-> ((Maybe a, Integer) -> IO (Maybe a, Integer)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: (Maybe a, Integer)
s@(Maybe a
old, Integer
_count) ->
    if a -> Bool
forall a. ElidingTracer a => a -> Bool
doelide a
ev
      then
        case Maybe a
old of
          Maybe a
Nothing -> TracingVerbosity -> Trace IO t -> a -> IO (Maybe a, Integer)
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity -> Trace IO t -> a -> IO (Maybe a, Integer)
starteliding TracingVerbosity
tverb Trace IO t
tr a
ev
          Just a
ev0 ->
            if a
ev a -> a -> Bool
forall a. ElidingTracer a => a -> a -> Bool
`isEquivalent` a
ev0
              then
                TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
conteliding TracingVerbosity
tverb Trace IO t
tr a
ev (Maybe a, Integer)
s IO (Maybe a, Integer)
-> ((Maybe a, Integer) -> IO (Maybe a, Integer))
-> IO (Maybe a, Integer)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  (Maybe a
Nothing, Integer
_) -> TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
stopeliding TracingVerbosity
tverb Trace IO t
tr a
ev (Maybe a, Integer)
s
                  (Maybe a, Integer)
newpair -> (Maybe a, Integer) -> IO (Maybe a, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a, Integer)
newpair
              else
                TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
stopeliding TracingVerbosity
tverb Trace IO t
tr a
ev (Maybe a, Integer)
s
      else
        TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity
-> Trace IO t -> a -> (Maybe a, Integer) -> IO (Maybe a, Integer)
stopeliding TracingVerbosity
tverb Trace IO t
tr a
ev (Maybe a, Integer)
s

\end{code}

\subsubsection{Tracing a summary messages after eliding}
\label{code:defaultelidedreporting}\index{defaultelidedreporting}

This is the default implementation of tracing a summary message after eliding stopped.
It simply outputs the internal counter.
In cases where this state is used for other purposes than counting messages, the
\ref{reportelided} function should be implemented in the \ref{ElidingTracer} instance.

\begin{code}
defaultelidedreporting :: (ToObject t, Transformable t IO a)
                       => TracingVerbosity -> Trace IO t
                       -> a -> Integer -> IO ()
defaultelidedreporting :: TracingVerbosity -> Trace IO t -> a -> Integer -> IO ()
defaultelidedreporting TracingVerbosity
_tverb Trace IO t
tr a
ev0 Integer
count = do
    LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (a -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation a
ev0) (a -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation a
ev0)
    Trace IO t -> (LOMeta, LOContent t) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO t
tr (LOMeta
meta, Text -> Measurable -> LOContent t
forall a. Text -> Measurable -> LOContent a
LogValue Text
"before next, messages elided" (Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)))

\end{code}