-- |
-- Module     : Simulation.Aivika.GPSS.Results
-- Copyright  : Copyright (c) 2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.2
--
-- The module allows exporting the simulation results from the model.
--
module Simulation.Aivika.GPSS.Results () where

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika

import qualified Simulation.Aivika.GPSS.Queue as Q
import Simulation.Aivika.GPSS.Facility
import Simulation.Aivika.GPSS.Storage
import Simulation.Aivika.GPSS.Results.Locale
  
-- | Return a source by the specified queue.
queueResultSource :: ResultContainer Q.Queue
                     -- ^ the queue container
                     -> ResultSource
queueResultSource :: ResultContainer Queue -> ResultSource
queueResultSource ResultContainer Queue
c =
  ResultObject -> ResultSource
ResultObjectSource (ResultObject -> ResultSource) -> ResultObject -> ResultSource
forall a b. (a -> b) -> a -> b
$
  ResultObject :: ResultName
-> ResultId
-> ResultId
-> [ResultProperty]
-> ResultSignal
-> ResultSource
-> ResultObject
ResultObject {
    resultObjectName :: ResultName
resultObjectName = ResultContainer Queue -> ResultName
forall e. ResultContainer e -> ResultName
resultContainerName ResultContainer Queue
c,
    resultObjectId :: ResultId
resultObjectId = ResultContainer Queue -> ResultId
forall e. ResultContainer e -> ResultId
resultContainerId ResultContainer Queue
c,
    resultObjectTypeId :: ResultId
resultObjectTypeId = ResultId
queueId,
    resultObjectSignal :: ResultSignal
resultObjectSignal = ResultContainer Queue -> ResultSignal
forall e. ResultContainer e -> ResultSignal
resultContainerSignal ResultContainer Queue
c,
    resultObjectSummary :: ResultSource
resultObjectSummary = ResultContainer Queue -> ResultSource
queueResultSummary ResultContainer Queue
c,
    resultObjectProperties :: [ResultProperty]
resultObjectProperties = [
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Bool)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueNull" ResultId
queueNullId Queue -> Event Bool
Q.queueNull Queue -> Signal ()
Q.queueNullChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Int)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueContent" ResultId
queueContentId Queue -> Event Int
Q.queueContent Queue -> Signal ()
Q.queueContentChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event (TimingStats Int))
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueContentStats" ResultId
queueContentStatsId Queue -> Event (TimingStats Int)
Q.queueContentStats Queue -> Signal ()
Q.queueContentChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Int)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"enqueueCount" ResultId
enqueueCountId Queue -> Event Int
Q.enqueueCount Queue -> Signal ()
Q.enqueueCountChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Int)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"enqueueZeroEntryCount" ResultId
enqueueZeroEntryCountId Queue -> Event Int
Q.enqueueZeroEntryCount Queue -> Signal ()
Q.enqueueZeroEntryCountChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event (SamplingStats Double))
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueWaitTime" ResultId
queueWaitTimeId Queue -> Event (SamplingStats Double)
Q.queueWaitTime Queue -> Signal ()
Q.queueWaitTimeChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event (SamplingStats Double))
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueNonZeroEntryWaitTime" ResultId
queueNonZeroEntryWaitTimeId Queue -> Event (SamplingStats Double)
Q.queueNonZeroEntryWaitTime Queue -> Signal ()
Q.queueNonZeroEntryWaitTimeChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Double)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueRate" ResultId
queueRateId Queue -> Event Double
Q.queueRate Queue -> Signal ()
Q.queueRateChanged_ ] }

-- | Return the summary by the specified queue.
queueResultSummary :: ResultContainer Q.Queue
                      -- ^ the queue container
                      -> ResultSource
queueResultSummary :: ResultContainer Queue -> ResultSource
queueResultSummary ResultContainer Queue
c =
  ResultObject -> ResultSource
ResultObjectSource (ResultObject -> ResultSource) -> ResultObject -> ResultSource
forall a b. (a -> b) -> a -> b
$
  ResultObject :: ResultName
