\label{code:Control.Tracer}

%if style == newcode
\begin{code}
{-# LANGUAGE RankNTypes #-}
{-|
Module: Control.Tracer

'Tracer' is a contravariant functor to thread observable values through a
number of transformers, possibly annotating them with additional information,
or filtering them based on evaluating predicates.
-}
module Control.Tracer
    ( Tracer (..)
    , Contravariant(..)
    -- * tracing
    , traceWith
    -- * tracers
    , nullTracer
    , stdoutTracer
    , debugTracer
    -- * transformers
    , contramapM
    , showTracing
    , condTracing
    , condTracingM
    , natTracer
    ) where

import           Control.Monad (when, (>=>))
import           Control.Monad.IO.Class (MonadIO (..))
import           Data.Functor.Contravariant (Contravariant (..))
import           Debug.Trace (traceM)

\end{code}
%endif

\subsection{Examples}
Tracing using the contravariant |Tracer| naturally reads:

\begin{spec}
let logTrace = traceWith $ showTracing $ stdoutTracer
in  logTrace "hello world"

\end{spec}

%if style == newcode
\begin{code}
{-| example: simply output a message on the console

> let logTrace = traceWith $ showTracing $ stdoutTracer
> in  logTrace "hello world"

-}
\end{code}
%endif

%if style == newcode
\begin{code}
{-| example: calling a function and passing in a 'Tracer'

> example1 :: IO ()
> example1 = do
>     let logTrace a = traceWith (showTracing (contramap ("Debug: " ++) stdoutTracer)) a
>     void $ callFun1 logTrace

> callFun1 :: (String -> IO ()) -> IO Int
> callFun1 logTrace = do
>     logTrace "in function 1"
>     return 42

-}
\end{code}
%endif

\subsection{Contravariant |Tracer|}\label{code:Tracer}\index{Tracer}
The notion of a |Tracer| is an action that can be used to observe
information of interest during evaluation. |Tracer|s can capture (and
annotate) such observations with additional information from their
execution context.

%if style == newcode
\begin{code}
-- | 'runTracer' evaluates a 'Tracer' (i.e. consumes its argument)
\end{code}
%endif
\begin{code}
newtype Tracer m a = Tracer { Tracer m a -> a -> m ()
runTracer :: a -> m () }

\end{code}

\index{Tracer!instance of Contravariant}
A |Tracer| is an instance of |Contravariant|, which permits new
|Tracer|s to be constructed that feed into the existing Tracer by use
of |contramap|.

\begin{code}
instance Contravariant (Tracer m) where
    contramap :: (a -> b) -> Tracer m b -> Tracer m a
contramap a -> b
f (Tracer b -> m ()
t) = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (b -> m ()
t (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

\end{code}

Although a |Tracer| is invoked in a monadic context (which may be
|Identity|), the construction of a new |Tracer| is a pure function.
This brings with it the constraint that the derived |Tracer|s form a
hierachy which has its root at the top level tracer.

\index{Tracer!instance of Monoid}

In principle a |Tracer| is an instance of |Semigroup| and |Monoid|, by
sequential composition of the tracing actions.

\begin{code}
instance Applicative m => Semigroup (Tracer m s) where
    Tracer s -> m ()
a1 <> :: Tracer m s -> Tracer m s -> Tracer m s
<> Tracer s -> m ()
a2 = (s -> m ()) -> Tracer m s
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((s -> m ()) -> Tracer m s) -> (s -> m ()) -> Tracer m s
forall a b. (a -> b) -> a -> b
$ \s
s -> s -> m ()
a1 s
s m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> s -> m ()
a2 s
s

instance Applicative m => Monoid (Tracer m s) where
    mappend :: Tracer m s -> Tracer m s -> Tracer m s
mappend = Tracer m s -> Tracer m s -> Tracer m s
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: Tracer m s
mempty  = Tracer m s
forall (m :: * -> *) s. Applicative m => Tracer m s
nullTracer
\end{code}

\subsubsection{nullTracer}\label{code:nullTracer}\index{nullTracer}
The simplest tracer - one that suppresses all output.

%if style == newcode
\begin{code}
-- | this 'Tracer' forgets about all arguments
\end{code}
%endif
\begin{code}
nullTracer :: Applicative m => Tracer m a
nullTracer :: Tracer m a
nullTracer = (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
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

\end{code}

\subsubsection{traceWith}\label{code:traceWith}\index{traceWith}

%if style == newcode
\begin{code}
-- | trace an observable value with a 'Tracer'
\end{code}
%endif
\begin{code}
traceWith :: Tracer m a -> a -> m ()
traceWith :: Tracer m a -> a -> m ()
traceWith = Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
runTracer

\end{code}

\subsection{Transformers}
\subsubsection{Contravariant transformers using Kleisli arrows}
Tracers can be transformed using Kleisli arrows, e.g. arrows of the type
|Monad m => a -> m b|, technically this makes |Tracer| a contravariant functor
over |Kleisli| category.  The important difference from using `contramap` is
that the monadic action runs when a tracer is called, this might be the prefered
behaviour when trying to trace timeing information.

%if style == newcode
\begin{code}
-- | Transform a tracer using a Kleisli map.
\end{code}
%endif
\begin{code}
contramapM :: Monad m
           => (a -> m b)
           -> Tracer m b
           -> Tracer m a
contramapM :: (a -> m b) -> Tracer m b -> Tracer m a
contramapM a -> m b
f (Tracer b -> m ()
tr) = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (a -> m b
f (a -> m b) -> (b -> m ()) -> a -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m ()
tr)
\end{code}

\subsubsection{Applying |show| on a |Tracer|'s messages}
The Tracer transformer exploiting Show.

%if style == newcode
\begin{code}
-- | transform a traced value to a showable instance.
\end{code}
%endif
\begin{code}
showTracing :: (Show a) => Tracer m String -> Tracer m a
showTracing :: Tracer m String -> Tracer m a
showTracing = (a -> String) -> Tracer m String -> Tracer m a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> String
forall a. Show a => a -> String
show

\end{code}

\subsubsection{Conditional tracing - statically defined}\label{code:condTracing}\index{condTracing}
The Tracer transformer that allows for on/off control of tracing at
trace creation time.

%if style == newcode
\begin{code}
-- | conditionally trace an observable given the evaluation of a predicate.
\end{code}
%endif
\begin{code}
condTracing :: (Monad m) => (a -> Bool) -> Tracer m a -> Tracer m a
condTracing :: (a -> Bool) -> Tracer m a -> Tracer m a
condTracing a -> Bool
active 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
s ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
active a
s) (Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
tr a
s)

\end{code}

\subsubsection{Conditional tracing - dynamically evaluated}\label{code:condTracingM}\index{condTracingM}
The tracer transformer that can exercise dynamic control
over tracing, the dynamic decision being made using the
context accessible in the monadic context.

%if style == newcode
\begin{code}
-- | conditionally trace an observable given the evaluation of a predicate in a monadic context.
\end{code}
%endif
\begin{code}
condTracingM :: (Monad m) => m (a -> Bool) -> Tracer m a -> Tracer m a
condTracingM :: m (a -> Bool) -> Tracer m a -> Tracer m a
condTracingM m (a -> Bool)
activeP 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
s -> do
    a -> Bool
active <- m (a -> Bool)
activeP
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
active a
s) (Tracer m a -> a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m a
tr a
s)

\end{code}

\subsubsection{natTrace}\label{code:natTrace}\index{natTrace}
Natural transformation from monad |m| to monad |n|.
%if style == newcode
\begin{code}
-- | natural transformation from monad 'm' to monad 'n'.
\end{code}
%endif
\begin{code}
natTracer :: (forall x . m x -> n x) -> Tracer m s -> Tracer n s
natTracer :: (forall x. m x -> n x) -> Tracer m s -> Tracer n s
natTracer forall x. m x -> n x
nat (Tracer s -> m ()
tr) = (s -> n ()) -> Tracer n s
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (m () -> n ()
forall x. m x -> n x
nat (m () -> n ()) -> (s -> m ()) -> s -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
tr)

\end{code}

\subsection{Output}
\subsubsection{Directing a |Tracer|'s output to stdout}\label{code:stdoutTracer}\index{stdoutTracer}

The Tracer that prints a string (as a line) to stdout (usual caveats
about interleaving should be heeded).

%if style == newcode
\begin{code}
-- | Output a traced 'String' to 'stdout'
\end{code}
%endif
\begin{code}
stdoutTracer :: (MonadIO m) => Tracer m String
stdoutTracer :: Tracer m String
stdoutTracer = (String -> m ()) -> Tracer m String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((String -> m ()) -> Tracer m String)
-> (String -> m ()) -> Tracer m String
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn

\end{code}

\subsubsection{Outputting a |Tracer| with \emph{Debug.Trace}}\label{code:debugTracer}\index{debugTracer}

A Tracer that uses |TraceM| (from |Debug.Trace|) as its output mechanism.

%if style == newcode
\begin{code}
-- | Output a traced 'String' using 'Debug.Trace'
\end{code}
%endif
\begin{code}
debugTracer :: (Applicative m) => Tracer m String
debugTracer :: Tracer m String
debugTracer = (String -> m ()) -> Tracer m String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
Debug.Trace.traceM

\end{code}