\subsection{Cardano.BM.Data.Tracer}
\label{code:Cardano.BM.Data.Tracer}

%if style == newcode
\begin{code}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module Cardano.BM.Data.Tracer
    ( Tracer (..)
    , TracingVerbosity (..)
    , Transformable (..)
    , ToLogObject (..)
    , ToObject (..)
    , HasTextFormatter (..)
    , HasSeverityAnnotation (..)
    , HasPrivacyAnnotation (..)
    , WithSeverity (..)
    , WithPrivacyAnnotation (..)
    , contramap
    , mkObject, emptyObject
    , traceWith
    -- * tracer transformers
    , natTracer
    , nullTracer
    , stdoutTracer
    , debugTracer
    , showTracing
    , trStructured
    , trStructuredText
    -- * conditional tracing
    , condTracing
    , condTracingM
    -- * severity transformers
    , annotateSeverity
    , filterSeverity
    , setSeverity
    , severityDebug
    , severityInfo
    , severityNotice
    , severityWarning
    , severityError
    , severityCritical
    , severityAlert
    , severityEmergency
    -- * privacy annotation transformers
    , annotateConfidential
    , annotatePublic
    , annotatePrivacyAnnotation
    , filterPrivacyAnnotation
    ) where


import           Control.Monad (when)
import           Control.Monad.IO.Class (MonadIO (..))

import           Data.Aeson (Object, ToJSON (..), Value (..))
import           Data.Aeson.Text (encodeToLazyText)
import qualified Data.HashMap.Strict as HM
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import           Data.Word (Word64)

import           Cardano.BM.Data.Aggregated
import           Cardano.BM.Data.LogItem (LoggerName,
                     LogObject (..), LOContent (..), LOMeta (..),
                     PrivacyAnnotation (..), mkLOMeta)
import           Cardano.BM.Data.Severity (Severity (..))
import           Cardano.BM.Data.Trace
import           Control.Tracer

\end{code}
%endif

This module extends the basic |Tracer| with one that keeps a list of context names to
create the basis for |Trace| which accepts messages from a Tracer and ends in the |Switchboard|
for further processing of the messages.

\begin{scriptsize}
\begin{verbatim}
   +-----------------------+
   |                       |
   |    external code      |
   |                       |
   +----------+------------+
              |
              |
        +-----v-----+
        |           |
        |  Tracer   |
        |           |
        +-----+-----+
              |
              |
  +-----------v------------+
  |                        |
  |        Trace           |
  |                        |
  +-----------+------------+
              |
  +-----------v------------+
  |      Switchboard       |
  +------------------------+

  +----------+ +-----------+
  |Monitoring| |Aggregation|
  +----------+ +-----------+

          +-------+
          |Logging|
          +-------+

+-------------+ +------------+
|Visualisation| |Benchmarking|
+-------------+ +------------+

\end{verbatim}
\end{scriptsize}

\subsubsection{ToLogObject - transforms a logged item to LogObject}
\label{code:ToLogObject}\index{ToLogObject}
\label{code:toLogObject}\index{ToLogObject!toLogObject}
\label{code:toLogObject'}\index{ToLogObject!toLogObject'}
\label{code:toLogObjectVerbose}\index{ToLogObject!toLogObjectVerbose}
\label{code:toLogObjectMinimal}\index{ToLogObject!toLogObjectMinimal}

The transformer |toLogObject| accepts any type for which a |ToObject| instance
is available and returns a |LogObject| which can be forwarded into the
|Switchboard|. It adds a verbosity hint of |NormalVerbosity|.
\\
A verbosity level |TracingVerbosity| can be passed
to the transformer |toLogObject'|.


\begin{code}
class Monad m => ToLogObject m where
    toLogObject :: (ToObject a, Transformable a m b)
                => Trace m a -> Tracer m b
    toLogObject' :: (ToObject a, Transformable a m b)
                 => TracingVerbosity -> Trace m a -> Tracer m b
    toLogObjectVerbose :: (ToObject a, Transformable a m b)
                       => Trace m a -> Tracer m b
    default toLogObjectVerbose :: (ToObject a, Transformable a m b)
                       => Trace m a -> Tracer m b
    toLogObjectVerbose = TracingVerbosity -> Trace m a -> Tracer m b
forall a (m :: * -> *) b.
Transformable a m b =>
TracingVerbosity -> Trace m a -> Tracer m b
trTransformer TracingVerbosity
MaximalVerbosity
    toLogObjectMinimal :: (ToObject a, Transformable a m b)
                       => Trace m a -> Tracer m b
    default toLogObjectMinimal :: (ToObject a, Transformable a m b)
                       => Trace m a -> Tracer m b
    toLogObjectMinimal = TracingVerbosity -> Trace m a -> Tracer m b
forall a (m :: * -> *) b.
Transformable a m b =>
TracingVerbosity -> Trace m a -> Tracer m b
trTransformer TracingVerbosity
MinimalVerbosity