-> ResultId
-> ResultId
-> [ResultProperty]
-> ResultSignal
-> ResultSource
-> ResultObject
ResultObject {
    resultObjectName :: ResultName
resultObjectName = ResultContainer Queue -> ResultName
forall e. ResultContainer e -> ResultName
resultContainerName ResultContainer Queue
c,
    resultObjectId :: ResultId
resultObjectId = ResultContainer Queue -> ResultId
forall e. ResultContainer e -> ResultId
resultContainerId ResultContainer Queue
c,
    resultObjectTypeId :: ResultId
resultObjectTypeId = ResultId
queueId,
    resultObjectSignal :: ResultSignal
resultObjectSignal = ResultContainer Queue -> ResultSignal
forall e. ResultContainer e -> ResultSignal
resultContainerSignal ResultContainer Queue
c,
    resultObjectSummary :: ResultSource
resultObjectSummary = ResultContainer Queue -> ResultSource
queueResultSummary ResultContainer Queue
c,
    resultObjectProperties :: [ResultProperty]
resultObjectProperties = [
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event (TimingStats Int))
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueContentStats" ResultId
queueContentStatsId Queue -> Event (TimingStats Int)
Q.queueContentStats Queue -> Signal ()
Q.queueContentChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Int)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"enqueueCount" ResultId
enqueueCountId Queue -> Event Int
Q.enqueueCount Queue -> Signal ()
Q.enqueueCountChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Int)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"enqueueZeroEntryCount" ResultId
enqueueZeroEntryCountId Queue -> Event Int
Q.enqueueZeroEntryCount Queue -> Signal ()
Q.enqueueZeroEntryCountChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event (SamplingStats Double))
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueWaitTime" ResultId
queueWaitTimeId Queue -> Event (SamplingStats Double)
Q.queueWaitTime Queue -> Signal ()
Q.queueWaitTimeChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event (SamplingStats Double))
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueNonZeroEntryWaitTime" ResultId
queueNonZeroEntryWaitTimeId Queue -> Event (SamplingStats Double)
Q.queueNonZeroEntryWaitTime Queue -> Signal ()
Q.queueNonZeroEntryWaitTimeChanged_,
      ResultContainer Queue
-> ResultName
-> ResultId
-> (Queue -> Event Double)
-> (Queue -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Queue
c ResultName
"queueRate" ResultId
queueRateId Queue -> Event Double
Q.queueRate Queue -> Signal ()
Q.queueRateChanged_ ] }

-- | Return a source by the specified facility.
facilityResultSource :: ResultContainer (Facility a)
                        -- ^ the facility container
                        -> ResultSource
facilityResultSource :: ResultContainer (Facility a) -> ResultSource
facilityResultSource ResultContainer (Facility a)
c =
  ResultObject -> ResultSource
ResultObjectSource (ResultObject -> ResultSource) -> ResultObject -> ResultSource
forall a b. (a -> b) -> a -> b
$
  ResultObject :: ResultName
