{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE RecordWildCards #-}

module Network.Mux.DeltaQ.TraceTransformer
  ( initDeltaQTracer
  , initDeltaQTracer'
  ) where

import Control.Concurrent.Class.MonadSTM.Strict
import Control.Tracer

import Network.Mux.DeltaQ.TraceStats
import Network.Mux.Trace
import Network.Mux.Types


-- | Create a trace transformer that will emit
--   `MuxTraceRecvDeltaQSample` no more frequently than every 10
--   seconds (when in use).
initDeltaQTracer :: MonadSTM m
                 => m (Tracer m Trace -> Tracer m Trace)
initDeltaQTracer :: forall (m :: * -> *).
MonadSTM m =>
m (Tracer m Trace -> Tracer m Trace)
initDeltaQTracer = StatsA -> m (StrictTVar m StatsA)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO StatsA
initialStatsA m (StrictTVar m StatsA)
-> (StrictTVar m StatsA -> m (Tracer m Trace -> Tracer m Trace))
-> m (Tracer m Trace -> Tracer m Trace)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tracer m Trace -> Tracer m Trace)
-> m (Tracer m Trace -> Tracer m Trace)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Tracer m Trace -> Tracer m Trace)
 -> m (Tracer m Trace -> Tracer m Trace))
-> (StrictTVar m StatsA -> Tracer m Trace -> Tracer m Trace)
-> StrictTVar m StatsA
-> m (Tracer m Trace -> Tracer m Trace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTVar m StatsA -> Tracer m Trace -> Tracer m Trace
forall (m :: * -> *).
MonadSTM m =>
StrictTVar m StatsA -> Tracer m Trace -> Tracer m Trace
dqTracer

initDeltaQTracer' :: MonadSTM m
                  => Tracer m Trace
                  -> m (Tracer m Trace)
initDeltaQTracer' :: forall (m :: * -> *).
MonadSTM m =>
Tracer m Trace -> m (Tracer m Trace)
initDeltaQTracer' Tracer m Trace
tr = do
    v <- StatsA -> m (StrictTVar m StatsA)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO StatsA
initialStatsA
    return $ dqTracer v tr

dqTracer :: MonadSTM m
         => StrictTVar m StatsA
         -> Tracer m Trace
         -> Tracer m Trace
dqTracer :: forall (m :: * -> *).
MonadSTM m =>
StrictTVar m StatsA -> Tracer m Trace -> Tracer m Trace
dqTracer StrictTVar m StatsA
sTvar Tracer m Trace
tr = (Trace -> m ()) -> Tracer m Trace
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer Trace -> m ()
go
  where
    go :: Trace -> m ()
go (TraceRecvDeltaQObservation SDUHeader { RemoteClockModel
mhTimestamp :: RemoteClockModel
mhTimestamp :: SDUHeader -> RemoteClockModel
mhTimestamp, Word16
mhLength :: Word16
mhLength :: SDUHeader -> Word16
mhLength } Time
t)
      = RemoteClockModel -> Time -> Int -> m (Maybe OneWayDeltaQSample)
update RemoteClockModel
mhTimestamp Time
t (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
mhLength)
        m (Maybe OneWayDeltaQSample)
-> (Maybe OneWayDeltaQSample -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m ()
-> (OneWayDeltaQSample -> m ()) -> Maybe OneWayDeltaQSample -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Tracer m Trace -> Trace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m Trace
tr (Trace -> m ())
-> (OneWayDeltaQSample -> Trace) -> OneWayDeltaQSample -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneWayDeltaQSample -> Trace
formatSample)
    go te :: Trace
te@(TraceCleanExit {})
       = m ()
emitSample m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tracer m Trace -> Trace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m Trace
tr Trace
te
    go te :: Trace
te@(TraceExceptionExit {})
       = m ()
emitSample m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tracer m Trace -> Trace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m Trace
tr Trace
te
    go Trace
x
      = Tracer m Trace -> Trace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m Trace
tr Trace
x

    update :: RemoteClockModel -> Time -> Int -> m (Maybe OneWayDeltaQSample)
update RemoteClockModel
rClock Time
lClock Int
n
      = STM m (Maybe OneWayDeltaQSample) -> m (Maybe OneWayDeltaQSample)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar m StatsA
-> (StatsA -> (Maybe OneWayDeltaQSample, StatsA))
-> STM m (Maybe OneWayDeltaQSample)
forall (m :: * -> *) s a.
MonadSTM m =>
StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar StrictTVar m StatsA
sTvar (RemoteClockModel
-> Time -> Int -> StatsA -> (Maybe OneWayDeltaQSample, StatsA)
step RemoteClockModel
rClock Time
lClock Int
n))

    emitSample :: m ()
emitSample
      =  STM m OneWayDeltaQSample -> m OneWayDeltaQSample
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar m StatsA
-> (StatsA -> (OneWayDeltaQSample, StatsA))
-> STM m OneWayDeltaQSample
forall (m :: * -> *) s a.
MonadSTM m =>
StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar StrictTVar m StatsA
sTvar StatsA -> (OneWayDeltaQSample, StatsA)
processSample)
         m OneWayDeltaQSample -> (OneWayDeltaQSample -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tracer m Trace -> Trace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m Trace
tr (Trace -> m ())
-> (OneWayDeltaQSample -> Trace) -> OneWayDeltaQSample -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneWayDeltaQSample -> Trace
formatSample

    processSample :: StatsA -> (OneWayDeltaQSample, StatsA)
processSample StatsA
s
      = (StatsA -> OneWayDeltaQSample
constructSample StatsA
s, StatsA
initialStatsA)

    formatSample :: OneWayDeltaQSample -> Trace
formatSample (OneWaySample {Double
Int
String
duration :: Double
sumPackets :: Int
sumTotalSDU :: Int
estDeltaQS :: Double
estDeltaQVMean :: Double
estDeltaQVVar :: Double
estR :: Double
sizeDist :: String
duration :: OneWayDeltaQSample -> Double
estDeltaQS :: OneWayDeltaQSample -> Double
estDeltaQVMean :: OneWayDeltaQSample -> Double
estDeltaQVVar :: OneWayDeltaQSample -> Double
estR :: OneWayDeltaQSample -> Double
sizeDist :: OneWayDeltaQSample -> String
sumPackets :: OneWayDeltaQSample -> Int
sumTotalSDU :: OneWayDeltaQSample -> Int
..})
      = Double
-> Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> String
-> Trace
TraceRecvDeltaQSample Double
duration Int
sumPackets Int
sumTotalSDU
                              Double
estDeltaQS Double
estDeltaQVMean Double
estDeltaQVVar
                              Double
estR String
sizeDist