instance ToLogObject IO where
    toLogObject :: (MonadIO m, ToObject a, Transformable a m b)
                => Trace m a -> Tracer m b
    toLogObject :: Trace m a -> Tracer m b
toLogObject = TracingVerbosity -> Trace m a -> Tracer m b
forall a (m :: * -> *) b.
Transformable a m b =>
TracingVerbosity -> Trace m a -> Tracer m b
trTransformer TracingVerbosity
NormalVerbosity
    toLogObject' :: (MonadIO m, ToObject a, Transformable a m b)
                 => TracingVerbosity -> Trace m a -> Tracer m b
    toLogObject' :: TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' = TracingVerbosity -> Trace m a -> Tracer m b
forall a (m :: * -> *) b.
Transformable a m b =>
TracingVerbosity -> Trace m a -> Tracer m b
trTransformer

\end{code}

\begin{spec}
To be placed in ouroboros-network.

instance (MonadFork m, MonadTimer m) => ToLogObject m where
    toLogObject tr = Tracer $ \a -> do
        lo <- LogObject <$> pure ""
                        <*> (LOMeta <$> getMonotonicTime  -- must be evaluated at the calling site
                                    <*> (pack . show <$> myThreadId)
                                    <*> pure Debug
                                    <*> pure Public)
                        <*> pure (LogMessage a)
        traceWith tr lo

\end{spec}

\subsubsection{Verbosity levels}
\label{code:TracingVerbosity}\index{TracingVerbosity}
\label{code:MinimalVerbosity}\index{TracingVerbosity!MinimalVerbosity}
\label{code:NormalVerbosity}\index{TracingVerbosity!NormalVerbosity}
\label{code:MaximalVerbosity}\index{TracingVerbosity!MaximalVerbosity}
The tracing verbosity will be passed to instances of |ToObject| for rendering
the traced item accordingly.
\begin{code}
data TracingVerbosity = MinimalVerbosity | NormalVerbosity | MaximalVerbosity
                        deriving (TracingVerbosity -> TracingVerbosity -> Bool
(TracingVerbosity -> TracingVerbosity -> Bool)
-> (TracingVerbosity -> TracingVerbosity -> Bool)
-> Eq TracingVerbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracingVerbosity -> TracingVerbosity -> Bool
$c/= :: TracingVerbosity -> TracingVerbosity -> Bool
== :: TracingVerbosity -> TracingVerbosity -> Bool
$c== :: TracingVerbosity -> TracingVerbosity -> Bool
Eq, ReadPrec [TracingVerbosity]
ReadPrec TracingVerbosity
Int -> ReadS TracingVerbosity
ReadS [TracingVerbosity]
(Int -> ReadS TracingVerbosity)
-> ReadS [TracingVerbosity]
-> ReadPrec TracingVerbosity
-> ReadPrec [TracingVerbosity]
-> Read TracingVerbosity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TracingVerbosity]
$creadListPrec :: ReadPrec [TracingVerbosity]
readPrec :: ReadPrec TracingVerbosity
$creadPrec :: ReadPrec TracingVerbosity
readList :: ReadS [TracingVerbosity]
$creadList :: ReadS [TracingVerbosity]
readsPrec :: Int -> ReadS TracingVerbosity
$creadsPrec :: Int -> ReadS TracingVerbosity
Read, Eq TracingVerbosity
Eq TracingVerbosity
-> (TracingVerbosity -> TracingVerbosity -> Ordering)
-> (TracingVerbosity -> TracingVerbosity -> Bool)
-> (TracingVerbosity -> TracingVerbosity -> Bool)
-> (TracingVerbosity -> TracingVerbosity -> Bool)
-> (TracingVerbosity -> TracingVerbosity -> Bool)
-> (TracingVerbosity -> TracingVerbosity -> TracingVerbosity)
-> (TracingVerbosity -> TracingVerbosity -> TracingVerbosity)
-> Ord TracingVerbosity
TracingVerbosity -> TracingVerbosity -> Bool
TracingVerbosity -> TracingVerbosity -> Ordering
TracingVerbosity -> TracingVerbosity -> TracingVerbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TracingVerbosity -> TracingVerbosity -> TracingVerbosity
$cmin :: TracingVerbosity -> TracingVerbosity -> TracingVerbosity
max :: TracingVerbosity -> TracingVerbosity -> TracingVerbosity
$cmax :: TracingVerbosity -> TracingVerbosity -> TracingVerbosity
>= :: TracingVerbosity -> TracingVerbosity -> Bool
$c>= :: TracingVerbosity -> TracingVerbosity -> Bool
> :: TracingVerbosity -> TracingVerbosity -> Bool
$c> :: TracingVerbosity -> TracingVerbosity -> Bool
<= :: TracingVerbosity -> TracingVerbosity -> Bool
$c<= :: TracingVerbosity -> TracingVerbosity -> Bool
< :: TracingVerbosity -> TracingVerbosity -> Bool
$c< :: TracingVerbosity -> TracingVerbosity -> Bool
compare :: TracingVerbosity -> TracingVerbosity -> Ordering
$ccompare :: TracingVerbosity -> TracingVerbosity -> Ordering
$cp1Ord :: Eq TracingVerbosity
Ord)