-> ResultId
-> ResultId
-> [ResultProperty]
-> ResultSignal
-> ResultSource
-> ResultObject
ResultObject {
    resultObjectName :: ResultName
resultObjectName = ResultContainer (Facility a) -> ResultName
forall e. ResultContainer e -> ResultName
resultContainerName ResultContainer (Facility a)
c,
    resultObjectId :: ResultId
resultObjectId = ResultContainer (Facility a) -> ResultId
forall e. ResultContainer e -> ResultId
resultContainerId ResultContainer (Facility a)
c,
    resultObjectTypeId :: ResultId
resultObjectTypeId = ResultId
facilityId,
    resultObjectSignal :: ResultSignal
resultObjectSignal = ResultContainer (Facility a) -> ResultSignal
forall e. ResultContainer e -> ResultSignal
resultContainerSignal ResultContainer (Facility a)
c,
    resultObjectSummary :: ResultSource
resultObjectSummary = ResultContainer (Facility a) -> ResultSource
forall a. ResultContainer (Facility a) -> ResultSource
facilityResultSummary ResultContainer (Facility a)
c,
    resultObjectProperties :: [ResultProperty]
resultObjectProperties = [
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Int)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"queueCount" ResultId
facilityQueueCountId Facility a -> Event Int
forall a. Facility a -> Event Int
facilityQueueCount Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityQueueCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (TimingStats Int))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"queueCountStats" ResultId
facilityQueueCountStatsId Facility a -> Event (TimingStats Int)
forall a. Facility a -> Event (TimingStats Int)
facilityQueueCountStats Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityQueueCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Double)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"totalWaitTime" ResultId
facilityTotalWaitTimeId Facility a -> Event Double
forall a. Facility a -> Event Double
facilityTotalWaitTime Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityWaitTimeChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (SamplingStats Double))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"waitTime" ResultId
facilityWaitTimeId Facility a -> Event (SamplingStats Double)
forall a. Facility a -> Event (SamplingStats Double)
facilityWaitTime Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityWaitTimeChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Double)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"totalHoldingTime" ResultId
facilityTotalHoldingTimeId Facility a -> Event Double
forall a. Facility a -> Event Double
facilityTotalHoldingTime Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityHoldingTimeChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (SamplingStats Double))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"holdingTime" ResultId
facilityHoldingTimeId Facility a -> Event (SamplingStats Double)
forall a. Facility a -> Event (SamplingStats Double)
facilityHoldingTime Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityHoldingTimeChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Bool)
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> Event b) -> ResultProperty
resultContainerIntegProperty ResultContainer (Facility a)
c ResultName
"interrupted" ResultId
facilityInterruptedId Facility a -> Event Bool
forall a. Facility a -> Event Bool
facilityInterrupted,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Int)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"count" ResultId
facilityCountId Facility a -> Event Int
forall a. Facility a -> Event Int
facilityCount Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (TimingStats Int))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"countStats" ResultId
facilityCountStatsId Facility a -> Event (TimingStats Int)
forall a. Facility a -> Event (TimingStats Int)
facilityCountStats Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Int)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"captureCount" ResultId
facilityCaptureCountId Facility a -> Event Int
forall a. Facility a -> Event Int
facilityCaptureCount Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityCaptureCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Int)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"utilisationCount" ResultId
facilityUtilisationCountId Facility a -> Event Int
forall a. Facility a -> Event Int
facilityUtilisationCount Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityUtilisationCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (TimingStats Int))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"utilisationCountStats" ResultId
facilityUtilisationCountStatsId Facility a -> Event (TimingStats Int)
forall a. Facility a -> Event (TimingStats Int)
facilityUtilisationCountStats Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityUtilisationCountChanged_ ] }

-- | Return a summary by the specified facility.
facilityResultSummary :: ResultContainer (Facility a)
                         -- ^ the facility container
                         -> ResultSource
facilityResultSummary :: ResultContainer (Facility a) -> ResultSource
facilityResultSummary ResultContainer (Facility a)
c =
  ResultObject -> ResultSource
ResultObjectSource (ResultObject -> ResultSource) -> ResultObject -> ResultSource
forall a b. (a -> b) -> a -> b
$
  ResultObject :: ResultName
