-- |
-- Module     : Simulation.Aivika.Server
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- It models the server that prodives a service.
module Simulation.Aivika.Server
       (-- * Server
        Server,
        newServer,
        newStateServer,
        newPreemptibleServer,
        newPreemptibleStateServer,
        -- * Processing
        serverProcessor,
        -- * Server Properties and Activities
        serverInitState,
        serverState,
        serverTotalInputWaitTime,
        serverTotalProcessingTime,
        serverTotalOutputWaitTime,
        serverTotalPreemptionTime,
        serverInputWaitTime,
        serverProcessingTime,
        serverOutputWaitTime,
        serverPreemptionTime,
        serverInputWaitFactor,
        serverProcessingFactor,
        serverOutputWaitFactor,
        serverPreemptionFactor,
        -- * Statistics Reset
        resetServer,
        -- * Summary
        serverSummary,
        -- * Derived Signals for Properties
        serverStateChanged,
        serverStateChanged_,
        serverTotalInputWaitTimeChanged,
        serverTotalInputWaitTimeChanged_,
        serverTotalProcessingTimeChanged,
        serverTotalProcessingTimeChanged_,
        serverTotalOutputWaitTimeChanged,
        serverTotalOutputWaitTimeChanged_,
        serverTotalPreemptionTimeChanged,
        serverTotalPreemptionTimeChanged_,
        serverInputWaitTimeChanged,
        serverInputWaitTimeChanged_,
        serverProcessingTimeChanged,
        serverProcessingTimeChanged_,
        serverOutputWaitTimeChanged,
        serverOutputWaitTimeChanged_,
        serverPreemptionTimeChanged,
        serverPreemptionTimeChanged_,
        serverInputWaitFactorChanged,
        serverInputWaitFactorChanged_,
        serverProcessingFactorChanged,
        serverProcessingFactorChanged_,
        serverOutputWaitFactorChanged,
        serverOutputWaitFactorChanged_,
        serverPreemptionFactorChanged,
        serverPreemptionFactorChanged_,
        -- * Basic Signals
        serverInputReceived,
        serverTaskPreemptionBeginning,
        serverTaskPreemptionEnding,
        serverTaskProcessed,
        serverOutputProvided,
        -- * Overall Signal
        serverChanged_) where

import Data.IORef
import Data.Monoid

import Control.Monad
import Control.Monad.Trans
import Control.Arrow

import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Signal
import Simulation.Aivika.Cont
import Simulation.Aivika.Process
import Simulation.Aivika.Processor
import Simulation.Aivika.Stream
import Simulation.Aivika.Statistics

-- | It models a server that takes @a@ and provides @b@ having state @s@.
data Server s a b =
  Server { Server s a b -> s
serverInitState :: s,
           -- ^ The initial state of the server.
           Server s a b -> IORef s
serverStateRef :: IORef s,
           -- ^ The current state of the server.
           Server s a b -> s -> a -> Process (s, b)
serverProcess :: s -> a -> Process (s, b),
           -- ^ Provide @b@ by specified @a@.
           Server s a b -> Bool
serverProcessPreemptible :: Bool,
           -- ^ Whether the process can be preempted.
           Server s a b -> IORef Double
serverTotalInputWaitTimeRef :: IORef Double,
           -- ^ The counted total time spent in awating the input.
           Server s a b -> IORef Double
serverTotalProcessingTimeRef :: IORef Double,
           -- ^ The counted total time spent to process the input and prepare the output.
           Server s a b -> IORef Double
serverTotalOutputWaitTimeRef :: IORef Double,
           -- ^ The counted total time spent for delivering the output.
           Server s a b -> IORef Double
serverTotalPreemptionTimeRef :: IORef Double,
           -- ^ The counted total time spent being preempted and waiting for the proceeding. 
           Server s a b -> IORef (SamplingStats Double)
serverInputWaitTimeRef :: IORef (SamplingStats Double),
           -- ^ The statistics for the time spent in awaiting the input.
           Server s a b -> IORef (SamplingStats Double)
serverProcessingTimeRef :: IORef (SamplingStats Double),
           -- ^ The statistics for the time spent to process the input and prepare the output.
           Server s a b -> IORef (SamplingStats Double)
serverOutputWaitTimeRef :: IORef (SamplingStats Double),
           -- ^ The statistics for the time spent for delivering the output.
           Server s a b -> IORef (SamplingStats Double)
serverPreemptionTimeRef :: IORef (SamplingStats Double),
           -- ^ The statistics for the time spent being preempted.
           Server s a b -> SignalSource a
serverInputReceivedSource :: SignalSource a,
           -- ^ A signal raised when the server recieves a new input to process.
           Server s a b -> SignalSource a
serverTaskPreemptionBeginningSource :: SignalSource a,
           -- ^ A signal raised when the task was preempted.
           Server s a b -> SignalSource a
serverTaskPreemptionEndingSource :: SignalSource a,
           -- ^ A signal raised when the task was proceeded after it had been preempted earlier.
           Server s a b -> SignalSource (a, b)
serverTaskProcessedSource :: SignalSource (a, b),
           -- ^ A signal raised when the input is processed and
           -- the output is prepared for deliverying.
           Server s a b -> SignalSource (a, b)
serverOutputProvidedSource :: SignalSource (a, b)
           -- ^ A signal raised when the server has supplied the output.
         }

-- | Create a new server that can provide output @b@ by input @a@.
--
-- By default, it is assumed that the server process cannot be preempted,
-- because the handling of possible task preemption is rather costly
-- operation.
newServer :: (a -> Process b)
             -- ^ provide an output by the specified input
             -> Simulation (Server () a b)
