\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
$
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
$
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}