-- |
-- Module     : Simulation.Aivika.GPSS.Results.Transform
-- 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 defines transformations for the simulation results.
--
module Simulation.Aivika.GPSS.Results.Transform where

import Control.Category

import Simulation.Aivika
import qualified Simulation.Aivika.Results.Transform as T

import qualified Simulation.Aivika.GPSS.Queue as Q
import qualified Simulation.Aivika.GPSS.Facility as F
import qualified Simulation.Aivika.GPSS.Storage as S
import Simulation.Aivika.GPSS.Results
import Simulation.Aivika.GPSS.Results.Locale

-- | Represents the 'Q.Queue'.
newtype Queue = Queue ResultTransform

-- | An instance of the result transformer.
instance T.ResultTransformer Queue where
  tr :: Queue -> ResultTransform
tr (Queue ResultTransform
a) = ResultTransform
a

-- | Property 'Q.queueNull'.
queueNull :: Queue -> ResultTransform
queueNull :: Queue -> ResultTransform
queueNull (Queue ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
queueNullId

-- | Property 'Q.queueContent'.
queueContent :: Queue -> ResultTransform
queueContent :: Queue -> ResultTransform
queueContent (Queue ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
queueContentId

-- | Property 'Q.queueContentStats'.
queueContentStats :: Queue -> T.TimingStats
queueContentStats :: Queue -> TimingStats
queueContentStats (Queue ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
queueContentStatsId)

-- | Property 'Q.enqueueCount'.
enqueueCount :: Queue -> ResultTransform
enqueueCount :: Queue -> ResultTransform
enqueueCount (Queue ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
enqueueCountId

-- | Property 'Q.enqueueZeroEntryCount'.
enqueueZeroEntryCount :: Queue -> ResultTransform
enqueueZeroEntryCount :: Queue -> ResultTransform
enqueueZeroEntryCount (Queue ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
enqueueZeroEntryCountId

-- | Property 'Q.queueWaitTime'.
queueWaitTime :: Queue -> T.SamplingStats
queueWaitTime :: Queue -> SamplingStats
queueWaitTime (Queue ResultTransform
a) =
  ResultTransform -> SamplingStats
T.SamplingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
queueWaitTimeId)

-- | Property 'Q.queueNonZeroEntryWaitTime'.
queueNonZeroEntryWaitTime :: Queue -> T.SamplingStats
queueNonZeroEntryWaitTime :: Queue -> SamplingStats
queueNonZeroEntryWaitTime (Queue ResultTransform
a) =
  ResultTransform -> SamplingStats
T.SamplingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
queueNonZeroEntryWaitTimeId)

-- | Property 'Q.queueRate'.
queueRate :: Queue -> ResultTransform
queueRate :: Queue -> ResultTransform
queueRate (Queue ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
queueRateId

-- | Represents the 'F.Facility'.
newtype Facility = Facility ResultTransform

-- | An instance of the result transformer.
instance T.ResultTransformer Facility where
  tr :: Facility -> ResultTransform
tr (Facility ResultTransform
a) = ResultTransform
a

-- | Property 'F.facilityCount'.
facilityCount :: Facility -> ResultTransform
facilityCount :: Facility -> ResultTransform
facilityCount (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityCountId

-- | Property 'F.facilityCountStats'.
facilityCountStats :: Facility -> T.TimingStats
facilityCountStats :: Facility -> TimingStats
facilityCountStats (Facility ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityCountStatsId)

-- | Property 'F.facilityCaptureCount'.
facilityCaptureCount :: Facility -> ResultTransform
facilityCaptureCount :: Facility -> ResultTransform
facilityCaptureCount (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityCaptureCountId

-- | Property 'F.facilityUtilisationCount'.
facilityUtilisationCount :: Facility -> ResultTransform
facilityUtilisationCount :: Facility -> ResultTransform
facilityUtilisationCount (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityUtilisationCountId

-- | Property 'F.facilityUtilisationCountStats'.
facilityUtilisationCountStats :: Facility -> T.TimingStats
facilityUtilisationCountStats :: Facility -> TimingStats
facilityUtilisationCountStats (Facility ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityUtilisationCountStatsId)

-- | Property 'F.facilityQueueCount'.
facilityQueueCount :: Facility -> ResultTransform
facilityQueueCount :: Facility -> ResultTransform
facilityQueueCount (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityQueueCountId

-- | Property 'F.facilityQueueCountStats'.
facilityQueueCountStats :: Facility -> T.TimingStats
facilityQueueCountStats :: Facility -> TimingStats
facilityQueueCountStats (Facility ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityQueueCountStatsId)

-- | Property 'F.facilityTotalWaitTime'.
facilityTotalWaitTime :: Facility -> ResultTransform
facilityTotalWaitTime :: Facility -> ResultTransform
facilityTotalWaitTime (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityTotalWaitTimeId

-- | Property 'F.facilityWaitTime'.
facilityWaitTime :: Facility -> T.SamplingStats
facilityWaitTime :: Facility -> SamplingStats
facilityWaitTime (Facility ResultTransform
a) =
  ResultTransform -> SamplingStats
T.SamplingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityWaitTimeId)

-- | Property 'F.facilityTotalHoldingTime'.
facilityTotalHoldingTime :: Facility -> ResultTransform
facilityTotalHoldingTime :: Facility -> ResultTransform
facilityTotalHoldingTime (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityTotalHoldingTimeId

-- | Property 'F.facilityHoldingTime'.
facilityHoldingTime :: Facility -> T.SamplingStats
facilityHoldingTime :: Facility -> SamplingStats
facilityHoldingTime (Facility ResultTransform
a) =
  ResultTransform -> SamplingStats
T.SamplingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityHoldingTimeId)

-- | Property 'F.facilityInterrupted'.
facilityInterrupted :: Facility -> ResultTransform
facilityInterrupted :: Facility -> ResultTransform
facilityInterrupted (Facility ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
facilityInterruptedId

-- | Represents the 'S.Storage'.
newtype Storage = Storage ResultTransform

-- | An instance of the result transformer.
instance T.ResultTransformer Storage where
  tr :: Storage -> ResultTransform
tr (Storage ResultTransform
a) = ResultTransform
a

-- | Property 'S.storageCapacity'.
storageCapacity :: Storage -> ResultTransform
storageCapacity :: Storage -> ResultTransform
storageCapacity (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageCapacityId

-- | Property 'S.storageEmpty'.
storageEmpty :: Storage -> ResultTransform
storageEmpty :: Storage -> ResultTransform
storageEmpty (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageEmptyId

-- | Property 'S.storageFull'.
storageFull :: Storage -> ResultTransform
storageFull :: Storage -> ResultTransform
storageFull (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageFullId

-- | Property 'S.storageContent'.
storageContent :: Storage -> ResultTransform
storageContent :: Storage -> ResultTransform
storageContent (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageContentId

-- | Property 'S.storageContentStats'.
storageContentStats :: Storage -> T.TimingStats
storageContentStats :: Storage -> TimingStats
storageContentStats (Storage ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageContentStatsId)

-- | Property 'S.storageUseCount'.
storageUseCount :: Storage -> ResultTransform
storageUseCount :: Storage -> ResultTransform
storageUseCount (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageUseCountId

-- | Property 'S.storageUsedContent'.
storageUsedContent :: Storage -> ResultTransform
storageUsedContent :: Storage -> ResultTransform
storageUsedContent (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageUsedContentId

-- | Property 'S.storageUtilisationCount'.
storageUtilisationCount :: Storage -> ResultTransform
storageUtilisationCount :: Storage -> ResultTransform
storageUtilisationCount (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageUtilisationCountId

-- | Property 'S.storageUtilisationCountStats'.
storageUtilisationCountStats :: Storage -> T.TimingStats
storageUtilisationCountStats :: Storage -> TimingStats
storageUtilisationCountStats (Storage ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageUtilisationCountStatsId)

-- | Property 'S.storageQueueCount'.
storageQueueCount :: Storage -> ResultTransform
storageQueueCount :: Storage -> ResultTransform
storageQueueCount (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageQueueCountId

-- | Property 'S.storageQueueCountStats'.
storageQueueCountStats :: Storage -> T.TimingStats
storageQueueCountStats :: Storage -> TimingStats
storageQueueCountStats (Storage ResultTransform
a) =
  ResultTransform -> TimingStats
T.TimingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageQueueCountStatsId)

-- | Property 'S.storageTotalWaitTime'.
storageTotalWaitTime :: Storage -> ResultTransform
storageTotalWaitTime :: Storage -> ResultTransform
storageTotalWaitTime (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageTotalWaitTimeId

-- | Property 'S.storageWaitTime'.
storageWaitTime :: Storage -> T.SamplingStats
storageWaitTime :: Storage -> SamplingStats
storageWaitTime (Storage ResultTransform
a) =
  ResultTransform -> SamplingStats
T.SamplingStats (ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageWaitTimeId)

-- | Property 'S.storageAverageHoldingTime'.
storageAverageHoldingTime :: Storage -> ResultTransform
storageAverageHoldingTime :: Storage -> ResultTransform
storageAverageHoldingTime (Storage ResultTransform
a) =
  ResultTransform
a ResultTransform -> ResultTransform -> ResultTransform
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ResultId -> ResultTransform
resultById ResultId
storageAverageHoldingTimeId