newServer :: (a -> Process b) -> Simulation (Server () a b)
newServer = Bool -> (a -> Process b) -> Simulation (Server () a b)
forall a b. Bool -> (a -> Process b) -> Simulation (Server () a b)
newPreemptibleServer Bool
False

-- | Create a new server that can provide output @b@ by input @a@
-- starting from state @s@.
--
-- By default, it is assumed that the server process cannot be preempted,
-- because the handling of possible task preemption is rather costly
-- operation.
newStateServer :: (s -> a -> Process (s, b))
                  -- ^ provide a new state and output by the specified 
                  -- old state and input
                  -> s
                  -- ^ the initial state
                  -> Simulation (Server s a b)
newStateServer :: (s -> a -> Process (s, b)) -> s -> Simulation (Server s a b)
newStateServer = Bool
-> (s -> a -> Process (s, b)) -> s -> Simulation (Server s a b)
forall s a b.
Bool
-> (s -> a -> Process (s, b)) -> s -> Simulation (Server s a b)
newPreemptibleStateServer Bool
False

-- | Create a new preemptible server that can provide output @b@ by input @a@.
newPreemptibleServer :: Bool
                        -- ^ whether the server process can be preempted
                        -> (a -> Process b)
                        -- ^ provide an output by the specified input
                        -> Simulation (Server () a b)
newPreemptibleServer :: Bool -> (a -> Process b) -> Simulation (Server () a b)
newPreemptibleServer Bool
preemptible a -> Process b
provide =
  ((() -> a -> Process ((), b)) -> () -> Simulation (Server () a b))
-> () -> (() -> a -> Process ((), b)) -> Simulation (Server () a b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> (() -> a -> Process ((), b)) -> () -> Simulation (Server () a b)
forall s a b.
Bool
-> (s -> a -> Process (s, b)) -> s -> Simulation (Server s a b)
newPreemptibleStateServer Bool
preemptible) () ((() -> a -> Process ((), b)) -> Simulation (Server () a b))
-> (() -> a -> Process ((), b)) -> Simulation (Server () a b)
forall a b. (a -> b) -> a -> b
$ \()
s a
a ->
  do b
b <- a -> Process b
provide a
a
     ((), b) -> Process ((), b)
forall (m :: * -> *) a. Monad m => a -> m a
return (()
s, b
b)

-- | Create a new preemptible server that can provide output @b@ by input @a@
-- starting from state @s@.
newPreemptibleStateServer :: Bool
                             -- ^ whether the server process can be preempted
                             -> (s -> a -> Process (s, b))
                             -- ^ provide a new state and output by the specified 
                             -- old state and input
                             -> s
                             -- ^ the initial state
                             -> Simulation (Server s a b)
newPreemptibleStateServer :: Bool
-> (s -> a -> Process (s, b)) -> s -> Simulation (Server s a b)
newPreemptibleStateServer Bool
preemptible s -> a -> Process (s, b)
provide s
state =
  do IORef s