\end{code}

\subsubsection{ToObject - transforms a logged item to a JSON Object}
\label{code:ToObject}\index{ToObject}
\label{code:toObject}\index{ToObject!toObject}
Katip requires JSON objects to be logged as context. This
typeclass provides a default instance which uses |ToJSON| and
produces an empty object if 'toJSON' results in any type other than
|Object|. If you have a type you want to log that produces an Array
or Number for example, you'll want to write an explicit instance of
|ToObject|. You can trivially add a |ToObject| instance for something with
a |ToJSON| instance like:
\begin{spec}
instance ToObject Foo
\end{spec}
\\
The |toObject| function accepts a |TracingVerbosity| level as argument
and can render the traced item differently depending on the verbosity level.

\begin{code}
class ToObject a where
    toObject :: TracingVerbosity -> a -> Object
    default toObject :: ToJSON a => TracingVerbosity -> a -> Object
    toObject TracingVerbosity
_ a
v = case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v of
        Object Object
o     -> Object
o
        s :: Value
s@(String Text
_) -> Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
"string" Value
s
        Value
_            -> Object
forall a. Monoid a => a
mempty
    textTransformer :: a -> Object -> Text
    default textTransformer :: a -> Object -> Text
    textTransformer a
_ Object
o = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Object -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText Object
o

\end{code}

A helper function for creating an |Object| given a list of pairs, named items,
or the empty |Object|.
\label{code:mkObject}\index{mkObject}
\label{code:emptyObject}\index{emptyObject}
\begin{code}
mkObject :: ToObject a => [(Text, a)] -> HM.HashMap Text a
mkObject :: [(Text, a)] -> HashMap Text a
mkObject = [(Text, a)] -> HashMap Text a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList

emptyObject :: ToObject a => HM.HashMap Text a
emptyObject :: HashMap Text a
emptyObject = HashMap Text a
forall k v. HashMap k v
HM.empty

\end{code}

default instances:
\begin{code}
instance ToObject () where
    toObject :: TracingVerbosity -> () -> Object
toObject TracingVerbosity
_ ()
_ = Object
forall a. Monoid a => a
mempty

instance ToObject String
instance ToObject Text
instance ToObject Value
instance ToJSON a => ToObject (LogObject a)
instance ToJSON a => ToObject (LOContent a)

\end{code}

\subsubsection{A transformable Tracer}
\label{code:Transformable}\index{Transformable}
\label{code:trTransformer}\index{Transformable!trTransformer}
Parameterised over the source |Tracer| (\emph{b}) and
the target |Tracer| (\emph{a}).\\
The default definition of |trTransformer| is the |nullTracer|. This blocks output
of all items which lack a corresponding instance of |Transformable|.\\
Depending on the input type it can create objects of |LogValue| for numerical values,
|LogMessage| for textual messages, and for all others a |LogStructured| of their
|ToObject| representation.

\begin{code}
class (Monad m, HasPrivacyAnnotation b, HasSeverityAnnotation b)  => Transformable a m b where
    trTransformer :: TracingVerbosity -> Trace m a -> Tracer m b
    default trTransformer :: TracingVerbosity -> Trace m a -> Tracer m b
    trTransformer TracingVerbosity
_ Trace m a
_ = Tracer m b
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer

trFromIntegral :: (Integral b, MonadIO m, HasPrivacyAnnotation b, HasSeverityAnnotation b)
               => LoggerName -> Trace m a -> Tracer m b
trFromIntegral :: Text -> Trace m a -> Tracer m b
trFromIntegral Text
name Trace m a
tr = (b -> m ()) -> Tracer m b
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((b -> m ()) -> Tracer m b) -> (b -> m ()) -> Tracer m b
forall a b. (a -> b) -> a -> b
$ \b
arg ->
        Trace m a -> (Text, LogObject a) -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace m a
