{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}
module Simulation.Aivika.Trans.Experiment.Types where
import Control.Monad
import Control.Exception
import Data.Maybe
import Data.Monoid
import Data.Either
import GHC.Conc (getNumCapabilities)
import Simulation.Aivika.Trans
data Experiment m =
Experiment { Experiment m -> Specs m
experimentSpecs :: Specs m,
Experiment m -> ResultTransform m
experimentTransform :: ResultTransform m,
Experiment m -> ResultLocalisation
experimentLocalisation :: ResultLocalisation,
Experiment m -> Int
experimentRunCount :: Int,
Experiment m -> String
experimentTitle :: String,
Experiment m -> String
experimentDescription :: String,
Experiment m -> Bool
experimentVerbose :: Bool,
Experiment m -> IO Int
experimentNumCapabilities :: IO Int
}
defaultExperiment :: Experiment m
defaultExperiment :: Experiment m
defaultExperiment =
Experiment :: forall (m :: * -> *).
Specs m
-> ResultTransform m
-> ResultLocalisation
-> Int
-> String
-> String
-> Bool
-> IO Int
-> Experiment m
Experiment { experimentSpecs :: Specs m
experimentSpecs = Double -> Double -> Double -> Method -> GeneratorType m -> Specs m
forall (m :: * -> *).
Double -> Double -> Double -> Method -> GeneratorType m -> Specs m
Specs Double
0 Double
10 Double
0.01 Method
RungeKutta4 GeneratorType m
forall (m :: * -> *). GeneratorType m
SimpleGenerator,
experimentTransform :: ResultTransform m
experimentTransform = ResultTransform m
forall a. a -> a
id,
experimentLocalisation :: ResultLocalisation
experimentLocalisation = ResultLocalisation
englishResultLocalisation,
experimentRunCount :: Int
experimentRunCount = Int
1,
experimentTitle :: String
experimentTitle = String
"Simulation Experiment",
experimentDescription :: String
experimentDescription = String
"",
experimentVerbose :: Bool
experimentVerbose = Bool
True,
experimentNumCapabilities :: IO Int
experimentNumCapabilities = IO Int
getNumCapabilities }
class ExperimentMonadProviding r (m :: * -> *) where
type ExperimentMonad r m :: * -> *
type ExperimentMonadTry r m a = ExperimentMonad r m (Either SomeException a)
class ExperimentMonadProviding r m => ExperimentRendering r m where
data ExperimentContext r m :: *
type ExperimentEnvironment r m :: *
prepareExperiment :: Experiment m -> r -> ExperimentMonad r m (ExperimentEnvironment r m)
renderExperiment :: Experiment m -> r -> [ExperimentReporter r m] -> ExperimentEnvironment r m -> ExperimentMonad r m ()
onExperimentCompleted :: Experiment m -> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
onExperimentFailed :: Exception e => Experiment m -> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
data ExperimentGenerator r m =
ExperimentGenerator { ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
generateReporter :: Experiment m -> r -> ExperimentEnvironment r m -> ExperimentMonad r m (ExperimentReporter r m)
}
class ExperimentRendering r m => ExperimentView v r m where
outputView :: v m -> ExperimentGenerator r m
data ExperimentData m =
ExperimentData { ExperimentData m -> Results m
experimentResults :: Results m,
ExperimentData m -> ResultPredefinedSignals m
experimentPredefinedSignals :: ResultPredefinedSignals m
}
data ExperimentReporter r m =
ExperimentReporter { ExperimentReporter r m -> ExperimentMonad r m ()
reporterInitialise :: ExperimentMonad r m (),
ExperimentReporter r m -> ExperimentMonad r m ()
reporterFinalise :: ExperimentMonad r m (),
ExperimentReporter r m -> ExperimentData m -> Composite m ()
reporterSimulate :: ExperimentData m -> Composite m (),
ExperimentReporter r m -> ExperimentContext r m
reporterContext :: ExperimentContext r m
}
runExperiment_ :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m ()
{-# INLINABLE runExperiment_ #-}
runExperiment_ :: (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m ()
runExperiment_ m () -> ExperimentMonad r m a
executor0 Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation =
do Either SomeException ()
x <- ([m ()] -> ExperimentMonad r m ())
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m ()
forall (m :: * -> *) r a.
(MonadDES m, ExperimentRendering r m, Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m)) =>
([m ()] -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m a
runExperimentWithExecutor [m ()] -> ExperimentMonad r m ()
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation
Either SomeException () -> ExperimentMonadTry r m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException ()
x Either SomeException ()
-> Either SomeException () -> Either SomeException ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either SomeException ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where executor :: [m ()] -> ExperimentMonad r m ()
executor = [ExperimentMonad r m a] -> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([ExperimentMonad r m a] -> ExperimentMonad r m ())
-> ([m ()] -> [ExperimentMonad r m a])
-> [m ()]
-> ExperimentMonad r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m () -> ExperimentMonad r m a)
-> [m ()] -> [ExperimentMonad r m a]
forall a b. (a -> b) -> [a] -> [b]
map m () -> ExperimentMonad r m a
executor0
runExperiment :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m [a]
{-# INLINABLE runExperiment #-}
runExperiment :: (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m [a]
runExperiment m () -> ExperimentMonad r m a
executor0 = ([m ()] -> ExperimentMonad r m [a])
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m [a]
forall (m :: * -> *) r a.
(MonadDES m, ExperimentRendering r m, Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m)) =>
([m ()] -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m a
runExperimentWithExecutor [m ()] -> ExperimentMonad r m [a]
executor
where executor :: [m ()] -> ExperimentMonad r m [a]
executor = [ExperimentMonad r m a] -> ExperimentMonad r m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([ExperimentMonad r m a] -> ExperimentMonad r m [a])
-> ([m ()] -> [ExperimentMonad r m a])
-> [m ()]
-> ExperimentMonad r m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m () -> ExperimentMonad r m a)
-> [m ()] -> [ExperimentMonad r m a]
forall a b. (a -> b) -> [a] -> [b]
map m () -> ExperimentMonad r m a
executor0
runExperimentWithExecutor :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> ([m ()] -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m a
{-# INLINABLE runExperimentWithExecutor #-}
runExperimentWithExecutor :: ([m ()] -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> ExperimentMonadTry r m a
runExperimentWithExecutor [m ()] -> ExperimentMonad r m a
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation =
do let specs :: Specs m
specs = Experiment m -> Specs m
forall (m :: * -> *). Experiment m -> Specs m
experimentSpecs Experiment m
e
runCount :: Int
runCount = Experiment m -> Int
forall (m :: * -> *). Experiment m -> Int
experimentRunCount Experiment m
e
ExperimentEnvironment r m
env <- Experiment m
-> r -> ExperimentMonad r m (ExperimentEnvironment r m)
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r -> ExperimentMonad r m (ExperimentEnvironment r m)
prepareExperiment Experiment m
e r
r
let c1 :: ExperimentMonadTry r m a
c1 =
do [ExperimentReporter r m]
reporters <- (ExperimentGenerator r m
-> ExperimentMonad r m (ExperimentReporter r m))
-> [ExperimentGenerator r m]
-> ExperimentMonad r m [ExperimentReporter r m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ExperimentGenerator r m
x -> ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
forall r (m :: * -> *).
ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
generateReporter ExperimentGenerator r m
x Experiment m
e r
r ExperimentEnvironment r m
env)
[ExperimentGenerator r m]
generators
[ExperimentReporter r m]
-> (ExperimentReporter r m -> ExperimentMonad r m ())
-> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ExperimentReporter r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentMonad r m ()
reporterInitialise
let simulate :: Simulation m ()
simulate =
do ResultPredefinedSignals m
signals <- Simulation m (ResultPredefinedSignals m)
forall (m :: * -> *).
MonadDES m =>
Simulation m (ResultPredefinedSignals m)
newResultPredefinedSignals
Results m
results <- Simulation m (Results m)
simulation
let d :: ExperimentData m
d = ExperimentData :: forall (m :: * -> *).
Results m -> ResultPredefinedSignals m -> ExperimentData m
ExperimentData { experimentResults :: Results m
experimentResults = Experiment m -> ResultTransform m
forall (m :: * -> *). Experiment m -> ResultTransform m
experimentTransform Experiment m
e Results m
results,
experimentPredefinedSignals :: ResultPredefinedSignals m
experimentPredefinedSignals = ResultPredefinedSignals m
signals }
((), DisposableEvent m
fs) <- Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m)
forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStartTime (Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m))
-> Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
EventProcessing
-> Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m)
forall (m :: * -> *) a.
EventQueueing m =>
EventProcessing -> Event m a -> Dynamics m a
runEventWith EventProcessing
EarlierEvents (Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m))
-> Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
(Composite m ()
-> DisposableEvent m -> Event m ((), DisposableEvent m))
-> DisposableEvent m
-> Composite m ()
-> Event m ((), DisposableEvent m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Composite m ()
-> DisposableEvent m -> Event m ((), DisposableEvent m)
forall (m :: * -> *) a.
Composite m a
-> DisposableEvent m -> Event m (a, DisposableEvent m)
runComposite DisposableEvent m
forall a. Monoid a => a
mempty (Composite m () -> Event m ((), DisposableEvent m))
-> Composite m () -> Event m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
[ExperimentReporter r m]
-> (ExperimentReporter r m -> Composite m ()) -> Composite m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ((ExperimentReporter r m -> Composite m ()) -> Composite m ())
-> (ExperimentReporter r m -> Composite m ()) -> Composite m ()
forall a b. (a -> b) -> a -> b
$ \ExperimentReporter r m
reporter ->
ExperimentReporter r m -> ExperimentData m -> Composite m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentData m -> Composite m ()
reporterSimulate ExperimentReporter r m
reporter ExperimentData m
d
let m1 :: Simulation m ()
m1 =
Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$
() -> Event m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
m2 :: Simulation m ()
m2 =
Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$
DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
fs
mh :: SimulationAbort -> m ()
mh (SimulationAbort String
e') =
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Simulation m () -> Simulation m () -> Simulation m ()
forall (m :: * -> *) a b.
MonadException m =>
Simulation m a -> Simulation m b -> Simulation m a
finallySimulation (Simulation m ()
-> (SimulationAbort -> Simulation m ()) -> Simulation m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Simulation m a -> (e -> Simulation m a) -> Simulation m a
catchSimulation Simulation m ()
m1 SimulationAbort -> Simulation m ()
forall (m :: * -> *). Monad m => SimulationAbort -> m ()
mh) Simulation m ()
m2
a
a <- [m ()] -> ExperimentMonad r m a
executor ([m ()] -> ExperimentMonad r m a)
-> [m ()] -> ExperimentMonad r m a
forall a b. (a -> b) -> a -> b
$
Simulation m () -> Specs m -> Int -> [m ()]
forall (m :: * -> *) a.
MonadDES m =>
Simulation m a -> Specs m -> Int -> [m a]
runSimulations Simulation m ()
simulate Specs m
specs Int
runCount
[ExperimentReporter r m]
-> (ExperimentReporter r m -> ExperimentMonad r m ())
-> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ExperimentReporter r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentMonad r m ()
reporterFinalise
Experiment m
-> r
-> [ExperimentReporter r m]
-> ExperimentEnvironment r m
-> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r
-> [ExperimentReporter r m]
-> ExperimentEnvironment r m
-> ExperimentMonad r m ()
renderExperiment Experiment m
e r
r [ExperimentReporter r m]
reporters ExperimentEnvironment r m
env
Experiment m
-> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
onExperimentCompleted Experiment m
e r
r ExperimentEnvironment r m
env
Either SomeException a -> ExperimentMonadTry r m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)
ch :: SomeException -> ExperimentMonadTry r m a
ch z :: SomeException
z@(SomeException e
e') =
do Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
forall r (m :: * -> *) e.
(ExperimentRendering r m, Exception e) =>
Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
onExperimentFailed Experiment m
e r
r ExperimentEnvironment r m
env e
e'
Either SomeException a -> ExperimentMonadTry r m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
z)
ExperimentMonadTry r m a
-> (SomeException -> ExperimentMonadTry r m a)
-> ExperimentMonadTry r m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp ExperimentMonadTry r m a
c1 SomeException -> ExperimentMonadTry r m a
ch
runExperimentByIndex :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m a
{-# INLINABLE runExperimentByIndex #-}
runExperimentByIndex :: (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m a
runExperimentByIndex m () -> ExperimentMonad r m a
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation Int
runIndex =
do let specs :: Specs m
specs = Experiment m -> Specs m
forall (m :: * -> *). Experiment m -> Specs m
experimentSpecs Experiment m
e
runCount :: Int
runCount = Experiment m -> Int
forall (m :: * -> *). Experiment m -> Int
experimentRunCount Experiment m
e
ExperimentEnvironment r m
env <- Experiment m
-> r -> ExperimentMonad r m (ExperimentEnvironment r m)
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r -> ExperimentMonad r m (ExperimentEnvironment r m)
prepareExperiment Experiment m
e r
r
let c1 :: ExperimentMonadTry r m a
c1 =
do [ExperimentReporter r m]
reporters <- (ExperimentGenerator r m
-> ExperimentMonad r m (ExperimentReporter r m))
-> [ExperimentGenerator r m]
-> ExperimentMonad r m [ExperimentReporter r m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ExperimentGenerator r m
x -> ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
forall r (m :: * -> *).
ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
generateReporter ExperimentGenerator r m
x Experiment m
e r
r ExperimentEnvironment r m
env)
[ExperimentGenerator r m]
generators
[ExperimentReporter r m]
-> (ExperimentReporter r m -> ExperimentMonad r m ())
-> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ExperimentReporter r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentMonad r m ()
reporterInitialise
let simulate :: Simulation m ()
simulate =
do ResultPredefinedSignals m
signals <- Simulation m (ResultPredefinedSignals m)
forall (m :: * -> *).
MonadDES m =>
Simulation m (ResultPredefinedSignals m)
newResultPredefinedSignals
Results m
results <- Simulation m (Results m)
simulation
let d :: ExperimentData m
d = ExperimentData :: forall (m :: * -> *).
Results m -> ResultPredefinedSignals m -> ExperimentData m
ExperimentData { experimentResults :: Results m
experimentResults = Experiment m -> ResultTransform m
forall (m :: * -> *). Experiment m -> ResultTransform m
experimentTransform Experiment m
e Results m
results,
experimentPredefinedSignals :: ResultPredefinedSignals m
experimentPredefinedSignals = ResultPredefinedSignals m
signals }
((), DisposableEvent m
fs) <- Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m)
forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStartTime (Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m))
-> Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
EventProcessing
-> Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m)
forall (m :: * -> *) a.
EventQueueing m =>
EventProcessing -> Event m a -> Dynamics m a
runEventWith EventProcessing
EarlierEvents (Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m))
-> Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
(Composite m ()
-> DisposableEvent m -> Event m ((), DisposableEvent m))
-> DisposableEvent m
-> Composite m ()
-> Event m ((), DisposableEvent m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Composite m ()
-> DisposableEvent m -> Event m ((), DisposableEvent m)
forall (m :: * -> *) a.
Composite m a
-> DisposableEvent m -> Event m (a, DisposableEvent m)
runComposite DisposableEvent m
forall a. Monoid a => a
mempty (Composite m () -> Event m ((), DisposableEvent m))
-> Composite m () -> Event m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
[ExperimentReporter r m]
-> (ExperimentReporter r m -> Composite m ()) -> Composite m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ((ExperimentReporter r m -> Composite m ()) -> Composite m ())
-> (ExperimentReporter r m -> Composite m ()) -> Composite m ()
forall a b. (a -> b) -> a -> b
$ \ExperimentReporter r m
reporter ->
ExperimentReporter r m -> ExperimentData m -> Composite m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentData m -> Composite m ()
reporterSimulate ExperimentReporter r m
reporter ExperimentData m
d
let m1 :: Simulation m ()
m1 =
Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$
() -> Event m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
m2 :: Simulation m ()
m2 =
Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$
DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
fs
mh :: SimulationAbort -> m ()
mh (SimulationAbort String
e') =
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Simulation m () -> Simulation m () -> Simulation m ()
forall (m :: * -> *) a b.
MonadException m =>
Simulation m a -> Simulation m b -> Simulation m a
finallySimulation (Simulation m ()
-> (SimulationAbort -> Simulation m ()) -> Simulation m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Simulation m a -> (e -> Simulation m a) -> Simulation m a
catchSimulation Simulation m ()
m1 SimulationAbort -> Simulation m ()
forall (m :: * -> *). Monad m => SimulationAbort -> m ()
mh) Simulation m ()
m2
a
a <- m () -> ExperimentMonad r m a
executor (m () -> ExperimentMonad r m a) -> m () -> ExperimentMonad r m a
forall a b. (a -> b) -> a -> b
$
Simulation m () -> Specs m -> Int -> Int -> m ()
forall (m :: * -> *) a.
MonadDES m =>
Simulation m a -> Specs m -> Int -> Int -> m a
runSimulationByIndex Simulation m ()
simulate Specs m
specs Int
runCount Int
runIndex
[ExperimentReporter r m]
-> (ExperimentReporter r m -> ExperimentMonad r m ())
-> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ExperimentReporter r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentMonad r m ()
reporterFinalise
Experiment m
-> r
-> [ExperimentReporter r m]
-> ExperimentEnvironment r m
-> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r
-> [ExperimentReporter r m]
-> ExperimentEnvironment r m
-> ExperimentMonad r m ()
renderExperiment Experiment m
e r
r [ExperimentReporter r m]
reporters ExperimentEnvironment r m
env
Experiment m
-> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
onExperimentCompleted Experiment m
e r
r ExperimentEnvironment r m
env
Either SomeException a -> ExperimentMonadTry r m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)
ch :: SomeException -> ExperimentMonadTry r m a
ch z :: SomeException
z@(SomeException e
e') =
do Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
forall r (m :: * -> *) e.
(ExperimentRendering r m, Exception e) =>
Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
onExperimentFailed Experiment m
e r
r ExperimentEnvironment r m
env e
e'
Either SomeException a -> ExperimentMonadTry r m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
z)
ExperimentMonadTry r m a
-> (SomeException -> ExperimentMonadTry r m a)
-> ExperimentMonadTry r m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp ExperimentMonadTry r m a
c1 SomeException -> ExperimentMonadTry r m a
ch
runExperimentByIndex_ :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m ()
{-# INLINABLE runExperimentByIndex_ #-}
runExperimentByIndex_ :: (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m ()
runExperimentByIndex_ m () -> ExperimentMonad r m a
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation Int
runIndex =
do Either SomeException a
x <- (m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonad r m (Either SomeException a)
forall (m :: * -> *) r a.
(MonadDES m, ExperimentRendering r m, Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m)) =>
(m () -> ExperimentMonad r m a)
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m a
runExperimentByIndex m () -> ExperimentMonad r m a
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation Int
runIndex
Either SomeException () -> ExperimentMonadTry r m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a
x Either SomeException a
-> Either SomeException () -> Either SomeException ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either SomeException ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
runExperimentContByIndex :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
{-# INLINABLE runExperimentContByIndex #-}
runExperimentContByIndex :: (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
runExperimentContByIndex m () -> ExperimentMonad r m (a, ExperimentMonad r m b)
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation Int
runIndex =
do let specs :: Specs m
specs = Experiment m -> Specs m
forall (m :: * -> *). Experiment m -> Specs m
experimentSpecs Experiment m
e
runCount :: Int
runCount = Experiment m -> Int
forall (m :: * -> *). Experiment m -> Int
experimentRunCount Experiment m
e
ExperimentEnvironment r m
env <- Experiment m
-> r -> ExperimentMonad r m (ExperimentEnvironment r m)
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r -> ExperimentMonad r m (ExperimentEnvironment r m)
prepareExperiment Experiment m
e r
r
let c1 :: ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
c1 =
do [ExperimentReporter r m]
reporters <- (ExperimentGenerator r m
-> ExperimentMonad r m (ExperimentReporter r m))
-> [ExperimentGenerator r m]
-> ExperimentMonad r m [ExperimentReporter r m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ExperimentGenerator r m
x -> ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
forall r (m :: * -> *).
ExperimentGenerator r m
-> Experiment m
-> r
-> ExperimentEnvironment r m
-> ExperimentMonad r m (ExperimentReporter r m)
generateReporter ExperimentGenerator r m
x Experiment m
e r
r ExperimentEnvironment r m
env)
[ExperimentGenerator r m]
generators
[ExperimentReporter r m]
-> (ExperimentReporter r m -> ExperimentMonad r m ())
-> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ExperimentReporter r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentMonad r m ()
reporterInitialise
let simulate :: Simulation m ()
simulate =
do ResultPredefinedSignals m
signals <- Simulation m (ResultPredefinedSignals m)
forall (m :: * -> *).
MonadDES m =>
Simulation m (ResultPredefinedSignals m)
newResultPredefinedSignals
Results m
results <- Simulation m (Results m)
simulation
let d :: ExperimentData m
d = ExperimentData :: forall (m :: * -> *).
Results m -> ResultPredefinedSignals m -> ExperimentData m
ExperimentData { experimentResults :: Results m
experimentResults = Experiment m -> ResultTransform m
forall (m :: * -> *). Experiment m -> ResultTransform m
experimentTransform Experiment m
e Results m
results,
experimentPredefinedSignals :: ResultPredefinedSignals m
experimentPredefinedSignals = ResultPredefinedSignals m
signals }
((), DisposableEvent m
fs) <- Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m)
forall (m :: * -> *) a. Dynamics m a -> Simulation m a
runDynamicsInStartTime (Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m))
-> Dynamics m ((), DisposableEvent m)
-> Simulation m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
EventProcessing
-> Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m)
forall (m :: * -> *) a.
EventQueueing m =>
EventProcessing -> Event m a -> Dynamics m a
runEventWith EventProcessing
EarlierEvents (Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m))
-> Event m ((), DisposableEvent m)
-> Dynamics m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
(Composite m ()
-> DisposableEvent m -> Event m ((), DisposableEvent m))
-> DisposableEvent m
-> Composite m ()
-> Event m ((), DisposableEvent m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Composite m ()
-> DisposableEvent m -> Event m ((), DisposableEvent m)
forall (m :: * -> *) a.
Composite m a
-> DisposableEvent m -> Event m (a, DisposableEvent m)
runComposite DisposableEvent m
forall a. Monoid a => a
mempty (Composite m () -> Event m ((), DisposableEvent m))
-> Composite m () -> Event m ((), DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
[ExperimentReporter r m]
-> (ExperimentReporter r m -> Composite m ()) -> Composite m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ((ExperimentReporter r m -> Composite m ()) -> Composite m ())
-> (ExperimentReporter r m -> Composite m ()) -> Composite m ()
forall a b. (a -> b) -> a -> b
$ \ExperimentReporter r m
reporter ->
ExperimentReporter r m -> ExperimentData m -> Composite m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentData m -> Composite m ()
reporterSimulate ExperimentReporter r m
reporter ExperimentData m
d
let m1 :: Simulation m ()
m1 =
Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$
() -> Event m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
m2 :: Simulation m ()
m2 =
Event m () -> Simulation m ()
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime (Event m () -> Simulation m ()) -> Event m () -> Simulation m ()
forall a b. (a -> b) -> a -> b
$
DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
fs
mh :: SimulationAbort -> m ()
mh (SimulationAbort String
e') =
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Simulation m () -> Simulation m () -> Simulation m ()
forall (m :: * -> *) a b.
MonadException m =>
Simulation m a -> Simulation m b -> Simulation m a
finallySimulation (Simulation m ()
-> (SimulationAbort -> Simulation m ()) -> Simulation m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Simulation m a -> (e -> Simulation m a) -> Simulation m a
catchSimulation Simulation m ()
m1 SimulationAbort -> Simulation m ()
forall (m :: * -> *). Monad m => SimulationAbort -> m ()
mh) Simulation m ()
m2
(a
a, ExperimentMonad r m b
m) <- m () -> ExperimentMonad r m (a, ExperimentMonad r m b)
executor (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> m () -> ExperimentMonad r m (a, ExperimentMonad r m b)
forall a b. (a -> b) -> a -> b
$
Simulation m () -> Specs m -> Int -> Int -> m ()
forall (m :: * -> *) a.
MonadDES m =>
Simulation m a -> Specs m -> Int -> Int -> m a
runSimulationByIndex Simulation m ()
simulate Specs m
specs Int
runCount Int
runIndex
let m2 :: ExperimentMonadTry r m b
m2 =
do b
b <- ExperimentMonad r m b
m
[ExperimentReporter r m]
-> (ExperimentReporter r m -> ExperimentMonad r m ())
-> ExperimentMonad r m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r m]
reporters ExperimentReporter r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentReporter r m -> ExperimentMonad r m ()
reporterFinalise
Experiment m
-> r
-> [ExperimentReporter r m]
-> ExperimentEnvironment r m
-> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r
-> [ExperimentReporter r m]
-> ExperimentEnvironment r m
-> ExperimentMonad r m ()
renderExperiment Experiment m
e r
r [ExperimentReporter r m]
reporters ExperimentEnvironment r m
env
Experiment m
-> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
forall r (m :: * -> *).
ExperimentRendering r m =>
Experiment m
-> r -> ExperimentEnvironment r m -> ExperimentMonad r m ()
onExperimentCompleted Experiment m
e r
r ExperimentEnvironment r m
env
Either SomeException b -> ExperimentMonadTry r m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either SomeException b
forall a b. b -> Either a b
Right b
b)
mh :: SomeException -> ExperimentMonadTry r m b
mh z :: SomeException
z@(SomeException e
e') =
do Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
forall r (m :: * -> *) e.
(ExperimentRendering r m, Exception e) =>
Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
onExperimentFailed Experiment m
e r
r ExperimentEnvironment r m
env e
e'
Either SomeException b -> ExperimentMonadTry r m b
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException b
forall a b. a -> Either a b
Left SomeException
z)
Either SomeException (a, ExperimentMonadTry r m b)
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, ExperimentMonadTry r m b)
-> Either SomeException (a, ExperimentMonadTry r m b)
forall a b. b -> Either a b
Right (a
a, ExperimentMonadTry r m b
-> (SomeException -> ExperimentMonadTry r m b)
-> ExperimentMonadTry r m b
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp ExperimentMonadTry r m b
m2 SomeException -> ExperimentMonadTry r m b
mh))
ch :: SomeException
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
ch z :: SomeException
z@(SomeException e
e') =
do Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
forall r (m :: * -> *) e.
(ExperimentRendering r m, Exception e) =>
Experiment m
-> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()
onExperimentFailed Experiment m
e r
r ExperimentEnvironment r m
env e
e'
Either SomeException (a, ExperimentMonadTry r m b)
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException (a, ExperimentMonadTry r m b)
forall a b. a -> Either a b
Left SomeException
z)
ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
-> (SomeException
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b))
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
c1 SomeException
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
ch
runExperimentContByIndex_ :: (MonadDES m,
ExperimentRendering r m,
Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m))
=> (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m ())
{-# INLINABLE runExperimentContByIndex_ #-}
runExperimentContByIndex_ :: (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m ())
runExperimentContByIndex_ m () -> ExperimentMonad r m (a, ExperimentMonad r m b)
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation Int
runIndex =
do Either
SomeException (a, ExperimentMonad r m (Either SomeException b))
x <- (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonad
r
m
(Either
SomeException (a, ExperimentMonad r m (Either SomeException b)))
forall (m :: * -> *) r a b.
(MonadDES m, ExperimentRendering r m, Monad (ExperimentMonad r m),
MonadException (ExperimentMonad r m)) =>
(m () -> ExperimentMonad r m (a, ExperimentMonad r m b))
-> Experiment m
-> [ExperimentGenerator r m]
-> r
-> Simulation m (Results m)
-> Int
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)
runExperimentContByIndex m () -> ExperimentMonad r m (a, ExperimentMonad r m b)
executor Experiment m
e [ExperimentGenerator r m]
generators r
r Simulation m (Results m)
simulation Int
runIndex
case Either
SomeException (a, ExperimentMonad r m (Either SomeException b))
x of
Left SomeException
e -> Either SomeException (a, ExperimentMonadTry r m ())
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException
-> Either SomeException (a, ExperimentMonadTry r m ())
forall a b. a -> Either a b
Left SomeException
e)
Right (a
a, ExperimentMonad r m (Either SomeException b)
cont) -> Either SomeException (a, ExperimentMonadTry r m ())
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException (a, ExperimentMonadTry r m ())
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m ()))
-> Either SomeException (a, ExperimentMonadTry r m ())
-> ExperimentMonadTry r m (a, ExperimentMonadTry r m ())
forall a b. (a -> b) -> a -> b
$ (a, ExperimentMonadTry r m ())
-> Either SomeException (a, ExperimentMonadTry r m ())
forall a b. b -> Either a b
Right (a
a, ExperimentMonad r m (Either SomeException b)
cont ExperimentMonad r m (Either SomeException b)
-> ExperimentMonadTry r m () -> ExperimentMonadTry r m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either SomeException () -> ExperimentMonadTry r m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either SomeException ()
forall a b. b -> Either a b
Right ()))