r0 <- IO (IORef s) -> Simulation (IORef s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef s) -> Simulation (IORef s))
-> IO (IORef s) -> Simulation (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
state
     IORef Double
r1 <- IO (IORef Double) -> Simulation (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Simulation (IORef Double))
-> IO (IORef Double) -> Simulation (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef Double
r2 <- IO (IORef Double) -> Simulation (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Simulation (IORef Double))
-> IO (IORef Double) -> Simulation (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef Double
r3 <- IO (IORef Double) -> Simulation (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Simulation (IORef Double))
-> IO (IORef Double) -> Simulation (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef Double
r4 <- IO (IORef Double) -> Simulation (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Simulation (IORef Double))
-> IO (IORef Double) -> Simulation (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef (SamplingStats Double)
r5 <- IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> Simulation (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     IORef (SamplingStats Double)
r6 <- IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> Simulation (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     IORef (SamplingStats Double)
r7 <- IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> Simulation (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     IORef (SamplingStats Double)
r8 <- IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> Simulation (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> Simulation (IORef (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource a
s1 <- Simulation (SignalSource a)
forall a. Simulation (SignalSource a)
newSignalSource
     SignalSource a
s2 <- Simulation (SignalSource a)
forall a. Simulation (SignalSource a)
newSignalSource
     SignalSource a
s3 <- Simulation (SignalSource a)
forall a. Simulation (SignalSource a)
newSignalSource
     SignalSource (a, b)
s4 <- Simulation (SignalSource (a, b))
forall a. Simulation (SignalSource a)
newSignalSource
     SignalSource (a, b)
s5 <- Simulation (SignalSource (a, b))
forall a. Simulation (SignalSource a)
newSignalSource
     let server :: Server s a b
server = Server :: forall s a b.
s
-> IORef s
-> (s -> a -> Process (s, b))
-> Bool
-> IORef Double
-> IORef Double
-> IORef Double
-> IORef Double
-> IORef (SamplingStats Double)
-> IORef (SamplingStats Double)
-> IORef (SamplingStats Double)
-> IORef (SamplingStats Double)
-> SignalSource a
-> SignalSource a
-> SignalSource a
-> SignalSource (a, b)
-> SignalSource (a, b)
-> Server s a b
Server { serverInitState :: s
serverInitState = s
state,
                           serverStateRef :: IORef s
serverStateRef = IORef s
r0,
                           serverProcess :: s -> a -> Process (s, b)
serverProcess = s -> a -> Process (s, b)
provide,
                           serverProcessPreemptible :: Bool
serverProcessPreemptible = Bool
preemptible,
                           serverTotalInputWaitTimeRef :: IORef Double
serverTotalInputWaitTimeRef = IORef Double
r1,
                           serverTotalProcessingTimeRef :: IORef Double
serverTotalProcessingTimeRef = IORef Double
r2,
                           serverTotalOutputWaitTimeRef :: IORef Double
serverTotalOutputWaitTimeRef = IORef Double
r3,
                           serverTotalPreemptionTimeRef :: IORef Double
serverTotalPreemptionTimeRef = IORef Double
r4,
                           serverInputWaitTimeRef :: IORef (SamplingStats Double)
serverInputWaitTimeRef = IORef (SamplingStats Double)
r5,
                           serverProcessingTimeRef :: IORef (SamplingStats Double)
serverProcessingTimeRef = IORef (SamplingStats Double)
r6,
                           serverOutputWaitTimeRef :: IORef (SamplingStats Double)
serverOutputWaitTimeRef = IORef (SamplingStats Double)
r7,
                           serverPreemptionTimeRef :: IORef (SamplingStats Double)
serverPreemptionTimeRef = IORef (SamplingStats Double)
r8,
                           serverInputReceivedSource :: SignalSource a
serverInputReceivedSource = SignalSource a
s1,
                           serverTaskPreemptionBeginningSource :: SignalSource a
serverTaskPreemptionBeginningSource = SignalSource a
s2,
                           serverTaskPreemptionEndingSource :: SignalSource a
serverTaskPreemptionEndingSource = SignalSource a
s3,
                           serverTaskProcessedSource :: SignalSource (a, b)
serverTaskProcessedSource = SignalSource (a, b)
s4,
                           serverOutputProvidedSource :: SignalSource (a, b)
serverOutputProvidedSource = SignalSource (a, b)
s5 }
     Server s a b -> Simulation (Server s a b)
forall (m :: * -> *) a. Monad m => a -> m a
return Server s a b
server

-- | Return a processor for the specified server.
--
-- The processor updates the internal state of the server. The usual case is when 
-- the processor is applied only once in a chain of data processing. Otherwise; 
-- every time the processor is used, the state of the server changes. Sometimes 
-- it can be indeed useful if you want to aggregate the statistics for different 
-- servers simultaneously, but it would be more preferable to avoid this.
--
-- If you connect different server processors returned by this function in a chain 
-- with help of '>>>' or other category combinator then this chain will act as one 
-- whole, where the first server will take a new task only after the last server 
-- finishes its current task and requests for the next one from the previous processor 
-- in the chain. This is not always that thing you might need.
--
-- To model a sequence of the server processors working independently, you
-- should use the 'processorSeq' function which separates the processors with help of
-- the 'prefetchProcessor' that plays a role of a small one-place buffer in that case.
--
-- The queue processors usually have the prefetching capabilities per se, where
-- the items are already stored in the queue. Therefore, the server processor
-- should not be prefetched if it is connected directly to the queue processor.
serverProcessor :: Server s a b -> Processor a b
serverProcessor :: Server s a b -> Processor a b
serverProcessor Server s a b
server =
  (Stream a -> Stream b) -> Processor a b
forall a b. (Stream a -> Stream b) -> Processor a b
Processor ((Stream a -> Stream b) -> Processor a b)
-> (Stream a -> Stream b) -> Processor a b
forall a b. (a -> b) -> a -> b
$ \Stream a
xs -> s -> Maybe (Double, a, b) -> Stream a -> Stream b
loop (Server s a b -> s
forall s a b. Server s a b -> s
serverInitState Server s a b
server) Maybe (Double, a, b)
forall a. Maybe a
Nothing Stream a
xs
  where
    loop :: s -> Maybe (Double, a, b) -> Stream a -> Stream b
loop s
s Maybe (Double, a, b)
r Stream a
xs =
      Process (b, Stream b) -> Stream b
forall a. Process (a, Stream a) -> Stream a
Cons (Process (b, Stream b) -> Stream b)
-> Process (b, Stream b) -> Stream b
forall a b. (a -> b) -> a -> b
$
      do Double
t0 <- Dynamics Double -> Process Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
         Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
           case Maybe (Double, a, b)
r of
             Maybe (Double, a, b)
Nothing -> () -> Event ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             Just (Double
t', a
a', b
b') ->
               do IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
                    do IORef Double -> (Double -> Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server) (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
t0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t'))
                       IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverOutputWaitTimeRef Server s a b
server) ((SamplingStats Double -> SamplingStats Double) -> IO ())
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a b. (a -> b) -> a -> b
$
                         Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t')
                  SignalSource (a, b) -> (a, b) -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Server s a b -> SignalSource (a, b)
forall s a b. Server s a b -> SignalSource (a, b)
serverOutputProvidedSource Server s a b
server) (a
a', b
b')
         -- get input
         (a
a, Stream a
xs') <- Stream a -> Process (a, Stream a)
forall a. Stream a -> Process (a, Stream a)
runStream Stream a
xs
         Double
t1 <- Dynamics Double -> Process Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
         Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
           do IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
                do IORef Double -> (Double -> Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server) (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0))
                   IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverInputWaitTimeRef Server s a b
server) ((SamplingStats Double -> SamplingStats Double) -> IO ())
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a b. (a -> b) -> a -> b
$
                     Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0)
              SignalSource a -> a -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Server s a b -> SignalSource a
forall s a b. Server s a b -> SignalSource a
serverInputReceivedSource Server s a b
server) a
a
         -- provide the service
         (s
s', b
b, Double
dt) <-
           if Server s a b -> Bool
forall s a b. Server s a b -> Bool
serverProcessPreemptible Server s a b
server
           then Server s a b -> s -> a -> Process (s, b, Double)
forall s a b. Server s a b -> s -> a -> Process (s, b, Double)
serverProcessPreempting Server s a b
server s
s a
a
           else do (s
s', b
b) <- Server s a b -> s -> a -> Process (s, b)
forall s a b. Server s a b -> s -> a -> Process (s, b)
serverProcess Server s a b
server s
s a
a
                   (s, b, Double) -> Process (s, b, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', b
b, Double
0)
         Double
t2 <- Dynamics Double -> Process Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
         Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
           do IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
                do IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef s
forall s a b. Server s a b -> IORef s
serverStateRef Server s a b
server) (s -> IO ()) -> s -> IO ()
forall a b. (a -> b) -> a -> b
$! s
s'
                   IORef Double -> (Double -> Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server) (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dt))
                   IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverProcessingTimeRef Server s a b
server) ((SamplingStats Double -> SamplingStats Double) -> IO ())
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a b. (a -> b) -> a -> b
$
                     Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats (Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dt)
              SignalSource (a, b) -> (a, b) -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Server s a b -> SignalSource (a, b)
forall s a b. Server s a b -> SignalSource (a, b)
serverTaskProcessedSource Server s a b
server) (a
a, b
b)
         (b, Stream b) -> Process (b, Stream b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, s -> Maybe (Double, a, b) -> Stream a -> Stream b
loop s
s' ((Double, a, b) -> Maybe (Double, a, b)
forall a. a -> Maybe a
Just (Double
t2, a
a, b
b)) Stream a
xs')

-- | Process the input with ability to handle a possible preemption.
serverProcessPreempting :: Server s a b -> s -> a -> Process (s, b, Double)
serverProcessPreempting :: Server s a b -> s -> a -> Process (s, b, Double)
serverProcessPreempting Server s a b
server s
s a
a =
  do ProcessId
pid <- Process ProcessId
processId
     Double
t1  <- Dynamics Double -> Process Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
     IORef Double
rs  <- IO (IORef Double) -> Process (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Process (IORef Double))
-> IO (IORef Double) -> Process (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef Double
r1  <- IO (IORef Double) -> Process (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Process (IORef Double))
-> IO (IORef Double) -> Process (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
t1
     DisposableEvent
h1  <- Event DisposableEvent -> Process DisposableEvent
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event DisposableEvent -> Process DisposableEvent)
-> Event DisposableEvent -> Process DisposableEvent
forall a b. (a -> b) -> a -> b
$
            Signal () -> (() -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal (ProcessId -> Signal ()
processPreemptionBeginning ProcessId
pid) ((() -> Event ()) -> Event DisposableEvent)
-> (() -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \() ->
            do Double
t1 <- Dynamics Double -> Event Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
               IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Double
r1 Double
t1
               SignalSource a -> a -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Server s a b -> SignalSource a
forall s a b. Server s a b -> SignalSource a
serverTaskPreemptionBeginningSource Server s a b
server) a
a
     DisposableEvent
h2  <- Event DisposableEvent -> Process DisposableEvent
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event DisposableEvent -> Process DisposableEvent)
-> Event DisposableEvent -> Process DisposableEvent
forall a b. (a -> b) -> a -> b
$
            Signal () -> (() -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal (ProcessId -> Signal ()
processPreemptionEnding ProcessId
pid) ((() -> Event ()) -> Event DisposableEvent)
-> (() -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ \() ->
            do Double
t1 <- IO Double -> Event Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Event Double) -> IO Double -> Event Double
forall a b. (a -> b) -> a -> b
$ IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef IORef Double
r1
               Double
t2 <- Dynamics Double -> Event Double
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
               let dt :: Double
dt = Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t1
               IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
                 do IORef Double -> (Double -> Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Double
rs (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt)
                    IORef Double -> (Double -> Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server) (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt)
                    IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverPreemptionTimeRef Server s a b
server) ((SamplingStats Double -> SamplingStats Double) -> IO ())
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a b. (a -> b) -> a -> b
$
                      Double -> SamplingStats Double -> SamplingStats Double
forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats Double
dt
               SignalSource a -> a -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Server s a b -> SignalSource a
forall s a b. Server s a b -> SignalSource a
serverTaskPreemptionEndingSource Server s a b
server) a
a 
     let m1 :: Process (s, b, Double)
m1 =
           do (s
s', b
b) <- Server s a b -> s -> a -> Process (s, b)
forall s a b. Server s a b -> s -> a -> Process (s, b)
serverProcess Server s a b
server s
s a
a
              Double
dt <- IO Double -> Process Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> Process Double) -> IO Double -> Process Double
forall a b. (a -> b) -> a -> b
$ IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef IORef Double
rs
              (s, b, Double) -> Process (s, b, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s', b
b, Double
dt)
         m2 :: Process ()
m2 =
           Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
           do DisposableEvent -> Event ()
disposeEvent DisposableEvent
h1
              DisposableEvent -> Event ()
disposeEvent DisposableEvent
h2
     Process (s, b, Double) -> Process () -> Process (s, b, Double)
forall a b. Process a -> Process b -> Process a
finallyProcess Process (s, b, Double)
m1 Process ()
m2

-- | Return the current state of the server.
--
-- See also 'serverStateChanged' and 'serverStateChanged_'.
serverState :: Server s a b -> Event s
serverState :: Server s a b -> Event s
serverState Server s a b
server =
  (Point -> IO s) -> Event s
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO s) -> Event s) -> (Point -> IO s) -> Event s
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef s -> IO s
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef s
forall s a b. Server s a b -> IORef s
serverStateRef Server s a b
server)
  
-- | Signal when the 'serverState' property value has changed.
serverStateChanged :: Server s a b -> Signal s
serverStateChanged :: Server s a b -> Signal s
serverStateChanged Server s a b
server =
  (() -> Event s) -> Signal () -> Signal s
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event s -> () -> Event s
forall a b. a -> b -> a
const (Event s -> () -> Event s) -> Event s -> () -> Event s
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event s
forall s a b. Server s a b -> Event s
serverState Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverStateChanged_ Server s a b
server)
  
-- | Signal when the 'serverState' property value has changed.
serverStateChanged_ :: Server s a b -> Signal ()
serverStateChanged_ :: Server s a b -> Signal ()
serverStateChanged_ Server s a b
server =
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server)

