\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
, natTracer
, nullTracer
, stdoutTracer
, debugTracer
, showTracing
, trStructured
, trStructuredText
, condTracing
, condTracingM
, annotateSeverity
, filterSeverity
, setSeverity
, severityDebug
, severityInfo
, severityNotice
, severityWarning
, severityError
, severityCritical
, severityAlert
, severityEmergency
, 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
<*> (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
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
instance HasPrivacyAnnotation Double
instance HasPrivacyAnnotation Float
instance HasPrivacyAnnotation Int
instance HasPrivacyAnnotation Integer
instance HasPrivacyAnnotation String
instance HasPrivacyAnnotation Text
instance HasPrivacyAnnotation Word64
\end{code}