\label{code:Control.Tracer.Transformers.WithThreadAndTime}

%if style == newcode
\begin{code}
{-|
Module: WithThreadAndTime

Observing events with annotations of thread id and time.
-}
{-# LANGUAGE BangPatterns   #-}
{-# LANGUAGE LambdaCase     #-}
{-# LANGUAGE NamedFieldPuns #-}

module Control.Tracer.Transformers.WithThreadAndTime
    (
    -- * transformer
      WithThreadAndTime (..)
    , threadAndTimeTracer
    ) where

import           Control.Concurrent (ThreadId, myThreadId)
import           Control.Monad.IO.Class (MonadIO (..))
import           Data.Time.Clock.System (SystemTime, getSystemTime)

import           Control.Tracer (Tracer (..), traceWith)

\end{code}
%endif

\begin{code}
-- | Add some operational context, time and thread
data WithThreadAndTime a
  = WithThreadAndTime { WithThreadAndTime a -> SystemTime
occurredAt   :: !SystemTime
                      , WithThreadAndTime a -> ThreadId
withinThread :: !ThreadId
                      , WithThreadAndTime a -> a
event        :: !a
                      }
-- ^ note that this could, for example, be an instance of 'ToJSON' or
-- 'Generic' or similar to project it into a more general framework

instance (Show a) => Show (WithThreadAndTime a) where
  show :: WithThreadAndTime a -> String
show (WithThreadAndTime {SystemTime
occurredAt :: SystemTime
occurredAt :: forall a. WithThreadAndTime a -> SystemTime
occurredAt, ThreadId
withinThread :: ThreadId
withinThread :: forall a. WithThreadAndTime a -> ThreadId
withinThread, a
event :: a
event :: forall a. WithThreadAndTime a -> a
event})
    = SystemTime -> String
forall a. Show a => a -> String
show SystemTime
occurredAt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ThreadId -> String
forall a. Show a => a -> String
show ThreadId
withinThread String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
event

-- | Add the time and thread to a trace observation
threadAndTimeTracer :: (MonadIO m) => Tracer m (WithThreadAndTime a) -> Tracer m a
threadAndTimeTracer :: Tracer m (WithThreadAndTime a) -> Tracer m a
threadAndTimeTracer Tracer m (WithThreadAndTime 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
   !SystemTime
now <- IO SystemTime -> m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
   !ThreadId
tid <- IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId
   Tracer m (WithThreadAndTime a) -> WithThreadAndTime a -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (WithThreadAndTime a)
tr (WithThreadAndTime a -> m ()) -> WithThreadAndTime a -> m ()
forall a b. (a -> b) -> a -> b
$ SystemTime -> ThreadId -> a -> WithThreadAndTime a
forall a. SystemTime -> ThreadId -> a -> WithThreadAndTime a
WithThreadAndTime SystemTime
now ThreadId
tid a
s

\end{code}