-- | Return the counted total time when the server was locked while awaiting the input.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverTotalInputWaitTimeChanged' and 'serverTotalInputWaitTimeChanged_'.
serverTotalInputWaitTime :: Server s a b -> Event Double
serverTotalInputWaitTime :: Server s a b -> Event Double
serverTotalInputWaitTime Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server)
  
-- | Signal when the 'serverTotalInputWaitTime' property value has changed.
serverTotalInputWaitTimeChanged :: Server s a b -> Signal Double
serverTotalInputWaitTimeChanged :: Server s a b -> Signal Double
serverTotalInputWaitTimeChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverTotalInputWaitTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverTotalInputWaitTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverTotalInputWaitTime' property value has changed.
serverTotalInputWaitTimeChanged_ :: Server s a b -> Signal ()
serverTotalInputWaitTimeChanged_ :: Server s a b -> Signal ()
serverTotalInputWaitTimeChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server)

-- | Return the counted total time spent by the server while processing the tasks.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverTotalProcessingTimeChanged' and 'serverTotalProcessingTimeChanged_'.
serverTotalProcessingTime :: Server s a b -> Event Double
serverTotalProcessingTime :: Server s a b -> Event Double
serverTotalProcessingTime Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server)
  
-- | Signal when the 'serverTotalProcessingTime' property value has changed.
serverTotalProcessingTimeChanged :: Server s a b -> Signal Double
serverTotalProcessingTimeChanged :: Server s a b -> Signal Double
serverTotalProcessingTimeChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverTotalProcessingTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverTotalProcessingTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverTotalProcessingTime' property value has changed.
serverTotalProcessingTimeChanged_ :: Server s a b -> Signal ()
serverTotalProcessingTimeChanged_ :: Server s a b -> Signal ()
serverTotalProcessingTimeChanged_ Server s a b
server =
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server)

