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

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

import           Control.Monad.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 MuxTrace -> Tracer m MuxTrace)
initDeltaQTracer :: m (Tracer m MuxTrace -> Tracer m MuxTrace)
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 MuxTrace -> Tracer m MuxTrace))
-> m (Tracer m MuxTrace -> Tracer m MuxTrace)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tracer m MuxTrace -> Tracer m MuxTrace)
-> m (Tracer m MuxTrace -> Tracer m MuxTrace)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Tracer m MuxTrace -> Tracer m MuxTrace)
 -> m (Tracer m MuxTrace -> Tracer m MuxTrace))
-> (StrictTVar m StatsA -> Tracer m MuxTrace -> Tracer m MuxTrace)
-> StrictTVar m StatsA
-> m (Tracer m MuxTrace -> Tracer m MuxTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTVar m StatsA -> Tracer m MuxTrace -> Tracer m MuxTrace
forall (m :: * -> *).
MonadSTM m =>
StrictTVar m StatsA -> Tracer m MuxTrace -> Tracer m MuxTrace
dqTracer

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

dqTracer :: MonadSTM m
         => StrictTVar m StatsA
         -> Tracer m MuxTrace
         -> Tracer m MuxTrace
dqTracer :: StrictTVar m StatsA -> Tracer m MuxTrace -> Tracer m MuxTrace
dqTracer StrictTVar m StatsA
sTvar Tracer m MuxTrace
tr = (MuxTrace -> m ()) -> Tracer m MuxTrace
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer MuxTrace -> m ()
go
  where
    go :: MuxTrace -> m ()
go (MuxTraceRecvDeltaQObservation MuxSDUHeader { RemoteClockModel
mhTimestamp :: MuxSDUHeader -> RemoteClockModel
mhTimestamp :: RemoteClockModel
mhTimestamp, Word16
mhLength :: MuxSDUHeader -> Word16
mhLength :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()) (Tracer m MuxTrace -> MuxTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m MuxTrace
tr (MuxTrace -> m ())
-> (OneWayDeltaQSample -> MuxTrace) -> OneWayDeltaQSample -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneWayDeltaQSample -> MuxTrace
formatSample)
    go te :: MuxTrace
te@(MuxTraceCleanExit {})
       = m ()
emitSample m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tracer m MuxTrace -> MuxTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m MuxTrace
tr MuxTrace
te
    go te :: MuxTrace
te@(MuxTraceExceptionExit {})
       = m ()
emitSample m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tracer m MuxTrace -> MuxTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m MuxTrace
tr MuxTrace
te
    go MuxTrace
x
      = Tracer m MuxTrace -> MuxTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m MuxTrace
tr MuxTrace
x

    update :: RemoteClockModel -> Time -> Int -> m (Maybe OneWayDeltaQSample)
update RemoteClockModel
rClock Time
lClock Int
n
      = STM m (Maybe OneWayDeltaQSample) -> m (Maybe OneWayDeltaQSample)
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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tracer m MuxTrace -> MuxTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m MuxTrace
tr (MuxTrace -> m ())
-> (OneWayDeltaQSample -> MuxTrace) -> OneWayDeltaQSample -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneWayDeltaQSample -> MuxTrace
formatSample

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

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