{-# LANGUAGE FlexibleInstances #-}
module Simulation.Aivika.Results.Transform
(
ResultTransformer(..),
SamplingStats(..),
samplingStatsCount,
samplingStatsMin,
samplingStatsMax,
samplingStatsMean,
samplingStatsMean2,
samplingStatsVariance,
samplingStatsDeviation,
TimingStats(..),
timingStatsCount,
timingStatsMin,
timingStatsMax,
timingStatsMean,
timingStatsVariance,
timingStatsDeviation,
timingStatsMinTime,
timingStatsMaxTime,
timingStatsStartTime,
timingStatsLastTime,
timingStatsSum,
timingStatsSum2,
SamplingCounter(..),
samplingCounterValue,
samplingCounterStats,
TimingCounter(..),
timingCounterValue,
timingCounterStats,
Queue(..),
enqueueStrategy,
enqueueStoringStrategy,
dequeueStrategy,
queueNull,
queueFull,
queueMaxCount,
queueCount,
queueCountStats,
enqueueCount,
enqueueLostCount,
enqueueStoreCount,
dequeueCount,
dequeueExtractCount,
queueLoadFactor,
enqueueRate,
enqueueStoreRate,
dequeueRate,
dequeueExtractRate,
queueWaitTime,
queueTotalWaitTime,
enqueueWaitTime,
dequeueWaitTime,
queueRate,
ArrivalTimer(..),
arrivalProcessingTime,
Server(..),
serverInitState,
serverState,
serverTotalInputWaitTime,
serverTotalProcessingTime,
serverTotalOutputWaitTime,
serverTotalPreemptionTime,
serverInputWaitTime,
serverProcessingTime,
serverOutputWaitTime,
serverPreemptionTime,
serverInputWaitFactor,
serverProcessingFactor,
serverOutputWaitFactor,
serverPreemptionFactor,
Activity(..),
activityInitState,
activityState,
activityTotalUtilisationTime,
activityTotalIdleTime,
activityTotalPreemptionTime,
activityUtilisationTime,
activityIdleTime,
activityPreemptionTime,
activityUtilisationFactor,
activityIdleFactor,
activityPreemptionFactor,
Resource(..),
resourceCount,
resourceCountStats,
resourceUtilisationCount,
resourceUtilisationCountStats,
resourceQueueCount,
resourceQueueCountStats,
resourceTotalWaitTime,
resourceWaitTime,
Operation(..),
operationTotalUtilisationTime,
operationTotalPreemptionTime,
operationUtilisationTime,
operationPreemptionTime,
operationUtilisationFactor,
operationPreemptionFactor) where
import Control.Arrow
import Simulation.Aivika.Results
import Simulation.Aivika.Results.Locale
class ResultTransformer a where
tr :: a -> ResultTransform
newtype SamplingStats = SamplingStats ResultTransform
instance ResultTransformer SamplingStats where
tr :: SamplingStats -> ResultTransform
tr (SamplingStats ResultTransform
a) = ResultTransform
a
samplingStatsCount :: SamplingStats -> ResultTransform
samplingStatsCount :: SamplingStats -> ResultTransform
samplingStatsCount (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsCountId
samplingStatsMin :: SamplingStats -> ResultTransform
samplingStatsMin :: SamplingStats -> ResultTransform
samplingStatsMin (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsMinId
samplingStatsMax :: SamplingStats -> ResultTransform
samplingStatsMax :: SamplingStats -> ResultTransform
samplingStatsMax (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsMaxId
samplingStatsMean :: SamplingStats -> ResultTransform
samplingStatsMean :: SamplingStats -> ResultTransform
samplingStatsMean (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsMeanId
samplingStatsMean2 :: SamplingStats -> ResultTransform
samplingStatsMean2 :: SamplingStats -> ResultTransform
samplingStatsMean2 (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsMean2Id
samplingStatsVariance :: SamplingStats -> ResultTransform
samplingStatsVariance :: SamplingStats -> ResultTransform
samplingStatsVariance (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsVarianceId
samplingStatsDeviation :: SamplingStats -> ResultTransform
samplingStatsDeviation :: SamplingStats -> ResultTransform
samplingStatsDeviation (SamplingStats 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
>>> ResultTransform
expandResults 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
SamplingStatsDeviationId
newtype SamplingCounter = SamplingCounter ResultTransform
instance ResultTransformer SamplingCounter where
tr :: SamplingCounter -> ResultTransform
tr (SamplingCounter ResultTransform
a) = ResultTransform
a
samplingCounterValue :: SamplingCounter -> ResultTransform
samplingCounterValue :: SamplingCounter -> ResultTransform
samplingCounterValue (SamplingCounter 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
SamplingCounterValueId
samplingCounterStats :: SamplingCounter -> SamplingStats
samplingCounterStats :: SamplingCounter -> SamplingStats
samplingCounterStats (SamplingCounter ResultTransform
a) =
ResultTransform -> SamplingStats
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
SamplingCounterStatsId)
newtype TimingStats = TimingStats ResultTransform
instance ResultTransformer TimingStats where
tr :: TimingStats -> ResultTransform
tr (TimingStats ResultTransform
a) = ResultTransform
a
timingStatsCount :: TimingStats -> ResultTransform
timingStatsCount :: TimingStats -> ResultTransform
timingStatsCount (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsCountId
timingStatsMin :: TimingStats -> ResultTransform
timingStatsMin :: TimingStats -> ResultTransform
timingStatsMin (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsMinId
timingStatsMax :: TimingStats -> ResultTransform
timingStatsMax :: TimingStats -> ResultTransform
timingStatsMax (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsMaxId
timingStatsMean :: TimingStats -> ResultTransform
timingStatsMean :: TimingStats -> ResultTransform
timingStatsMean (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsMeanId
timingStatsVariance :: TimingStats -> ResultTransform
timingStatsVariance :: TimingStats -> ResultTransform
timingStatsVariance (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsVarianceId
timingStatsDeviation :: TimingStats -> ResultTransform
timingStatsDeviation :: TimingStats -> ResultTransform
timingStatsDeviation (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsDeviationId
timingStatsMinTime :: TimingStats -> ResultTransform
timingStatsMinTime :: TimingStats -> ResultTransform
timingStatsMinTime (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsMinTimeId
timingStatsMaxTime :: TimingStats -> ResultTransform
timingStatsMaxTime :: TimingStats -> ResultTransform
timingStatsMaxTime (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsMaxTimeId
timingStatsStartTime :: TimingStats -> ResultTransform
timingStatsStartTime :: TimingStats -> ResultTransform
timingStatsStartTime (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsStartTimeId
timingStatsLastTime :: TimingStats -> ResultTransform
timingStatsLastTime :: TimingStats -> ResultTransform
timingStatsLastTime (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsLastTimeId
timingStatsSum :: TimingStats -> ResultTransform
timingStatsSum :: TimingStats -> ResultTransform
timingStatsSum (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsSumId
timingStatsSum2 :: TimingStats -> ResultTransform
timingStatsSum2 :: TimingStats -> ResultTransform
timingStatsSum2 (TimingStats 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
>>> ResultTransform
expandResults 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
TimingStatsSum2Id
newtype TimingCounter = TimingCounter ResultTransform
instance ResultTransformer TimingCounter where
tr :: TimingCounter -> ResultTransform
tr (TimingCounter ResultTransform
a) = ResultTransform
a
timingCounterValue :: TimingCounter -> ResultTransform
timingCounterValue :: TimingCounter -> ResultTransform
timingCounterValue (TimingCounter 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
TimingCounterValueId
timingCounterStats :: TimingCounter -> TimingStats
timingCounterStats :: TimingCounter -> TimingStats
timingCounterStats (TimingCounter ResultTransform
a) =
ResultTransform -> TimingStats
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
TimingCounterStatsId)
newtype Queue = Queue ResultTransform
instance ResultTransformer Queue where
tr :: Queue -> ResultTransform
tr (Queue ResultTransform
a) = ResultTransform
a
enqueueStrategy :: Queue -> ResultTransform
enqueueStrategy :: Queue -> ResultTransform
enqueueStrategy (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
EnqueueStrategyId
enqueueStoringStrategy :: Queue -> ResultTransform
enqueueStoringStrategy :: Queue -> ResultTransform
enqueueStoringStrategy (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
EnqueueStoringStrategyId
dequeueStrategy :: Queue -> ResultTransform
dequeueStrategy :: Queue -> ResultTransform
dequeueStrategy (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
DequeueStrategyId
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
queueFull :: Queue -> ResultTransform
queueFull :: Queue -> ResultTransform
queueFull (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
QueueFullId
queueMaxCount :: Queue -> ResultTransform
queueMaxCount :: Queue -> ResultTransform
queueMaxCount (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
QueueMaxCountId
queueCount :: Queue -> ResultTransform
queueCount :: Queue -> ResultTransform
queueCount (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
QueueCountId
queueCountStats :: Queue -> TimingStats
queueCountStats :: Queue -> TimingStats
queueCountStats (Queue ResultTransform
a) =
ResultTransform -> TimingStats
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
QueueCountStatsId)
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
enqueueLostCount :: Queue -> ResultTransform
enqueueLostCount :: Queue -> ResultTransform
enqueueLostCount (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
EnqueueLostCountId
enqueueStoreCount :: Queue -> ResultTransform
enqueueStoreCount :: Queue -> ResultTransform
enqueueStoreCount (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
EnqueueStoreCountId
dequeueCount :: Queue -> ResultTransform
dequeueCount :: Queue -> ResultTransform
dequeueCount (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
DequeueCountId
dequeueExtractCount :: Queue -> ResultTransform
(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
DequeueExtractCountId
queueLoadFactor :: Queue -> ResultTransform
queueLoadFactor :: Queue -> ResultTransform
queueLoadFactor (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
QueueLoadFactorId
enqueueRate :: Queue -> ResultTransform
enqueueRate :: Queue -> ResultTransform
enqueueRate (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
EnqueueRateId
enqueueStoreRate :: Queue -> ResultTransform
enqueueStoreRate :: Queue -> ResultTransform
enqueueStoreRate (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
EnqueueStoreRateId
dequeueRate :: Queue -> ResultTransform
dequeueRate :: Queue -> ResultTransform
dequeueRate (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
DequeueRateId
dequeueExtractRate :: Queue -> ResultTransform
(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
DequeueExtractRateId
queueWaitTime :: Queue -> SamplingStats
queueWaitTime :: Queue -> SamplingStats
queueWaitTime (Queue ResultTransform
a) =
ResultTransform -> SamplingStats
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)
queueTotalWaitTime :: Queue -> SamplingStats
queueTotalWaitTime :: Queue -> SamplingStats
queueTotalWaitTime (Queue ResultTransform
a) =
ResultTransform -> SamplingStats
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
QueueTotalWaitTimeId)
enqueueWaitTime :: Queue -> SamplingStats
enqueueWaitTime :: Queue -> SamplingStats
enqueueWaitTime (Queue ResultTransform
a) =
ResultTransform -> SamplingStats
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
EnqueueWaitTimeId)
dequeueWaitTime :: Queue -> SamplingStats
dequeueWaitTime :: Queue -> SamplingStats
dequeueWaitTime (Queue ResultTransform
a) =
ResultTransform -> SamplingStats
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
DequeueWaitTimeId)
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
newtype ArrivalTimer = ArrivalTimer ResultTransform
instance ResultTransformer ArrivalTimer where
tr :: ArrivalTimer -> ResultTransform
tr (ArrivalTimer ResultTransform
a) = ResultTransform
a
arrivalProcessingTime :: ArrivalTimer -> SamplingStats
arrivalProcessingTime :: ArrivalTimer -> SamplingStats
arrivalProcessingTime (ArrivalTimer ResultTransform
a) =
ResultTransform -> SamplingStats
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
ArrivalProcessingTimeId)
newtype Server = Server ResultTransform
instance ResultTransformer Server where
tr :: Server -> ResultTransform
tr (Server ResultTransform
a) = ResultTransform
a
serverInitState :: Server -> ResultTransform
serverInitState :: Server -> ResultTransform
serverInitState (Server 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
ServerInitStateId
serverState :: Server -> ResultTransform
serverState :: Server -> ResultTransform
serverState (Server 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
ServerStateId
serverTotalInputWaitTime :: Server -> ResultTransform
serverTotalInputWaitTime :: Server -> ResultTransform
serverTotalInputWaitTime (Server 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
ServerTotalInputWaitTimeId
serverTotalProcessingTime :: Server -> ResultTransform
serverTotalProcessingTime :: Server -> ResultTransform
serverTotalProcessingTime (Server 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
ServerTotalProcessingTimeId
serverTotalOutputWaitTime :: Server -> ResultTransform
serverTotalOutputWaitTime :: Server -> ResultTransform
serverTotalOutputWaitTime (Server 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
ServerTotalOutputWaitTimeId
serverTotalPreemptionTime :: Server -> ResultTransform
serverTotalPreemptionTime :: Server -> ResultTransform
serverTotalPreemptionTime (Server 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
ServerTotalPreemptionTimeId
serverInputWaitTime :: Server -> SamplingStats
serverInputWaitTime :: Server -> SamplingStats
serverInputWaitTime (Server ResultTransform
a) =
ResultTransform -> SamplingStats
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
ServerInputWaitTimeId)
serverProcessingTime :: Server -> SamplingStats
serverProcessingTime :: Server -> SamplingStats
serverProcessingTime (Server ResultTransform
a) =
ResultTransform -> SamplingStats
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
ServerProcessingTimeId)
serverOutputWaitTime :: Server -> SamplingStats
serverOutputWaitTime :: Server -> SamplingStats
serverOutputWaitTime (Server ResultTransform
a) =
ResultTransform -> SamplingStats
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
ServerOutputWaitTimeId)
serverPreemptionTime :: Server -> SamplingStats
serverPreemptionTime :: Server -> SamplingStats
serverPreemptionTime (Server ResultTransform
a) =
ResultTransform -> SamplingStats
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
ServerPreemptionTimeId)
serverInputWaitFactor :: Server -> ResultTransform
serverInputWaitFactor :: Server -> ResultTransform
serverInputWaitFactor (Server 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
ServerInputWaitFactorId
serverProcessingFactor :: Server -> ResultTransform
serverProcessingFactor :: Server -> ResultTransform
serverProcessingFactor (Server 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
ServerProcessingFactorId
serverOutputWaitFactor :: Server -> ResultTransform
serverOutputWaitFactor :: Server -> ResultTransform
serverOutputWaitFactor (Server 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
ServerOutputWaitFactorId
serverPreemptionFactor :: Server -> ResultTransform
serverPreemptionFactor :: Server -> ResultTransform
serverPreemptionFactor (Server 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
ServerPreemptionFactorId
newtype Activity = Activity ResultTransform
instance ResultTransformer Activity where
tr :: Activity -> ResultTransform
tr (Activity ResultTransform
a) = ResultTransform
a
activityInitState :: Activity -> ResultTransform
activityInitState :: Activity -> ResultTransform
activityInitState (Activity 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
ActivityInitStateId
activityState :: Activity -> ResultTransform
activityState :: Activity -> ResultTransform
activityState (Activity 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
ActivityStateId
activityTotalUtilisationTime :: Activity -> ResultTransform
activityTotalUtilisationTime :: Activity -> ResultTransform
activityTotalUtilisationTime (Activity 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
ActivityTotalUtilisationTimeId
activityTotalIdleTime :: Activity -> ResultTransform
activityTotalIdleTime :: Activity -> ResultTransform
activityTotalIdleTime (Activity 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
ActivityTotalIdleTimeId
activityTotalPreemptionTime :: Activity -> ResultTransform
activityTotalPreemptionTime :: Activity -> ResultTransform
activityTotalPreemptionTime (Activity 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
ActivityTotalPreemptionTimeId
activityUtilisationTime :: Activity -> SamplingStats
activityUtilisationTime :: Activity -> SamplingStats
activityUtilisationTime (Activity ResultTransform
a) =
ResultTransform -> SamplingStats
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
ActivityUtilisationTimeId)
activityIdleTime :: Activity -> SamplingStats
activityIdleTime :: Activity -> SamplingStats
activityIdleTime (Activity ResultTransform
a) =
ResultTransform -> SamplingStats
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
ActivityIdleTimeId)
activityPreemptionTime :: Activity -> SamplingStats
activityPreemptionTime :: Activity -> SamplingStats
activityPreemptionTime (Activity ResultTransform
a) =
ResultTransform -> SamplingStats
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
ActivityPreemptionTimeId)
activityUtilisationFactor :: Activity -> ResultTransform
activityUtilisationFactor :: Activity -> ResultTransform
activityUtilisationFactor (Activity 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
ActivityUtilisationFactorId
activityIdleFactor :: Activity -> ResultTransform
activityIdleFactor :: Activity -> ResultTransform
activityIdleFactor (Activity 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
ActivityIdleFactorId
activityPreemptionFactor :: Activity -> ResultTransform
activityPreemptionFactor :: Activity -> ResultTransform
activityPreemptionFactor (Activity 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
ActivityPreemptionFactorId
newtype Resource = Resource ResultTransform
instance ResultTransformer Resource where
tr :: Resource -> ResultTransform
tr (Resource ResultTransform
a) = ResultTransform
a
resourceCount :: Resource -> ResultTransform
resourceCount :: Resource -> ResultTransform
resourceCount (Resource 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
ResourceCountId
resourceCountStats :: Resource -> TimingStats
resourceCountStats :: Resource -> TimingStats
resourceCountStats (Resource ResultTransform
a) =
ResultTransform -> TimingStats
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
ResourceCountStatsId)
resourceUtilisationCount :: Resource -> ResultTransform
resourceUtilisationCount :: Resource -> ResultTransform
resourceUtilisationCount (Resource 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
ResourceUtilisationCountId
resourceUtilisationCountStats :: Resource -> TimingStats
resourceUtilisationCountStats :: Resource -> TimingStats
resourceUtilisationCountStats (Resource ResultTransform
a) =
ResultTransform -> TimingStats
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
ResourceUtilisationCountStatsId)
resourceQueueCount :: Resource -> ResultTransform
resourceQueueCount :: Resource -> ResultTransform
resourceQueueCount (Resource 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
ResourceQueueCountId
resourceQueueCountStats :: Resource -> TimingStats
resourceQueueCountStats :: Resource -> TimingStats
resourceQueueCountStats (Resource ResultTransform
a) =
ResultTransform -> TimingStats
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
ResourceQueueCountStatsId)
resourceTotalWaitTime :: Resource -> ResultTransform
resourceTotalWaitTime :: Resource -> ResultTransform
resourceTotalWaitTime (Resource 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
ResourceTotalWaitTimeId
resourceWaitTime :: Resource -> SamplingStats
resourceWaitTime :: Resource -> SamplingStats
resourceWaitTime (Resource ResultTransform
a) =
ResultTransform -> SamplingStats
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
ResourceWaitTimeId)
newtype Operation = Operation ResultTransform
instance ResultTransformer Operation where
tr :: Operation -> ResultTransform
tr (Operation ResultTransform
a) = ResultTransform
a
operationTotalUtilisationTime :: Operation -> ResultTransform
operationTotalUtilisationTime :: Operation -> ResultTransform
operationTotalUtilisationTime (Operation 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
OperationTotalUtilisationTimeId
operationTotalPreemptionTime :: Operation -> ResultTransform
operationTotalPreemptionTime :: Operation -> ResultTransform
operationTotalPreemptionTime (Operation 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
OperationTotalPreemptionTimeId
operationUtilisationTime :: Operation -> SamplingStats
operationUtilisationTime :: Operation -> SamplingStats
operationUtilisationTime (Operation ResultTransform
a) =
ResultTransform -> SamplingStats
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
OperationUtilisationTimeId)
operationPreemptionTime :: Operation -> SamplingStats
operationPreemptionTime :: Operation -> SamplingStats
operationPreemptionTime (Operation ResultTransform
a) =
ResultTransform -> SamplingStats
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
OperationPreemptionTimeId)
operationUtilisationFactor :: Operation -> ResultTransform
operationUtilisationFactor :: Operation -> ResultTransform
operationUtilisationFactor (Operation 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
OperationUtilisationFactorId
operationPreemptionFactor :: Operation -> ResultTransform
operationPreemptionFactor :: Operation -> ResultTransform
operationPreemptionFactor (Operation 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
OperationPreemptionFactorId