-- | Return the counted total time when the server was locked while trying
-- to deliver the output.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverTotalOutputWaitTimeChanged' and 'serverTotalOutputWaitTimeChanged_'.
serverTotalOutputWaitTime :: Server s a b -> Event Double
serverTotalOutputWaitTime :: Server s a b -> Event Double
serverTotalOutputWaitTime Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server)
  
-- | Signal when the 'serverTotalOutputWaitTime' property value has changed.
serverTotalOutputWaitTimeChanged :: Server s a b -> Signal Double
serverTotalOutputWaitTimeChanged :: Server s a b -> Signal Double
serverTotalOutputWaitTimeChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverTotalOutputWaitTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverTotalOutputWaitTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverTotalOutputWaitTime' property value has changed.
serverTotalOutputWaitTimeChanged_ :: Server s a b -> Signal ()
serverTotalOutputWaitTimeChanged_ :: Server s a b -> Signal ()
serverTotalOutputWaitTimeChanged_ Server s a b
server =
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server)

-- | Return the counted total time spent by the server while it was preempted
-- waiting for the further proceeding.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverTotalPreemptionTimeChanged' and 'serverTotalPreemptionTimeChanged_'.
serverTotalPreemptionTime :: Server s a b -> Event Double
serverTotalPreemptionTime :: Server s a b -> Event Double
serverTotalPreemptionTime Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server)
  
-- | Signal when the 'serverTotalPreemptionTime' property value has changed.
serverTotalPreemptionTimeChanged :: Server s a b -> Signal Double
serverTotalPreemptionTimeChanged :: Server s a b -> Signal Double
serverTotalPreemptionTimeChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverTotalPreemptionTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverTotalPreemptionTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverTotalPreemptionTime' property value has changed.
serverTotalPreemptionTimeChanged_ :: Server s a b -> Signal ()
serverTotalPreemptionTimeChanged_ :: Server s a b -> Signal ()
serverTotalPreemptionTimeChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | Return the statistics of the time when the server was locked while awaiting the input.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverInputWaitTimeChanged' and 'serverInputWaitTimeChanged_'.
serverInputWaitTime :: Server s a b -> Event (SamplingStats Double)
serverInputWaitTime :: Server s a b -> Event (SamplingStats Double)
serverInputWaitTime Server s a b
server =
  (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (SamplingStats Double))
 -> Event (SamplingStats Double))
-> (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverInputWaitTimeRef Server s a b
server)
  
-- | Signal when the 'serverInputWaitTime' property value has changed.
serverInputWaitTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverInputWaitTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverInputWaitTimeChanged Server s a b
server =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event (SamplingStats Double)
forall s a b. Server s a b -> Event (SamplingStats Double)
serverInputWaitTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverInputWaitTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverInputWaitTime' property value has changed.
serverInputWaitTimeChanged_ :: Server s a b -> Signal ()
serverInputWaitTimeChanged_ :: Server s a b -> Signal ()
serverInputWaitTimeChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server)

