{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, ExistentialQuantification, OverlappingInstances #-}
module Simulation.Aivika.Results
(
Results,
ResultTransform,
ResultName,
ResultProvider(..),
results,
expandResults,
resultSummary,
resultByName,
resultByProperty,
resultById,
resultByIndex,
resultBySubscript,
ResultComputing(..),
ResultComputation(..),
ResultListWithSubscript(..),
ResultArrayWithSubscript(..),
ResultVectorWithSubscript(..),
ResultValue(..),
resultsToIntValues,
resultsToIntListValues,
resultsToIntStatsValues,
resultsToIntStatsEitherValues,
resultsToIntTimingStatsValues,
resultsToDoubleValues,
resultsToDoubleListValues,
resultsToDoubleStatsValues,
resultsToDoubleStatsEitherValues,
resultsToDoubleTimingStatsValues,
resultsToStringValues,
ResultPredefinedSignals(..),
newResultPredefinedSignals,
resultSignal,
pureResultSignal,
ResultSourceMap,
ResultSource(..),
ResultItem(..),
ResultItemable(..),
resultItemAsIntStatsEitherValue,
resultItemAsDoubleStatsEitherValue,
resultItemToIntValue,
resultItemToIntListValue,
resultItemToIntStatsValue,
resultItemToIntStatsEitherValue,
resultItemToIntTimingStatsValue,
resultItemToDoubleValue,
resultItemToDoubleListValue,
resultItemToDoubleStatsValue,
resultItemToDoubleStatsEitherValue,
resultItemToDoubleTimingStatsValue,
resultItemToStringValue,
ResultObject(..),
ResultProperty(..),
ResultVector(..),
memoResultVectorSignal,
memoResultVectorSummary,
ResultSeparator(..),
ResultContainer(..),
resultContainerPropertySource,
resultContainerConstProperty,
resultContainerIntegProperty,
resultContainerProperty,
resultContainerMapProperty,
resultValueToContainer,
resultContainerToValue,
ResultData,
ResultSignal(..),
maybeResultSignal,
textResultSource,
timeResultSource,
resultSourceToIntValues,
resultSourceToIntListValues,
resultSourceToIntStatsValues,
resultSourceToIntStatsEitherValues,
resultSourceToIntTimingStatsValues,
resultSourceToDoubleValues,
resultSourceToDoubleListValues,
resultSourceToDoubleStatsValues,
resultSourceToDoubleStatsEitherValues,
resultSourceToDoubleTimingStatsValues,
resultSourceToStringValues,
resultSourceMap,
resultSourceList,
composeResults,
computeResultValue) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import qualified Data.Array as A
import qualified Data.Vector as V
import Data.Ix
import Data.Maybe
import Data.Monoid hiding ((<>))
import Data.Semigroup (Semigroup(..))
import Simulation.Aivika.Parameter
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics
import Simulation.Aivika.Statistics.Accumulator
import Simulation.Aivika.Ref
import qualified Simulation.Aivika.Ref.Base as BR
import Simulation.Aivika.Var
import Simulation.Aivika.QueueStrategy
import qualified Simulation.Aivika.Queue as Q
import qualified Simulation.Aivika.Queue.Infinite as IQ
import Simulation.Aivika.Arrival
import Simulation.Aivika.Server
import Simulation.Aivika.Activity
import Simulation.Aivika.Resource
import qualified Simulation.Aivika.Resource.Preemption as PR
import Simulation.Aivika.Operation
import Simulation.Aivika.Results.Locale.Types
class ResultProvider p where
resultSource :: ResultName -> ResultDescription -> p -> ResultSource
resultSource name descr = resultSource' name [name] i [i]
where i = (UserDefinedResultId $ UserDefinedResult name descr title)
title = resultNameToTitle name
resultSource3 :: ResultName -> ResultDescription -> ResultDescription -> p -> ResultSource
resultSource3 name descr title = resultSource' name [name] i [i]
where i = (UserDefinedResultId $ UserDefinedResult name descr title)
resultSource' :: ResultName -> [ResultName] -> ResultId -> [ResultId] -> p -> ResultSource
type ResultSourceMap = M.Map ResultName ResultSource
data ResultSource = ResultItemSource ResultItem
| ResultObjectSource ResultObject
| ResultVectorSource ResultVector
| ResultSeparatorSource ResultSeparator
data ResultItem = forall a. ResultItemable a => ResultItem a
class ResultItemable a where
resultItemName :: a -> ResultName
resultItemNamePath :: a -> [ResultName]
resultItemId :: a -> ResultId
resultItemIdPath :: a -> [ResultId]
resultItemSignal :: a -> ResultSignal
resultItemExpansion :: a -> ResultSource
resultItemSummary :: a -> ResultSource
resultItemAsIntValue :: a -> Maybe (ResultValue Int)
resultItemAsIntListValue :: a -> Maybe (ResultValue [Int])
resultItemAsIntStatsValue :: a -> Maybe (ResultValue (SamplingStats Int))
resultItemAsIntTimingStatsValue :: a -> Maybe (ResultValue (TimingStats Int))
resultItemAsDoubleValue :: a -> Maybe (ResultValue Double)
resultItemAsDoubleListValue :: a -> Maybe (ResultValue [Double])
resultItemAsDoubleStatsValue :: a -> Maybe (ResultValue (SamplingStats Double))
resultItemAsDoubleTimingStatsValue :: a -> Maybe (ResultValue (TimingStats Double))
resultItemAsStringValue :: a -> Maybe (ResultValue String)
resultItemAsIntStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Int (SamplingStats Int)))
resultItemAsIntStatsEitherValue x =
case x1 of
Just a1 -> Just $ fmap Left a1
Nothing ->
case x2 of
Just a2 -> Just $ fmap Right a2
Nothing -> Nothing
where
x1 = resultItemAsIntValue x
x2 = resultItemAsIntStatsValue x
resultItemAsDoubleStatsEitherValue :: ResultItemable a => a -> Maybe (ResultValue (Either Double (SamplingStats Double)))
resultItemAsDoubleStatsEitherValue x =
case x1 of
Just a1 -> Just $ fmap Left a1
Nothing ->
case x2 of
Just a2 -> Just $ fmap Right a2
Nothing -> Nothing
where
x1 = resultItemAsDoubleValue x
x2 = resultItemAsDoubleStatsValue x
resultItemToIntValue :: ResultItemable a => a -> ResultValue Int
resultItemToIntValue x =
case resultItemAsIntValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of integer numbers: resultItemToIntValue"
resultItemToIntListValue :: ResultItemable a => a -> ResultValue [Int]
resultItemToIntListValue x =
case resultItemAsIntListValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of lists of integer numbers: resultItemToIntListValue"
resultItemToIntStatsValue :: ResultItemable a => a -> ResultValue (SamplingStats Int)
resultItemToIntStatsValue x =
case resultItemAsIntStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of statistics based on integer numbers: resultItemToIntStatsValue"
resultItemToIntStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Int (SamplingStats Int))
resultItemToIntStatsEitherValue x =
case resultItemAsIntStatsEitherValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as an optimised source of statistics based on integer numbers: resultItemToIntStatsEitherValue"
resultItemToIntTimingStatsValue :: ResultItemable a => a -> ResultValue (TimingStats Int)
resultItemToIntTimingStatsValue x =
case resultItemAsIntTimingStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of timing statistics based on integer numbers: resultItemToIntTimingStatsValue"
resultItemToDoubleValue :: ResultItemable a => a -> ResultValue Double
resultItemToDoubleValue x =
case resultItemAsDoubleValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of double-precision floating-point numbers: resultItemToDoubleValue"
resultItemToDoubleListValue :: ResultItemable a => a -> ResultValue [Double]
resultItemToDoubleListValue x =
case resultItemAsDoubleListValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of lists of double-precision floating-point numbers: resultItemToDoubleListValue"
resultItemToDoubleStatsValue :: ResultItemable a => a -> ResultValue (SamplingStats Double)
resultItemToDoubleStatsValue x =
case resultItemAsDoubleStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of statistics based on double-precision floating-point numbers: resultItemToDoubleStatsValue"
resultItemToDoubleStatsEitherValue :: ResultItemable a => a -> ResultValue (Either Double (SamplingStats Double))
resultItemToDoubleStatsEitherValue x =
case resultItemAsDoubleStatsEitherValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as an optimised source of statistics based on double-precision floating-point numbers: resultItemToDoubleStatsEitherValue"
resultItemToDoubleTimingStatsValue :: ResultItemable a => a -> ResultValue (TimingStats Double)
resultItemToDoubleTimingStatsValue x =
case resultItemAsDoubleTimingStatsValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of timing statistics based on double-precision floating-point numbers: resultItemToDoubleTimingStatsValue"
resultItemToStringValue :: ResultItemable a => a -> ResultValue String
resultItemToStringValue x =
case resultItemAsStringValue x of
Just a -> a
Nothing ->
error $
"Cannot represent " ++ resultItemName x ++
" as a source of strings: resultItemToStringValue"
data ResultObject =
ResultObject { resultObjectName :: ResultName,
resultObjectId :: ResultId,
resultObjectTypeId :: ResultId,
resultObjectProperties :: [ResultProperty],
resultObjectSignal :: ResultSignal,
resultObjectSummary :: ResultSource
}
data ResultProperty =
ResultProperty { resultPropertyLabel :: ResultName,
resultPropertyId :: ResultId,
resultPropertySource :: ResultSource
}
data ResultVector =
ResultVector { resultVectorName :: ResultName,
resultVectorId :: ResultId,
resultVectorItems :: A.Array Int ResultSource,
resultVectorSubscript :: A.Array Int ResultName,
resultVectorSignal :: ResultSignal,
resultVectorSummary :: ResultSource
}
memoResultVectorSignal :: ResultVector -> ResultVector
memoResultVectorSignal x =
x { resultVectorSignal =
foldr (<>) mempty $ map resultSourceSignal $ A.elems $ resultVectorItems x }
memoResultVectorSummary :: ResultVector -> ResultVector
memoResultVectorSummary x =
x { resultVectorSummary =
ResultVectorSource $
x { resultVectorItems =
A.array bnds [(i, resultSourceSummary e) | (i, e) <- ies] } }
where
arr = resultVectorItems x
bnds = A.bounds arr
ies = A.assocs arr
data ResultSeparator =
ResultSeparator { resultSeparatorText :: String
}
data ResultValue e =
ResultValue { resultValueName :: ResultName,
resultValueNamePath :: [ResultName],
resultValueId :: ResultId,
resultValueIdPath :: [ResultId],
resultValueData :: ResultData e,
resultValueSignal :: ResultSignal
}
instance Functor ResultValue where
fmap f x = x { resultValueData = fmap f (resultValueData x) }
apResultValue :: ResultData (a -> b) -> ResultValue a -> ResultValue b
apResultValue f x = x { resultValueData = ap f (resultValueData x) }
data ResultContainer e =
ResultContainer { resultContainerName :: ResultName,
resultContainerNamePath :: [ResultName],
resultContainerId :: ResultId,
resultContainerIdPath :: [ResultId],
resultContainerData :: e,
resultContainerSignal :: ResultSignal
}
instance Functor ResultContainer where
fmap f x = x { resultContainerData = f (resultContainerData x) }
resultContainerPropertySource :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> ResultData b)
-> (a -> ResultSignal)
-> ResultSource
resultContainerPropertySource cont name i f g =
ResultItemSource $
ResultItem $
ResultValue {
resultValueName = (resultContainerName cont) ++ "." ++ name,
resultValueNamePath = (resultContainerNamePath cont) ++ [name],
resultValueId = i,
resultValueIdPath = (resultContainerIdPath cont) ++ [i],
resultValueData = f (resultContainerData cont),
resultValueSignal = g (resultContainerData cont) }
resultContainerConstProperty :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> b)
-> ResultProperty
resultContainerConstProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (return . f) (const EmptyResultSignal) }
resultContainerIntegProperty :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> ResultProperty
resultContainerIntegProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i f (const UnknownResultSignal) }
resultContainerProperty :: ResultItemable (ResultValue b)
=> ResultContainer a
-> ResultName
-> ResultId
-> (a -> Event b)
-> (a -> Signal ())
-> ResultProperty
resultContainerProperty cont name i f g =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i f (ResultSignal . g) }
resultContainerMapProperty :: ResultItemable (ResultValue b)
=> ResultContainer (ResultData a)
-> ResultName
-> ResultId
-> (a -> b)
-> ResultProperty
resultContainerMapProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (fmap f) (const $ resultContainerSignal cont) }
resultValueToContainer :: ResultValue a -> ResultContainer (ResultData a)
resultValueToContainer x =
ResultContainer {
resultContainerName = resultValueName x,
resultContainerNamePath = resultValueNamePath x,
resultContainerId = resultValueId x,
resultContainerIdPath = resultValueIdPath x,
resultContainerData = resultValueData x,
resultContainerSignal = resultValueSignal x }
resultContainerToValue :: ResultContainer (ResultData a) -> ResultValue a
resultContainerToValue x =
ResultValue {
resultValueName = resultContainerName x,
resultValueNamePath = resultContainerNamePath x,
resultValueId = resultContainerId x,
resultValueIdPath = resultContainerIdPath x,
resultValueData = resultContainerData x,
resultValueSignal = resultContainerSignal x }
type ResultData e = Event e
normTimingStatsData :: TimingData a => ResultData (TimingStats a -> SamplingStats a)
normTimingStatsData =
do n <- liftDynamics integIteration
return $ normTimingStats (fromIntegral n)
data ResultSignal = EmptyResultSignal
| UnknownResultSignal
| ResultSignal (Signal ())
| ResultSignalMix (Signal ())
instance Semigroup ResultSignal where
(<>) EmptyResultSignal z = z
(<>) UnknownResultSignal EmptyResultSignal = UnknownResultSignal
(<>) UnknownResultSignal UnknownResultSignal = UnknownResultSignal
(<>) UnknownResultSignal (ResultSignal x) = ResultSignalMix x
(<>) UnknownResultSignal z@(ResultSignalMix x) = z
(<>) z@(ResultSignal x) EmptyResultSignal = z
(<>) (ResultSignal x) UnknownResultSignal = ResultSignalMix x
(<>) (ResultSignal x) (ResultSignal y) = ResultSignal (x <> y)
(<>) (ResultSignal x) (ResultSignalMix y) = ResultSignalMix (x <> y)
(<>) z@(ResultSignalMix x) EmptyResultSignal = z
(<>) z@(ResultSignalMix x) UnknownResultSignal = z
(<>) (ResultSignalMix x) (ResultSignal y) = ResultSignalMix (x <> y)
(<>) (ResultSignalMix x) (ResultSignalMix y) = ResultSignalMix (x <> y)
instance Monoid ResultSignal where
mempty = EmptyResultSignal
mappend = (<>)
maybeResultSignal :: Maybe (Signal ()) -> ResultSignal
maybeResultSignal (Just x) = ResultSignal x
maybeResultSignal Nothing = EmptyResultSignal
instance ResultItemable (ResultValue Int) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = Just
resultItemAsIntListValue = Just . fmap return
resultItemAsIntStatsValue = Just . fmap returnSamplingStats
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = Just . fmap fromIntegral
resultItemAsDoubleListValue = Just . fmap (return . fromIntegral)
resultItemAsDoubleStatsValue = Just . fmap (returnSamplingStats . fromIntegral)
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue Double) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = Just
resultItemAsDoubleListValue = Just . fmap return
resultItemAsDoubleStatsValue = Just . fmap returnSamplingStats
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Int]) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = Just
resultItemAsIntStatsValue = Just . fmap listSamplingStats
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = Just . fmap (map fromIntegral)
resultItemAsDoubleStatsValue = Just . fmap (fromIntSamplingStats . listSamplingStats)
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Double]) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = Just
resultItemAsDoubleStatsValue = Just . fmap listSamplingStats
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue (SamplingStats Int)) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = Just
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just . fmap fromIntSamplingStats
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (SamplingStats Double)) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Int)) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = Just . apResultValue normTimingStatsData
resultItemAsIntTimingStatsValue = Just
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just . fmap fromIntSamplingStats . apResultValue normTimingStatsData
resultItemAsDoubleTimingStatsValue = Just . fmap fromIntTimingStats
resultItemAsStringValue = Just . fmap show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Double)) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = Just . apResultValue normTimingStatsData
resultItemAsDoubleTimingStatsValue = Just
resultItemAsStringValue = Just . fmap show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue Bool) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue String) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue ()) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue FCFS) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue LCFS) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue SIRO) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue StaticPriorities) where
resultItemName = resultValueName
resultItemNamePath = resultValueNamePath
resultItemId = resultValueId
resultItemIdPath = resultValueIdPath
resultItemSignal = resultValueSignal
resultItemAsIntValue = const Nothing
resultItemAsIntListValue = const Nothing
resultItemAsIntStatsValue = const Nothing
resultItemAsIntTimingStatsValue = const Nothing
resultItemAsDoubleValue = const Nothing
resultItemAsDoubleListValue = const Nothing
resultItemAsDoubleStatsValue = const Nothing
resultItemAsDoubleTimingStatsValue = const Nothing
resultItemAsStringValue = Just . fmap show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
flattenResultSource :: ResultSource -> [ResultItem]
flattenResultSource (ResultItemSource x) = [x]
flattenResultSource (ResultObjectSource x) =
concat $ map (flattenResultSource . resultPropertySource) $ resultObjectProperties x
flattenResultSource (ResultVectorSource x) =
concat $ map flattenResultSource $ A.elems $ resultVectorItems x
flattenResultSource (ResultSeparatorSource x) = []
resultSourceName :: ResultSource -> ResultName
resultSourceName (ResultItemSource (ResultItem x)) = resultItemName x
resultSourceName (ResultObjectSource x) = resultObjectName x
resultSourceName (ResultVectorSource x) = resultVectorName x
resultSourceName (ResultSeparatorSource x) = []
expandResultSource :: ResultSource -> ResultSource
expandResultSource (ResultItemSource (ResultItem x)) = resultItemExpansion x
expandResultSource (ResultObjectSource x) =
ResultObjectSource $
x { resultObjectProperties =
flip fmap (resultObjectProperties x) $ \p ->
p { resultPropertySource = expandResultSource (resultPropertySource p) } }
expandResultSource (ResultVectorSource x) =
ResultVectorSource $
x { resultVectorItems =
A.array bnds [(i, expandResultSource e) | (i, e) <- ies] }
where arr = resultVectorItems x
bnds = A.bounds arr
ies = A.assocs arr
expandResultSource z@(ResultSeparatorSource x) = z
resultSourceSummary :: ResultSource -> ResultSource
resultSourceSummary (ResultItemSource (ResultItem x)) = resultItemSummary x
resultSourceSummary (ResultObjectSource x) = resultObjectSummary x
resultSourceSummary (ResultVectorSource x) = resultVectorSummary x
resultSourceSummary z@(ResultSeparatorSource x) = z
resultSourceSignal :: ResultSource -> ResultSignal
resultSourceSignal (ResultItemSource (ResultItem x)) = resultItemSignal x
resultSourceSignal (ResultObjectSource x) = resultObjectSignal x
resultSourceSignal (ResultVectorSource x) = resultVectorSignal x
resultSourceSignal (ResultSeparatorSource x) = EmptyResultSignal
resultSourceToIntValues :: ResultSource -> [ResultValue Int]
resultSourceToIntValues = map (\(ResultItem x) -> resultItemToIntValue x) . flattenResultSource
resultSourceToIntListValues :: ResultSource -> [ResultValue [Int]]
resultSourceToIntListValues = map (\(ResultItem x) -> resultItemToIntListValue x) . flattenResultSource
resultSourceToIntStatsValues :: ResultSource -> [ResultValue (SamplingStats Int)]
resultSourceToIntStatsValues = map (\(ResultItem x) -> resultItemToIntStatsValue x) . flattenResultSource
resultSourceToIntStatsEitherValues :: ResultSource -> [ResultValue (Either Int (SamplingStats Int))]
resultSourceToIntStatsEitherValues = map (\(ResultItem x) -> resultItemToIntStatsEitherValue x) . flattenResultSource
resultSourceToIntTimingStatsValues :: ResultSource -> [ResultValue (TimingStats Int)]
resultSourceToIntTimingStatsValues = map (\(ResultItem x) -> resultItemToIntTimingStatsValue x) . flattenResultSource
resultSourceToDoubleValues :: ResultSource -> [ResultValue Double]
resultSourceToDoubleValues = map (\(ResultItem x) -> resultItemToDoubleValue x) . flattenResultSource
resultSourceToDoubleListValues :: ResultSource -> [ResultValue [Double]]
resultSourceToDoubleListValues = map (\(ResultItem x) -> resultItemToDoubleListValue x) . flattenResultSource
resultSourceToDoubleStatsValues :: ResultSource -> [ResultValue (SamplingStats Double)]
resultSourceToDoubleStatsValues = map (\(ResultItem x) -> resultItemToDoubleStatsValue x) . flattenResultSource
resultSourceToDoubleStatsEitherValues :: ResultSource -> [ResultValue (Either Double (SamplingStats Double))]
resultSourceToDoubleStatsEitherValues = map (\(ResultItem x) -> resultItemToDoubleStatsEitherValue x) . flattenResultSource
resultSourceToDoubleTimingStatsValues :: ResultSource -> [ResultValue (TimingStats Double)]
resultSourceToDoubleTimingStatsValues = map (\(ResultItem x) -> resultItemToDoubleTimingStatsValue x) . flattenResultSource
resultSourceToStringValues :: ResultSource -> [ResultValue String]
resultSourceToStringValues = map (\(ResultItem x) -> resultItemToStringValue x) . flattenResultSource
data Results =
Results { resultSourceMap :: ResultSourceMap,
resultSourceList :: [ResultSource]
}
type ResultTransform = Results -> Results
data ResultPredefinedSignals =
ResultPredefinedSignals { resultSignalInIntegTimes :: Signal Double,
resultSignalInStartTime :: Signal Double,
resultSignalInStopTime :: Signal Double
}
newResultPredefinedSignals :: Simulation ResultPredefinedSignals
newResultPredefinedSignals = runDynamicsInStartTime $ runEventWith EarlierEvents d where
d = do signalInIntegTimes <- newSignalInIntegTimes
signalInStartTime <- newSignalInStartTime
signalInStopTime <- newSignalInStopTime
return ResultPredefinedSignals { resultSignalInIntegTimes = signalInIntegTimes,
resultSignalInStartTime = signalInStartTime,
resultSignalInStopTime = signalInStopTime }
instance Semigroup Results where
x <> y = results $ resultSourceList x <> resultSourceList y
instance Monoid Results where
mempty = results mempty
mappend = (<>)
results :: [ResultSource] -> Results
results ms =
Results { resultSourceMap = M.fromList $ map (\x -> (resultSourceName x, x)) ms,
resultSourceList = ms }
resultsToIntValues :: Results -> [ResultValue Int]
resultsToIntValues = concat . map resultSourceToIntValues . resultSourceList
resultsToIntListValues :: Results -> [ResultValue [Int]]
resultsToIntListValues = concat . map resultSourceToIntListValues . resultSourceList
resultsToIntStatsValues :: Results -> [ResultValue (SamplingStats Int)]
resultsToIntStatsValues = concat . map resultSourceToIntStatsValues . resultSourceList
resultsToIntStatsEitherValues :: Results -> [ResultValue (Either Int (SamplingStats Int))]
resultsToIntStatsEitherValues = concat . map resultSourceToIntStatsEitherValues . resultSourceList
resultsToIntTimingStatsValues :: Results -> [ResultValue (TimingStats Int)]
resultsToIntTimingStatsValues = concat . map resultSourceToIntTimingStatsValues . resultSourceList
resultsToDoubleValues :: Results -> [ResultValue Double]
resultsToDoubleValues = concat . map resultSourceToDoubleValues . resultSourceList
resultsToDoubleListValues :: Results -> [ResultValue [Double]]
resultsToDoubleListValues = concat . map resultSourceToDoubleListValues . resultSourceList
resultsToDoubleStatsValues :: Results -> [ResultValue (SamplingStats Double)]
resultsToDoubleStatsValues = concat . map resultSourceToDoubleStatsValues . resultSourceList
resultsToDoubleStatsEitherValues :: Results -> [ResultValue (Either Double (SamplingStats Double))]
resultsToDoubleStatsEitherValues = concat . map resultSourceToDoubleStatsEitherValues . resultSourceList
resultsToDoubleTimingStatsValues :: Results -> [ResultValue (TimingStats Double)]
resultsToDoubleTimingStatsValues = concat . map resultSourceToDoubleTimingStatsValues . resultSourceList
resultsToStringValues :: Results -> [ResultValue String]
resultsToStringValues = concat . map resultSourceToStringValues . resultSourceList
resultSignal :: Results -> ResultSignal
resultSignal = mconcat . map resultSourceSignal . resultSourceList
expandResults :: ResultTransform
expandResults = results . map expandResultSource . resultSourceList
resultSummary :: ResultTransform
resultSummary = results . map resultSourceSummary . resultSourceList
resultByName :: ResultName -> ResultTransform
resultByName name rs =
case M.lookup name (resultSourceMap rs) of
Just x -> results [x]
Nothing ->
error $
"Not found result source with name " ++ name ++
": resultByName"
resultByProperty :: ResultName -> ResultTransform
resultByProperty label rs = flip composeResults rs loop
where
loop x =
case x of
ResultObjectSource s ->
let ps =
flip filter (resultObjectProperties s) $ \p ->
resultPropertyLabel p == label
in case ps of
[] ->
error $
"Not found property " ++ label ++
" for object " ++ resultObjectName s ++
": resultByProperty"
ps ->
map resultPropertySource ps
ResultVectorSource s ->
concat $ map loop $ A.elems $ resultVectorItems s
x ->
error $
"Result source " ++ resultSourceName x ++
" is neither object, nor vector " ++
": resultByProperty"
resultById :: ResultId -> ResultTransform
resultById i rs = flip composeResults rs loop
where
loop x =
case x of
ResultItemSource (ResultItem s) ->
if resultItemId s == i
then [x]
else error $
"Expected to find item with Id = " ++ show i ++
", while the item " ++ resultItemName s ++
" has actual Id = " ++ show (resultItemId s) ++
": resultById"
ResultObjectSource s ->
if resultObjectId s == i
then [x]
else let ps =
flip filter (resultObjectProperties s) $ \p ->
resultPropertyId p == i
in case ps of
[] ->
error $
"Not found property with Id = " ++ show i ++
" for object " ++ resultObjectName s ++
" that has actual Id = " ++ show (resultObjectId s) ++
": resultById"
ps ->
map resultPropertySource ps
ResultVectorSource s ->
if resultVectorId s == i
then [x]
else concat $ map loop $ A.elems $ resultVectorItems s
x ->
error $
"Result source " ++ resultSourceName x ++
" is neither item, nor object, nor vector " ++
": resultById"
resultByIndex :: Int -> ResultTransform
resultByIndex index rs = flip composeResults rs loop
where
loop x =
case x of
ResultVectorSource s ->
[resultVectorItems s A.! index]
x ->
error $
"Result source " ++ resultSourceName x ++
" is not vector " ++
": resultByIndex"
resultBySubscript :: ResultName -> ResultTransform
resultBySubscript subscript rs = flip composeResults rs loop
where
loop x =
case x of
ResultVectorSource s ->
let ys = A.elems $ resultVectorItems s
zs = A.elems $ resultVectorSubscript s
ps =
flip filter (zip ys zs) $ \(y, z) ->
z == subscript
in case ps of
[] ->
error $
"Not found subscript " ++ subscript ++
" for vector " ++ resultVectorName s ++
": resultBySubscript"
ps ->
map fst ps
x ->
error $
"Result source " ++ resultSourceName x ++
" is not vector " ++
": resultBySubscript"
composeResults :: (ResultSource -> [ResultSource]) -> ResultTransform
composeResults f =
results . concat . map f . resultSourceList
concatResults :: [ResultTransform] -> ResultTransform
concatResults trs rs =
results $ concat $ map (\tr -> resultSourceList $ tr rs) trs
appendResults :: ResultTransform -> ResultTransform -> ResultTransform
appendResults x y =
concatResults [x, y]
pureResultSignal :: ResultPredefinedSignals -> ResultSignal -> Signal ()
pureResultSignal rs EmptyResultSignal =
void (resultSignalInStartTime rs)
pureResultSignal rs UnknownResultSignal =
void (resultSignalInIntegTimes rs)
pureResultSignal rs (ResultSignal s) =
void (resultSignalInStartTime rs) <> void (resultSignalInStopTime rs) <> s
pureResultSignal rs (ResultSignalMix s) =
void (resultSignalInIntegTimes rs) <> s
class ResultComputing m where
computeResultData :: m a -> ResultData a
computeResultSignal :: m a -> ResultSignal
computeResultValue :: ResultComputing m
=> ResultName
-> [ResultName]
-> ResultId
-> [ResultId]
-> m a
-> ResultValue a
computeResultValue name names i is m =
ResultValue {
resultValueName = name,
resultValueNamePath = names,
resultValueId = i,
resultValueIdPath = is,
resultValueData = computeResultData m,
resultValueSignal = computeResultSignal m }
data ResultComputation a =
ResultComputation { resultComputationData :: ResultData a,
resultComputationSignal :: ResultSignal
}
instance ResultComputing ResultComputation where
computeResultData = resultComputationData
computeResultSignal = resultComputationSignal
instance ResultComputing Parameter where
computeResultData = liftParameter
computeResultSignal = const UnknownResultSignal
instance ResultComputing Simulation where
computeResultData = liftSimulation
computeResultSignal = const UnknownResultSignal
instance ResultComputing Dynamics where
computeResultData = liftDynamics
computeResultSignal = const UnknownResultSignal
instance ResultComputing Event where
computeResultData = id
computeResultSignal = const UnknownResultSignal
instance ResultComputing Ref where
computeResultData = readRef
computeResultSignal = ResultSignal . refChanged_
instance ResultComputing BR.Ref where
computeResultData = BR.readRef
computeResultSignal = const UnknownResultSignal
instance ResultComputing Var where
computeResultData = readVar
computeResultSignal = ResultSignal . varChanged_
instance ResultComputing Signalable where
computeResultData = readSignalable
computeResultSignal = ResultSignal . signalableChanged_
samplingStatsResultSource :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingStats a)
-> ResultSource
samplingStatsResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = SamplingStatsId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = samplingStatsResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "count" SamplingStatsCountId samplingStatsCount,
resultContainerMapProperty c "mean" SamplingStatsMeanId samplingStatsMean,
resultContainerMapProperty c "mean2" SamplingStatsMean2Id samplingStatsMean2,
resultContainerMapProperty c "std" SamplingStatsDeviationId samplingStatsDeviation,
resultContainerMapProperty c "var" SamplingStatsVarianceId samplingStatsVariance,
resultContainerMapProperty c "min" SamplingStatsMinId samplingStatsMin,
resultContainerMapProperty c "max" SamplingStatsMaxId samplingStatsMax ] }
where
c = resultValueToContainer x
samplingStatsResultSummary :: ResultItemable (ResultValue (SamplingStats a))
=> ResultValue (SamplingStats a)
-> ResultSource
samplingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
timingStatsResultSource :: (TimingData a,
ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingStats a)
-> ResultSource
timingStatsResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = TimingStatsId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = timingStatsResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "count" TimingStatsCountId timingStatsCount,
resultContainerMapProperty c "mean" TimingStatsMeanId timingStatsMean,
resultContainerMapProperty c "std" TimingStatsDeviationId timingStatsDeviation,
resultContainerMapProperty c "var" TimingStatsVarianceId timingStatsVariance,
resultContainerMapProperty c "min" TimingStatsMinId timingStatsMin,
resultContainerMapProperty c "max" TimingStatsMaxId timingStatsMax,
resultContainerMapProperty c "minTime" TimingStatsMinTimeId timingStatsMinTime,
resultContainerMapProperty c "maxTime" TimingStatsMaxTimeId timingStatsMaxTime,
resultContainerMapProperty c "startTime" TimingStatsStartTimeId timingStatsStartTime,
resultContainerMapProperty c "lastTime" TimingStatsLastTimeId timingStatsLastTime,
resultContainerMapProperty c "sum" TimingStatsSumId timingStatsSum,
resultContainerMapProperty c "sum2" TimingStatsSum2Id timingStatsSum2 ] }
where
c = resultValueToContainer x
timingStatsResultSummary :: (TimingData a, ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingStats a)
-> ResultSource
timingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
samplingCounterResultSource :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingCounter a)
-> ResultSource
samplingCounterResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = SamplingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = samplingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" SamplingCounterValueId samplingCounterValue,
resultContainerMapProperty c "stats" SamplingCounterStatsId samplingCounterStats ] }
where
c = resultValueToContainer x
samplingCounterResultSummary :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingCounter a)
-> ResultSource
samplingCounterResultSummary x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = SamplingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = samplingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" SamplingCounterValueId samplingCounterValue,
resultContainerMapProperty c "stats" SamplingCounterStatsId samplingCounterStats ] }
where
c = resultValueToContainer x
timingCounterResultSource :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingCounter a)
-> ResultSource
timingCounterResultSource x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = TimingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = timingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" TimingCounterValueId timingCounterValue,
resultContainerMapProperty c "stats" TimingCounterStatsId timingCounterStats ] }
where
c = resultValueToContainer x
timingCounterResultSummary :: (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingCounter a)
-> ResultSource
timingCounterResultSummary x =
ResultObjectSource $
ResultObject {
resultObjectName = resultValueName x,
resultObjectId = resultValueId x,
resultObjectTypeId = TimingCounterId,
resultObjectSignal = resultValueSignal x,
resultObjectSummary = timingCounterResultSummary x,
resultObjectProperties = [
resultContainerMapProperty c "value" TimingCounterValueId timingCounterValue,
resultContainerMapProperty c "stats" TimingCounterStatsId timingCounterStats ] }
where
c = resultValueToContainer x
queueResultSource :: (Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (Q.Queue si sm so a)
-> ResultSource
queueResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = queueResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "enqueueStrategy" EnqueueStrategyId Q.enqueueStrategy,
resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId Q.enqueueStoringStrategy,
resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId Q.dequeueStrategy,
resultContainerProperty c "queueNull" QueueNullId Q.queueNull Q.queueNullChanged_,
resultContainerProperty c "queueFull" QueueFullId Q.queueFull Q.queueFullChanged_,
resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,
resultContainerProperty c "queueCount" QueueCountId Q.queueCount Q.queueCountChanged_,
resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,
resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,
resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,
resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,
resultContainerIntegProperty c "enqueueRate" EnqueueRateId Q.enqueueRate,
resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId Q.enqueueStoreRate,
resultContainerIntegProperty c "dequeueRate" DequeueRateId Q.dequeueRate,
resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId Q.dequeueExtractRate,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,
resultContainerProperty c "queueTotalWaitTime" QueueTotalWaitTimeId Q.queueTotalWaitTime Q.queueTotalWaitTimeChanged_,
resultContainerProperty c "enqueueWaitTime" EnqueueWaitTimeId Q.enqueueWaitTime Q.enqueueWaitTimeChanged_,
resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId Q.dequeueWaitTime Q.dequeueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }
queueResultSummary :: (Show si, Show sm, Show so)
=> ResultContainer (Q.Queue si sm so a)
-> ResultSource
queueResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = queueResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,
resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,
resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,
resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,
resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }
infiniteQueueResultSource :: (Show sm, Show so,
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (IQ.Queue sm so a)
-> ResultSource
infiniteQueueResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = infiniteQueueResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId IQ.enqueueStoringStrategy,
resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId IQ.dequeueStrategy,
resultContainerProperty c "queueNull" QueueNullId IQ.queueNull IQ.queueNullChanged_,
resultContainerProperty c "queueCount" QueueCountId IQ.queueCount IQ.queueCountChanged_,
resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,
resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId IQ.enqueueStoreRate,
resultContainerIntegProperty c "dequeueRate" DequeueRateId IQ.dequeueRate,
resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId IQ.dequeueExtractRate,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,
resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId IQ.dequeueWaitTime IQ.dequeueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }
infiniteQueueResultSummary :: (Show sm, Show so)
=> ResultContainer (IQ.Queue sm so a)
-> ResultSource
infiniteQueueResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = FiniteQueueId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = infiniteQueueResultSummary c,
resultObjectProperties = [
resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,
resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,
resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,
resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,
resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,
resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }
arrivalTimerResultSource :: ResultContainer ArrivalTimer
-> ResultSource
arrivalTimerResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ArrivalTimerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = arrivalTimerResultSummary c,
resultObjectProperties = [
resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }
arrivalTimerResultSummary :: ResultContainer ArrivalTimer
-> ResultSource
arrivalTimerResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ArrivalTimerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = arrivalTimerResultSummary c,
resultObjectProperties = [
resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }
serverResultSource :: (Show s, ResultItemable (ResultValue s))
=> ResultContainer (Server s a b)
-> ResultSource
serverResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ServerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = serverResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "initState" ServerInitStateId serverInitState,
resultContainerProperty c "state" ServerStateId serverState serverStateChanged_,
resultContainerProperty c "totalInputWaitTime" ServerTotalInputWaitTimeId serverTotalInputWaitTime serverTotalInputWaitTimeChanged_,
resultContainerProperty c "totalProcessingTime" ServerTotalProcessingTimeId serverTotalProcessingTime serverTotalProcessingTimeChanged_,
resultContainerProperty c "totalOutputWaitTime" ServerTotalOutputWaitTimeId serverTotalOutputWaitTime serverTotalOutputWaitTimeChanged_,
resultContainerProperty c "totalPreemptionTime" ServerTotalPreemptionTimeId serverTotalPreemptionTime serverTotalPreemptionTimeChanged_,
resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
resultContainerProperty c "preemptionTime" ServerPreemptionTimeId serverPreemptionTime serverPreemptionTimeChanged_,
resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_,
resultContainerProperty c "preemptionFactor" ServerPreemptionFactorId serverPreemptionFactor serverPreemptionFactorChanged_ ] }
serverResultSummary :: ResultContainer (Server s a b)
-> ResultSource
serverResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ServerId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = serverResultSummary c,
resultObjectProperties = [
resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
resultContainerProperty c "preemptionTime" ServerPreemptionTimeId serverPreemptionTime serverPreemptionTimeChanged_,
resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_,
resultContainerProperty c "preemptionFactor" ServerPreemptionFactorId serverPreemptionFactor serverPreemptionFactorChanged_ ] }
activityResultSource :: (Show s, ResultItemable (ResultValue s))
=> ResultContainer (Activity s a b)
-> ResultSource
activityResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ActivityId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = activityResultSummary c,
resultObjectProperties = [
resultContainerConstProperty c "initState" ActivityInitStateId activityInitState,
resultContainerProperty c "state" ActivityStateId activityState activityStateChanged_,
resultContainerProperty c "totalUtilisationTime" ActivityTotalUtilisationTimeId activityTotalUtilisationTime activityTotalUtilisationTimeChanged_,
resultContainerProperty c "totalIdleTime" ActivityTotalIdleTimeId activityTotalIdleTime activityTotalIdleTimeChanged_,
resultContainerProperty c "totalPreemptionTime" ActivityTotalPreemptionTimeId activityTotalPreemptionTime activityTotalPreemptionTimeChanged_,
resultContainerProperty c "utilisationTime" ActivityUtilisationTimeId activityUtilisationTime activityUtilisationTimeChanged_,
resultContainerProperty c "idleTime" ActivityIdleTimeId activityIdleTime activityIdleTimeChanged_,
resultContainerProperty c "preemptionTime" ActivityPreemptionTimeId activityPreemptionTime activityPreemptionTimeChanged_,
resultContainerProperty c "utilisationFactor" ActivityUtilisationFactorId activityUtilisationFactor activityUtilisationFactorChanged_,
resultContainerProperty c "idleFactor" ActivityIdleFactorId activityIdleFactor activityIdleFactorChanged_,
resultContainerProperty c "preemptionFactor" ActivityPreemptionFactorId activityPreemptionFactor activityPreemptionFactorChanged_ ] }
activityResultSummary :: ResultContainer (Activity s a b)
-> ResultSource
activityResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ActivityId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = activityResultSummary c,
resultObjectProperties = [
resultContainerProperty c "utilisationTime" ActivityUtilisationTimeId activityUtilisationTime activityUtilisationTimeChanged_,
resultContainerProperty c "idleTime" ActivityIdleTimeId activityIdleTime activityIdleTimeChanged_,
resultContainerProperty c "preemptionTime" ActivityPreemptionTimeId activityPreemptionTime activityPreemptionTimeChanged_,
resultContainerProperty c "utilisationFactor" ActivityUtilisationFactorId activityUtilisationFactor activityUtilisationFactorChanged_,
resultContainerProperty c "idleFactor" ActivityIdleFactorId activityIdleFactor activityIdleFactorChanged_,
resultContainerProperty c "preemptionFactor" ActivityPreemptionFactorId activityPreemptionFactor activityPreemptionFactorChanged_ ] }
resourceResultSource :: (Show s, ResultItemable (ResultValue s))
=> ResultContainer (Resource s)
-> ResultSource
resourceResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ResourceId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = resourceResultSummary c,
resultObjectProperties = [
resultContainerProperty c "queueCount" ResourceQueueCountId resourceQueueCount resourceQueueCountChanged_,
resultContainerProperty c "queueCountStats" ResourceQueueCountStatsId resourceQueueCountStats resourceQueueCountChanged_,
resultContainerProperty c "totalWaitTime" ResourceTotalWaitTimeId resourceTotalWaitTime resourceWaitTimeChanged_,
resultContainerProperty c "waitTime" ResourceWaitTimeId resourceWaitTime resourceWaitTimeChanged_,
resultContainerProperty c "count" ResourceCountId resourceCount resourceCountChanged_,
resultContainerProperty c "countStats" ResourceCountStatsId resourceCountStats resourceCountChanged_,
resultContainerProperty c "utilisationCount" ResourceUtilisationCountId resourceUtilisationCount resourceUtilisationCountChanged_,
resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId resourceUtilisationCountStats resourceUtilisationCountChanged_ ] }
resourceResultSummary :: ResultContainer (Resource s)
-> ResultSource
resourceResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ResourceId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = resourceResultSummary c,
resultObjectProperties = [
resultContainerProperty c "queueCountStats" ResourceQueueCountStatsId resourceQueueCountStats resourceQueueCountChanged_,
resultContainerProperty c "waitTime" ResourceWaitTimeId resourceWaitTime resourceWaitTimeChanged_,
resultContainerProperty c "countStats" ResourceCountStatsId resourceCountStats resourceCountChanged_,
resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId resourceUtilisationCountStats resourceUtilisationCountChanged_ ] }
preemptibleResourceResultSource :: ResultContainer PR.Resource
-> ResultSource
preemptibleResourceResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ResourceId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = preemptibleResourceResultSummary c,
resultObjectProperties = [
resultContainerProperty c "queueCount" ResourceQueueCountId PR.resourceQueueCount PR.resourceQueueCountChanged_,
resultContainerProperty c "queueCountStats" ResourceQueueCountStatsId PR.resourceQueueCountStats PR.resourceQueueCountChanged_,
resultContainerProperty c "totalWaitTime" ResourceTotalWaitTimeId PR.resourceTotalWaitTime PR.resourceWaitTimeChanged_,
resultContainerProperty c "waitTime" ResourceWaitTimeId PR.resourceWaitTime PR.resourceWaitTimeChanged_,
resultContainerProperty c "count" ResourceCountId PR.resourceCount PR.resourceCountChanged_,
resultContainerProperty c "countStats" ResourceCountStatsId PR.resourceCountStats PR.resourceCountChanged_,
resultContainerProperty c "utilisationCount" ResourceUtilisationCountId PR.resourceUtilisationCount PR.resourceUtilisationCountChanged_,
resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId PR.resourceUtilisationCountStats PR.resourceUtilisationCountChanged_ ] }
preemptibleResourceResultSummary :: ResultContainer PR.Resource
-> ResultSource
preemptibleResourceResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = ResourceId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = preemptibleResourceResultSummary c,
resultObjectProperties = [
resultContainerProperty c "queueCountStats" ResourceQueueCountStatsId PR.resourceQueueCountStats PR.resourceQueueCountChanged_,
resultContainerProperty c "waitTime" ResourceWaitTimeId PR.resourceWaitTime PR.resourceWaitTimeChanged_,
resultContainerProperty c "countStats" ResourceCountStatsId PR.resourceCountStats PR.resourceCountChanged_,
resultContainerProperty c "utilisationCountStats" ResourceUtilisationCountStatsId PR.resourceUtilisationCountStats PR.resourceUtilisationCountChanged_ ] }
operationResultSource :: ResultContainer (Operation a b)
-> ResultSource
operationResultSource c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = OperationId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = operationResultSummary c,
resultObjectProperties = [
resultContainerProperty c "totalUtilisationTime" OperationTotalUtilisationTimeId operationTotalUtilisationTime operationTotalUtilisationTimeChanged_,
resultContainerProperty c "totalPreemptionTime" OperationTotalPreemptionTimeId operationTotalPreemptionTime operationTotalPreemptionTimeChanged_,
resultContainerProperty c "utilisationTime" OperationUtilisationTimeId operationUtilisationTime operationUtilisationTimeChanged_,
resultContainerProperty c "preemptionTime" OperationPreemptionTimeId operationPreemptionTime operationPreemptionTimeChanged_,
resultContainerProperty c "utilisationFactor" OperationUtilisationFactorId operationUtilisationFactor operationUtilisationFactorChanged_,
resultContainerProperty c "preemptionFactor" OperationPreemptionFactorId operationPreemptionFactor operationPreemptionFactorChanged_ ] }
operationResultSummary :: ResultContainer (Operation a b)
-> ResultSource
operationResultSummary c =
ResultObjectSource $
ResultObject {
resultObjectName = resultContainerName c,
resultObjectId = resultContainerId c,
resultObjectTypeId = OperationId,
resultObjectSignal = resultContainerSignal c,
resultObjectSummary = operationResultSummary c,
resultObjectProperties = [
resultContainerProperty c "utilisationTime" OperationUtilisationTimeId operationUtilisationTime operationUtilisationTimeChanged_,
resultContainerProperty c "preemptionTime" OperationPreemptionTimeId operationPreemptionTime operationPreemptionTimeChanged_,
resultContainerProperty c "utilisationFactor" OperationUtilisationFactorId operationUtilisationFactor operationUtilisationFactorChanged_,
resultContainerProperty c "preemptionFactor" OperationPreemptionFactorId operationPreemptionFactor operationPreemptionFactorChanged_ ] }
textResultSource :: String -> ResultSource
textResultSource text =
ResultSeparatorSource $
ResultSeparator { resultSeparatorText = text }
timeResultSource :: ResultSource
timeResultSource = resultSource' "t" ["t"] TimeId [TimeId] time
intSubscript :: Int -> ResultName
intSubscript i = "[" ++ show i ++ "]"
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Parameter a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Simulation a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Dynamics a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Event a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Ref a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (BR.Ref a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Var a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Signalable a) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Parameter (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Simulation (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Dynamics (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Event (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Ref (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (BR.Ref (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Var (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultProvider (Signalable (SamplingCounter a)) where
resultSource' name names i is m =
samplingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Parameter (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Simulation (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Dynamics (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Event (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Ref (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (BR.Ref (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Var (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultProvider (Signalable (TimingCounter a)) where
resultSource' name names i is m =
timingCounterResultSource $ computeResultValue name names i is m
instance ResultProvider p => ResultProvider [p] where
resultSource' name names i is m =
resultSource' name names i is $ ResultListWithSubscript m subscript where
subscript = map snd $ zip m $ map intSubscript [0..]
instance (Show i, Ix i, ResultProvider p) => ResultProvider (A.Array i p) where
resultSource' name names i is m =
resultSource' name names i is $ ResultListWithSubscript items subscript where
items = A.elems m
subscript = map (\i -> "[" ++ show i ++ "]") (A.indices m)
instance ResultProvider p => ResultProvider (V.Vector p) where
resultSource' name names i is m =
resultSource' name names i is $ ResultVectorWithSubscript m subscript where
subscript = V.imap (\i x -> intSubscript i) m
data ResultListWithSubscript p =
ResultListWithSubscript [p] [String]
data ResultArrayWithSubscript i p =
ResultArrayWithSubscript (A.Array i p) (A.Array i String)
data ResultVectorWithSubscript p =
ResultVectorWithSubscript (V.Vector p) (V.Vector String)
instance ResultProvider p => ResultProvider (ResultListWithSubscript p) where
resultSource' name names i is (ResultListWithSubscript xs ys) =
ResultVectorSource $
memoResultVectorSignal $
memoResultVectorSummary $
ResultVector { resultVectorName = name,
resultVectorId = i,
resultVectorItems = axs,
resultVectorSubscript = ays,
resultVectorSignal = undefined,
resultVectorSummary = undefined }
where
bnds = (0, length xs - 1)
axs = A.listArray bnds items
ays = A.listArray bnds ys
items =
flip map (zip ys xs) $ \(y, x) ->
let name' = name ++ y
names' = names ++ [y]
i' = VectorItemId y
is' = is ++ [i']
in resultSource' name' names' i' is' x
items' = map resultSourceSummary items
instance (Show i, Ix i, ResultProvider p) => ResultProvider (ResultArrayWithSubscript i p) where
resultSource' name names i is (ResultArrayWithSubscript xs ys) =
resultSource' name names i is $ ResultListWithSubscript items subscript where
items = A.elems xs
subscript = A.elems ys
instance ResultProvider p => ResultProvider (ResultVectorWithSubscript p) where
resultSource' name names i is (ResultVectorWithSubscript xs ys) =
ResultVectorSource $
memoResultVectorSignal $
memoResultVectorSummary $
ResultVector { resultVectorName = name,
resultVectorId = i,
resultVectorItems = axs,
resultVectorSubscript = ays,
resultVectorSignal = undefined,
resultVectorSummary = undefined }
where
bnds = (0, V.length xs - 1)
axs = A.listArray bnds (V.toList items)
ays = A.listArray bnds (V.toList ys)
items =
V.generate (V.length xs) $ \i ->
let x = xs V.! i
y = ys V.! i
name' = name ++ y
names' = names ++ [y]
i' = VectorItemId y
is' = is ++ [i']
in resultSource' name' names' i' is' x
items' = V.map resultSourceSummary items
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Parameter (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Simulation (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Dynamics (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Event (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Ref (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (BR.Ref (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Var (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Signalable (A.Array i e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Parameter (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Simulation (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Dynamics (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Event (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Ref (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (BR.Ref (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Var (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Signalable (V.Vector e)) where
resultSource' name names i is m =
ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name names i is m
instance (Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultProvider (Q.Queue si sm so a) where
resultSource' name names i is m =
queueResultSource $ ResultContainer name names i is m (ResultSignal $ Q.queueChanged_ m)
instance (Show sm, Show so,
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultProvider (IQ.Queue sm so a) where
resultSource' name names i is m =
infiniteQueueResultSource $ ResultContainer name names i is m (ResultSignal $ IQ.queueChanged_ m)
instance ResultProvider ArrivalTimer where
resultSource' name names i is m =
arrivalTimerResultSource $ ResultContainer name names i is m (ResultSignal $ arrivalProcessingTimeChanged_ m)
instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Server s a b) where
resultSource' name names i is m =
serverResultSource $ ResultContainer name names i is m (ResultSignal $ serverChanged_ m)
instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Activity s a b) where
resultSource' name names i is m =
activityResultSource $ ResultContainer name names i is m (ResultSignal $ activityChanged_ m)
instance (Show s, ResultItemable (ResultValue s)) => ResultProvider (Resource s) where
resultSource' name names i is m =
resourceResultSource $ ResultContainer name names i is m (ResultSignal $ resourceChanged_ m)
instance ResultProvider PR.Resource where
resultSource' name names i is m =
preemptibleResourceResultSource $ ResultContainer name names i is m (ResultSignal $ PR.resourceChanged_ m)
instance ResultProvider (Operation a b) where
resultSource' name names i is m =
operationResultSource $ ResultContainer name names i is m (ResultSignal $ operationChanged_ m)