-> ResultId
-> ResultId
-> [ResultProperty]
-> ResultSignal
-> ResultSource
-> ResultObject
ResultObject {
    resultObjectName :: ResultName
resultObjectName = ResultContainer (Facility a) -> ResultName
forall e. ResultContainer e -> ResultName
resultContainerName ResultContainer (Facility a)
c,
    resultObjectId :: ResultId
resultObjectId = ResultContainer (Facility a) -> ResultId
forall e. ResultContainer e -> ResultId
resultContainerId ResultContainer (Facility a)
c,
    resultObjectTypeId :: ResultId
resultObjectTypeId = ResultId
facilityId,
    resultObjectSignal :: ResultSignal
resultObjectSignal = ResultContainer (Facility a) -> ResultSignal
forall e. ResultContainer e -> ResultSignal
resultContainerSignal ResultContainer (Facility a)
c,
    resultObjectSummary :: ResultSource
resultObjectSummary = ResultContainer (Facility a) -> ResultSource
forall a. ResultContainer (Facility a) -> ResultSource
facilityResultSummary ResultContainer (Facility a)
c,
    resultObjectProperties :: [ResultProperty]
resultObjectProperties = [
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (TimingStats Int))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"queueCountStats" ResultId
facilityQueueCountStatsId Facility a -> Event (TimingStats Int)
forall a. Facility a -> Event (TimingStats Int)
facilityQueueCountStats Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityQueueCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (SamplingStats Double))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"waitTime" ResultId
facilityWaitTimeId Facility a -> Event (SamplingStats Double)
forall a. Facility a -> Event (SamplingStats Double)
facilityWaitTime Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityWaitTimeChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (SamplingStats Double))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"holdingTime" ResultId
facilityHoldingTimeId Facility a -> Event (SamplingStats Double)
forall a. Facility a -> Event (SamplingStats Double)
facilityHoldingTime Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityHoldingTimeChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (TimingStats Int))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"countStats" ResultId
facilityCountStatsId Facility a -> Event (TimingStats Int)
forall a. Facility a -> Event (TimingStats Int)
facilityCountStats Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event Int)
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"captureCount" ResultId
facilityCaptureCountId Facility a -> Event Int
forall a. Facility a -> Event Int
facilityCaptureCount Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityCaptureCountChanged_,
      ResultContainer (Facility a)
-> ResultName
-> ResultId
-> (Facility a -> Event (TimingStats Int))
-> (Facility a -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer (Facility a)
c ResultName
"utilisationCountStats" ResultId
facilityUtilisationCountStatsId Facility a -> Event (TimingStats Int)
forall a. Facility a -> Event (TimingStats Int)
facilityUtilisationCountStats Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityUtilisationCountChanged_ ] }

-- | Return a source by the specified storage.
storageResultSource :: ResultContainer Storage
                       -- ^ the storage container
                       -> ResultSource
storageResultSource :: ResultContainer Storage -> ResultSource
storageResultSource ResultContainer Storage
c =
  ResultObject -> ResultSource
ResultObjectSource (ResultObject -> ResultSource) -> ResultObject -> ResultSource
forall a b. (a -> b) -> a -> b
$
  ResultObject :: ResultName
-> ResultId
-> ResultId
-> [ResultProperty]
-> ResultSignal
-> ResultSource
-> ResultObject
ResultObject {
    resultObjectName :: ResultName
resultObjectName = ResultContainer Storage -> ResultName
forall e. ResultContainer e -> ResultName
resultContainerName ResultContainer Storage
c,
    resultObjectId :: ResultId
resultObjectId = ResultContainer Storage -> ResultId
forall e. ResultContainer e -> ResultId
resultContainerId ResultContainer Storage
c,
    resultObjectTypeId :: ResultId
resultObjectTypeId = ResultId
storageId,
    resultObjectSignal :: ResultSignal
resultObjectSignal = ResultContainer Storage -> ResultSignal
forall e. ResultContainer e -> ResultSignal
resultContainerSignal ResultContainer Storage
c,
    resultObjectSummary :: ResultSource
resultObjectSummary = ResultContainer Storage -> ResultSource
storageResultSummary ResultContainer Storage
c,
    resultObjectProperties :: [ResultProperty]
resultObjectProperties = [
      ResultContainer Storage
-> ResultName -> ResultId -> (Storage -> Int) -> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> b) -> ResultProperty
resultContainerConstProperty ResultContainer Storage
c ResultName
"capacity" ResultId
storageCapacityId Storage -> Int
storageCapacity,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Bool)
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> Event b) -> ResultProperty
resultContainerIntegProperty ResultContainer Storage
c ResultName
"empty" ResultId
storageEmptyId Storage -> Event Bool
storageEmpty,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Bool)
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> Event b) -> ResultProperty
resultContainerIntegProperty ResultContainer Storage
c ResultName
"full" ResultId
storageFullId Storage -> Event Bool
storageFull,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"queueCount" ResultId
storageQueueCountId Storage -> Event Int
storageQueueCount Storage -> Signal ()
storageQueueCountChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (TimingStats Int))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"queueCountStats" ResultId
storageQueueCountStatsId Storage -> Event (TimingStats Int)
storageQueueCountStats Storage -> Signal ()
storageQueueCountChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Double)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"totalWaitTime" ResultId
storageTotalWaitTimeId Storage -> Event Double
storageTotalWaitTime Storage -> Signal ()
storageWaitTimeChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (SamplingStats Double))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"waitTime" ResultId
storageWaitTimeId Storage -> Event (SamplingStats Double)
storageWaitTime Storage -> Signal ()
storageWaitTimeChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Double)
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> Event b) -> ResultProperty
resultContainerIntegProperty ResultContainer Storage
c ResultName
"averageHoldingTime" ResultId
storageAverageHoldingTimeId Storage -> Event Double
storageAverageHoldingTime,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"content" ResultId
storageContentId Storage -> Event Int
storageContent Storage -> Signal ()
storageContentChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (TimingStats Int))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"contentStats" ResultId
storageContentStatsId Storage -> Event (TimingStats Int)
storageContentStats Storage -> Signal ()
storageContentChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"useCount" ResultId
storageUseCountId Storage -> Event Int
storageUseCount Storage -> Signal ()
storageUseCountChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"usedContent" ResultId
storageUsedContentId Storage -> Event Int
storageUsedContent Storage -> Signal ()
storageUsedContentChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"utilisationCount" ResultId
storageUtilisationCountId Storage -> Event Int
storageUtilisationCount Storage -> Signal ()
storageUtilisationCountChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (TimingStats Int))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"utilisationCountStats" ResultId
storageUtilisationCountStatsId Storage -> Event (TimingStats Int)
storageUtilisationCountStats Storage -> Signal ()
storageUtilisationCountChanged_ ] }