-- | Return the statistics of the time spent by the server while processing the tasks.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverProcessingTimeChanged' and 'serverProcessingTimeChanged_'.
serverProcessingTime :: Server s a b -> Event (SamplingStats Double)
serverProcessingTime :: Server s a b -> Event (SamplingStats Double)
serverProcessingTime Server s a b
server =
  (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (SamplingStats Double))
 -> Event (SamplingStats Double))
-> (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverProcessingTimeRef Server s a b
server)
  
-- | Signal when the 'serverProcessingTime' property value has changed.
serverProcessingTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverProcessingTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverProcessingTimeChanged Server s a b
server =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event (SamplingStats Double)
forall s a b. Server s a b -> Event (SamplingStats Double)
serverProcessingTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverProcessingTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverProcessingTime' property value has changed.
serverProcessingTimeChanged_ :: Server s a b -> Signal ()
serverProcessingTimeChanged_ :: Server s a b -> Signal ()
serverProcessingTimeChanged_ Server s a b
server =
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server)

-- | Return the statistics of the time when the server was locked while trying
-- to deliver the output. 
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverOutputWaitTimeChanged' and 'serverOutputWaitTimeChanged_'.
serverOutputWaitTime :: Server s a b -> Event (SamplingStats Double)
serverOutputWaitTime :: Server s a b -> Event (SamplingStats Double)
serverOutputWaitTime Server s a b
server =
  (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (SamplingStats Double))
 -> Event (SamplingStats Double))
-> (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverOutputWaitTimeRef Server s a b
server)
  
-- | Signal when the 'serverOutputWaitTime' property value has changed.
serverOutputWaitTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverOutputWaitTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverOutputWaitTimeChanged Server s a b
server =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event (SamplingStats Double)
forall s a b. Server s a b -> Event (SamplingStats Double)
serverOutputWaitTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverOutputWaitTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverOutputWaitTime' property value has changed.
serverOutputWaitTimeChanged_ :: Server s a b -> Signal ()
serverOutputWaitTimeChanged_ :: Server s a b -> Signal ()
serverOutputWaitTimeChanged_ Server s a b
server =
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server)

-- | Return the statistics of the time spent by the server while it was preempted
-- waiting for the further proceeding.
--
-- The value returned changes discretely and it is usually delayed relative
-- to the current simulation time.
--
-- See also 'serverPreemptionTimeChanged' and 'serverPreemptionTimeChanged_'.
serverPreemptionTime :: Server s a b -> Event (SamplingStats Double)
serverPreemptionTime :: Server s a b -> Event (SamplingStats Double)
serverPreemptionTime Server s a b
server =
  (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (SamplingStats Double))
 -> Event (SamplingStats Double))
-> (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverPreemptionTimeRef Server s a b
server)
  
-- | Signal when the 'serverPreemptionTime' property value has changed.
serverPreemptionTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverPreemptionTimeChanged :: Server s a b -> Signal (SamplingStats Double)
serverPreemptionTimeChanged Server s a b
server =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event (SamplingStats Double) -> () -> Event (SamplingStats Double)
forall a b. a -> b -> a
const (Event (SamplingStats Double)
 -> () -> Event (SamplingStats Double))
-> Event (SamplingStats Double)
-> ()
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event (SamplingStats Double)
forall s a b. Server s a b -> Event (SamplingStats Double)
serverPreemptionTime Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverPreemptionTimeChanged_ Server s a b
server)
  
-- | Signal when the 'serverPreemptionTime' property value has changed.
serverPreemptionTimeChanged_ :: Server s a b -> Signal ()
serverPreemptionTimeChanged_ :: Server s a b -> Signal ()
serverPreemptionTimeChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | It returns the factor changing from 0 to 1, which estimates how often
-- the server was awaiting for the next input task.
--
-- This factor is calculated as
--
-- @
--   totalInputWaitTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime + totalPreemptionTime)
-- @
--
-- As before in this module, the value returned changes discretely and
-- it is usually delayed relative to the current simulation time.
--
-- See also 'serverInputWaitFactorChanged' and 'serverInputWaitFactorChanged_'.
serverInputWaitFactor :: Server s a b -> Event Double
serverInputWaitFactor :: Server s a b -> Event Double
serverInputWaitFactor Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
x1 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server)
     Double
x2 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server)
     Double
x3 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server)
     Double
x4 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server)
     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x4))
  
-- | Signal when the 'serverInputWaitFactor' property value has changed.
serverInputWaitFactorChanged :: Server s a b -> Signal Double
serverInputWaitFactorChanged :: Server s a b -> Signal Double
serverInputWaitFactorChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverInputWaitFactor Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverInputWaitFactorChanged_ Server s a b
server)
  
-- | Signal when the 'serverInputWaitFactor' property value has changed.
serverInputWaitFactorChanged_ :: Server s a b -> Signal ()
serverInputWaitFactorChanged_ :: Server s a b -> Signal ()
serverInputWaitFactorChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | It returns the factor changing from 0 to 1, which estimates how often
-- the server was busy with direct processing its tasks.
--
-- This factor is calculated as
--
-- @
--   totalProcessingTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime + totalPreemptionTime)
-- @
--
-- As before in this module, the value returned changes discretely and
-- it is usually delayed relative to the current simulation time.
--
-- See also 'serverProcessingFactorChanged' and 'serverProcessingFactorChanged_'.
serverProcessingFactor :: Server s a b -> Event Double
serverProcessingFactor :: Server s a b -> Event Double
serverProcessingFactor Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
x1 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server)
     Double
