{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}

-- |
-- Module     : Simulation.Aivika.Distributed.Optimistic.State
-- Copyright  : Copyright (c) 2015-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.3
--
-- This module defines the monitoring states.
--
module Simulation.Aivika.Distributed.Optimistic.State
       (LogicalProcessState(..),
        TimeServerState(..)) where

import GHC.Generics

import Data.Typeable
import Data.Binary

import qualified Control.Distributed.Process as DP
import Control.Distributed.Process.Serializable

-- | Represents the state of the logical process.
data LogicalProcessState =
  LogicalProcessState { LogicalProcessState -> ProcessId
lpStateId :: DP.ProcessId,
                        -- ^ the process identifier
                        LogicalProcessState -> String
lpStateName :: String,
                        -- ^ the process name
                        LogicalProcessState -> Double
lpStateStartTime :: Double,
                        -- ^ the start time
                        LogicalProcessState -> Double
lpStateStopTime :: Double,
                        -- ^ the stop time
                        LogicalProcessState -> Double
lpStateLocalTime :: Double,
                        -- ^ the local time of the process
                        LogicalProcessState -> Double
lpStateEventQueueTime :: Double,
                        -- ^ the event queue time of the process
                        LogicalProcessState -> Int
lpStateEventQueueSize :: Int,
                        -- ^ the event queue size
                        LogicalProcessState -> Int
lpStateLogSize :: Int,
                        -- ^ the log size of the process
                        LogicalProcessState -> Int
lpStateInputMessageCount :: Int,
                        -- ^ the count of the input messages
                        LogicalProcessState -> Int
lpStateOutputMessageCount :: Int,
                        -- ^ the count of the output messages
                        LogicalProcessState -> Int
lpStateTransientMessageCount :: Int,
                        -- ^ the count of the transient messages that did not receive an acknowledgement
                        LogicalProcessState -> Int
lpStateRollbackCount :: Int
                        -- ^ the count of rollbacks
                      } deriving (LogicalProcessState -> LogicalProcessState -> Bool
(LogicalProcessState -> LogicalProcessState -> Bool)
-> (LogicalProcessState -> LogicalProcessState -> Bool)
-> Eq LogicalProcessState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogicalProcessState -> LogicalProcessState -> Bool
== :: LogicalProcessState -> LogicalProcessState -> Bool
$c/= :: LogicalProcessState -> LogicalProcessState -> Bool
/= :: LogicalProcessState -> LogicalProcessState -> Bool
Eq, Int -> LogicalProcessState -> ShowS
[LogicalProcessState] -> ShowS
LogicalProcessState -> String
(Int -> LogicalProcessState -> ShowS)
-> (LogicalProcessState -> String)
-> ([LogicalProcessState] -> ShowS)
-> Show LogicalProcessState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicalProcessState -> ShowS
showsPrec :: Int -> LogicalProcessState -> ShowS
$cshow :: LogicalProcessState -> String
show :: LogicalProcessState -> String
$cshowList :: [LogicalProcessState] -> ShowS
showList :: [LogicalProcessState] -> ShowS
Show, Typeable, (forall x. LogicalProcessState -> Rep LogicalProcessState x)
-> (forall x. Rep LogicalProcessState x -> LogicalProcessState)
-> Generic LogicalProcessState
forall x. Rep LogicalProcessState x -> LogicalProcessState
forall x. LogicalProcessState -> Rep LogicalProcessState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogicalProcessState -> Rep LogicalProcessState x
from :: forall x. LogicalProcessState -> Rep LogicalProcessState x
$cto :: forall x. Rep LogicalProcessState x -> LogicalProcessState
to :: forall x. Rep LogicalProcessState x -> LogicalProcessState
Generic)

instance Binary LogicalProcessState

-- | Represents the state of the time server.
data TimeServerState =
  TimeServerState { TimeServerState -> ProcessId
tsStateId :: DP.ProcessId,
                    -- ^ the process identifier
                    TimeServerState -> String
tsStateName :: String,
                    -- ^ the time server name
                    TimeServerState -> Maybe Double
tsStateGlobalVirtualTime :: Maybe Double,
                    -- ^ the global virtual time
                    TimeServerState -> [ProcessId]
tsStateLogicalProcesses :: [DP.ProcessId]
                    -- ^ the registered logical process identifiers
                  } deriving (TimeServerState -> TimeServerState -> Bool
(TimeServerState -> TimeServerState -> Bool)
-> (TimeServerState -> TimeServerState -> Bool)
-> Eq TimeServerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeServerState -> TimeServerState -> Bool
== :: TimeServerState -> TimeServerState -> Bool
$c/= :: TimeServerState -> TimeServerState -> Bool
/= :: TimeServerState -> TimeServerState -> Bool
Eq, Int -> TimeServerState -> ShowS
[TimeServerState] -> ShowS
TimeServerState -> String
(Int -> TimeServerState -> ShowS)
-> (TimeServerState -> String)
-> ([TimeServerState] -> ShowS)
-> Show TimeServerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeServerState -> ShowS
showsPrec :: Int -> TimeServerState -> ShowS
$cshow :: TimeServerState -> String
show :: TimeServerState -> String
$cshowList :: [TimeServerState] -> ShowS
showList :: [TimeServerState] -> ShowS
Show, Typeable, (forall x. TimeServerState -> Rep TimeServerState x)
-> (forall x. Rep TimeServerState x -> TimeServerState)
-> Generic TimeServerState
forall x. Rep TimeServerState x -> TimeServerState
forall x. TimeServerState -> Rep TimeServerState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeServerState -> Rep TimeServerState x
from :: forall x. TimeServerState -> Rep TimeServerState x
$cto :: forall x. Rep TimeServerState x -> TimeServerState
to :: forall x. Rep TimeServerState x -> TimeServerState
Generic)

instance Binary TimeServerState