content: 
  -- |
  -- 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 { serverInitState :: s,
             -- ^ The initial state of the server.
             serverStateRef :: IORef s,
             -- ^ The current state of the server.
             serverProcess :: s -> a -> Process (s, b),
             -- ^ Provide @b@ by specified @a@.
             serverProcessPreemptible :: Bool,
             -- ^ Whether the process can be preempted.
             serverTotalInputWaitTimeRef :: IORef Double,
             -- ^ The counted total time spent in awating the input.
             serverTotalProcessingTimeRef :: IORef Double,
             -- ^ The counted total time spent to process the input and prepare the output.
             serverTotalOutputWaitTimeRef :: IORef Double,
             -- ^ The counted total time spent for delivering the output.
             serverTotalPreemptionTimeRef :: IORef Double,
             -- ^ The counted total time spent being preempted and waiting for the proceeding. 
             serverInputWaitTimeRef :: IORef (SamplingStats Double),
             -- ^ The statistics for the time spent in awaiting the input.
             serverProcessingTimeRef :: IORef (SamplingStats Double),
             -- ^ The statistics for the time spent to process the input and prepare the output.
             serverOutputWaitTimeRef :: IORef (SamplingStats Double),
             -- ^ The statistics for the time spent for delivering the output.
             serverPreemptionTimeRef :: IORef (SamplingStats Double),
             -- ^ The statistics for the time spent being preempted.
             serverInputReceivedSource :: SignalSource a,
             -- ^ A signal raised when the server recieves a new input to process.
             serverTaskPreemptionBeginningSource :: SignalSource a,
             -- ^ A signal raised when the task was preempted.
             serverTaskPreemptionEndingSource :: SignalSource a,
             -- ^ A signal raised when the task was proceeded after it had been preempted earlier.
             serverTaskProcessedSource :: SignalSource (a, b),
             -- ^ A signal raised when the input is processed and
             -- the output is prepared for deliverying.
             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 = newPreemptibleServer 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 = newPreemptibleStateServer 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 preemptible provide =
    flip (newPreemptibleStateServer preemptible) () $ \s a ->
    do b <- provide a
       return (s, 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 preemptible provide state =
    do r0 <- liftIO $ newIORef state
       r1 <- liftIO $ newIORef 0
       r2 <- liftIO $ newIORef 0
       r3 <- liftIO $ newIORef 0
       r4 <- liftIO $ newIORef 0
       r5 <- liftIO $ newIORef emptySamplingStats
       r6 <- liftIO $ newIORef emptySamplingStats
       r7 <- liftIO $ newIORef emptySamplingStats
       r8 <- liftIO $ newIORef emptySamplingStats
       s1 <- newSignalSource
       s2 <- newSignalSource
       s3 <- newSignalSource
       s4 <- newSignalSource
       s5 <- newSignalSource
       let server = Server { serverInitState = state,
                             serverStateRef = r0,
                             serverProcess = provide,
                             serverProcessPreemptible = preemptible,
                             serverTotalInputWaitTimeRef = r1,
                             serverTotalProcessingTimeRef = r2,
                             serverTotalOutputWaitTimeRef = r3,
                             serverTotalPreemptionTimeRef = r4,
                             serverInputWaitTimeRef = r5,
                             serverProcessingTimeRef = r6,
                             serverOutputWaitTimeRef = r7,
                             serverPreemptionTimeRef = r8,
                             serverInputReceivedSource = s1,
                             serverTaskPreemptionBeginningSource = s2,
                             serverTaskPreemptionEndingSource = s3,
                             serverTaskProcessedSource = s4,
                             serverOutputProvidedSource = s5 }
       return 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 =
    Processor $ \xs -> loop (serverInitState server) Nothing xs
    where
      loop s r xs =
        Cons $
        do t0 <- liftDynamics time
           liftEvent $
             case r of
               Nothing -> return ()
               Just (t', a', b') ->
                 do liftIO $
                      do modifyIORef' (serverTotalOutputWaitTimeRef server) (+ (t0 - t'))
                         modifyIORef' (serverOutputWaitTimeRef server) $
                           addSamplingStats (t0 - t')
                    triggerSignal (serverOutputProvidedSource server) (a', b')
           -- get input
           (a, xs') <- runStream xs
           t1 <- liftDynamics time
           liftEvent $
             do liftIO $
                  do modifyIORef' (serverTotalInputWaitTimeRef server) (+ (t1 - t0))
                     modifyIORef' (serverInputWaitTimeRef server) $
                       addSamplingStats (t1 - t0)
                triggerSignal (serverInputReceivedSource server) a
           -- provide the service
           (s', b, dt) <-
             if serverProcessPreemptible server
             then serverProcessPreempting server s a
             else do (s', b) <- serverProcess server s a
                     return (s', b, 0)
           t2 <- liftDynamics time
           liftEvent $
             do liftIO $
                  do writeIORef (serverStateRef server) $! s'
                     modifyIORef' (serverTotalProcessingTimeRef server) (+ (t2 - t1 - dt))
                     modifyIORef' (serverProcessingTimeRef server) $
                       addSamplingStats (t2 - t1 - dt)
                triggerSignal (serverTaskProcessedSource server) (a, b)
           return (b, loop s' (Just (t2, a, b)) 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 =
    do pid <- processId
       t1  <- liftDynamics time
       rs  <- liftIO $ newIORef 0
       r1  <- liftIO $ newIORef t1
       h1  <- liftEvent $
              handleSignal (processPreemptionBeginning pid) $ \() ->
              do t1 <- liftDynamics time
                 liftIO $ writeIORef r1 t1
                 triggerSignal (serverTaskPreemptionBeginningSource server) a
       h2  <- liftEvent $
              handleSignal (processPreemptionEnding pid) $ \() ->
              do t1 <- liftIO $ readIORef r1
                 t2 <- liftDynamics time
                 let dt = t2 - t1
                 liftIO $
                   do modifyIORef' rs (+ dt)
                      modifyIORef' (serverTotalPreemptionTimeRef server) (+ dt)
                      modifyIORef' (serverPreemptionTimeRef server) $
                        addSamplingStats dt
                 triggerSignal (serverTaskPreemptionEndingSource server) a 
       let m1 =
             do (s', b) <- serverProcess server s a
                dt <- liftIO $ readIORef rs
                return (s', b, dt)
           m2 =
             liftEvent $
             do disposeEvent h1
                disposeEvent h2
       finallyProcess m1 m2
  
  -- | Return the current state of the server.
  --
  -- See also 'serverStateChanged' and 'serverStateChanged_'.
  serverState :: Server s a b -> Event s
  serverState server =
    Event $ \p -> readIORef (serverStateRef server)
    
  -- | Signal when the 'serverState' property value has changed.
  serverStateChanged :: Server s a b -> Signal s
  serverStateChanged server =
    mapSignalM (const $ serverState server) (serverStateChanged_ server)
    
  -- | Signal when the 'serverState' property value has changed.
  serverStateChanged_ :: Server s a b -> Signal ()
  serverStateChanged_ server =
    mapSignal (const ()) (serverTaskProcessed 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 =
    Event $ \p -> readIORef (serverTotalInputWaitTimeRef server)
    
  -- | Signal when the 'serverTotalInputWaitTime' property value has changed.
  serverTotalInputWaitTimeChanged :: Server s a b -> Signal Double
  serverTotalInputWaitTimeChanged server =
    mapSignalM (const $ serverTotalInputWaitTime server) (serverTotalInputWaitTimeChanged_ server)
    
  -- | Signal when the 'serverTotalInputWaitTime' property value has changed.
  serverTotalInputWaitTimeChanged_ :: Server s a b -> Signal ()
  serverTotalInputWaitTimeChanged_ server =
    mapSignal (const ()) (serverInputReceived 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 =
    Event $ \p -> readIORef (serverTotalProcessingTimeRef server)
    
  -- | Signal when the 'serverTotalProcessingTime' property value has changed.
  serverTotalProcessingTimeChanged :: Server s a b -> Signal Double
  serverTotalProcessingTimeChanged server =
    mapSignalM (const $ serverTotalProcessingTime server) (serverTotalProcessingTimeChanged_ server)
    
  -- | Signal when the 'serverTotalProcessingTime' property value has changed.
  serverTotalProcessingTimeChanged_ :: Server s a b -> Signal ()
  serverTotalProcessingTimeChanged_ server =
    mapSignal (const ()) (serverTaskProcessed 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 =
    Event $ \p -> readIORef (serverTotalOutputWaitTimeRef server)
    
  -- | Signal when the 'serverTotalOutputWaitTime' property value has changed.
  serverTotalOutputWaitTimeChanged :: Server s a b -> Signal Double
  serverTotalOutputWaitTimeChanged server =
    mapSignalM (const $ serverTotalOutputWaitTime server) (serverTotalOutputWaitTimeChanged_ server)
    
  -- | Signal when the 'serverTotalOutputWaitTime' property value has changed.
  serverTotalOutputWaitTimeChanged_ :: Server s a b -> Signal ()
  serverTotalOutputWaitTimeChanged_ server =
    mapSignal (const ()) (serverOutputProvided 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 =
    Event $ \p -> readIORef (serverTotalPreemptionTimeRef server)
    
  -- | Signal when the 'serverTotalPreemptionTime' property value has changed.
  serverTotalPreemptionTimeChanged :: Server s a b -> Signal Double
  serverTotalPreemptionTimeChanged server =
    mapSignalM (const $ serverTotalPreemptionTime server) (serverTotalPreemptionTimeChanged_ server)
    
  -- | Signal when the 'serverTotalPreemptionTime' property value has changed.
  serverTotalPreemptionTimeChanged_ :: Server s a b -> Signal ()
  serverTotalPreemptionTimeChanged_ server =
    mapSignal (const ()) (serverTaskPreemptionEnding 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 =
    Event $ \p -> readIORef (serverInputWaitTimeRef server)
    
  -- | Signal when the 'serverInputWaitTime' property value has changed.
  serverInputWaitTimeChanged :: Server s a b -> Signal (SamplingStats Double)
  serverInputWaitTimeChanged server =
    mapSignalM (const $ serverInputWaitTime server) (serverInputWaitTimeChanged_ server)
    
  -- | Signal when the 'serverInputWaitTime' property value has changed.
  serverInputWaitTimeChanged_ :: Server s a b -> Signal ()
  serverInputWaitTimeChanged_ server =
    mapSignal (const ()) (serverInputReceived 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 =
    Event $ \p -> readIORef (serverProcessingTimeRef server)
    
  -- | Signal when the 'serverProcessingTime' property value has changed.
  serverProcessingTimeChanged :: Server s a b -> Signal (SamplingStats Double)
  serverProcessingTimeChanged server =
    mapSignalM (const $ serverProcessingTime server) (serverProcessingTimeChanged_ server)
    
  -- | Signal when the 'serverProcessingTime' property value has changed.
  serverProcessingTimeChanged_ :: Server s a b -> Signal ()
  serverProcessingTimeChanged_ server =
    mapSignal (const ()) (serverTaskProcessed 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 =
    Event $ \p -> readIORef (serverOutputWaitTimeRef server)
    
  -- | Signal when the 'serverOutputWaitTime' property value has changed.
  serverOutputWaitTimeChanged :: Server s a b -> Signal (SamplingStats Double)
  serverOutputWaitTimeChanged server =
    mapSignalM (const $ serverOutputWaitTime server) (serverOutputWaitTimeChanged_ server)
    
  -- | Signal when the 'serverOutputWaitTime' property value has changed.
  serverOutputWaitTimeChanged_ :: Server s a b -> Signal ()
  serverOutputWaitTimeChanged_ server =
    mapSignal (const ()) (serverOutputProvided 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 =
    Event $ \p -> readIORef (serverPreemptionTimeRef server)
    
  -- | Signal when the 'serverPreemptionTime' property value has changed.
  serverPreemptionTimeChanged :: Server s a b -> Signal (SamplingStats Double)
  serverPreemptionTimeChanged server =
    mapSignalM (const $ serverPreemptionTime server) (serverPreemptionTimeChanged_ server)
    
  -- | Signal when the 'serverPreemptionTime' property value has changed.
  serverPreemptionTimeChanged_ :: Server s a b -> Signal ()
  serverPreemptionTimeChanged_ server =
    mapSignal (const ()) (serverTaskPreemptionEnding 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 =
    Event $ \p ->
    do x1 <- readIORef (serverTotalInputWaitTimeRef server)
       x2 <- readIORef (serverTotalProcessingTimeRef server)
       x3 <- readIORef (serverTotalOutputWaitTimeRef server)
       x4 <- readIORef (serverTotalPreemptionTimeRef server)
       return (x1 / (x1 + x2 + x3 + x4))
    
  -- | Signal when the 'serverInputWaitFactor' property value has changed.
  serverInputWaitFactorChanged :: Server s a b -> Signal Double
  serverInputWaitFactorChanged server =
    mapSignalM (const $ serverInputWaitFactor server) (serverInputWaitFactorChanged_ server)
    
  -- | Signal when the 'serverInputWaitFactor' property value has changed.
  serverInputWaitFactorChanged_ :: Server s a b -> Signal ()
  serverInputWaitFactorChanged_ server =
    mapSignal (const ()) (serverInputReceived server) <>
    mapSignal (const ()) (serverTaskProcessed server) <>
    mapSignal (const ()) (serverOutputProvided server) <>
    mapSignal (const ()) (serverTaskPreemptionEnding 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 =
    Event $ \p ->
    do x1 <- readIORef (serverTotalInputWaitTimeRef server)
       x2 <- readIORef (serverTotalProcessingTimeRef server)
       x3 <- readIORef (serverTotalOutputWaitTimeRef server)
       x4 <- readIORef (serverTotalPreemptionTimeRef server)
       return (x2 / (x1 + x2 + x3 + x4))
    
  -- | Signal when the 'serverProcessingFactor' property value has changed.
  serverProcessingFactorChanged :: Server s a b -> Signal Double
  serverProcessingFactorChanged server =
    mapSignalM (const $ serverProcessingFactor server) (serverProcessingFactorChanged_ server)
    
  -- | Signal when the 'serverProcessingFactor' property value has changed.
  serverProcessingFactorChanged_ :: Server s a b -> Signal ()
  serverProcessingFactorChanged_ server =
    mapSignal (const ()) (serverInputReceived server) <>
    mapSignal (const ()) (serverTaskProcessed server) <>
    mapSignal (const ()) (serverOutputProvided server) <>
    mapSignal (const ()) (serverTaskPreemptionEnding 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 =
    Event $ \p ->
    do x1 <- readIORef (serverTotalInputWaitTimeRef server)
       x2 <- readIORef (serverTotalProcessingTimeRef server)
       x3 <- readIORef (serverTotalOutputWaitTimeRef server)
       x4 <- readIORef (serverTotalPreemptionTimeRef server)
       return (x3 / (x1 + x2 + x3 + x4))
    
  -- | Signal when the 'serverOutputWaitFactor' property value has changed.
  serverOutputWaitFactorChanged :: Server s a b -> Signal Double
  serverOutputWaitFactorChanged server =
    mapSignalM (const $ serverOutputWaitFactor server) (serverOutputWaitFactorChanged_ server)
    
  -- | Signal when the 'serverOutputWaitFactor' property value has changed.
  serverOutputWaitFactorChanged_ :: Server s a b -> Signal ()
  serverOutputWaitFactorChanged_ server =
    mapSignal (const ()) (serverInputReceived server) <>
    mapSignal (const ()) (serverTaskProcessed server) <>
    mapSignal (const ()) (serverOutputProvided server) <>
    mapSignal (const ()) (serverTaskPreemptionEnding 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 =
    Event $ \p ->
    do x1 <- readIORef (serverTotalInputWaitTimeRef server)
       x2 <- readIORef (serverTotalProcessingTimeRef server)
       x3 <- readIORef (serverTotalOutputWaitTimeRef server)
       x4 <- readIORef (serverTotalPreemptionTimeRef server)
       return (x4 / (x1 + x2 + x3 + x4))
    
  -- | Signal when the 'serverPreemptionFactor' property value has changed.
  serverPreemptionFactorChanged :: Server s a b -> Signal Double
  serverPreemptionFactorChanged server =
    mapSignalM (const $ serverPreemptionFactor server) (serverPreemptionFactorChanged_ server)
    
  -- | Signal when the 'serverPreemptionFactor' property value has changed.
  serverPreemptionFactorChanged_ :: Server s a b -> Signal ()
  serverPreemptionFactorChanged_ server =
    mapSignal (const ()) (serverInputReceived server) <>
    mapSignal (const ()) (serverTaskProcessed server) <>
    mapSignal (const ()) (serverOutputProvided server) <>
    mapSignal (const ()) (serverTaskPreemptionEnding server)
  
  -- | Raised when the server receives a new input task.
  serverInputReceived :: Server s a b -> Signal a
  serverInputReceived = publishSignal . serverInputReceivedSource
  
  -- | Raised when the task processing was preempted.
  serverTaskPreemptionBeginning :: Server s a b -> Signal a
  serverTaskPreemptionBeginning = publishSignal . serverTaskPreemptionBeginningSource
  
  -- | Raised when the task processing was proceeded after it had been preempeted earlier.
  serverTaskPreemptionEnding :: Server s a b -> Signal a
  serverTaskPreemptionEnding = publishSignal . serverTaskPreemptionEndingSource
  
  -- | Raised when the server has just processed the task.
  serverTaskProcessed :: Server s a b -> Signal (a, b)
  serverTaskProcessed = publishSignal . serverTaskProcessedSource
  
  -- | Raised when the server has just delivered the output.
  serverOutputProvided :: Server s a b -> Signal (a, b)
  serverOutputProvided = publishSignal . serverOutputProvidedSource
  
  -- | Signal whenever any property of the server changes.
  serverChanged_ :: Server s a b -> Signal ()
  serverChanged_ server =
    mapSignal (const ()) (serverInputReceived server) <>
    mapSignal (const ()) (serverTaskProcessed server) <>
    mapSignal (const ()) (serverOutputProvided server) <>
    mapSignal (const ()) (serverTaskPreemptionEnding 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 indent =
    Event $ \p ->
    do tx1 <- readIORef (serverTotalInputWaitTimeRef server)
       tx2 <- readIORef (serverTotalProcessingTimeRef server)
       tx3 <- readIORef (serverTotalOutputWaitTimeRef server)
       tx4 <- readIORef (serverTotalPreemptionTimeRef server)
       let xf1 = tx1 / (tx1 + tx2 + tx3 + tx4)
           xf2 = tx2 / (tx1 + tx2 + tx3 + tx4)
           xf3 = tx3 / (tx1 + tx2 + tx3 + tx4)
           xf4 = tx4 / (tx1 + tx3 + tx3 + tx4)
       xs1 <- readIORef (serverInputWaitTimeRef server)
       xs2 <- readIORef (serverProcessingTimeRef server)
       xs3 <- readIORef (serverOutputWaitTimeRef server)
       xs4 <- readIORef (serverPreemptionTimeRef server)
       let tab = replicate indent ' '
       return $
         showString tab .
         showString "total input wait time (locked while awaiting the input) = " . shows tx1 .
         showString "\n" .
         showString tab .
         showString "total processing time = " . shows tx2 .
         showString "\n" .
         showString tab .
         showString "total output wait time (locked while delivering the output) = " . shows tx3 .
         showString "\n\n" .
         showString tab .
         showString "total preemption time = " . shows tx4 .
         showString "\n" .
         showString tab .
         showString "input wait factor (from 0 to 1) = " . shows xf1 .
         showString "\n" .
         showString tab .
         showString "processing factor (from 0 to 1) = " . shows xf2 .
         showString "\n" .
         showString tab .
         showString "output wait factor (from 0 to 1) = " . shows xf3 .
         showString "\n\n" .
         showString tab .
         showString "output preemption factor (from 0 to 1) = " . shows xf4 .
         showString "\n\n" .
         showString tab .
         showString "input wait time (locked while awaiting the input):\n\n" .
         samplingStatsSummary xs1 (2 + indent) .
         showString "\n\n" .
         showString tab .
         showString "processing time:\n\n" .
         samplingStatsSummary xs2 (2 + indent) .
         showString "\n\n" .
         showString tab .
         showString "output wait time (locked while delivering the output):\n\n" .
         samplingStatsSummary xs3 (2 + indent) .
         showString "\n\n" .
         showString tab .
         showString "preemption time (waiting for the proceeding after preemption):\n\n" .
         samplingStatsSummary xs4 (2 + indent)
  
  -- | Reset the statistics.
  resetServer :: Server s a b -> Event ()
  resetServer server =
    Event $ \p ->
    do writeIORef (serverTotalInputWaitTimeRef server) 0
       writeIORef (serverTotalProcessingTimeRef server) 0
       writeIORef (serverTotalOutputWaitTimeRef server) 0
       writeIORef (serverTotalPreemptionTimeRef server) 0
       writeIORef (serverInputWaitTimeRef server) mempty
       writeIORef (serverProcessingTimeRef server) mempty
       writeIORef (serverOutputWaitTimeRef server) mempty
       writeIORef (serverPreemptionTimeRef server) mempty
  