x2 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server)
     Double
x3 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server)
     Double
x4 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server)
     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x4))
  
-- | Signal when the 'serverProcessingFactor' property value has changed.
serverProcessingFactorChanged :: Server s a b -> Signal Double
serverProcessingFactorChanged :: Server s a b -> Signal Double
serverProcessingFactorChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverProcessingFactor Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverProcessingFactorChanged_ Server s a b
server)
  
-- | Signal when the 'serverProcessingFactor' property value has changed.
serverProcessingFactorChanged_ :: Server s a b -> Signal ()
serverProcessingFactorChanged_ :: Server s a b -> Signal ()
serverProcessingFactorChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | It returns the factor changing from 0 to 1, which estimates how often
-- the server was locked trying to deliver the output after the task is finished.
--
-- This factor is calculated as
--
-- @
--   totalOutputWaitTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime + totalPreemptionTime)
-- @
--
-- As before in this module, the value returned changes discretely and
-- it is usually delayed relative to the current simulation time.
--
-- See also 'serverOutputWaitFactorChanged' and 'serverOutputWaitFactorChanged_'.
serverOutputWaitFactor :: Server s a b -> Event Double
serverOutputWaitFactor :: Server s a b -> Event Double
serverOutputWaitFactor Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
x1 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server)
     Double
x2 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server)
     Double
x3 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server)
     Double
x4 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server)
     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x3 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x4))
  
-- | Signal when the 'serverOutputWaitFactor' property value has changed.
serverOutputWaitFactorChanged :: Server s a b -> Signal Double
serverOutputWaitFactorChanged :: Server s a b -> Signal Double
serverOutputWaitFactorChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverOutputWaitFactor Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverOutputWaitFactorChanged_ Server s a b
server)
  
-- | Signal when the 'serverOutputWaitFactor' property value has changed.
serverOutputWaitFactorChanged_ :: Server s a b -> Signal ()
serverOutputWaitFactorChanged_ :: Server s a b -> Signal ()
serverOutputWaitFactorChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | It returns the factor changing from 0 to 1, which estimates how often
-- the server was preempted waiting for the further proceeding.
--
-- This factor is calculated as
--
-- @
--   totalPreemptionTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime + totalPreemptionTime)
-- @
--
-- As before in this module, the value returned changes discretely and
-- it is usually delayed relative to the current simulation time.
--
-- See also 'serverPreemptionFactorChanged' and 'serverPreemptionFactorChanged_'.
serverPreemptionFactor :: Server s a b -> Event Double
serverPreemptionFactor :: Server s a b -> Event Double
serverPreemptionFactor Server s a b
server =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
x1 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server)
     Double
x2 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server)
     Double
x3 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server)
     Double
x4 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server)
     Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x4))
  
-- | Signal when the 'serverPreemptionFactor' property value has changed.
serverPreemptionFactorChanged :: Server s a b -> Signal Double
serverPreemptionFactorChanged :: Server s a b -> Signal Double
serverPreemptionFactorChanged Server s a b
server =
  (() -> Event Double) -> Signal () -> Signal Double
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (Event Double -> () -> Event Double
forall a b. a -> b -> a
const (Event Double -> () -> Event Double)
-> Event Double -> () -> Event Double
forall a b. (a -> b) -> a -> b
$ Server s a b -> Event Double
forall s a b. Server s a b -> Event Double
serverPreemptionFactor Server s a b
server) (Server s a b -> Signal ()
forall s a b. Server s a b -> Signal ()
serverPreemptionFactorChanged_ Server s a b
server)
  
-- | Signal when the 'serverPreemptionFactor' property value has changed.
serverPreemptionFactorChanged_ :: Server s a b -> Signal ()
serverPreemptionFactorChanged_ :: Server s a b -> Signal ()
serverPreemptionFactorChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | Raised when the server receives a new input task.
serverInputReceived :: Server s a b -> Signal a
serverInputReceived :: Server s a b -> Signal a
serverInputReceived = SignalSource a -> Signal a
forall a. SignalSource a -> Signal a
publishSignal (SignalSource a -> Signal a)
-> (Server s a b -> SignalSource a) -> Server s a b -> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server s a b -> SignalSource a
forall s a b. Server s a b -> SignalSource a
serverInputReceivedSource

-- | Raised when the task processing was preempted.
serverTaskPreemptionBeginning :: Server s a b -> Signal a
serverTaskPreemptionBeginning :: Server s a b -> Signal a
serverTaskPreemptionBeginning = SignalSource a -> Signal a
forall a. SignalSource a -> Signal a
publishSignal (SignalSource a -> Signal a)
-> (Server s a b -> SignalSource a) -> Server s a b -> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server s a b -> SignalSource a
forall s a b. Server s a b -> SignalSource a
serverTaskPreemptionBeginningSource

-- | Raised when the task processing was proceeded after it had been preempeted earlier.
serverTaskPreemptionEnding :: Server s a b -> Signal a
serverTaskPreemptionEnding :: Server s a b -> Signal a
serverTaskPreemptionEnding = SignalSource a -> Signal a
forall a. SignalSource a -> Signal a
publishSignal (SignalSource a -> Signal a)
-> (Server s a b -> SignalSource a) -> Server s a b -> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server s a b -> SignalSource a
forall s a b. Server s a b -> SignalSource a
serverTaskPreemptionEndingSource