-- | Return a summary by the specified storage.
storageResultSummary :: ResultContainer Storage
                        -- ^ the storage container
                        -> ResultSource
storageResultSummary :: ResultContainer Storage -> ResultSource
storageResultSummary ResultContainer Storage
c =
  ResultObject -> ResultSource
ResultObjectSource (ResultObject -> ResultSource) -> ResultObject -> ResultSource
forall a b. (a -> b) -> a -> b
$
  ResultObject :: ResultName
-> ResultId
-> ResultId
-> [ResultProperty]
-> ResultSignal
-> ResultSource
-> ResultObject
ResultObject {
    resultObjectName :: ResultName
resultObjectName = ResultContainer Storage -> ResultName
forall e. ResultContainer e -> ResultName
resultContainerName ResultContainer Storage
c,
    resultObjectId :: ResultId
resultObjectId = ResultContainer Storage -> ResultId
forall e. ResultContainer e -> ResultId
resultContainerId ResultContainer Storage
c,
    resultObjectTypeId :: ResultId
resultObjectTypeId = ResultId
storageId,
    resultObjectSignal :: ResultSignal
resultObjectSignal = ResultContainer Storage -> ResultSignal
forall e. ResultContainer e -> ResultSignal
resultContainerSignal ResultContainer Storage
c,
    resultObjectSummary :: ResultSource
resultObjectSummary = ResultContainer Storage -> ResultSource
storageResultSummary ResultContainer Storage
c,
    resultObjectProperties :: [ResultProperty]
resultObjectProperties = [
      ResultContainer Storage
-> ResultName -> ResultId -> (Storage -> Int) -> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> b) -> ResultProperty
resultContainerConstProperty ResultContainer Storage
c ResultName
"capacity" ResultId
storageCapacityId Storage -> Int
storageCapacity,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (TimingStats Int))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"queueCountStats" ResultId
storageQueueCountStatsId Storage -> Event (TimingStats Int)
storageQueueCountStats Storage -> Signal ()
storageQueueCountChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (SamplingStats Double))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"waitTime" ResultId
storageWaitTimeId Storage -> Event (SamplingStats Double)
storageWaitTime Storage -> Signal ()
storageWaitTimeChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Double)
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName -> ResultId -> (a -> Event b) -> ResultProperty
resultContainerIntegProperty ResultContainer Storage
c ResultName
"averageHoldingTime" ResultId
storageAverageHoldingTimeId Storage -> Event Double
storageAverageHoldingTime,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (TimingStats Int))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"contentStats" ResultId
storageContentStatsId Storage -> Event (TimingStats Int)
storageContentStats Storage -> Signal ()
storageContentChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"useCount" ResultId
storageUseCountId Storage -> Event Int
storageUseCount Storage -> Signal ()
storageUseCountChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event Int)
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"usedContent" ResultId
storageUsedContentId Storage -> Event Int
storageUsedContent Storage -> Signal ()
storageUsedContentChanged_,
      ResultContainer Storage
