module Simulation.Aivika.Trans.Results
(
Results,
ResultTransform,
ResultName,
ResultProvider(..),
results,
expandResults,
resultSummary,
resultByName,
resultByProperty,
resultById,
resultByIndex,
resultBySubscript,
ResultComputing(..),
ResultListWithSubscript(..),
ResultArrayWithSubscript(..),
#ifndef __HASTE__
ResultVectorWithSubscript(..),
#endif
ResultExtract(..),
extractIntResults,
extractIntListResults,
extractIntStatsResults,
extractIntStatsEitherResults,
extractIntTimingStatsResults,
extractDoubleResults,
extractDoubleListResults,
extractDoubleStatsResults,
extractDoubleStatsEitherResults,
extractDoubleTimingStatsResults,
extractStringResults,
ResultPredefinedSignals(..),
newResultPredefinedSignals,
resultSignal,
pureResultSignal,
ResultSourceMap,
ResultSource(..),
ResultItem(..),
ResultItemable(..),
resultItemToIntStatsEitherValue,
resultItemToDoubleStatsEitherValue,
ResultObject(..),
ResultProperty(..),
ResultVector(..),
memoResultVectorSignal,
memoResultVectorSummary,
ResultSeparator(..),
ResultValue(..),
voidResultValue,
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,
resultsToIntValues,
resultsToIntListValues,
resultsToIntStatsValues,
resultsToIntStatsEitherValues,
resultsToIntTimingStatsValues,
resultsToDoubleValues,
resultsToDoubleListValues,
resultsToDoubleStatsValues,
resultsToDoubleStatsEitherValues,
resultsToDoubleTimingStatsValues,
resultsToStringValues,
composeResults,
computeResultValue) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import qualified Data.Array as A
#ifndef __HASTE__
import qualified Data.Vector as V
#endif
import Data.Ix
import Data.Maybe
import Data.Monoid
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Parameter
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Statistics
import Simulation.Aivika.Trans.Statistics.Accumulator
import Simulation.Aivika.Trans.Ref
import qualified Simulation.Aivika.Trans.Ref.Plain as LR
import Simulation.Aivika.Trans.Var
import Simulation.Aivika.Trans.QueueStrategy
import qualified Simulation.Aivika.Trans.Queue as Q
import qualified Simulation.Aivika.Trans.Queue.Infinite as IQ
import Simulation.Aivika.Trans.Arrival
import Simulation.Aivika.Trans.Server
import Simulation.Aivika.Trans.Results.Locale
type ResultName = String
class MonadComp m => ResultProvider p m | p -> m where
resultSource :: ResultName -> ResultDescription -> p -> ResultSource m
resultSource name descr = resultSource' name (UserDefinedResultId descr)
resultSource' :: ResultName -> ResultId -> p -> ResultSource m
type ResultSourceMap m = M.Map ResultName (ResultSource m)
data ResultSource m = ResultItemSource (ResultItem m)
| ResultObjectSource (ResultObject m)
| ResultVectorSource (ResultVector m)
| ResultSeparatorSource ResultSeparator
data ResultItem m = forall a. ResultItemable a => ResultItem (a m)
class ResultItemable a where
resultItemName :: a m -> ResultName
resultItemId :: a m -> ResultId
resultItemSignal :: MonadComp m => a m -> ResultSignal m
resultItemExpansion :: MonadComp m => a m -> ResultSource m
resultItemSummary :: MonadComp m => a m -> ResultSource m
resultItemToIntValue :: MonadComp m => a m -> ResultValue Int m
resultItemToIntListValue :: MonadComp m => a m -> ResultValue [Int] m
resultItemToIntStatsValue :: MonadComp m => a m -> ResultValue (SamplingStats Int) m
resultItemToIntTimingStatsValue :: MonadComp m => a m -> ResultValue (TimingStats Int) m
resultItemToDoubleValue :: MonadComp m => a m -> ResultValue Double m
resultItemToDoubleListValue :: MonadComp m => a m -> ResultValue [Double] m
resultItemToDoubleStatsValue :: MonadComp m => a m -> ResultValue (SamplingStats Double) m
resultItemToDoubleTimingStatsValue :: MonadComp m => a m -> ResultValue (TimingStats Double) m
resultItemToStringValue :: MonadComp m => a m -> ResultValue String m
resultItemToIntStatsEitherValue :: (MonadComp m, ResultItemable a) => a m -> ResultValue (Either Int (SamplingStats Int)) m
resultItemToIntStatsEitherValue x =
case resultValueData x1 of
Just a1 -> mapResultValue Left x1
Nothing ->
case resultValueData x2 of
Just a2 -> mapResultValue Right x2
Nothing -> voidResultValue x2
where
x1 = resultItemToIntValue x
x2 = resultItemToIntStatsValue x
resultItemToDoubleStatsEitherValue :: (MonadComp m, ResultItemable a) => a m -> ResultValue (Either Double (SamplingStats Double)) m
resultItemToDoubleStatsEitherValue x =
case resultValueData x1 of
Just a1 -> mapResultValue Left x1
Nothing ->
case resultValueData x2 of
Just a2 -> mapResultValue Right x2
Nothing -> voidResultValue x2
where
x1 = resultItemToDoubleValue x
x2 = resultItemToDoubleStatsValue x
data ResultObject m =
ResultObject { resultObjectName :: ResultName,
resultObjectId :: ResultId,
resultObjectTypeId :: ResultId,
resultObjectProperties :: [ResultProperty m],
resultObjectSignal :: ResultSignal m,
resultObjectSummary :: ResultSource m
}
data ResultProperty m =
ResultProperty { resultPropertyLabel :: ResultName,
resultPropertyId :: ResultId,
resultPropertySource :: ResultSource m
}
data ResultVector m =
ResultVector { resultVectorName :: ResultName,
resultVectorId :: ResultId,
resultVectorItems :: A.Array Int (ResultSource m),
resultVectorSubscript :: A.Array Int ResultName,
resultVectorSignal :: ResultSignal m,
resultVectorSummary :: ResultSource m
}
memoResultVectorSignal :: MonadComp m => ResultVector m -> ResultVector m
memoResultVectorSignal x =
x { resultVectorSignal =
foldr (<>) mempty $ map resultSourceSignal $ A.elems $ resultVectorItems x }
memoResultVectorSummary :: MonadComp m => ResultVector m -> ResultVector m
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 m =
ResultValue { resultValueName :: ResultName,
resultValueId :: ResultId,
resultValueData :: ResultData e m,
resultValueSignal :: ResultSignal m
}
mapResultValue :: MonadComp m => (a -> b) -> ResultValue a m -> ResultValue b m
mapResultValue f x = x { resultValueData = fmap (fmap f) (resultValueData x) }
voidResultValue :: ResultValue a m -> ResultValue b m
voidResultValue x = x { resultValueData = Nothing }
data ResultContainer e m =
ResultContainer { resultContainerName :: ResultName,
resultContainerId :: ResultId,
resultContainerData :: e,
resultContainerSignal :: ResultSignal m
}
mapResultContainer :: (a -> b) -> ResultContainer a m -> ResultContainer b m
mapResultContainer f x = x { resultContainerData = f (resultContainerData x) }
resultContainerPropertySource :: ResultItemable (ResultValue b)
=> ResultContainer a m
-> ResultName
-> ResultId
-> (a -> ResultData b m)
-> (a -> ResultSignal m)
-> ResultSource m
resultContainerPropertySource cont name i f g =
ResultItemSource $
ResultItem $
ResultValue {
resultValueName = (resultContainerName cont) ++ "." ++ name,
resultValueId = i,
resultValueData = f (resultContainerData cont),
resultValueSignal = g (resultContainerData cont) }
resultContainerConstProperty :: (MonadComp m,
ResultItemable (ResultValue b))
=> ResultContainer a m
-> ResultName
-> ResultId
-> (a -> b)
-> ResultProperty m
resultContainerConstProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (Just . return . f) (const EmptyResultSignal) }
resultContainerIntegProperty :: (MonadComp m,
ResultItemable (ResultValue b))
=> ResultContainer a m
-> ResultName
-> ResultId
-> (a -> Event m b)
-> ResultProperty m
resultContainerIntegProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (Just . f) (const UnknownResultSignal) }
resultContainerProperty :: (MonadComp m,
ResultItemable (ResultValue b))
=> ResultContainer a m
-> ResultName
-> ResultId
-> (a -> Event m b)
-> (a -> Signal m ())
-> ResultProperty m
resultContainerProperty cont name i f g =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (Just . f) (ResultSignal . g) }
resultContainerMapProperty :: (MonadComp m,
ResultItemable (ResultValue b))
=> ResultContainer (ResultData a m) m
-> ResultName
-> ResultId
-> (a -> b)
-> ResultProperty m
resultContainerMapProperty cont name i f =
ResultProperty {
resultPropertyLabel = name,
resultPropertyId = i,
resultPropertySource =
resultContainerPropertySource cont name i (fmap $ fmap f) (const $ resultContainerSignal cont) }
resultValueToContainer :: ResultValue a m -> ResultContainer (ResultData a m) m
resultValueToContainer x =
ResultContainer {
resultContainerName = resultValueName x,
resultContainerId = resultValueId x,
resultContainerData = resultValueData x,
resultContainerSignal = resultValueSignal x }
resultContainerToValue :: ResultContainer (ResultData a m) m -> ResultValue a m
resultContainerToValue x =
ResultValue {
resultValueName = resultContainerName x,
resultValueId = resultContainerId x,
resultValueData = resultContainerData x,
resultValueSignal = resultContainerSignal x }
type ResultData e m = Maybe (Event m e)
data ResultSignal m = EmptyResultSignal
| UnknownResultSignal
| ResultSignal (Signal m ())
| ResultSignalMix (Signal m ())
instance MonadComp m => Monoid (ResultSignal m) where
mempty = EmptyResultSignal
mappend EmptyResultSignal z = z
mappend UnknownResultSignal EmptyResultSignal = UnknownResultSignal
mappend UnknownResultSignal UnknownResultSignal = UnknownResultSignal
mappend UnknownResultSignal (ResultSignal x) = ResultSignalMix x
mappend UnknownResultSignal z@(ResultSignalMix x) = z
mappend z@(ResultSignal x) EmptyResultSignal = z
mappend (ResultSignal x) UnknownResultSignal = ResultSignalMix x
mappend (ResultSignal x) (ResultSignal y) = ResultSignal (x <> y)
mappend (ResultSignal x) (ResultSignalMix y) = ResultSignalMix (x <> y)
mappend z@(ResultSignalMix x) EmptyResultSignal = z
mappend z@(ResultSignalMix x) UnknownResultSignal = z
mappend (ResultSignalMix x) (ResultSignal y) = ResultSignalMix (x <> y)
mappend (ResultSignalMix x) (ResultSignalMix y) = ResultSignalMix (x <> y)
maybeResultSignal :: Maybe (Signal m ()) -> ResultSignal m
maybeResultSignal (Just x) = ResultSignal x
maybeResultSignal Nothing = EmptyResultSignal
instance ResultItemable (ResultValue Int) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = id
resultItemToIntListValue = mapResultValue return
resultItemToIntStatsValue = mapResultValue returnSamplingStats
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = mapResultValue fromIntegral
resultItemToDoubleListValue = mapResultValue (return . fromIntegral)
resultItemToDoubleStatsValue = mapResultValue (returnSamplingStats . fromIntegral)
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue Double) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = id
resultItemToDoubleListValue = mapResultValue return
resultItemToDoubleStatsValue = mapResultValue returnSamplingStats
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Int]) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = id
resultItemToIntStatsValue = mapResultValue listSamplingStats
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = mapResultValue (map fromIntegral)
resultItemToDoubleStatsValue = mapResultValue (fromIntSamplingStats . listSamplingStats)
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue [Double]) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = id
resultItemToDoubleStatsValue = mapResultValue listSamplingStats
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue (SamplingStats Int)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = id
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = mapResultValue fromIntSamplingStats
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (SamplingStats Double)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = id
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = samplingStatsResultSource
resultItemSummary = samplingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Int)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = id
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = mapResultValue fromIntTimingStats
resultItemToStringValue = mapResultValue show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue (TimingStats Double)) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = id
resultItemToStringValue = mapResultValue show
resultItemExpansion = timingStatsResultSource
resultItemSummary = timingStatsResultSummary
instance ResultItemable (ResultValue Bool) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue String) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue ()) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue FCFS) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue LCFS) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue SIRO) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
instance ResultItemable (ResultValue StaticPriorities) where
resultItemName = resultValueName
resultItemId = resultValueId
resultItemSignal = resultValueSignal
resultItemToIntValue = voidResultValue
resultItemToIntListValue = voidResultValue
resultItemToIntStatsValue = voidResultValue
resultItemToIntTimingStatsValue = voidResultValue
resultItemToDoubleValue = voidResultValue
resultItemToDoubleListValue = voidResultValue
resultItemToDoubleStatsValue = voidResultValue
resultItemToDoubleTimingStatsValue = voidResultValue
resultItemToStringValue = mapResultValue show
resultItemExpansion = ResultItemSource . ResultItem
resultItemSummary = ResultItemSource . ResultItem
flattenResultSource :: ResultSource m -> [ResultItem m]
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 m -> ResultName
resultSourceName (ResultItemSource (ResultItem x)) = resultItemName x
resultSourceName (ResultObjectSource x) = resultObjectName x
resultSourceName (ResultVectorSource x) = resultVectorName x
resultSourceName (ResultSeparatorSource x) = []
expandResultSource :: MonadComp m => ResultSource m -> ResultSource m
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 :: MonadComp m => ResultSource m -> ResultSource m
resultSourceSummary (ResultItemSource (ResultItem x)) = resultItemSummary x
resultSourceSummary (ResultObjectSource x) = resultObjectSummary x
resultSourceSummary (ResultVectorSource x) = resultVectorSummary x
resultSourceSummary z@(ResultSeparatorSource x) = z
resultSourceSignal :: MonadComp m => ResultSource m -> ResultSignal m
resultSourceSignal (ResultItemSource (ResultItem x)) = resultItemSignal x
resultSourceSignal (ResultObjectSource x) = resultObjectSignal x
resultSourceSignal (ResultVectorSource x) = resultVectorSignal x
resultSourceSignal (ResultSeparatorSource x) = EmptyResultSignal
resultSourceToIntValues :: MonadComp m => ResultSource m -> [ResultValue Int m]
resultSourceToIntValues = map (\(ResultItem x) -> resultItemToIntValue x) . flattenResultSource
resultSourceToIntListValues :: MonadComp m => ResultSource m -> [ResultValue [Int] m]
resultSourceToIntListValues = map (\(ResultItem x) -> resultItemToIntListValue x) . flattenResultSource
resultSourceToIntStatsValues :: MonadComp m => ResultSource m -> [ResultValue (SamplingStats Int) m]
resultSourceToIntStatsValues = map (\(ResultItem x) -> resultItemToIntStatsValue x) . flattenResultSource
resultSourceToIntStatsEitherValues :: MonadComp m => ResultSource m -> [ResultValue (Either Int (SamplingStats Int)) m]
resultSourceToIntStatsEitherValues = map (\(ResultItem x) -> resultItemToIntStatsEitherValue x) . flattenResultSource
resultSourceToIntTimingStatsValues :: MonadComp m => ResultSource m -> [ResultValue (TimingStats Int) m]
resultSourceToIntTimingStatsValues = map (\(ResultItem x) -> resultItemToIntTimingStatsValue x) . flattenResultSource
resultSourceToDoubleValues :: MonadComp m => ResultSource m -> [ResultValue Double m]
resultSourceToDoubleValues = map (\(ResultItem x) -> resultItemToDoubleValue x) . flattenResultSource
resultSourceToDoubleListValues :: MonadComp m => ResultSource m -> [ResultValue [Double] m]
resultSourceToDoubleListValues = map (\(ResultItem x) -> resultItemToDoubleListValue x) . flattenResultSource
resultSourceToDoubleStatsValues :: MonadComp m => ResultSource m -> [ResultValue (SamplingStats Double) m]
resultSourceToDoubleStatsValues = map (\(ResultItem x) -> resultItemToDoubleStatsValue x) . flattenResultSource
resultSourceToDoubleStatsEitherValues :: MonadComp m => ResultSource m -> [ResultValue (Either Double (SamplingStats Double)) m]
resultSourceToDoubleStatsEitherValues = map (\(ResultItem x) -> resultItemToDoubleStatsEitherValue x) . flattenResultSource
resultSourceToDoubleTimingStatsValues :: MonadComp m => ResultSource m -> [ResultValue (TimingStats Double) m]
resultSourceToDoubleTimingStatsValues = map (\(ResultItem x) -> resultItemToDoubleTimingStatsValue x) . flattenResultSource
resultSourceToStringValues :: MonadComp m => ResultSource m -> [ResultValue String m]
resultSourceToStringValues = map (\(ResultItem x) -> resultItemToStringValue x) . flattenResultSource
data Results m =
Results { resultSourceMap :: ResultSourceMap m,
resultSourceList :: [ResultSource m]
}
type ResultTransform m = Results m -> Results m
data ResultPredefinedSignals m =
ResultPredefinedSignals { resultSignalInIntegTimes :: Signal m Double,
resultSignalInStartTime :: Signal m Double,
resultSignalInStopTime :: Signal m Double
}
newResultPredefinedSignals :: MonadComp m => Simulation m (ResultPredefinedSignals m)
newResultPredefinedSignals = runDynamicsInStartTime $ runEventWith EarlierEvents d where
d = do signalInIntegTimes <- newSignalInIntegTimes
signalInStartTime <- newSignalInStartTime
signalInStopTime <- newSignalInStopTime
return ResultPredefinedSignals { resultSignalInIntegTimes = signalInIntegTimes,
resultSignalInStartTime = signalInStartTime,
resultSignalInStopTime = signalInStopTime }
instance Monoid (Results m) where
mempty = results mempty
mappend x y = results $ resultSourceList x <> resultSourceList y
results :: [ResultSource m] -> Results m
results ms =
Results { resultSourceMap = M.fromList $ map (\x -> (resultSourceName x, x)) ms,
resultSourceList = ms }
resultsToIntValues :: MonadComp m => Results m -> [ResultValue Int m]
resultsToIntValues = concat . map resultSourceToIntValues . resultSourceList
resultsToIntListValues :: MonadComp m => Results m -> [ResultValue [Int] m]
resultsToIntListValues = concat . map resultSourceToIntListValues . resultSourceList
resultsToIntStatsValues :: MonadComp m => Results m -> [ResultValue (SamplingStats Int) m]
resultsToIntStatsValues = concat . map resultSourceToIntStatsValues . resultSourceList
resultsToIntStatsEitherValues :: MonadComp m => Results m -> [ResultValue (Either Int (SamplingStats Int)) m]
resultsToIntStatsEitherValues = concat . map resultSourceToIntStatsEitherValues . resultSourceList
resultsToIntTimingStatsValues :: MonadComp m => Results m -> [ResultValue (TimingStats Int) m]
resultsToIntTimingStatsValues = concat . map resultSourceToIntTimingStatsValues . resultSourceList
resultsToDoubleValues :: MonadComp m => Results m -> [ResultValue Double m]
resultsToDoubleValues = concat . map resultSourceToDoubleValues . resultSourceList
resultsToDoubleListValues :: MonadComp m => Results m -> [ResultValue [Double] m]
resultsToDoubleListValues = concat . map resultSourceToDoubleListValues . resultSourceList
resultsToDoubleStatsValues :: MonadComp m => Results m -> [ResultValue (SamplingStats Double) m]
resultsToDoubleStatsValues = concat . map resultSourceToDoubleStatsValues . resultSourceList
resultsToDoubleStatsEitherValues :: MonadComp m => Results m -> [ResultValue (Either Double (SamplingStats Double)) m]
resultsToDoubleStatsEitherValues = concat . map resultSourceToDoubleStatsEitherValues . resultSourceList
resultsToDoubleTimingStatsValues :: MonadComp m => Results m -> [ResultValue (TimingStats Double) m]
resultsToDoubleTimingStatsValues = concat . map resultSourceToDoubleTimingStatsValues . resultSourceList
resultsToStringValues :: MonadComp m => Results m -> [ResultValue String m]
resultsToStringValues = concat . map resultSourceToStringValues . resultSourceList
resultSignal :: MonadComp m => Results m -> ResultSignal m
resultSignal = mconcat . map resultSourceSignal . resultSourceList
expandResults :: MonadComp m => ResultTransform m
expandResults = results . map expandResultSource . resultSourceList
resultSummary :: MonadComp m => ResultTransform m
resultSummary = results . map resultSourceSummary . resultSourceList
resultByName :: ResultName -> ResultTransform m
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 m
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 m
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 m
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 m
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 m -> [ResultSource m]) -> ResultTransform m
composeResults f =
results . concat . map f . resultSourceList
concatResults :: [ResultTransform m] -> ResultTransform m
concatResults trs rs =
results $ concat $ map (\tr -> resultSourceList $ tr rs) trs
appendResults :: ResultTransform m -> ResultTransform m -> ResultTransform m
appendResults x y =
concatResults [x, y]
pureResultSignal :: MonadComp m => ResultPredefinedSignals m -> ResultSignal m -> Signal m ()
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
data ResultExtract e m =
ResultExtract { resultExtractName :: ResultName,
resultExtractId :: ResultId,
resultExtractData :: Event m e,
resultExtractSignal :: ResultSignal m
}
extractIntResults :: MonadComp m => Results m -> [ResultExtract Int m]
extractIntResults rs = flip map (resultsToIntValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of integer values: extractIntResults"
Just a ->
ResultExtract n i a s
extractIntListResults :: MonadComp m => Results m -> [ResultExtract [Int] m]
extractIntListResults rs = flip map (resultsToIntListValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of lists of integer values: extractIntListResults"
Just a ->
ResultExtract n i a s
extractIntStatsResults :: MonadComp m => Results m -> [ResultExtract (SamplingStats Int) m]
extractIntStatsResults rs = flip map (resultsToIntStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on integer values: extractIntStatsResults"
Just a ->
ResultExtract n i a s
extractIntStatsEitherResults :: MonadComp m => Results m -> [ResultExtract (Either Int (SamplingStats Int)) m]
extractIntStatsEitherResults rs = flip map (resultsToIntStatsEitherValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on integer values: extractIntStatsEitherResults"
Just a ->
ResultExtract n i a s
extractIntTimingStatsResults :: MonadComp m => Results m -> [ResultExtract (TimingStats Int) m]
extractIntTimingStatsResults rs = flip map (resultsToIntTimingStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of timing statistics based on integer values: extractIntTimingStatsResults"
Just a ->
ResultExtract n i a s
extractDoubleResults :: MonadComp m => Results m -> [ResultExtract Double m]
extractDoubleResults rs = flip map (resultsToDoubleValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of double floating point values: extractDoubleResults"
Just a ->
ResultExtract n i a s
extractDoubleListResults :: MonadComp m => Results m -> [ResultExtract [Double] m]
extractDoubleListResults rs = flip map (resultsToDoubleListValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of lists of double floating point values: extractDoubleListResults"
Just a ->
ResultExtract n i a s
extractDoubleStatsResults :: MonadComp m => Results m -> [ResultExtract (SamplingStats Double) m]
extractDoubleStatsResults rs = flip map (resultsToDoubleStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on double floating point values: extractDoubleStatsResults"
Just a ->
ResultExtract n i a s
extractDoubleStatsEitherResults :: MonadComp m => Results m -> [ResultExtract (Either Double (SamplingStats Double)) m]
extractDoubleStatsEitherResults rs = flip map (resultsToDoubleStatsEitherValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of statistics based on double floating point values: extractDoubleStatsEitherResults"
Just a ->
ResultExtract n i a s
extractDoubleTimingStatsResults :: MonadComp m => Results m -> [ResultExtract (TimingStats Double) m]
extractDoubleTimingStatsResults rs = flip map (resultsToDoubleTimingStatsValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of timing statistics based on double floating point values: extractDoubleTimingStatsResults"
Just a ->
ResultExtract n i a s
extractStringResults :: MonadComp m => Results m -> [ResultExtract String m]
extractStringResults rs = flip map (resultsToStringValues rs) $ \x ->
let n = resultValueName x
i = resultValueId x
a = resultValueData x
s = resultValueSignal x
in case a of
Nothing ->
error $
"Cannot represent variable " ++ n ++
" as a source of string values: extractStringResults"
Just a ->
ResultExtract n i a s
class MonadComp m => ResultComputing t m where
computeResultData :: t m a -> ResultData a m
computeResultSignal :: t m a -> ResultSignal m
computeResultValue :: ResultComputing t m
=> ResultName
-> ResultId
-> t m a
-> ResultValue a m
computeResultValue name i m =
ResultValue {
resultValueName = name,
resultValueId = i,
resultValueData = computeResultData m,
resultValueSignal = computeResultSignal m }
instance MonadComp m => ResultComputing Parameter m where
computeResultData = Just . liftParameter
computeResultSignal = const UnknownResultSignal
instance MonadComp m => ResultComputing Simulation m where
computeResultData = Just . liftSimulation
computeResultSignal = const UnknownResultSignal
instance MonadComp m => ResultComputing Dynamics m where
computeResultData = Just . liftDynamics
computeResultSignal = const UnknownResultSignal
instance MonadComp m => ResultComputing Event m where
computeResultData = Just . id
computeResultSignal = const UnknownResultSignal
instance MonadComp m => ResultComputing Ref m where
computeResultData = Just . readRef
computeResultSignal = ResultSignal . refChanged_
instance MonadComp m => ResultComputing LR.Ref m where
computeResultData = Just . LR.readRef
computeResultSignal = const UnknownResultSignal
instance MonadComp m => ResultComputing Var m where
computeResultData = Just . readVar
computeResultSignal = ResultSignal . varChanged_
instance MonadComp m => ResultComputing Signalable m where
computeResultData = Just . readSignalable
computeResultSignal = ResultSignal . signalableChanged_
samplingStatsResultSource :: (MonadComp m,
ResultItemable (ResultValue a),
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingStats a) m
-> ResultSource m
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 :: (MonadComp m,
ResultItemable (ResultValue (SamplingStats a)))
=> ResultValue (SamplingStats a) m
-> ResultSource m
samplingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
timingStatsResultSource :: (MonadComp m,
TimingData a,
ResultItemable (ResultValue a),
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingStats a) m
-> ResultSource m
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 :: (MonadComp m,
TimingData a,
ResultItemable (ResultValue (TimingStats a)))
=> ResultValue (TimingStats a) m
-> ResultSource m
timingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
queueResultSource :: (MonadComp m,
Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (Q.Queue m si sm so a) m
-> ResultSource m
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 :: (MonadComp m,
Show si, Show sm, Show so)
=> ResultContainer (Q.Queue m si sm so a) m
-> ResultSource m
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 :: (MonadComp m,
Show sm, Show so,
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultContainer (IQ.Queue m sm so a) m
-> ResultSource m
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 :: (MonadComp m,
Show sm, Show so)
=> ResultContainer (IQ.Queue m sm so a) m
-> ResultSource m
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 :: MonadComp m
=> ResultContainer (ArrivalTimer m) m
-> ResultSource m
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 :: MonadComp m
=> ResultContainer (ArrivalTimer m) m
-> ResultSource m
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 :: (MonadComp m,
Show s, ResultItemable (ResultValue s))
=> ResultContainer (Server m s a b) m
-> ResultSource m
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 "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }
serverResultSummary :: MonadComp m
=> ResultContainer (Server m s a b) m
-> ResultSource m
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 "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }
textResultSource :: String -> ResultSource m
textResultSource text =
ResultSeparatorSource $
ResultSeparator { resultSeparatorText = text }
timeResultSource :: MonadComp m => ResultSource m
timeResultSource = resultSource' "t" TimeId time
intSubscript :: Int -> ResultName
intSubscript i = "[" ++ show i ++ "]"
instance ResultComputing t m => ResultProvider (t m Double) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m [Double]) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m (SamplingStats Double)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m (TimingStats Double)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m Int) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m [Int]) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m (SamplingStats Int)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m (TimingStats Int)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m String) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ computeResultValue name i m
instance ResultProvider p m => ResultProvider [p] m where
resultSource' name i m =
resultSource' name i $ ResultListWithSubscript m subscript where
subscript = map snd $ zip m $ map intSubscript [0..]
instance (Show i, Ix i, ResultProvider p m) => ResultProvider (A.Array i p) m where
resultSource' name i m =
resultSource' name i $ ResultListWithSubscript items subscript where
items = A.elems m
subscript = map (\i -> "[" ++ show i ++ "]") (A.indices m)
#ifndef __HASTE__
instance ResultProvider p m => ResultProvider (V.Vector p) m where
resultSource' name i m =
resultSource' name i $ ResultVectorWithSubscript m subscript where
subscript = V.imap (\i x -> intSubscript i) m
#endif
data ResultListWithSubscript p =
ResultListWithSubscript [p] [String]
data ResultArrayWithSubscript i p =
ResultArrayWithSubscript (A.Array i p) (A.Array i String)
#ifndef __HASTE__
data ResultVectorWithSubscript p =
ResultVectorWithSubscript (V.Vector p) (V.Vector String)
#endif
instance ResultProvider p m => ResultProvider (ResultListWithSubscript p) m where
resultSource' name i (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
in resultSource' name' (VectorItemId y) x
items' = map resultSourceSummary items
instance (Show i, Ix i, ResultProvider p m) => ResultProvider (ResultArrayWithSubscript i p) m where
resultSource' name i (ResultArrayWithSubscript xs ys) =
resultSource' name i $ ResultListWithSubscript items subscript where
items = A.elems xs
subscript = A.elems ys
#ifndef __HASTE__
instance ResultProvider p m => ResultProvider (ResultVectorWithSubscript p) m where
resultSource' name i (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
in resultSource' name' (VectorItemId y) x
items' = V.map resultSourceSummary items
#endif
instance (Ix i, Show i, ResultComputing t m) => ResultProvider (t m (A.Array i Double)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ mapResultValue A.elems $ computeResultValue name i m
instance (Ix i, Show i, ResultComputing t m) => ResultProvider (t m (A.Array i Int)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ mapResultValue A.elems $ computeResultValue name i m
#ifndef __HASTE__
instance ResultComputing t m => ResultProvider (t m (V.Vector Double)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ mapResultValue V.toList $ computeResultValue name i m
instance ResultComputing t m => ResultProvider (t m (V.Vector Int)) m where
resultSource' name i m =
ResultItemSource $ ResultItem $ mapResultValue V.toList $ computeResultValue name i m
#endif
instance (MonadComp m,
Show si, Show sm, Show so,
ResultItemable (ResultValue si),
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultProvider (Q.Queue m si sm so a) m where
resultSource' name i m =
queueResultSource $ ResultContainer name i m (ResultSignal $ Q.queueChanged_ m)
instance (MonadComp m,
Show sm, Show so,
ResultItemable (ResultValue sm),
ResultItemable (ResultValue so))
=> ResultProvider (IQ.Queue m sm so a) m where
resultSource' name i m =
infiniteQueueResultSource $ ResultContainer name i m (ResultSignal $ IQ.queueChanged_ m)
instance MonadComp m => ResultProvider (ArrivalTimer m) m where
resultSource' name i m =
arrivalTimerResultSource $ ResultContainer name i m (ResultSignal $ arrivalProcessingTimeChanged_ m)
instance (MonadComp m, Show s, ResultItemable (ResultValue s)) => ResultProvider (Server m s a b) m where
resultSource' name i m =
serverResultSource $ ResultContainer name i m (ResultSignal $ serverChanged_ m)