tr ((Text, LogObject a) -> m ()) -> m (Text, LogObject a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
            LOMeta
meta <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (b -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation b
arg) (b -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation b
arg)
            (Text, LogObject a) -> m (Text, LogObject a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                   , Text -> LOMeta -> LOContent a -> LogObject a
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
name (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
arg)
                   )

trFromReal :: (Real b, MonadIO m, HasPrivacyAnnotation b, HasSeverityAnnotation b)
           => LoggerName -> Trace m a -> Tracer m b
trFromReal :: Text -> Trace m a -> Tracer m b
trFromReal Text
name Trace m a
tr = (b -> m ()) -> Tracer m b
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((b -> m ()) -> Tracer m b) -> (b -> m ()) -> Tracer m b
forall a b. (a -> b) -> a -> b
$ \b
arg ->
        Trace m a -> (Text, LogObject a) -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace m a
tr ((Text, LogObject a) -> m ()) -> m (Text, LogObject a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
            LOMeta
meta <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (b -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation b
arg) (b -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation b
arg)
            (Text, LogObject a) -> m (Text, LogObject a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                   , Text -> LOMeta -> LOContent a -> LogObject a
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
name (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Double -> Measurable
PureD (Double -> Measurable) -> Double -> Measurable
forall a b. (a -> b) -> a -> b
$ b -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac b
arg)
                   )

instance Transformable a IO Int where
    trTransformer :: TracingVerbosity -> Trace IO a -> Tracer IO Int
trTransformer TracingVerbosity
MinimalVerbosity = Text -> Trace IO a -> Tracer IO Int
forall b (m :: * -> *) a.
(Integral b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromIntegral Text
""
    trTransformer TracingVerbosity
_ = Text -> Trace IO a -> Tracer IO Int
forall b (m :: * -> *) a.
(Integral b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromIntegral Text
"int"
instance Transformable a IO Integer where
    trTransformer :: TracingVerbosity -> Trace IO a -> Tracer IO Integer
trTransformer TracingVerbosity
MinimalVerbosity = Text -> Trace IO a -> Tracer IO Integer
forall b (m :: * -> *) a.
(Integral b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromIntegral Text
""
    trTransformer TracingVerbosity
_ = Text -> Trace IO a -> Tracer IO Integer
forall b (m :: * -> *) a.
(Integral b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromIntegral Text
"integer"
instance Transformable a IO Word64 where
    trTransformer :: TracingVerbosity -> Trace IO a -> Tracer IO Word64
trTransformer TracingVerbosity
MinimalVerbosity = Text -> Trace IO a -> Tracer IO Word64
forall b (m :: * -> *) a.
(Integral b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromIntegral Text
""
    trTransformer TracingVerbosity
_ = Text -> Trace IO a -> Tracer IO Word64
forall b (m :: * -> *) a.
(Integral b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromIntegral Text
"word64"
instance Transformable a IO Double where
    trTransformer :: TracingVerbosity -> Trace IO a -> Tracer IO Double
trTransformer TracingVerbosity
MinimalVerbosity = Text -> Trace IO a -> Tracer IO Double
forall b (m :: * -> *) a.
(Real b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromReal Text
""
    trTransformer TracingVerbosity
_ = Text -> Trace IO a -> Tracer IO Double
forall b (m :: * -> *) a.
(Real b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromReal Text
"double"
instance Transformable a IO Float where
    trTransformer :: TracingVerbosity -> Trace IO a -> Tracer IO Float
trTransformer TracingVerbosity
MinimalVerbosity = Text -> Trace IO a -> Tracer IO Float
forall b (m :: * -> *) a.
(Real b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromReal Text
""
    trTransformer TracingVerbosity
_ = Text -> Trace IO a -> Tracer IO Float
forall b (m :: * -> *) a.
(Real b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
Text -> Trace m a -> Tracer m b
trFromReal Text
"float"
instance Transformable Text IO Text where
    trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO Text
trTransformer TracingVerbosity
_ Trace IO Text
tr = (Text -> IO ()) -> Tracer IO Text
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((Text -> IO ()) -> Tracer IO Text)
-> (Text -> IO ()) -> Tracer IO Text
forall a b. (a -> b) -> a -> b
$ \Text
arg ->
        Trace IO Text -> (Text, LogObject Text) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO Text
tr ((Text, LogObject Text) -> IO ())
-> IO (Text, LogObject Text) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
            LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (Text -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation Text
arg) (Text -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation Text
arg)
            (Text, LogObject Text) -> IO (Text, LogObject Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                   , Text -> LOMeta -> LOContent Text -> LogObject Text
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (Text -> LOContent Text
forall a. a -> LOContent a
LogMessage Text
arg)
                   )
instance Transformable String IO String where
    trTransformer :: TracingVerbosity -> Trace IO String -> Tracer IO String
trTransformer TracingVerbosity
_ Trace IO String
tr = (String -> IO ()) -> Tracer IO String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((String -> IO ()) -> Tracer IO String)
-> (String -> IO ()) -> Tracer IO String
forall a b. (a -> b) -> a -> b
$ \String
arg ->
        Trace IO String -> (Text, LogObject String) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO String
tr ((Text, LogObject String) -> IO ())
-> IO (Text, LogObject String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
            LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (String -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation String
arg) (String -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation String
arg)
            (Text, LogObject String) -> IO (Text, LogObject String)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                   , Text -> LOMeta -> LOContent String -> LogObject String
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (String -> LOContent String
forall a. a -> LOContent a
LogMessage String
arg)
                   )
instance Transformable Text IO String where
    trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO String
trTransformer TracingVerbosity
_ Trace IO Text
tr = (String -> IO ()) -> Tracer IO String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((String -> IO ()) -> Tracer IO String)
-> (String -> IO ()) -> Tracer IO String
forall a b. (a -> b) -> a -> b
$ \String
arg ->
        Trace IO Text -> (Text, LogObject Text) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO Text
tr ((Text, LogObject Text) -> IO ())
-> IO (Text, LogObject Text) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
            LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (String -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation String
arg) (String -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation String
arg)
            (Text, LogObject Text) -> IO (Text, LogObject Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                   , Text -> LOMeta -> LOContent Text -> LogObject Text
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (Text -> LOContent Text
forall a. a -> LOContent a
LogMessage (Text -> LOContent Text) -> Text -> LOContent Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
arg)
                   )
instance Transformable String IO Text where
    trTransformer :: TracingVerbosity -> Trace IO String -> Tracer IO Text
trTransformer TracingVerbosity
_ Trace IO String
tr = (Text -> IO ()) -> Tracer IO Text
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((Text -> IO ()) -> Tracer IO Text)
-> (Text -> IO ()) -> Tracer IO Text
forall a b. (a -> b) -> a -> b
$ \Text
arg ->
        Trace IO String -> (Text, LogObject String) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO String
tr ((Text, LogObject String) -> IO ())
-> IO (Text, LogObject String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
            LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (Text -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation Text
arg) (Text -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation Text
arg)
            (Text, LogObject String) -> IO (Text, LogObject String)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                   , Text -> LOMeta -> LOContent String -> LogObject String
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (String -> LOContent String
forall a. a -> LOContent a
LogMessage (String -> LOContent String) -> String -> LOContent String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
arg)
                   )

\end{code}

The function |trStructured| is a tracer transformer which transforms traced items
to their |ToObject| representation and further traces them as a |LogObject| of type
|LogStructured|. If the |ToObject| representation is empty, then no tracing happens.
\label{code:trStructured}\index{trStructured}
\begin{code}
trStructured :: (ToObject b, MonadIO m, HasPrivacyAnnotation b, HasSeverityAnnotation b)
             => TracingVerbosity -> Trace m a -> Tracer m b
trStructured :: TracingVerbosity -> Trace m a -> Tracer m b
trStructured TracingVerbosity
verb Trace m a
tr = (b -> m ()) -> Tracer m b
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((b -> m ()) -> Tracer m b) -> (b -> m ()) -> Tracer m b
forall a b. (a -> b) -> a -> b
$ \b
arg ->
 let
   obj :: Object
obj = TracingVerbosity -> b -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb b
arg
 in Trace m a -> (Text, LogObject a) -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace m a
tr ((Text, LogObject a) -> m ()) -> m (Text, LogObject a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
          LOMeta
meta <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (b -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation b
arg) (b -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation b
arg)
          (Text, LogObject a) -> m (Text, LogObject a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                 , Text -> LOMeta -> LOContent a -> LogObject a
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (Object -> Text -> LOContent a
forall a. Object -> Text -> LOContent a
LogStructuredText Object
obj (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Object -> String
forall a. Show a => a -> String
show (Object -> String) -> Object -> String
forall a b. (a -> b) -> a -> b
$ Object
obj))
                 )

\end{code}


\label{code:trStructuredText}\index{trStructuredText}
\label{code:HasTextFormatter}\index{HasTextFormatter}
\begin{code}
class HasTextFormatter a where
    formatText :: a -> Object -> Text
    default formatText :: a -> Object -> Text
    formatText a
_a = String -> Text
T.pack (String -> Text) -> (Object -> String) -> Object -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> String
forall a. Show a => a -> String
show

trStructuredText :: ( ToObject b, MonadIO m, HasTextFormatter b
                    , HasPrivacyAnnotation b, HasSeverityAnnotation b )
                 => TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText :: TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText TracingVerbosity
verb Trace m a
tr = (b -> m ()) -> Tracer m b
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((b -> m ()) -> Tracer m b) -> (b -> m ()) -> Tracer m b
forall a b. (a -> b) -> a -> b
$ \b
arg ->
 let
   obj :: Object
obj = TracingVerbosity -> b -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb b
arg
 in Trace m a -> (Text, LogObject a) -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace m a
tr ((Text, LogObject a) -> m ()) -> m (Text, LogObject a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
          LOMeta
meta <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta (b -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation b
arg) (b -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation b
arg)
          (Text, LogObject a) -> m (Text, LogObject a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
forall a. Monoid a => a
mempty
                 , Text -> LOMeta -> LOContent a -> LogObject a
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject Text
forall a. Monoid a => a
mempty LOMeta
meta (Object -> Text -> LOContent a
forall a. Object -> Text -> LOContent a
LogStructuredText Object
obj (b -> Object -> Text
forall a. HasTextFormatter a => a -> Object -> Text
formatText b
arg Object
obj))
                 )

\end{code}

\subsubsection{Transformers for setting severity level}
\label{code:setSeverity}
\label{code:severityDebug}
\label{code:severityInfo}
\label{code:severityNotice}
\label{code:severityWarning}
\label{code:severityError}
\label{code:severityCritical}
\label{code:severityAlert}
\label{code:severityEmergency}
\index{setSeverity}\index{severityDebug}\index{severityInfo}
\index{severityNotice}\index{severityWarning}\index{severityError}
\index{severityCritical}\index{severityAlert}\index{severityEmergency}
The log |Severity| level of a |LogObject| can be altered.
\begin{code}
setSeverity :: Severity -> Trace m a -> Trace m a
setSeverity :: Severity -> Trace m a -> Trace m a
setSeverity Severity
sev Trace m a
tr = ((Text, LogObject a) -> m ()) -> Trace m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (((Text, LogObject a) -> m ()) -> Trace m a)
-> ((Text, LogObject a) -> m ()) -> Trace m a
forall a b. (a -> b) -> a -> b
$ \(Text
ctx,lo :: LogObject a
lo@(LogObject Text
_nm meta :: LOMeta
meta@(LOMeta UTCTime
_ts Text
_tid Text
_hn Severity
_sev PrivacyAnnotation
_pr) LOContent a
_lc)) ->
                                Trace m a -> (Text, LogObject a) -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace m a
tr ((Text, LogObject a) -> m ()) -> (Text, LogObject a) -> m ()
forall a b. (a -> b) -> a -> b
$ (Text
ctx, LogObject a
lo { loMeta :: LOMeta
loMeta = LOMeta
meta { severity :: Severity
severity = Severity
sev } })

severityDebug, severityInfo, severityNotice,
  severityWarning, severityError, severityCritical,
  severityAlert, severityEmergency  :: Trace m a -> Trace m a
severityDebug :: Trace m a -> Trace m a
severityDebug     = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Debug
severityInfo :: Trace m a -> Trace m a
severityInfo      = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Info
severityNotice :: Trace m a -> Trace m a
severityNotice    = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Notice
severityWarning :: Trace m a -> Trace m a
severityWarning   = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Warning
severityError :: Trace m a -> Trace m a
severityError     = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Error
severityCritical :: Trace m a -> Trace m a
severityCritical  = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Critical
severityAlert :: Trace m a -> Trace m a
severityAlert     = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Alert
severityEmergency :: Trace m a -> Trace m a
severityEmergency = Severity -> Trace m a -> Trace m a
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
Emergency

\end{code}

\label{code:annotateSeverity}\index{annotateSeverity}
The |Severity| of any |Tracer| can be set with wrapping it in |WithSeverity|.
The traced types need to be of class |HasSeverityAnnotation|.
\begin{code}
annotateSeverity :: HasSeverityAnnotation a => Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity :: Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity Tracer m (WithSeverity a)
tr = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((a -> m ()) -> Tracer m a) -> (a -> m ()) -> Tracer m a
forall a b. (a -> b) -> a -> b
$ \a
arg ->
    Tracer m (WithSeverity a) -> WithSeverity a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (WithSeverity a)
tr (WithSeverity a -> m ()) -> WithSeverity a -> m ()
forall a b. (a -> b) -> a -> b
$ Severity -> a -> WithSeverity a
forall a. Severity -> a -> WithSeverity a
WithSeverity (a -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation a
arg) a
arg

\end{code}

\subsubsection{Transformers for setting privacy annotation}
\label{code:setPrivacy}
\label{code:annotateConfidential}
\label{code:annotatePublic}
\index{setPrivacy}\index{annotateConfidential}\index{annotatePublic}
The privacy annotation (|PrivacyAnnotation|) of the |LogObject| can
be altered with the following functions.
\begin{code}
setPrivacy :: PrivacyAnnotation -> Trace m a -> Trace m a
setPrivacy :: PrivacyAnnotation -> Trace m a -> Trace m a
setPrivacy PrivacyAnnotation
prannot Trace m a
tr = ((Text, LogObject a) -> m ()) -> Trace m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (((Text, LogObject a) -> m ()) -> Trace m a)
-> ((Text, LogObject a) -> m ()) -> Trace m a
forall a b. (a -> b) -> a -> b
$ \(Text
ctx,lo :: LogObject a
lo@(LogObject Text
_nm LOMeta
meta LOContent a
_lc)) ->
                                   Trace m a -> (Text, LogObject a) -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace m a
tr ((Text, LogObject a) -> m ()) -> (Text, LogObject a) -> m ()
forall a b. (a -> b) -> a -> b
$ (Text
ctx, LogObject a
lo { loMeta :: LOMeta
loMeta = LOMeta
meta { privacy :: PrivacyAnnotation
privacy = PrivacyAnnotation
prannot }})

annotateConfidential, annotatePublic :: Trace m a -> Trace m a
annotateConfidential :: Trace m a -> Trace m a
annotateConfidential = PrivacyAnnotation -> Trace m a -> Trace m a
forall (m :: * -> *) a. PrivacyAnnotation -> Trace m a -> Trace m a
setPrivacy PrivacyAnnotation
Confidential
annotatePublic :: Trace m a -> Trace m a
annotatePublic = PrivacyAnnotation -> Trace m a -> Trace m a
forall (m :: * -> *) a. PrivacyAnnotation -> Trace m a -> Trace m a
setPrivacy PrivacyAnnotation
Public

\end{code}

\label{code:annotatePrivacyAnnotation}\index{annotatePrivacyAnnotation}
The |PrivacyAnnotation| of any |Tracer| can be set with wrapping it in |WithPrivacyAnnotation|.
The traced types need to be of class |DefinePrivacyAnnotation|.
\begin{code}
annotatePrivacyAnnotation :: HasPrivacyAnnotation a => Tracer m (WithPrivacyAnnotation a) -> Tracer m a
annotatePrivacyAnnotation :: Tracer m (WithPrivacyAnnotation a) -> Tracer m a
annotatePrivacyAnnotation Tracer m (WithPrivacyAnnotation a)
tr = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((a -> m ()) -> Tracer m a) -> (a -> m ()) -> Tracer m a
forall a b. (a -> b) -> a -> b
$ \a
arg ->
    Tracer m (WithPrivacyAnnotation a)
-> WithPrivacyAnnotation a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (WithPrivacyAnnotation a)
tr (WithPrivacyAnnotation a -> m ())
-> WithPrivacyAnnotation a -> m ()
forall a b. (a -> b) -> a -> b
$ PrivacyAnnotation -> a -> WithPrivacyAnnotation a
forall a. PrivacyAnnotation -> a -> WithPrivacyAnnotation a
WithPrivacyAnnotation (a -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation a
arg) a
arg

\end{code}

\subsubsection{Transformer for filtering based on \emph{Severity}}
\label{code:WithSeverity}\index{WithSeverity}
This structure wraps a |Severity| around traced observables.
\begin{code}
data WithSeverity a = WithSeverity Severity a

\end{code}

\label{code:filterSeverity}\index{filterSeverity}
The traced observables with annotated severity are filtered.
\begin{code}
filterSeverity :: forall m a. (Monad m, HasSeverityAnnotation a)
               => (a -> m Severity)
               -> Tracer m a
               -> Tracer m a
filterSeverity :: (a -> m Severity) -> Tracer m a -> Tracer m a
filterSeverity a -> m Severity
msevlimit Tracer m a
tr = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((a -> m ()) -> Tracer m a) -> (a -> m ()) -> Tracer m a
forall a b. (a -> b) -> a -> b
$ \a
arg -> do
    Severity
sevlimit <- a -> m Severity
msevlimit a
arg
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation a
arg Severity -> Severity -> Bool
forall a. Ord a => a -> a -> Bool
>= Severity
sevlimit) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
tr a
arg

\end{code}

General instances of |WithSeverity| wrapped observable types.

\begin{code}
instance forall m a t. (Monad m, Transformable t m a) => Transformable t m (WithSeverity a) where
    trTransformer :: TracingVerbosity -> Trace m t -> Tracer m (WithSeverity a)
trTransformer TracingVerbosity
verb Trace m t
tr = (WithSeverity a -> m ()) -> Tracer m (WithSeverity a)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity a -> m ()) -> Tracer m (WithSeverity a))
-> (WithSeverity a -> m ()) -> Tracer m (WithSeverity a)
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Severity
sev a
arg) ->
        let transformer :: Tracer m a
            transformer :: Tracer m a
transformer = TracingVerbosity -> Trace m t -> Tracer m a
forall a (m :: * -> *) b.
Transformable a m b =>
TracingVerbosity -> Trace m a -> Tracer m b
trTransformer TracingVerbosity
verb (Trace m t -> Tracer m a) -> Trace m t -> Tracer m a
forall a b. (a -> b) -> a -> b
$ Severity -> Trace m t -> Trace m t
forall (m :: * -> *) a. Severity -> Trace m a -> Trace m a
setSeverity Severity
sev Trace m t
tr
        in Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
transformer a
arg

\end{code}

\subsubsection{Transformer for filtering based on \emph{PrivacyAnnotation}}
\label{code:WithPrivacyAnnotation}\index{WithPrivacyAnnotation}
This structure wraps a |Severity| around traced observables.
\begin{code}
data WithPrivacyAnnotation a = WithPrivacyAnnotation PrivacyAnnotation a

\end{code}

\label{code:filterPrivacyAnnotation}\index{filterPrivacyAnnotation}
The traced observables with annotated severity are filtered.
\begin{code}
filterPrivacyAnnotation :: forall m a. (Monad m, HasPrivacyAnnotation a)
                        => (a -> m PrivacyAnnotation)
                        -> Tracer m a
                        -> Tracer m a
filterPrivacyAnnotation :: (a -> m PrivacyAnnotation) -> Tracer m a -> Tracer m a
filterPrivacyAnnotation a -> m PrivacyAnnotation
mpa Tracer m a
tr = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((a -> m ()) -> Tracer m a) -> (a -> m ()) -> Tracer m a
forall a b. (a -> b) -> a -> b
$ \a
arg -> do
    PrivacyAnnotation
pa <- a -> m PrivacyAnnotation
mpa a
arg
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation a
arg PrivacyAnnotation -> PrivacyAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== PrivacyAnnotation
pa) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
tr a
arg

\end{code}

General instances of |WithPrivacyAnnotation| wrapped observable types.

\begin{code}
instance forall m a t. (Monad m, Transformable t m a) => Transformable t m (WithPrivacyAnnotation a) where
    trTransformer :: TracingVerbosity -> Trace m t -> Tracer m (WithPrivacyAnnotation a)
trTransformer TracingVerbosity
verb Trace m t
tr = (WithPrivacyAnnotation a -> m ())
-> Tracer m (WithPrivacyAnnotation a)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithPrivacyAnnotation a -> m ())
 -> Tracer m (WithPrivacyAnnotation a))
-> (WithPrivacyAnnotation a -> m ())
-> Tracer m (WithPrivacyAnnotation a)
forall a b. (a -> b) -> a -> b
$ \(WithPrivacyAnnotation PrivacyAnnotation
pa a
arg) ->
        let transformer :: Tracer m a
            transformer :: Tracer m a
transformer = TracingVerbosity -> Trace m t -> Tracer m a
forall a (m :: * -> *) b.
Transformable a m b =>
TracingVerbosity -> Trace m a -> Tracer m b
trTransformer TracingVerbosity
verb (Trace m t -> Tracer m a) -> Trace m t -> Tracer m a
forall a b. (a -> b) -> a -> b
$ PrivacyAnnotation -> Trace m t -> Trace m t
forall (m :: * -> *) a. PrivacyAnnotation -> Trace m a -> Trace m a
setPrivacy PrivacyAnnotation
pa Trace m t
tr
        in Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
transformer a
arg

\end{code}

\subsubsection{The properties of being annotated with severity and privacy}
\label{code:HasSeverityAnnotation}\index{HasSeverityAnnotation}
From a type with the property of |HasSeverityAnnotation|, one will be able to
extract its severity annotation.

\begin{code}
class HasSeverityAnnotation a where
    getSeverityAnnotation :: a -> Severity
    default getSeverityAnnotation :: a -> Severity
    getSeverityAnnotation a
_ = Severity
Debug

instance HasSeverityAnnotation (WithSeverity a) where
    getSeverityAnnotation :: WithSeverity a -> Severity
getSeverityAnnotation (WithSeverity Severity
sev a
_) = Severity
sev

instance HasSeverityAnnotation a => HasSeverityAnnotation (WithPrivacyAnnotation a) where
    getSeverityAnnotation :: WithPrivacyAnnotation a -> Severity
getSeverityAnnotation (WithPrivacyAnnotation PrivacyAnnotation
_ a
a) = a -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation a
a

-- default instances
instance HasSeverityAnnotation Double
instance HasSeverityAnnotation Float
instance HasSeverityAnnotation Int
instance HasSeverityAnnotation Integer
instance HasSeverityAnnotation String
instance HasSeverityAnnotation Text
instance HasSeverityAnnotation Word64

\end{code}

\label{code:HasPrivacyAnnotation}\index{HasPrivacyAnnotation}
And, privacy annotation can be extracted from types with the property |HasPrivacyAnnotation|.

\begin{code}
class HasPrivacyAnnotation a where
    getPrivacyAnnotation :: a -> PrivacyAnnotation
    default getPrivacyAnnotation :: a -> PrivacyAnnotation
    getPrivacyAnnotation a
_ = PrivacyAnnotation
Public

instance HasPrivacyAnnotation (WithPrivacyAnnotation a) where
    getPrivacyAnnotation :: WithPrivacyAnnotation a -> PrivacyAnnotation
getPrivacyAnnotation (WithPrivacyAnnotation PrivacyAnnotation
pva a
_) = PrivacyAnnotation
pva

instance HasPrivacyAnnotation a => HasPrivacyAnnotation (WithSeverity a) where
    getPrivacyAnnotation :: WithSeverity a -> PrivacyAnnotation
getPrivacyAnnotation (WithSeverity Severity
_ a
a) = a -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation a
a

-- default instances
instance HasPrivacyAnnotation Double
instance HasPrivacyAnnotation Float
instance HasPrivacyAnnotation Int
instance HasPrivacyAnnotation Integer
instance HasPrivacyAnnotation String
instance HasPrivacyAnnotation Text
instance HasPrivacyAnnotation Word64

\end{code}