-- | Raised when the server has just processed the task.
serverTaskProcessed :: Server s a b -> Signal (a, b)
serverTaskProcessed :: Server s a b -> Signal (a, b)
serverTaskProcessed = SignalSource (a, b) -> Signal (a, b)
forall a. SignalSource a -> Signal a
publishSignal (SignalSource (a, b) -> Signal (a, b))
-> (Server s a b -> SignalSource (a, b))
-> Server s a b
-> Signal (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server s a b -> SignalSource (a, b)
forall s a b. Server s a b -> SignalSource (a, b)
serverTaskProcessedSource

-- | Raised when the server has just delivered the output.
serverOutputProvided :: Server s a b -> Signal (a, b)
serverOutputProvided :: Server s a b -> Signal (a, b)
serverOutputProvided = SignalSource (a, b) -> Signal (a, b)
forall a. SignalSource a -> Signal a
publishSignal (SignalSource (a, b) -> Signal (a, b))
-> (Server s a b -> SignalSource (a, b))
-> Server s a b
-> Signal (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server s a b -> SignalSource (a, b)
forall s a b. Server s a b -> SignalSource (a, b)
serverOutputProvidedSource

-- | Signal whenever any property of the server changes.
serverChanged_ :: Server s a b -> Signal ()
serverChanged_ :: Server s a b -> Signal ()
serverChanged_ Server s a b
server =
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverInputReceived Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverTaskProcessed Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  ((a, b) -> ()) -> Signal (a, b) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> (a, b) -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal (a, b)
forall s a b. Server s a b -> Signal (a, b)
serverOutputProvided Server s a b
server) Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  (a -> ()) -> Signal a -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Server s a b -> Signal a
forall s a b. Server s a b -> Signal a
serverTaskPreemptionEnding Server s a b
server)

-- | Return the summary for the server with desciption of its
-- properties and activities using the specified indent.
serverSummary :: Server s a b -> Int -> Event ShowS
serverSummary :: Server s a b -> Int -> Event ShowS
serverSummary Server s a b
server Int
indent =
  (Point -> IO ShowS) -> Event ShowS
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ShowS) -> Event ShowS)
-> (Point -> IO ShowS) -> Event ShowS
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Double
tx1 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server)
     Double
tx2 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server)
     Double
tx3 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server)
     Double
tx4 <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server)
     let xf1 :: Double
xf1 = Double
tx1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
tx1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx4)
         xf2 :: Double
xf2 = Double
tx2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
tx1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx4)
         xf3 :: Double
xf3 = Double
tx3 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
tx1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx4)
         xf4 :: Double
xf4 = Double
tx4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
tx1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx4)
     SamplingStats Double
xs1 <- IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverInputWaitTimeRef Server s a b
server)
     SamplingStats Double
xs2 <- IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverProcessingTimeRef Server s a b
server)
     SamplingStats Double
xs3 <- IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverOutputWaitTimeRef Server s a b
server)
     SamplingStats Double
xs4 <- IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverPreemptionTimeRef Server s a b
server)
     let tab :: [Char]
tab = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
indent Char
' '
     ShowS -> IO ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> IO ShowS) -> ShowS -> IO ShowS
forall a b. (a -> b) -> a -> b
$
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"total input wait time (locked while awaiting the input) = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
tx1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"total processing time = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
tx2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"total output wait time (locked while delivering the output) = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
tx3 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"total preemption time = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
tx4 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"input wait factor (from 0 to 1) = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
xf1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"processing factor (from 0 to 1) = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
xf2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"output wait factor (from 0 to 1) = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
xf3 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"output preemption factor (from 0 to 1) = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
xf4 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"input wait time (locked while awaiting the input):\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       SamplingStats Double -> Int -> ShowS
forall a. Show a => SamplingStats a -> Int -> ShowS
samplingStatsSummary SamplingStats Double
xs1 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indent) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"processing time:\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       SamplingStats Double -> Int -> ShowS
forall a. Show a => SamplingStats a -> Int -> ShowS
samplingStatsSummary SamplingStats Double
xs2 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indent) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"output wait time (locked while delivering the output):\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       SamplingStats Double -> Int -> ShowS
forall a. Show a => SamplingStats a -> Int -> ShowS
samplingStatsSummary SamplingStats Double
xs3 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indent) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
tab ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       [Char] -> ShowS
showString [Char]
"preemption time (waiting for the proceeding after preemption):\n\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       SamplingStats Double -> Int -> ShowS
forall a. Show a => SamplingStats a -> Int -> ShowS
samplingStatsSummary SamplingStats Double
xs4 (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indent)

-- | Reset the statistics.
resetServer :: Server s a b -> Event ()
resetServer :: Server s a b -> Event ()
resetServer Server s a b
server =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalInputWaitTimeRef Server s a b
server) Double
0
     IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalProcessingTimeRef Server s a b
server) Double
0
     IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalOutputWaitTimeRef Server s a b
server) Double
0
     IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef Double
forall s a b. Server s a b -> IORef Double
serverTotalPreemptionTimeRef Server s a b
server) Double
0
     IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverInputWaitTimeRef Server s a b
server) SamplingStats Double
forall a. Monoid a => a
mempty
     IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverProcessingTimeRef Server s a b
server) SamplingStats Double
forall a. Monoid a => a
mempty
     IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverOutputWaitTimeRef Server s a b
server) SamplingStats Double
forall a. Monoid a => a
mempty
     IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server s a b -> IORef (SamplingStats Double)
forall s a b. Server s a b -> IORef (SamplingStats Double)
serverPreemptionTimeRef Server s a b
server) SamplingStats Double
forall a. Monoid a => a
mempty