-> ResultName
-> ResultId
-> (Storage -> Event (TimingStats Int))
-> (Storage -> Signal ())
-> ResultProperty
forall b a.
ResultItemable (ResultValue b) =>
ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty ResultContainer Storage
c ResultName
"utilisationCountStats" ResultId
storageUtilisationCountStatsId Storage -> Event (TimingStats Int)
storageUtilisationCountStats Storage -> Signal ()
storageUtilisationCountChanged_ ] }

instance ResultProvider Q.Queue where

  resultSource' :: ResultName
-> [ResultName] -> ResultId -> [ResultId] -> Queue -> ResultSource
resultSource' ResultName
name [ResultName]
names ResultId
i [ResultId]
is Queue
m =
    ResultContainer Queue -> ResultSource
queueResultSource (ResultContainer Queue -> ResultSource)
-> ResultContainer Queue -> ResultSource
forall a b. (a -> b) -> a -> b
$ ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> Queue
-> ResultSignal
-> ResultContainer Queue
forall e.
ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> e
-> ResultSignal
-> ResultContainer e
ResultContainer ResultName
name [ResultName]
names ResultId
i [ResultId]
is Queue
m (Signal () -> ResultSignal
ResultSignal (Signal () -> ResultSignal) -> Signal () -> ResultSignal
forall a b. (a -> b) -> a -> b
$ Queue -> Signal ()
Q.queueChanged_ Queue
m)

instance ResultProvider (Facility a) where

  resultSource' :: ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> Facility a
-> ResultSource
resultSource' ResultName
name [ResultName]
names ResultId
i [ResultId]
is Facility a
m =
    ResultContainer (Facility a) -> ResultSource
forall a. ResultContainer (Facility a) -> ResultSource
facilityResultSource (ResultContainer (Facility a) -> ResultSource)
-> ResultContainer (Facility a) -> ResultSource
forall a b. (a -> b) -> a -> b
$ ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> Facility a
-> ResultSignal
-> ResultContainer (Facility a)
forall e.
ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> e
-> ResultSignal
-> ResultContainer e
ResultContainer ResultName
name [ResultName]
names ResultId
i [ResultId]
is Facility a
m (Signal () -> ResultSignal
ResultSignal (Signal () -> ResultSignal) -> Signal () -> ResultSignal
forall a b. (a -> b) -> a -> b
$ Facility a -> Signal ()
forall a. Facility a -> Signal ()
facilityChanged_ Facility a
m)

instance ResultProvider Storage where

  resultSource' :: ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> Storage
-> ResultSource
resultSource' ResultName
name [ResultName]
names ResultId
i [ResultId]
is Storage
m =
    ResultContainer Storage -> ResultSource
storageResultSource (ResultContainer Storage -> ResultSource)
-> ResultContainer Storage -> ResultSource
forall a b. (a -> b) -> a -> b
$ ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> Storage
-> ResultSignal
-> ResultContainer Storage
forall e.
ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> e
-> ResultSignal
-> ResultContainer e
ResultContainer ResultName
name [ResultName]
names ResultId
i [ResultId]
is Storage
m (Signal () -> ResultSignal
ResultSignal (Signal () -> ResultSignal) -> Signal () -> ResultSignal
forall a b. (a -> b) -> a -> b
$ Storage -> Signal ()
storageChanged_ Storage
m)