aivika-experiment 4.0.3 → 5.0

raw patch · 42 files changed

+3274/−2592 lines, 42 filesdep +aivika-transformersdep ~aivikaPVP ok

version bump matches the API change (PVP)

Dependencies added: aivika-transformers

Dependency ranges changed: aivika

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Simulation/Aivika/Experiment.hs +3/−31
• Simulation/Aivika/Experiment/Base.hs +43/−0
• Simulation/Aivika/Experiment/Base/ExperimentSpecsView.hs +97/−0
• Simulation/Aivika/Experiment/Base/ExperimentSpecsWriter.hs +131/−0
• Simulation/Aivika/Experiment/Base/ExperimentWriter.hs +154/−0
• Simulation/Aivika/Experiment/Base/FileRenderer.hs +64/−0
• Simulation/Aivika/Experiment/Base/FinalStatsView.hs +166/−0
• Simulation/Aivika/Experiment/Base/FinalTableView.hs +253/−0
• Simulation/Aivika/Experiment/Base/HtmlWriter.hs +401/−0
• Simulation/Aivika/Experiment/Base/InfoView.hs +175/−0
• Simulation/Aivika/Experiment/Base/LastValueView.hs +174/−0
• Simulation/Aivika/Experiment/Base/SamplingStatsWriter.hs +112/−0
• Simulation/Aivika/Experiment/Base/TableView.hs +258/−0
• Simulation/Aivika/Experiment/Base/TimingStatsView.hs +187/−0
• Simulation/Aivika/Experiment/Base/TimingStatsWriter.hs +130/−0
• Simulation/Aivika/Experiment/Base/WebPageRenderer.hs +108/−0
• Simulation/Aivika/Experiment/Concurrent/MVar.hs +46/−0
• Simulation/Aivika/Experiment/ExperimentSpecsView.hs +0/−97
• Simulation/Aivika/Experiment/ExperimentSpecsWriter.hs +0/−131
• Simulation/Aivika/Experiment/ExperimentWriter.hs +0/−129
• Simulation/Aivika/Experiment/FileRenderer.hs +0/−33
• Simulation/Aivika/Experiment/FinalStatsView.hs +0/−166
• Simulation/Aivika/Experiment/FinalTableView.hs +0/−253
• Simulation/Aivika/Experiment/Histogram.hs +2/−2
• Simulation/Aivika/Experiment/HtmlWriter.hs +0/−397
• Simulation/Aivika/Experiment/InfoView.hs +0/−175
• Simulation/Aivika/Experiment/LastValueView.hs +0/−174
• Simulation/Aivika/Experiment/MRef.hs +0/−107
• Simulation/Aivika/Experiment/SamplingStatsWriter.hs +0/−112
• Simulation/Aivika/Experiment/TableView.hs +0/−259
• Simulation/Aivika/Experiment/TimingStatsView.hs +0/−188
• Simulation/Aivika/Experiment/TimingStatsWriter.hs +0/−130
• Simulation/Aivika/Experiment/Types.hs +96/−72
• Simulation/Aivika/Experiment/Utils.hs +2/−2
• Simulation/Aivika/Experiment/WebPageRenderer.hs +0/−85
• Simulation/Aivika/Trans/Experiment.hs +17/−0
• Simulation/Aivika/Trans/Experiment/Concurrent/MVar.hs +197/−0
• Simulation/Aivika/Trans/Experiment/Types.hs +402/−0
• aivika-experiment.cabal +34/−23
• examples/LinearArray.hs +11/−19
• examples/MachRep3.hs +10/−6

@@ -1,4 +1,4 @@-Copyright (c) 2012-2015 David Sorokin <david.sorokin@gmail.com>+Copyright (c) 2012-2017 David Sorokin <david.sorokin@gmail.com>  All rights reserved. 

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.10.1+-- Tested with: GHC 8.0.1 -- -- This module re-exports the library functionality. --@@ -13,37 +13,9 @@ module Simulation.Aivika.Experiment        (-- * Modules         module Simulation.Aivika.Experiment.Types,-        module Simulation.Aivika.Experiment.HtmlWriter,-        module Simulation.Aivika.Experiment.LastValueView,-        module Simulation.Aivika.Experiment.TableView,-        module Simulation.Aivika.Experiment.TimingStatsView,-        module Simulation.Aivika.Experiment.TimingStatsWriter,-        module Simulation.Aivika.Experiment.SamplingStatsWriter,-        module Simulation.Aivika.Experiment.FinalStatsView,         module Simulation.Aivika.Experiment.Histogram,-        module Simulation.Aivika.Experiment.ExperimentSpecsView,-        module Simulation.Aivika.Experiment.ExperimentSpecsWriter,-        module Simulation.Aivika.Experiment.ExperimentWriter,-        module Simulation.Aivika.Experiment.FinalTableView,-        module Simulation.Aivika.Experiment.InfoView,-        module Simulation.Aivika.Experiment.Utils,-        module Simulation.Aivika.Experiment.WebPageRenderer,-        module Simulation.Aivika.Experiment.FileRenderer) where+        module Simulation.Aivika.Experiment.Utils) where  import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.LastValueView-import Simulation.Aivika.Experiment.TableView-import Simulation.Aivika.Experiment.TimingStatsView-import Simulation.Aivika.Experiment.TimingStatsWriter-import Simulation.Aivika.Experiment.SamplingStatsWriter-import Simulation.Aivika.Experiment.FinalStatsView import Simulation.Aivika.Experiment.Histogram-import Simulation.Aivika.Experiment.ExperimentSpecsView-import Simulation.Aivika.Experiment.ExperimentSpecsWriter-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.FinalTableView-import Simulation.Aivika.Experiment.InfoView import Simulation.Aivika.Experiment.Utils-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.FileRenderer

@@ -0,0 +1,43 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Base+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- This module re-exports the library functionality.+--++module Simulation.Aivika.Experiment.Base+       (-- * Modules+        module Simulation.Aivika.Experiment.Base.ExperimentSpecsView,+        module Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter,+        module Simulation.Aivika.Experiment.Base.ExperimentWriter,+        module Simulation.Aivika.Experiment.Base.FileRenderer,+        module Simulation.Aivika.Experiment.Base.FinalStatsView,+        module Simulation.Aivika.Experiment.Base.FinalTableView,+        module Simulation.Aivika.Experiment.Base.HtmlWriter,+        module Simulation.Aivika.Experiment.Base.InfoView,+        module Simulation.Aivika.Experiment.Base.LastValueView,+        module Simulation.Aivika.Experiment.Base.SamplingStatsWriter,+        module Simulation.Aivika.Experiment.Base.TableView,+        module Simulation.Aivika.Experiment.Base.TimingStatsView,+        module Simulation.Aivika.Experiment.Base.TimingStatsWriter,+        module Simulation.Aivika.Experiment.Base.WebPageRenderer) where++import Simulation.Aivika.Experiment.Base.ExperimentSpecsView+import Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.FileRenderer+import Simulation.Aivika.Experiment.Base.FinalStatsView+import Simulation.Aivika.Experiment.Base.FinalTableView+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Base.InfoView+import Simulation.Aivika.Experiment.Base.LastValueView+import Simulation.Aivika.Experiment.Base.SamplingStatsWriter+import Simulation.Aivika.Experiment.Base.TableView+import Simulation.Aivika.Experiment.Base.TimingStatsView+import Simulation.Aivika.Experiment.Base.TimingStatsWriter+import Simulation.Aivika.Experiment.Base.WebPageRenderer

@@ -0,0 +1,97 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.ExperimentSpecsView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'ExperimentSpecsView' that shows the +-- experiment specs.+--++module Simulation.Aivika.Experiment.Base.ExperimentSpecsView +       (ExperimentSpecsView(..),+        defaultExperimentSpecsView) where++import Control.Monad+import Control.Monad.Trans++import Data.Monoid++import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter++-- | Defines the 'View' that shows the experiment specs.+data ExperimentSpecsView =+  ExperimentSpecsView { experimentSpecsTitle       :: String,+                        -- ^ The title for the view.+                        experimentSpecsDescription :: String,+                        -- ^ The description for the view.+                        experimentSpecsWriter      :: ExperimentSpecsWriter+                        -- ^ It shows the specs.+                      }+  +-- | This is the default view.+defaultExperimentSpecsView :: ExperimentSpecsView+defaultExperimentSpecsView =  +  ExperimentSpecsView { experimentSpecsTitle       = "Experiment Specs",+                        experimentSpecsDescription = "It shows the experiment specs.",+                        experimentSpecsWriter      = defaultExperimentSpecsWriter }++instance ExperimentView ExperimentSpecsView (WebPageRenderer a) where  +  +  outputView v = +    let reporter exp renderer dir =+          do st <- newExperimentSpecs v exp+             let context =+                   WebPageContext $+                   WebPageWriter { reporterWriteTOCHtml = experimentSpecsTOCHtml st,+                                   reporterWriteHtml    = experimentSpecsHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = const $ return mempty,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }+  +-- | The state of the view.+data ExperimentSpecsViewState =+  ExperimentSpecsViewState { experimentSpecsView       :: ExperimentSpecsView,+                             experimentSpecsExperiment :: Experiment }+  +-- | Create a new state of the view.+newExperimentSpecs :: ExperimentSpecsView -> Experiment -> ExperimentWriter ExperimentSpecsViewState+newExperimentSpecs view exp =+  return ExperimentSpecsViewState { experimentSpecsView       = view,+                                    experimentSpecsExperiment = exp }+       +-- | Get the HTML code.     +experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()     +experimentSpecsHtml st index =+  do header st index+     let writer = experimentSpecsWriter (experimentSpecsView st)+         write  = experimentSpecsWrite writer+         exp    = experimentSpecsExperiment st+     write writer exp++header :: ExperimentSpecsViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $+       writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)+     let description = experimentSpecsDescription $ experimentSpecsView st+     unless (null description) $+       writeHtmlParagraph $+       writeHtmlText description++-- | Get the TOC item     +experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()+experimentSpecsTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)

@@ -0,0 +1,131 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'ExperimentSpecsWriter' that knows how to write+-- in HTML the experiment specs which include the simulation specs and +-- the number of simulation runs.+--++module Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter +       (ExperimentSpecsWriter(..),+        defaultExperimentSpecsWriter) where++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.HtmlWriter++-- | Defines a writer that knows how to represent the+-- experiment specs as the HTML table.+data ExperimentSpecsWriter =+  ExperimentSpecsWriter { experimentSpecsWidth         :: Int,+                          -- ^ The width of the HTML table.+                          experimentSpecsNameText     :: String,+                          -- ^ Translated text \"Experiment Specs\".+                          experimentSpecsStartTimeText :: String,+                          -- ^ Translated text \"start time\".+                          experimentSpecsStopTimeText  :: String,+                          -- ^ Translated text \"stop time\".+                          experimentSpecsDTText        :: String,+                          -- ^ Translated text \"time step\".+                          experimentSpecsRunCountText  :: String,+                          -- ^ Translated text \"run count\".+                          experimentSpecsIntegMethodText    :: String,+                          -- ^ Translated text \"integration method\".+                          experimentSpecsEulerText     :: String,+                          -- ^ Translated text \"Euler's\".+                          experimentSpecsRungeKutta2Text :: String,+                          -- ^ Translated text \"the 2-nd order Runge-Kutta\".+                          experimentSpecsRungeKutta4Text :: String,+                          -- ^ Translated text \"the 4-th order Runge-Kutta\".+                          experimentSpecsFormatter     :: ShowS,+                          -- ^ The formatter of numbers.+                          experimentSpecsWrite :: ExperimentSpecsWriter+                                                  -> Experiment+                                                  -> HtmlWriter ()+                          -- ^ This function creates HTML.+                        }++-- | The default writer.+defaultExperimentSpecsWriter :: ExperimentSpecsWriter+defaultExperimentSpecsWriter =+  ExperimentSpecsWriter { +    experimentSpecsWidth = 400,+    experimentSpecsNameText = "Experiment Specs",+    experimentSpecsStartTimeText = "start time",+    experimentSpecsStopTimeText = "stop time",+    experimentSpecsDTText = "time step",+    experimentSpecsRunCountText = "run count",+    experimentSpecsIntegMethodText = "integration method",+    experimentSpecsEulerText = "Euler's",+    experimentSpecsRungeKutta2Text = "the 2-nd order Runge-Kutta",+    experimentSpecsRungeKutta4Text = "the 4-th order Runge-Kutta",+    experimentSpecsFormatter = id,+    experimentSpecsWrite = \writer exp ->+      do let format x = experimentSpecsFormatter writer x+         writeHtml "<p>"+         writeHtml "<table frame='border' cellspacing='4' width='"+         writeHtml $ show $ experimentSpecsWidth writer+         writeHtml "'>"+         writeHtml "<tr>"+         writeHtml "<td colspan='2'>"+         writeHtml "<p align='center'>"+         writeHtmlText $ experimentSpecsNameText writer+         writeHtml "</p>"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsStartTimeText writer +         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ spcStartTime $ experimentSpecs exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsStopTimeText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ spcStopTime $ experimentSpecs exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsDTText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ spcDT $ experimentSpecs exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsRunCountText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ experimentRunCount exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsIntegMethodText writer+         writeHtml "</td>"+         writeHtml "<td>"+         let method = spcMethod $ experimentSpecs exp+         writeHtml $ methodName method writer+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "</table>" +         writeHtml "</p>"+    }++-- | Return the method name.+methodName :: Method -> ExperimentSpecsWriter -> String+methodName Euler       = experimentSpecsEulerText+methodName RungeKutta2 = experimentSpecsRungeKutta2Text+methodName RungeKutta4 = experimentSpecsRungeKutta4Text

@@ -0,0 +1,154 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Base.ExperimentWriter+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- It defines the 'Exp' monad that allows providing computation with+-- an ability to resolve file paths.+--+module Simulation.Aivika.Experiment.Base.ExperimentWriter+       (ExperimentWriter,+        runExperimentWriter,+        ExperimentFilePath(..),+        experimentFilePath,+        resolveFilePath,+        expandFilePath,+        mapFilePath) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Monad.State+import Control.Concurrent.MVar+import Control.Exception++import qualified Data.Map as M+import qualified Data.Set as S++import System.Directory+import System.FilePath++import Simulation.Aivika.Trans.Exception+import Simulation.Aivika.Experiment.Utils (replace)+  +-- | Specifies the file name, unique or writable, which can be appended with extension if required.+data ExperimentFilePath = WritableFilePath FilePath+                          -- ^ The file which is overwritten in +                          -- case if it existed before.+                        | UniqueFilePath FilePath+                          -- ^ The file which is always unique,+                          -- when an automatically generated suffix+                          -- is added to the name in case of need.++-- | The default experiment file path.+experimentFilePath :: ExperimentFilePath+experimentFilePath = UniqueFilePath "experiment"+                +-- | Resolve the file path relative to the specified directory passed in the first argument+-- and taking into account a possible requirement to have an unique file name.+resolveFilePath :: FilePath -> ExperimentFilePath -> ExperimentWriter FilePath+resolveFilePath dir (WritableFilePath path) =+  return $ dir </> path+resolveFilePath dir (UniqueFilePath path)   =+  ExperimentWriter $ \r ->+  let (name, ext) = splitExtension path+      loop y i =+        do let n  = dir </> addExtension y ext+               y' = name ++ "(" ++ show i ++ ")"+           f1 <- doesFileExist n+           f2 <- doesDirectoryExist n+           if f1 || f2+             then loop y' (i + 1)+             else do n' <- liftIO $+                           modifyMVar r $ \s ->+                           if S.member n s+                           then return (s, Nothing)+                           else return (S.insert n s, Just n)+                     case n' of+                       Nothing -> loop y' (i + 1)+                       Just n' -> return n'+  in loop name 2++-- | Expand the file path using the specified table of substitutions.+expandFilePath :: ExperimentFilePath -> M.Map String String -> ExperimentFilePath+expandFilePath (WritableFilePath path) map = WritableFilePath (expandTemplates path map)+expandFilePath (UniqueFilePath path) map = UniqueFilePath (expandTemplates path map)++-- | Expand the string templates using the specified table of substitutions.+expandTemplates :: String -> M.Map String String -> String     +expandTemplates name map = name' where+  ((), name') = flip runState name $+                forM_ (M.assocs map) $ \(k, v) ->+                do a <- get+                   put $ replace k v a++-- | Transform the file path using the specified function.+mapFilePath :: (FilePath -> FilePath) -> ExperimentFilePath -> ExperimentFilePath+mapFilePath f (WritableFilePath path) = WritableFilePath (f path)+mapFilePath f (UniqueFilePath path) = UniqueFilePath (f path) +++-- | Defines an 'IO' derived computation whithin which we can resolve the unique file paths.+newtype ExperimentWriter a = ExperimentWriter (MVar (S.Set String) -> IO a)++instance Functor ExperimentWriter where++  {-# INLINE fmap #-}+  fmap f (ExperimentWriter m) =+    ExperimentWriter $ \r -> fmap f (m r)++instance Applicative ExperimentWriter where++  {-# INLINE pure #-}+  pure a =+    ExperimentWriter $ \r -> return a++  {-# INLINE (<*>) #-}+  (ExperimentWriter f) <*> (ExperimentWriter m) =+    ExperimentWriter $ \r -> f r <*> m r++instance Monad ExperimentWriter where++  {-# INLINE return #-}+  return a =+    ExperimentWriter $ \r -> return a++  {-# INLINE (>>=) #-}+  (ExperimentWriter m) >>= k =+    ExperimentWriter $ \r ->+    do a <- m r+       let ExperimentWriter b = k a+       b r+       +instance MonadIO ExperimentWriter where++  {-# INLINE liftIO #-}+  liftIO m = ExperimentWriter $ \r -> liftIO m++instance MonadException ExperimentWriter where++  {-# INLINE catchComp #-}+  catchComp (ExperimentWriter m) h =+    ExperimentWriter $ \r ->+    catch (m r) $ \e ->+    let ExperimentWriter m' = h e in m' r++  {-# INLINE finallyComp #-}+  finallyComp (ExperimentWriter m) (ExperimentWriter m') =+    ExperimentWriter $ \r ->+    finally (m r) (m' r)++  {-# INLINE throwComp #-}+  throwComp e =+    ExperimentWriter $ \r ->+    throw e++-- | Run the 'ExperimentWriter' computation.+runExperimentWriter :: ExperimentWriter a -> IO a+runExperimentWriter (ExperimentWriter m) =+  do r <- newMVar S.empty+     m r

@@ -0,0 +1,64 @@++{-# LANGUAGE TypeFamilies #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.FileRenderer+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- It defines a renderer that saves the results in files when running the simulation experiment.+--++module Simulation.Aivika.Experiment.Base.FileRenderer where++import Control.Monad+import Control.Monad.Trans++import System.Directory+import System.FilePath++import Simulation.Aivika.Trans.Exception+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.ExperimentWriter++-- | It defines a simulation 'Experiment' renderer that saves the results in files. +data FileRenderer a = FileRenderer a ExperimentFilePath+                      -- ^ A file renderer that depends on the provided parameter and+                      -- a directory path, where the simulation results are saved in.++-- | A convenient type synonym for describing a file generator.+type FileGenerator a = ExperimentGenerator (FileRenderer a)++-- | Saving the results of simulation in files when running the experiment.+instance ExperimentRendering (FileRenderer a) where++  -- | A file rendering context.+  data ExperimentContext (FileRenderer a) = FileContext+                                            -- ^ A file context constructor.++  -- | A file environment.+  type ExperimentEnvironment (FileRenderer a) = FilePath++  -- | A file rendering monad.+  type ExperimentMonad (FileRenderer a) = ExperimentWriter++  liftExperiment r = runExperimentWriter++  prepareExperiment e (FileRenderer _ path0) =+    do path <- resolveFilePath "" path0+       liftIO $ do+         when (experimentVerbose e) $+           do putStr "Updating directory " +              putStrLn path+         createDirectoryIfMissing True path+       return path+  +  renderExperiment e r reporters path = return ()++  onExperimentCompleted e r path = return ()++  onExperimentFailed e r path e' = throwComp e'+

@@ -0,0 +1,166 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.FinalStatsView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'FinalStatsView' that gathers the statistics+-- in the final time points for different simulation runs.+--++module Simulation.Aivika.Experiment.Base.FinalStatsView+       (FinalStatsView(..), +        defaultFinalStatsView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import Data.IORef+import Data.Maybe++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Base.SamplingStatsWriter+import Simulation.Aivika.Experiment.Concurrent.MVar++-- | Defines the 'View' that gathers the statistics+-- in the final time points.+data FinalStatsView =+  FinalStatsView { finalStatsTitle       :: String,+                   -- ^ This is a title for the view.+                   finalStatsDescription :: String,+                   -- ^ This is a description used in HTML.+                   finalStatsWriter      :: SamplingStatsWriter Double,+                   -- ^ It shows the sampling statistics.+                   finalStatsPredicate   :: Event Bool,+                   -- ^ It specifies the predicate that defines+                   -- when we count data when gathering the statistics.+                   finalStatsTransform   :: ResultTransform,+                   -- ^ The transform applied to the results before receiving series.+                   finalStatsSeries      :: ResultTransform +                   -- ^ It defines the series for which the statistics to be collected.+                 }+  +-- | The default statistics view.  +defaultFinalStatsView :: FinalStatsView+defaultFinalStatsView = +  FinalStatsView { finalStatsTitle       = "Final Statistics Based on Observations",+                   finalStatsDescription = "Statistics is gathered in final time points for all runs.",+                   finalStatsWriter      = defaultSamplingStatsWriter,+                   finalStatsPredicate   = return True,+                   finalStatsTransform   = id,+                   finalStatsSeries      = id }++instance ExperimentView FinalStatsView (WebPageRenderer a) where+  +  outputView v = +    let reporter exp renderer dir =+          do st <- newFinalStats v exp dir+             let context =+                   WebPageContext $+                   WebPageWriter { reporterWriteTOCHtml = finalStatsTOCHtml st,+                                   reporterWriteHtml    = finalStatsHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = simulateFinalStats st,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }+  +-- | The state of the view.+data FinalStatsViewState =+  FinalStatsViewState { finalStatsView       :: FinalStatsView,+                        finalStatsExperiment :: Experiment,+                        finalStatsResults    :: MVar (Maybe FinalStatsResults) }++-- | The statistics results.+data FinalStatsResults =+  FinalStatsResults { finalStatsNames  :: [String],+                      finalStatsValues :: [MVar (SamplingStats Double)] }+  +-- | Create a new state of the view.+newFinalStats :: FinalStatsView -> Experiment -> FilePath -> ExperimentWriter FinalStatsViewState+newFinalStats view exp dir =+  do r <- liftIO $ newMVar Nothing+     return FinalStatsViewState { finalStatsView       = view,+                                  finalStatsExperiment = exp,+                                  finalStatsResults    = r }+       +-- | Create new statistics results.+newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults+newFinalStatsResults names exp =+  do values <- forM names $ \_ -> liftIO $ newMVar emptySamplingStats+     return FinalStatsResults { finalStatsNames  = names,+                                finalStatsValues = values }++-- | Require to return unique final statistics results associated with the specified state. +requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults+requireFinalStatsResults st names =+  maybePutMVar (finalStatsResults st)+  (newFinalStatsResults names (finalStatsExperiment st)) $ \results ->+  if (names /= finalStatsNames results)+  then error "Series with different names are returned for different runs: requireFinalStatsResults"+  else return results+       +-- | Simulate the specified series.+simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Composite ()+simulateFinalStats st expdata =+  do let view    = finalStatsView st+         rs      = finalStatsSeries view $+                   finalStatsTransform view $+                   experimentResults expdata+         exts    = resultsToDoubleStatsEitherValues rs+         signals = experimentPredefinedSignals expdata+         signal  = filterSignalM (const predicate) $+                   resultSignalInStopTime signals+         names   = map resultValueName exts+         predicate = finalStatsPredicate view+     results <- liftIO $ requireFinalStatsResults st names+     let values = finalStatsValues results +     handleSignalComposite signal $ \_ ->+       forM_ (zip exts values) $ \(ext, value) ->+       do x <- resultValueData ext+          liftIO $+            modifyMVar_ value $ \y ->+            let y' = combineSamplingStatsEither x y+            in y' `seq` return y'++-- | Get the HTML code.     +finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()+finalStatsHtml st index =+  do header st index+     results <- liftIO $ readMVar (finalStatsResults st)+     case results of+       Nothing -> return ()+       Just results ->+         do let names  = finalStatsNames results+                values = finalStatsValues results+                writer = finalStatsWriter (finalStatsView st)+                write  = samplingStatsWrite writer+            forM_ (zip names values) $ \(name, value) ->+              do stats <- liftIO $ readMVar value+                 write writer name stats++header :: FinalStatsViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (finalStatsTitle $ finalStatsView st)+     let description = finalStatsDescription $ finalStatsView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()+finalStatsTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (finalStatsTitle $ finalStatsView st)

@@ -0,0 +1,253 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.FinalTableView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'FinalTableView' that saves the simulation+-- results in the final time points for all simulation runs in+-- the CSV file.+--++module Simulation.Aivika.Experiment.Base.FinalTableView+       (FinalTableView(..), +        defaultFinalTableView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import qualified Data.Map as M+import Data.IORef+import Data.Maybe++import System.IO+import System.FilePath++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.FileRenderer+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Concurrent.MVar++-- | Defines the 'View' that saves the simulation +-- results in the final time points for all +-- simulation runs in the CSV file.+data FinalTableView =+  FinalTableView { finalTableTitle       :: String,+                   -- ^ This is a title used in HTML.+                   finalTableDescription :: String,+                   -- ^ This is a description used in HTML.+                   finalTableRunText     :: String,+                   -- ^ Translated text \"Run\".+                   finalTableLinkText    :: String,+                   -- ^ It specifies the text for the link +                   -- which is displayed in the HTML page. +                   -- The link downloads the corresponded +                   -- CSV file in the browser. +                   --+                   -- An example is+                   --+                   -- @+                   --   finalTableLinkText = \"Download the CSV file\"+                   -- @+                   finalTableFileName    :: ExperimentFilePath,+                   -- ^ It defines the file name for the CSV file. +                   -- It may include special variable @$TITLE@.+                   --+                   -- An example is+                   --+                   -- @+                   --   finalTableFileName = UniqueFilePath \"$TITLE.csv\"+                   -- @+                   finalTableSeparator   :: String,+                   -- ^ It defines the separator for the view. +                   -- It delimits the cells in the rows of the CSV file.+                   finalTableFormatter   :: ShowS,+                   -- ^ It defines the formatter which is applied+                   -- to all values before they will be written+                   -- in the CSV file.+                   finalTablePredicate   :: Event Bool,+                   -- ^ It specifies the predicate that defines+                   -- when we can save data in the table.+                   finalTableTransform   :: ResultTransform,+                   -- ^ The transform applied to the results before receiving series.+                   finalTableSeries      :: ResultTransform +                   -- ^ It defines the series to save in the CSV file.+                 }+  +-- | The default table view.  +defaultFinalTableView :: FinalTableView+defaultFinalTableView = +  FinalTableView { finalTableTitle       = "Final Table",+                   finalTableDescription = "It refers to the CSV file with the results in the final time points.",+                   finalTableRunText     = "Run",+                   finalTableLinkText    = "Download the CSV file",+                   finalTableFileName    = UniqueFilePath "FinalTable.csv",+                   finalTableSeparator   = ",",+                   finalTableFormatter   = id,+                   finalTablePredicate   = return True,+                   finalTableTransform   = expandResults,+                   finalTableSeries      = id }++instance ExperimentView FinalTableView (WebPageRenderer a) where+  +  outputView v = +    let reporter exp renderer dir =+          do st <- newFinalTable v exp dir+             let context =+                   WebPageContext+                   WebPageWriter { reporterWriteTOCHtml = finalTableTOCHtml st,+                                   reporterWriteHtml    = finalTableHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = finaliseFinalTable st,+                                         reporterSimulate   = simulateFinalTable st,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }++instance ExperimentView FinalTableView (FileRenderer a) where+  +  outputView v = +    let reporter exp renderer dir =+          do st <- newFinalTable v exp dir+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = finaliseFinalTable st,+                                         reporterSimulate   = simulateFinalTable st,+                                         reporterContext    = FileContext }+    in ExperimentGenerator { generateReporter = reporter }+  +-- | The state of the view.+data FinalTableViewState =+  FinalTableViewState { finalTableView       :: FinalTableView,+                        finalTableExperiment :: Experiment,+                        finalTableDir        :: FilePath, +                        finalTableFile       :: IORef (Maybe FilePath),+                        finalTableResults    :: MVar (Maybe FinalTableResults) }++-- | The table results.+data FinalTableResults =+  FinalTableResults { finalTableNames  :: [String],+                      finalTableValues :: MVar (M.Map Int [String]) }+  +-- | Create a new state of the view.+newFinalTable :: FinalTableView -> Experiment -> FilePath -> ExperimentWriter FinalTableViewState+newFinalTable view exp dir =+  do f <- liftIO $ newIORef Nothing+     r <- liftIO $ newMVar Nothing+     return FinalTableViewState { finalTableView       = view,+                                  finalTableExperiment = exp,+                                  finalTableDir        = dir, +                                  finalTableFile       = f,+                                  finalTableResults    = r }+       +-- | Create new table results.+newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults+newFinalTableResults names exp =+  do values <- newMVar M.empty +     return FinalTableResults { finalTableNames  = names,+                                finalTableValues = values }++-- | Require to return unique final tables results associated with the specified state. +requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults+requireFinalTableResults st names =+  maybePutMVar (finalTableResults st)+  (newFinalTableResults names (finalTableExperiment st)) $ \results ->+  if (names /= finalTableNames results)+  then error "Series with different names are returned for different runs: requireFinalTableResults"+  else return results+       +-- | Simulation of the specified series.+simulateFinalTable :: FinalTableViewState -> ExperimentData -> Composite ()+simulateFinalTable st expdata =+  do let view    = finalTableView st+         rs      = finalTableSeries view $+                   finalTableTransform view $+                   experimentResults expdata+         exts    = resultsToStringValues rs+         signals = experimentPredefinedSignals expdata+         signal  = filterSignalM (const predicate) $+                   resultSignalInStopTime signals+         names   = map resultValueName exts+         predicate = finalTablePredicate view+     results <- liftIO $ requireFinalTableResults st names+     let values = finalTableValues results +     handleSignalComposite signal $ \_ ->+       do xs <- mapM resultValueData exts+          i  <- liftParameter simulationIndex+          liftIO $ modifyMVar_ values $ return . M.insert i xs+     +-- | Save the results in the CSV file after the simulation is complete.+finaliseFinalTable :: FinalTableViewState -> ExperimentWriter ()+finaliseFinalTable st =+  do let view      = finalTableView st+         run       = finalTableRunText view+         formatter = finalTableFormatter view+         title     = finalTableTitle view+         separator = finalTableSeparator view+     results <- liftIO $ readMVar $ finalTableResults st+     case results of+       Nothing -> return ()+       Just results ->+         do let names  = finalTableNames results+                values = finalTableValues results+            m <- liftIO $ readMVar values +            file <- resolveFilePath (finalTableDir st) $+                    mapFilePath (flip replaceExtension ".csv") $+                    expandFilePath (finalTableFileName $ finalTableView st) $+                    M.fromList [("$TITLE", title)]+            liftIO $ do+              -- create a new file+              h <- openFile file WriteMode+              -- write a header+              hPutStr h $ show run+              forM_ names $ \name ->+                do hPutStr h separator+                   hPutStr h $ show name+              hPutStrLn h ""+              -- write data+              forM_ (M.assocs m) $ \(i, xs) ->+                do hPutStr h $ show i+                   forM_ xs $ \x ->+                     do hPutStr h separator+                        hPutStr h $ formatter x+                   hPutStrLn h ""+              -- close file+              hClose h +              when (experimentVerbose $ finalTableExperiment st) $+                putStr "Generated file " >> putStrLn file+              writeIORef (finalTableFile st) $ Just file+     +-- | Get the HTML code.     +finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()+finalTableHtml st index =+  do header st index+     file <- liftIO $ readIORef (finalTableFile st)+     case file of+       Nothing -> return ()+       Just f  ->+         writeHtmlParagraph $+         writeHtmlLink (makeRelative (finalTableDir st) f) $+         writeHtmlText (finalTableLinkText $ finalTableView st)++header :: FinalTableViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (finalTableTitle $ finalTableView st)+     let description = finalTableDescription $ finalTableView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()+finalTableTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (finalTableTitle $ finalTableView st)

@@ -0,0 +1,401 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Base.HtmlWriter+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- This is an utility module that provides an HTML writer.+--++module Simulation.Aivika.Experiment.Base.HtmlWriter +       (HtmlWriter,+        runHtmlWriter,+        composeHtml,+        writeHtml,+        writeHtmlLn,+        writeHtmlText,+        writeHtmlParagraph,+        writeHtmlParagraphWithId,+        writeHtmlHeader1,+        writeHtmlHeader1WithId,+        writeHtmlHeader2,+        writeHtmlHeader2WithId,+        writeHtmlHeader3,+        writeHtmlHeader3WithId,+        writeHtmlHeader4,+        writeHtmlHeader4WithId,+        writeHtmlHeader5,+        writeHtmlHeader5WithId,+        writeHtmlHeader6,+        writeHtmlHeader6WithId,+        writeHtmlBreak,+        writeHtmlLink,+        writeHtmlImage,+        writeHtmlList,+        writeHtmlListItem,+        writeHtmlDocumentWithTitle,+        encodeHtmlText) where++import Control.Monad+import Control.Monad.Trans+import Control.Applicative++import Network.URI++import Simulation.Aivika.Experiment.Base.ExperimentWriter++-- | It writes fast an HTML code.+newtype HtmlWriter a = +  HtmlWriter { runHtmlWriter :: ShowS -> ExperimentWriter (a, ShowS)+               -- ^ Run the HTML writer monad.+             }++instance Monad HtmlWriter where+  +  return a = HtmlWriter $ \f -> return (a, f)+  +  (HtmlWriter m) >>= k = HtmlWriter $ \f ->+    do (a, f') <- m f+       let HtmlWriter m' = k a+       m' f'+       +instance MonadIO HtmlWriter where       +  +  liftIO m = HtmlWriter $ \f ->+    do x <- liftIO m+       return (x, f)++instance Functor HtmlWriter where++  fmap f m = m >>= \a -> return (f a)++instance Applicative HtmlWriter where++  pure = return+  (<*>) = ap+       +-- | Write the HTML code.+writeHtml :: String -> HtmlWriter ()+writeHtml code = +  HtmlWriter $ \f -> return ((), f . (code ++))+                     +-- | Write the HTML code.+writeHtmlLn :: String -> HtmlWriter ()+writeHtmlLn code = +  do writeHtml code+     writeHtml "\n"+                     +-- | Write the text in HTML.                     +writeHtmlText :: String -> HtmlWriter ()                     +writeHtmlText text =+  HtmlWriter $ \f -> return ((), f . (encodeHtmlText text ++))+                     +-- | Compose the HTML applying the corresponded transformation.                     +composeHtml :: ShowS -> HtmlWriter ()                     +composeHtml g =+  HtmlWriter $ \f -> return ((), f . g)++-- | Write the HTML link with the specified URI and contents.+writeHtmlLink :: String -> HtmlWriter () -> HtmlWriter ()+writeHtmlLink uri inner =+  do writeHtml "<a href=\""+     writeHtml $ escapeURIString isUnescapedInURI uri+     writeHtml "\">"+     inner+     writeHtml "</a>"+     +-- | Write the HTML image with the specified URI.+writeHtmlImage :: String -> HtmlWriter ()+writeHtmlImage uri =+  do writeHtml "<img src=\""+     writeHtml $ escapeURIString isUnescapedInURI uri+     writeHtml "\" />"++-- | Write the @\<p\>@ element with the specified contents.     +writeHtmlParagraph :: HtmlWriter () -> HtmlWriter ()     +writeHtmlParagraph inner =+  do writeHtml "<p>"+     inner+     writeHtml "</p>"+     +-- | Write the @\<h1\>@ element with the specified contents.     +writeHtmlHeader1 :: HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader1 inner =+  do writeHtml "<h1>"+     inner+     writeHtml "</h1>"+     +-- | Write the @\<h2\>@ element with the specified contents.     +writeHtmlHeader2 :: HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader2 inner =+  do writeHtml "<h2>"+     inner+     writeHtml "</h2>"+     +-- | Write the @\<h3\>@ element with the specified contents.     +writeHtmlHeader3 :: HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader3 inner =+  do writeHtml "<h3>"+     inner+     writeHtml "</h3>"+     +-- | Write the @\<h4\>@ element with the specified contents.     +writeHtmlHeader4 :: HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader4 inner =+  do writeHtml "<h4>"+     inner+     writeHtml "</h4>"+     +-- | Write the @\<h5\>@ element with the specified contents.     +writeHtmlHeader5 :: HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader5 inner =+  do writeHtml "<h5>"+     inner+     writeHtml "</h5>"+     +-- | Write the @\<h6\>@ element with the specified contents.     +writeHtmlHeader6 :: HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader6 inner =+  do writeHtml "<h6>"+     inner+     writeHtml "</h6>"+     +-- | Write the @\<p\>@ element with the specified id and contents.     +writeHtmlParagraphWithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlParagraphWithId id inner =+  do writeHtml "<p id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</p>"+     +-- | Write the @\<h1\>@ element with the specified id and contents.     +writeHtmlHeader1WithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader1WithId id inner =+  do writeHtml "<h1 id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</h1>"+     +-- | Write the @\<h2\>@ element with the specified id and contents.     +writeHtmlHeader2WithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader2WithId id inner =+  do writeHtml "<h2 id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</h2>"+     +-- | Write the @\<h3\>@ element with the specified id and contents.     +writeHtmlHeader3WithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader3WithId id inner =+  do writeHtml "<h3 id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</h3>"+     +-- | Write the @\<h4\>@ element with the specified id and contents.     +writeHtmlHeader4WithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader4WithId id inner =+  do writeHtml "<h4 id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</h4>"+     +-- | Write the @\<h5\>@ element with the specified id and contents.     +writeHtmlHeader5WithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader5WithId id inner =+  do writeHtml "<h5 id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</h5>"+     +-- | Write the @\<h6\>@ element with the specified id and contents.     +writeHtmlHeader6WithId :: String -> HtmlWriter () -> HtmlWriter ()     +writeHtmlHeader6WithId id inner =+  do writeHtml "<h6 id=\""+     writeHtml id+     writeHtml "\">"+     inner+     writeHtml "</h6>"+     +-- | Write the @\<br\>@ element.+writeHtmlBreak :: HtmlWriter ()     +writeHtmlBreak =+  writeHtml "<br />"+     +-- | Write the list of items wrapped in @\<ul\>@.  +writeHtmlList :: HtmlWriter () -> HtmlWriter ()+writeHtmlList inner =+  do writeHtml "<ul>"+     inner+     writeHtml "</ul>"++-- | Write the item list wrapped in @\<li\>@.  +writeHtmlListItem :: HtmlWriter () -> HtmlWriter ()+writeHtmlListItem inner =+  do writeHtml "<li>"+     inner+     writeHtml "</li>"++-- | Write the HTML document with the specified title and contents+writeHtmlDocumentWithTitle :: String -> HtmlWriter () -> HtmlWriter ()+writeHtmlDocumentWithTitle title inner =+  do writeHtml "<html>"+     writeHtml "<head>"+     writeHtml "<meta http-equiv='Content-Type' content='text/html; charset=utf-8' />"+     writeHtml "<title>"+     writeHtmlText title+     writeHtml "</title>"+     writeHtmlCss +     writeHtml "</head>"+     writeHtml "<body>"+     writeHtmlHeader1 $ +       writeHtmlText title+     writeHtml "</h1>"+     inner+     writeHtml "<br /><p><font size=\"-1\">Automatically generated by "+     writeHtml "<a href=\"http://www.aivikasoft.com\">"+     writeHtml "Aivika</a>"+     writeHtml "</font></p>"+     writeHtml "</body>"+     writeHtml "</html>"++-- | Escape special HTML characters in the 'String'.+-- It is based on one function from package Web-Encodings,+-- which is licensed under BSD3 but obsolete now.+encodeHtmlText :: String -> String+encodeHtmlText x = join $ map encodeHtmlChar x++-- | Escape a character.+encodeHtmlChar :: Char -> String+encodeHtmlChar '<'  = "&lt;"+encodeHtmlChar '>'  = "&gt;"+encodeHtmlChar '&'  = "&amp;"+encodeHtmlChar '"'  = "&quot;"+encodeHtmlChar '\'' = "&#39;"+encodeHtmlChar c    = [c]++-- | Write the CSS styles+writeHtmlCss :: HtmlWriter ()+writeHtmlCss =+  do writeHtmlLn "<style type=\"text/css\">"+     writeHtmlLn "* { margin: 0; padding: 0 }"+     writeHtmlLn ""+     writeHtmlLn "html {"+     writeHtmlLn "  background-color: white;"+     writeHtmlLn "  width: 100%;"+     writeHtmlLn "  height: 100%;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "body {"+     writeHtmlLn "  background: white;"+     writeHtmlLn "  color: black;"+     writeHtmlLn "  text-align: left;"+     writeHtmlLn "  min-height: 100%;"+     writeHtmlLn "  width: 90%;"+     writeHtmlLn "  margin: 0px auto 0px auto;"+     writeHtmlLn "  position: relative;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "p {"+     writeHtmlLn "  margin: 0.8em 0;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "ul, ol {"+     writeHtmlLn "  margin: 0.8em 0 0.8em 2em;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "dl {"+     writeHtmlLn "  margin: 0.8em 0;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "dt {"+     writeHtmlLn "  font-weight: bold;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "dd {"+     writeHtmlLn "  margin-left: 2em;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "a { text-decoration: none; }"+     writeHtmlLn "a[href]:link { color: rgb(196,69,29); }"+     writeHtmlLn "a[href]:visited { color: rgb(171,105,84); }"+     writeHtmlLn "a[href]:hover { text-decoration:underline; }"+     writeHtmlLn ""+     writeHtmlLn "body {"+     writeHtmlLn "  font-size:medium;"+     -- writeHtmlLn "  font-family:sans-serif;"+     -- writeHtmlLn "  font:13px/1.4 sans-serif;"+     -- writeHtmlLn "  *font-size:small; /* for IE */"+     -- writeHtmlLn "  *font:x-small; /* for IE in quirks mode */"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "h1 { font-size: 146.5%; /* 19pt */ } "+     writeHtmlLn "h2 { font-size: 131%;   /* 17pt */ }"+     writeHtmlLn "h3 { font-size: 116%;   /* 15pt */ }"+     writeHtmlLn "h4 { font-size: 100%;   /* 13pt */ }"+     writeHtmlLn "h5 { font-size: 100%;   /* 13pt */ }"+     writeHtmlLn ""+     writeHtmlLn "select, input, button, textarea {"+     writeHtmlLn "  font:99% sans-serif;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "table {"+     writeHtmlLn "  font-size:inherit;"+     writeHtmlLn "  font:100%;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "pre, code, kbd, samp, tt, .src {"+     writeHtmlLn "  font-family:monospace;"+     writeHtmlLn "  *font-size:108%;"+     writeHtmlLn "  line-height: 124%;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn ".links, .link {"+     writeHtmlLn "  font-size: 85%; /* 11pt */"+     writeHtmlLn "}"+     writeHtmlLn ".info  {"+     writeHtmlLn "  font-size: 85%; /* 11pt */"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn ".caption, h1, h2, h3, h4, h5, h6 { "+     writeHtmlLn "  font-weight: bold;"+     writeHtmlLn "  color: rgb(78,98,114);"+     writeHtmlLn "  margin: 0.8em 0 0.4em;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "* + h1, * + h2, * + h3, * + h4, * + h5, * + h6 {"+     writeHtmlLn "  margin-top: 2em;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "h1 + h2, h2 + h3, h3 + h4, h4 + h5, h5 + h6 {"+     writeHtmlLn "  margin-top: inherit;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "ul.links {"+     writeHtmlLn "  list-style: none;"+     writeHtmlLn "  text-align: left;"+     writeHtmlLn "  float: right;"+     writeHtmlLn "  display: inline-table;"+     writeHtmlLn "  margin: 0 0 0 1em;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "ul.links li {"+     writeHtmlLn "  display: inline;"+     writeHtmlLn "  border-left: 1px solid #d5d5d5; "+     writeHtmlLn "  white-space: nowrap;"+     writeHtmlLn "  padding: 0;"+     writeHtmlLn "}"+     writeHtmlLn ""+     writeHtmlLn "ul.links li a {"+     writeHtmlLn "  padding: 0.2em 0.5em;"+     writeHtmlLn "}"+     writeHtmlLn "</style>"

@@ -0,0 +1,175 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.InfoView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'InfoView' that shows the description of series.+--++module Simulation.Aivika.Experiment.Base.InfoView+       (InfoView(..), +        defaultInfoView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import Data.IORef+import Data.Maybe+import Data.Monoid++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Concurrent.MVar++-- | Defines the 'View' that shows the description of series.+data InfoView =+  InfoView { infoTitle        :: String,+             -- ^ This is a title for the view.+             infoDescription  :: String,+             -- ^ This is a text description used in HTML.+             infoTransform    :: ResultTransform,+             -- ^ The transform applied to the results before receiving series.+             infoSeries       :: ResultTransform, +             -- ^ It defines the series for which the description is shown.+             infoLocalisation :: ResultLocalisation+             -- ^ It specifies the localisation.+           }+  +-- | The default description view.  +defaultInfoView :: InfoView+defaultInfoView = +  InfoView { infoTitle        = "Information",+             infoDescription  = "It shows the information about simulation entities:",+             infoTransform    = id,+             infoSeries       = id,+             infoLocalisation = englishResultLocalisation }++instance ExperimentView InfoView (WebPageRenderer a) where+  +  outputView v = +    let reporter exp renderer dir =+          do st <- newInfo v exp dir+             let context =+                   WebPageContext $+                   WebPageWriter { reporterWriteTOCHtml = infoTOCHtml st,+                                   reporterWriteHtml    = infoHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = simulateInfo st,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }+  +-- | The state of the view.+data InfoViewState =+  InfoViewState { infoView       :: InfoView,+                  infoExperiment :: Experiment,+                  infoResults    :: MVar (Maybe InfoResults) }++-- | The information table.+data InfoResults =+  InfoResults { infoNames  :: [String],+                infoValues :: [String] }+  +-- | Create a new state of the view.+newInfo :: InfoView -> Experiment -> FilePath -> ExperimentWriter InfoViewState+newInfo view exp dir =+  do r <- liftIO $ newMVar Nothing+     return InfoViewState { infoView       = view,+                            infoExperiment = exp,+                            infoResults    = r }+       +-- | Create a new information table.+newInfoResults :: [ResultSource] -> ResultLocalisation -> Experiment -> IO InfoResults+newInfoResults sources loc exp =+  do let xs =+           flip map sources $ \source ->+           case source of+             ResultItemSource (ResultItem x) ->+               [(resultItemName x, loc $ resultItemId x)]+             ResultObjectSource x ->+               [(resultObjectName x, loc $ resultObjectId x)]+             ResultVectorSource x ->+               [(resultVectorName x, loc $ resultVectorId x)]+             ResultSeparatorSource x ->+               []+         (names, values) = unzip $ concat xs+     return InfoResults { infoNames  = names,+                          infoValues = values }++-- | Require to return the unique information table associated with the specified state. +requireInfoResults :: InfoViewState -> [ResultSource] -> IO InfoResults+requireInfoResults st sources =+  let view = infoView st+      loc  = infoLocalisation view+      exp  = infoExperiment st+  in maybePutMVar (infoResults st)+     (newInfoResults sources loc exp) $ \results ->+  do let xs =+           flip map sources $ \source ->+           case source of+             ResultItemSource (ResultItem x) ->+               [resultItemName x]+             ResultObjectSource x ->+               [resultObjectName x]+             ResultVectorSource x ->+               [resultVectorName x]+             ResultSeparatorSource x ->+               []+     let names = concat xs+     if (names /= infoNames results)+       then error "Series with different names are returned for different runs: requireInfoResults"+       else return results+       +-- | Simulate the specified series.+simulateInfo :: InfoViewState -> ExperimentData -> Composite ()+simulateInfo st expdata =+  do let view    = infoView st+         rs      = infoSeries view $+                   infoTransform view $+                   experimentResults expdata+         sources = resultSourceList rs+     liftIO $ requireInfoResults st sources+     return ()++-- | Get the HTML code.     +infoHtml :: InfoViewState -> Int -> HtmlWriter ()+infoHtml st index =+  do header st index+     results <- liftIO $ readMVar (infoResults st)+     case results of+       Nothing -> return ()+       Just results ->+         do let names  = infoNames results+                values = infoValues results+            writeHtmlList $+              forM_ (zip names values) $ \(name, value) ->+              writeHtmlListItem $+              do writeHtmlText name+                 writeHtmlText " - "+                 writeHtmlText value++header :: InfoViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (infoTitle $ infoView st)+     let description = infoDescription $ infoView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+infoTOCHtml :: InfoViewState -> Int -> HtmlWriter ()+infoTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (infoTitle $ infoView st)

@@ -0,0 +1,174 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.LastValueView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'LastValueView' that shows the last values+-- for the simulation variables.+--++module Simulation.Aivika.Experiment.Base.LastValueView +       (LastValueView(..),+        defaultLastValueView) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import Data.IORef+import Data.Maybe++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Utils (replace)++-- | Defines the 'View' that shows the last values of the simulation+-- variables.+data LastValueView =+  LastValueView { lastValueTitle       :: String,+                  -- ^ The title for the view.+                  lastValueRunTitle    :: String,+                  -- ^ The run title for the view. It may include+                  -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and +                  -- @$TITLE@.+                  --+                  -- An example is +                  --+                  -- @+                  --   lastValueRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"+                  -- @+                  lastValueDescription :: String,+                  -- ^ The description for the view.+                  lastValueFormatter   :: ShowS,+                  -- ^ It transforms data before they will be shown.+                  lastValueTransform   :: ResultTransform,+                  -- ^ The transform applied to the results before receiving series.+                  lastValueSeries      :: ResultTransform +                  -- ^ It defines the series for which the last values to be shown.+                }+  +-- | This is the default view.+defaultLastValueView :: LastValueView+defaultLastValueView =  +  LastValueView { lastValueTitle       = "Last Values",+                  lastValueRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",+                  lastValueDescription = "It shows the values in the final time point(s).",+                  lastValueFormatter   = id,+                  lastValueTransform   = id,+                  lastValueSeries      = id }+  +instance ExperimentView LastValueView (WebPageRenderer a) where  +  +  outputView v = +    let reporter exp renderer dir =+          do st <- newLastValues v exp+             let context =+                   WebPageContext $+                   WebPageWriter { reporterWriteTOCHtml = lastValueTOCHtml st,+                                   reporterWriteHtml    = lastValueHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = simulateLastValues st,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }++-- | The state of the view.+data LastValueViewState =+  LastValueViewState { lastValueView       :: LastValueView,+                       lastValueExperiment :: Experiment,+                       lastValueMap        :: M.Map Int (IORef [(String, String)]) }+  +-- | Create a new state of the view.+newLastValues :: LastValueView -> Experiment -> ExperimentWriter LastValueViewState+newLastValues view exp =+  do let n = experimentRunCount exp+     rs <- forM [0..(n - 1)] $ \i -> liftIO $ newIORef []    +     let m = M.fromList $ zip [0..(n - 1)] rs+     return LastValueViewState { lastValueView       = view,+                                 lastValueExperiment = exp,+                                 lastValueMap        = m }+       +-- | Get the last values during the simulation.+simulateLastValues :: LastValueViewState -> ExperimentData -> Composite ()+simulateLastValues st expdata =+  do let view    = lastValueView st+         rs      = lastValueSeries view $+                   lastValueTransform view $+                   experimentResults expdata+         exts    = resultsToStringValues rs+         signals = experimentPredefinedSignals expdata+         signal  = resultSignalInStopTime signals+     i <- liftParameter simulationIndex+     handleSignalComposite signal $ \t ->+       do let r = fromJust $ M.lookup (i - 1) (lastValueMap st)+          output <- forM exts $ \ext ->+            do x <- resultValueData ext+               return (resultValueName ext, x)+          liftIO $ writeIORef r output+     +-- | Get the HTML code.     +lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()     +lastValueHtml st index =+  let n = experimentRunCount $ lastValueExperiment st+  in if n == 1+     then lastValueHtmlSingle st index+     else lastValueHtmlMultiple st index+     +-- | Get the HTML code for a single run.+lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter ()+lastValueHtmlSingle st index =+  do header st index+     let r = fromJust $ M.lookup 0 (lastValueMap st)+     pairs <- liftIO $ readIORef r+     forM_ pairs $ \pair ->+       formatPair pair (lastValueFormatter $ lastValueView st)++-- | Get the HTML code for multiple runs+lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter ()+lastValueHtmlMultiple st index =+  do header st index+     let n = experimentRunCount $ lastValueExperiment st+     forM_ [0..(n - 1)] $ \i ->+       do let subtitle = +                replace "$RUN_INDEX" (show $ i + 1) $+                replace "$RUN_COUNT" (show n) $+                replace "$TITLE" (lastValueTitle $ lastValueView st)+                (lastValueRunTitle $ lastValueView st)+          writeHtmlHeader4 $+            writeHtmlText subtitle+          let r = fromJust $ M.lookup i (lastValueMap st)+          pairs <- liftIO $ readIORef r+          forM_ pairs $ \pair ->+            formatPair pair (lastValueFormatter $ lastValueView st)++header :: LastValueViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $+       writeHtmlText (lastValueTitle $ lastValueView st)+     let description = lastValueDescription $ lastValueView st+     unless (null description) $+       writeHtmlParagraph $+       writeHtmlText description++formatPair :: (String, String) -> ShowS -> HtmlWriter ()+formatPair (name, value) formatter =+  writeHtmlParagraph $ +  do writeHtmlText name+     writeHtmlText " = "+     writeHtmlText $ formatter value+          +-- | Get the TOC item     +lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()+lastValueTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (lastValueTitle $ lastValueView st)

@@ -0,0 +1,112 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Base.SamplingStatsWriter+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'SamplingStatsWriter' that knows how to write+-- the sampling statistics in HTML.+--++module Simulation.Aivika.Experiment.Base.SamplingStatsWriter +       (SamplingStatsWriter(..),+        defaultSamplingStatsWriter) where++import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.HtmlWriter++import Simulation.Aivika.Statistics++-- | Defines a writer that knows how to represent the 'SamplingStats'+-- as the HTML table.+data SamplingStatsWriter a =+  SamplingStatsWriter { samplingStatsWidth         :: Int,+                        -- ^ The width of the HTML table.+                        samplingStatsMeanText      :: String,+                        -- ^ Translated text \"mean\".+                        samplingStatsDeviationText :: String,+                        -- ^ Translated text \"deviation\".+                        samplingStatsMinText       :: String,+                        -- ^ Translated text \"minimum\".+                        samplingStatsMaxText       :: String,+                        -- ^ Translated text \"maximum\".+                        samplingStatsCountText       :: String,+                        -- ^ Translated text \"count\".+                        samplingStatsFormatter     :: ShowS,+                        -- ^ The formatter of numbers.+                        samplingStatsWrite         :: SamplingStatsWriter a -> String ->+                                                      SamplingStats a -> HtmlWriter ()+                        -- ^ This function reprensents the named statistics+                        -- as the HTML table.+                      }++-- | The default writer.+defaultSamplingStatsWriter :: Show a => SamplingStatsWriter a+defaultSamplingStatsWriter =+  SamplingStatsWriter { +    samplingStatsWidth = 400,+    samplingStatsMeanText = "mean",+    samplingStatsDeviationText = "deviation",+    samplingStatsMinText = "minimum",+    samplingStatsMaxText = "maximum",+    samplingStatsCountText = "count",+    samplingStatsFormatter = id,+    samplingStatsWrite = \writer name stats ->+      do let format x = samplingStatsFormatter writer x+         writeHtml "<p>"+         writeHtml "<table frame='border' cellspacing='4' width='"+         writeHtml $ show $ samplingStatsWidth writer+         writeHtml "'>"+         writeHtml "<tr>"+         writeHtml "<td colspan='2'>"+         writeHtml "<p align='center'>"+         writeHtmlText name+         writeHtml "</h4>"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsMeanText writer +         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ samplingStatsMean stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsDeviationText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ samplingStatsDeviation stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsMinText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ samplingStatsMin stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsMaxText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ samplingStatsMax stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsCountText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtml $ format $ show $ samplingStatsCount stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "</table>" +         writeHtml "</p>"+    }

@@ -0,0 +1,258 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.TableView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'TableView' that saves the simulation+-- results in the CSV file(s).+--++module Simulation.Aivika.Experiment.Base.TableView +       (TableView(..), +        defaultTableView) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Monoid++import System.IO+import System.FilePath++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.FileRenderer+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Utils (replace)++-- | Defines the 'View' that saves the simulation results+-- in the CSV file(s).+data TableView =+  TableView { tableTitle       :: String,+              -- ^ This is a title used in HTML.+              tableDescription :: String,+              -- ^ This is a description in the HTML.+              tableLinkText    :: String,+              -- ^ It specifies the text for the link +              -- which is displayed in the HTML page+              -- if there is only one simulation run. +              -- The link downloads the corresponded +              -- CSV file in the browser. If there are+              -- more simulation runs, then this link +              -- is not shown.+              --+              -- An example is+              --+              -- @+              --   tableLinkText = \"Download the CSV file\"+              -- @+              tableRunLinkText :: String,+              -- ^ It specifies the link text which is +              -- displayed in the HTML page if there are +              -- many simulation runs. Such a link downloads +              -- the CSV file for the corresponded run. +              -- To define the text, you can use special +              -- variables @$LINK@, @$RUN_INDEX@ and @$RUN_COUNT@.+              --+              -- An example is +              -- +              -- @+              --   tableRunLinkText = \"$LINK / Run $RUN_INDEX of $RUN_COUNT\"+              -- @+              -- +              -- If there is only one run, then the link of +              -- this kind is not displayed. Instead, only one +              -- link is shown, which text is defined by the +              -- 'tableLinkText' field.+              tableFileName    :: ExperimentFilePath,+              -- ^ It defines the file name for each CSV file. +              -- It may include special variables @$TITLE@, +              -- @$RUN_INDEX@ and @$RUN_COUNT@.+              --+              -- An example is+              --+              -- @+              --   tableFileName = UniqueFilePath \"$TITLE - $RUN_INDEX.csv\"+              -- @+              tableSeparator   :: String,+              -- ^ It defines the separator for the view. +              -- It delimits the cells in the rows of the CSV file.+              tableFormatter   :: ShowS,+              -- ^ It defines the formatter which is applied+              -- to all values before they will be written+              -- in the CSV file(s).+              tablePredicate   :: Event Bool,+              -- ^ It specifies the predicate that defines+              -- when we can save data in the table.+              tableTransform   :: ResultTransform,+              -- ^ The transform applied to the results before receiving series.+              tableSeries      :: ResultTransform +              -- ^ It defines the series to save in the CSV file(s).+            }+  +-- | The default table view.  +defaultTableView :: TableView+defaultTableView = +  TableView { tableTitle       = "Table",+              tableDescription = "This section contains the CSV file(s) with the simulation results.",+              tableLinkText    = "Download the CSV file",+              tableRunLinkText = "$LINK / Run $RUN_INDEX of $RUN_COUNT",+              tableFileName    = UniqueFilePath "Table($RUN_INDEX).csv",+              tableSeparator   = ",",+              tableFormatter   = id,+              tablePredicate   = return True,+              tableTransform   = expandResults,+              tableSeries      = id }+  +instance ExperimentView TableView (WebPageRenderer a) where+  +  outputView v = +    let reporter exp renderer dir =+          do st <- newTable v exp dir+             let context =+                   WebPageContext $+                   WebPageWriter { reporterWriteTOCHtml = tableTOCHtml st,+                                   reporterWriteHtml    = tableHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = simulateTable st,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }+  +instance ExperimentView TableView (FileRenderer a) where+  +  outputView v = +    let reporter exp renderer dir =+          do st <- newTable v exp dir+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = simulateTable st,+                                         reporterContext    = FileContext }+    in ExperimentGenerator { generateReporter = reporter }+  +-- | The state of the view.+data TableViewState =+  TableViewState { tableView       :: TableView,+                   tableExperiment :: Experiment,+                   tableDir        :: FilePath, +                   tableMap        :: M.Map Int FilePath }+  +-- | Create a new state of the view.+newTable :: TableView -> Experiment -> FilePath -> ExperimentWriter TableViewState+newTable view exp dir =+  do let n = experimentRunCount exp+     fs <- forM [0..(n - 1)] $ \i ->+       resolveFilePath dir $+       mapFilePath (flip replaceExtension ".csv") $+       expandFilePath (tableFileName view) $+       M.fromList [("$TITLE", tableTitle view),+                   ("$RUN_INDEX", show $ i + 1),+                   ("$RUN_COUNT", show n)]+     liftIO $ forM_ fs $ flip writeFile []  -- reserve the file names+     let m = M.fromList $ zip [0..(n - 1)] fs+     return TableViewState { tableView       = view,+                             tableExperiment = exp,+                             tableDir          = dir, +                             tableMap          = m }+       +-- | Write the tables during the simulation.+simulateTable :: TableViewState -> ExperimentData -> Composite ()+simulateTable st expdata =+  do let view    = tableView st+         rs      = tableSeries view $+                   tableTransform view $+                   experimentResults expdata+         exts    = resultsToStringValues rs+         signals = experimentPredefinedSignals expdata+         signal  = pureResultSignal signals $+                   resultSignal rs+         separator = tableSeparator view+         formatter = tableFormatter view+         predicate = tablePredicate view+     i <- liftParameter simulationIndex+     -- create a new file+     let f = fromJust $ M.lookup (i - 1) (tableMap st)+     h <- liftIO $ openFile f WriteMode+     -- write a header+     liftIO $+       do forM_ (zip [0..] exts) $ \(column, ext) ->+            do when (column > 0) $ +                 hPutStr h separator+               hPutStr h $ show $ resultValueName ext+          hPutStrLn h ""+     handleSignalComposite signal $ \t ->+       do p <- predicate+          when p $+            do forM_ (zip [0..] exts) $ \(column, ext) ->  -- write the row+                 do x <- resultValueData ext               -- write the column+                    liftIO $+                      do when (column > 0) $ +                           hPutStr h separator+                         hPutStr h $ formatter x+               liftIO $ hPutStrLn h ""+     disposableComposite $+       DisposableEvent $+       liftIO $+       do when (experimentVerbose $ tableExperiment st) $+            putStr "Generated file " >> putStrLn f+          hClose h  -- close the file+     +-- | Get the HTML code.     +tableHtml :: TableViewState -> Int -> HtmlWriter ()     +tableHtml st index =+  let n = experimentRunCount $ tableExperiment st+  in if n == 1+     then tableHtmlSingle st index+     else tableHtmlMultiple st index+     +-- | Get the HTML code for a single run.+tableHtmlSingle :: TableViewState -> Int -> HtmlWriter ()+tableHtmlSingle st index =+  do header st index+     let f = fromJust $ M.lookup 0 (tableMap st)+     writeHtmlParagraph $+       writeHtmlLink (makeRelative (tableDir st) f) $+       writeHtmlText (tableLinkText $ tableView st)++-- | Get the HTML code for multiple runs+tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter ()+tableHtmlMultiple st index =+  do header st index+     let n = experimentRunCount $ tableExperiment st+     forM_ [0..(n - 1)] $ \i ->+       do let f = fromJust $ M.lookup i (tableMap st)+              sublink = +                replace "$RUN_INDEX" (show $ i + 1) $+                replace "$RUN_COUNT" (show n) $+                replace "$LINK" (tableLinkText $ tableView st)+                (tableRunLinkText $ tableView st)+          writeHtmlParagraph $+            writeHtmlLink (makeRelative (tableDir st) f) $+            writeHtmlText sublink++header :: TableViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (tableTitle $ tableView st)+     let description = tableDescription $ tableView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item     +tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()+tableTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (tableTitle $ tableView st)

@@ -0,0 +1,187 @@++{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.TimingStatsView+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'TimingStatsView' that shows the timing statistics+-- for the variables for every simulation run separately.+--++module Simulation.Aivika.Experiment.Base.TimingStatsView +       (TimingStatsView(..),+        defaultTimingStatsView) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Monoid++import Simulation.Aivika+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.WebPageRenderer+import Simulation.Aivika.Experiment.Base.ExperimentWriter+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Base.TimingStatsWriter+import Simulation.Aivika.Experiment.Utils (replace)++-- | Defines the 'View' that shows the timing statistics+-- for variables for every simulation run separately.+data TimingStatsView =+  TimingStatsView { timingStatsTitle       :: String,+                    -- ^ The title for the view.+                    timingStatsRunTitle    :: String,+                    -- ^ The run title for the view. It may include+                    -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and +                    -- @$TITLE@.+                    --+                    -- An example is +                    --+                    -- @+                    --   timingStatsRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"+                    -- @+                    timingStatsDescription :: String,+                    -- ^ The description for the view.+                    timingStatsWriter      :: TimingStatsWriter Double,+                    -- ^ It shows the timing statistics.+                    timingStatsPredicate   :: Event Bool,+                    -- ^ Specifies when gathering the statistics.+                    timingStatsTransform   :: ResultTransform,+                    -- ^ The transform applied to the results before receiving series.+                    timingStatsSeries      :: ResultTransform +                    -- ^ It defines the series for which the statistics to be collected.+                  }+  +-- | This is the default view.+defaultTimingStatsView :: TimingStatsView+defaultTimingStatsView =  +  TimingStatsView { timingStatsTitle       = "Statistics for Time-Persistent Variables",+                    timingStatsRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",+                    timingStatsDescription = "The statistical data are gathered in the time points.",+                    timingStatsWriter      = defaultTimingStatsWriter,+                    timingStatsPredicate   = return True,+                    timingStatsTransform   = id,+                    timingStatsSeries      = id }++instance ExperimentView TimingStatsView (WebPageRenderer a) where  +  +  outputView v = +    let reporter exp renderer dir =+          do st <- newTimingStats v exp+             let context =+                   WebPageContext $+                   WebPageWriter { reporterWriteTOCHtml = timingStatsTOCHtml st,+                                   reporterWriteHtml    = timingStatsHtml st }+             return ExperimentReporter { reporterInitialise = return (),+                                         reporterFinalise   = return (),+                                         reporterSimulate   = simulateTimingStats st,+                                         reporterContext    = context }+    in ExperimentGenerator { generateReporter = reporter }+  +-- | The state of the view.+data TimingStatsViewState =+  TimingStatsViewState { timingStatsView       :: TimingStatsView,+                         timingStatsExperiment :: Experiment,+                         timingStatsMap        :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }+  +-- | Create a new state of the view.+newTimingStats :: TimingStatsView -> Experiment -> ExperimentWriter TimingStatsViewState+newTimingStats view exp =+  do let n = experimentRunCount exp+     rs <- forM [0..(n - 1)] $ \i -> liftIO $ newIORef []    +     let m = M.fromList $ zip [0..(n - 1)] rs+     return TimingStatsViewState { timingStatsView       = view,+                                   timingStatsExperiment = exp,+                                   timingStatsMap        = m }+       +-- | Get the timing statistics during the simulation.+simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Composite ()+simulateTimingStats st expdata =+  do let view    = timingStatsView st+         rs      = timingStatsSeries view $+                   timingStatsTransform view $+                   experimentResults expdata+         exts    = resultsToDoubleValues rs+         signals = experimentPredefinedSignals expdata+         signal  = filterSignalM (const predicate) $+                   pureResultSignal signals $+                   resultSignal rs+         predicate = timingStatsPredicate view+     i <- liftParameter simulationIndex+     let r = fromJust $ M.lookup (i - 1) $ timingStatsMap st+     forM_ exts $ \ext ->+       do stats <- liftIO $ newIORef emptyTimingStats+          let name = resultValueName ext+          liftIO $ modifyIORef r ((:) (name, stats))+          handleSignalComposite signal $ \_ ->+            do t <- liftDynamics time+               x <- resultValueData ext+               liftIO $+                 do y <- readIORef stats+                    let y' = addTimingStats t x y+                    y' `seq` writeIORef stats y'+     +-- | Get the HTML code.     +timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()     +timingStatsHtml st index =+  let n = experimentRunCount $ timingStatsExperiment st+  in if n == 1+     then timingStatsHtmlSingle st index+     else timingStatsHtmlMultiple st index+     +-- | Get the HTML code for a single run.+timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsHtmlSingle st index =+  do header st index+     let r = fromJust $ M.lookup 0 (timingStatsMap st)+     pairs <- liftIO $ readIORef r+     forM_ (reverse pairs) $ \(name, r) ->+       do stats <- liftIO $ readIORef r+          let writer = timingStatsWriter (timingStatsView st)+              write  = timingStatsWrite writer+          write writer name stats++-- | Get the HTML code for multiple runs+timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsHtmlMultiple st index =+  do header st index+     let n = experimentRunCount $ timingStatsExperiment st+     forM_ [0..(n - 1)] $ \i ->+       do let subtitle = +                replace "$RUN_INDEX" (show $ i + 1) $+                replace "$RUN_COUNT" (show n) $+                replace "$TITLE" (timingStatsTitle $ timingStatsView st)+                (timingStatsRunTitle $ timingStatsView st)+          writeHtmlHeader4 $+            writeHtmlText subtitle+          let r = fromJust $ M.lookup i (timingStatsMap st)+          pairs <- liftIO $ readIORef r+          forM_ (reverse pairs) $ \(name, r) ->+            do stats <- liftIO $ readIORef r+               let writer = timingStatsWriter (timingStatsView st)+                   write  = timingStatsWrite writer+               write writer name stats++header :: TimingStatsViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $+       writeHtmlText (timingStatsTitle $ timingStatsView st)+     let description = timingStatsDescription $ timingStatsView st+     unless (null description) $+       writeHtmlParagraph $+       writeHtmlText description++-- | Get the TOC item     +timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (timingStatsTitle $ timingStatsView st)

@@ -0,0 +1,130 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Base.TimingStatsWriter+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines 'TimingStatsWriter' that knows how to write+-- the timing statistics in HTML.+--++module Simulation.Aivika.Experiment.Base.TimingStatsWriter +       (TimingStatsWriter(..),+        defaultTimingStatsWriter) where++import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.HtmlWriter++import Simulation.Aivika.Statistics++-- | Defines a writer that knows how to represent the 'TimingStats'+-- as the HTML table.+data TimingStatsWriter a =+  TimingStatsWriter { timingStatsWidth         :: Int,+                      -- ^ The width of the HTML table.+                      timingStatsTimeText      :: String,+                      -- ^ Translated text \"time\".+                      timingStatsMeanText      :: String,+                      -- ^ Translated text \"mean\".+                      timingStatsDeviationText :: String,+                      -- ^ Translated text \"deviation\".+                      timingStatsMinText       :: String,+                      -- ^ Translated text \"minimum\".+                      timingStatsMaxText       :: String,+                      -- ^ Translated text \"maximum\".+                      timingStatsFormatter     :: ShowS,+                      -- ^ The formatter of numbers.+                      timingStatsWrite         :: TimingStatsWriter a -> String ->+                                                  TimingStats a -> HtmlWriter ()+                      -- ^ This function reprensents the named statistics+                      -- as the HTML table.+                      }++-- | The default writer.+defaultTimingStatsWriter :: (Show a, TimingData a) => TimingStatsWriter a+defaultTimingStatsWriter =+  TimingStatsWriter { +    timingStatsWidth = 400,+    timingStatsMeanText = "mean",+    timingStatsTimeText = "time",+    timingStatsDeviationText = "deviation",+    timingStatsMinText = "minimum",+    timingStatsMaxText = "maximum",+    timingStatsFormatter = id,+    timingStatsWrite = \writer name stats ->+      do let format x = timingStatsFormatter writer x+         writeHtml "<p>"+         writeHtml "<table frame='border' cellspacing='4' width='"+         writeHtml $ show $ timingStatsWidth writer+         writeHtml "'>"+         writeHtml "<tr>"+         writeHtml "<td colspan='3'>"+         writeHtml "<p align='center'>"+         writeHtmlText name+         writeHtml "</h4>"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsMeanText writer +         writeHtml "</td>"+         writeHtml "<td colspan='2'>"+         writeHtmlText $ format $ show $ timingStatsMean stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsDeviationText writer+         writeHtml "</td>"+         writeHtml "<td colspan='2'>"+         writeHtmlText $ format $ show $ timingStatsDeviation stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsMinText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ timingStatsMin stats+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText "("+         writeHtmlText $ timingStatsTimeText writer+         writeHtmlText " = "+         writeHtmlText $ format $ show $ timingStatsMinTime stats+         writeHtmlText ")"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsMaxText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ show $ timingStatsMax stats+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText "("+         writeHtmlText $ timingStatsTimeText writer+         writeHtmlText " = "+         writeHtmlText $ format $ show $ timingStatsMaxTime stats+         writeHtmlText ")"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsTimeText writer+         writeHtml "</td>"+         writeHtml "<td colspan='2'>"+         writeHtml "["+         writeHtml $ format $ show $ timingStatsStartTime stats+         writeHtml "; "+         writeHtml $ format $ show $ timingStatsLastTime stats+         writeHtml "]"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "</table>" +         writeHtml "</p>"+    }

@@ -0,0 +1,108 @@++{-# LANGUAGE TypeFamilies #-}++-- |+-- Module     : Simulation.Aivika.Experiment.Base.WebPageRenderer+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- It defines a renderer that creates a web page when running the simulation experiment.+--++module Simulation.Aivika.Experiment.Base.WebPageRenderer where++import Control.Monad+import Control.Monad.Trans++import System.IO+import System.Directory+import System.FilePath++import Simulation.Aivika+import Simulation.Aivika.Trans.Exception+import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.Base.HtmlWriter+import Simulation.Aivika.Experiment.Base.ExperimentWriter++-- | It defines the web page renderer for simulation 'Experiment'. +data WebPageRenderer a = WebPageRenderer a ExperimentFilePath+                         -- ^ A renderer that depends on the provided parameter and+                         -- a directory path, where the simulation results are saved in.++-- | It replies to the requests made by the web page renderer.+data WebPageWriter =+  WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter (),+                  -- ^ Return a TOC (Table of Contents) item for +                  -- the HTML index file after the finalisation +                  -- function is called, i.e. in the very end. +                  -- The agument specifies the ordered number of +                  -- the item.+                  --+                  -- You should wrap your HTML in 'writeHtmlListItem'.+                  reporterWriteHtml :: Int -> HtmlWriter ()+                  -- ^ Return an HTML code for the index file+                  -- after the finalisation function is called,+                  -- i.e. in the very end. The agument specifies+                  -- the ordered number of the item.+                }++-- | A convenient type synonym for describing a web page generator.+type WebPageGenerator a = ExperimentGenerator (WebPageRenderer a)++-- | Rendering a web page with results when running the simulation experiment.+instance ExperimentRendering (WebPageRenderer a) where++  -- | A web page context.+  newtype ExperimentContext (WebPageRenderer a) =+    WebPageContext { runWebPageContext :: WebPageWriter+                     -- ^ Run the web page context.+                   }++  -- | A web page environment.+  type ExperimentEnvironment (WebPageRenderer a) = FilePath++  -- | A web page rendering monad.+  type ExperimentMonad (WebPageRenderer a) = ExperimentWriter++  liftExperiment r = runExperimentWriter++  prepareExperiment e (WebPageRenderer _ path0) =+    do path <- resolveFilePath "" path0+       liftIO $ do+         when (experimentVerbose e) $+           do putStr "Updating directory " +              putStrLn path+         createDirectoryIfMissing True path+       return path++  renderExperiment e r reporters path = +    do let html :: HtmlWriter ()+           html = +             writeHtmlDocumentWithTitle (experimentTitle e) $+             do writeHtmlList $+                  forM_ (zip [1..] reporters) $ \(i, reporter) -> +                  reporterWriteTOCHtml (runWebPageContext $+                                        reporterContext reporter) i+                writeHtmlBreak+                unless (null $ experimentDescription e) $+                  writeHtmlParagraph $+                  writeHtmlText $ experimentDescription e+                forM_ (zip [1..] reporters) $ \(i, reporter) ->+                  reporterWriteHtml (runWebPageContext $+                                     reporterContext reporter) i+           file = combine path "index.html"+       ((), contents) <- runHtmlWriter html id+       liftIO $+         withFile file WriteMode $ \h ->+         do hSetEncoding h utf8+            hPutStr h (contents [])+            when (experimentVerbose e) $+              do putStr "Generated file "+                 putStrLn file++  onExperimentCompleted e r path = return ()++  onExperimentFailed e r path e' = throwComp e'

@@ -0,0 +1,46 @@++-- |+-- Module     : Simulation.Aivika.Experiment.Concurrent.MVar+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines helper functions for working with synchronized variable 'MVar'.+--++module Simulation.Aivika.Experiment.Concurrent.MVar+       (maybeReadMVar,+        maybePutMVar) where++import Control.Exception+import Control.Concurrent.MVar++import Data.Maybe++-- | Like 'maybe' but for the synchronized variable.+maybeReadMVar :: b -> (a -> IO b) -> MVar (Maybe a) -> IO b+maybeReadMVar b0 f x =+  do a <- readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Update the contents if the variable was empty and then return a result of+-- applying the specified function to either the initial or current value.+maybePutMVar :: MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b+maybePutMVar x m0 f =+  mask_ $+  do a <- takeMVar x+     case a of+       Just a ->+         do putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: SomeException -> IO a+                handle e = do putMVar x Nothing+                              throw e+            a0 <- catch m0 handle+            putMVar x (Just a0)+            f a0

@@ -1,97 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.ExperimentSpecsView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'ExperimentSpecsView' that shows the --- experiment specs.-----module Simulation.Aivika.Experiment.ExperimentSpecsView -       (ExperimentSpecsView(..),-        defaultExperimentSpecsView) where--import Control.Monad-import Control.Monad.Trans--import Data.Monoid--import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.ExperimentSpecsWriter---- | Defines the 'View' that shows the experiment specs.-data ExperimentSpecsView =-  ExperimentSpecsView { experimentSpecsTitle       :: String,-                        -- ^ The title for the view.-                        experimentSpecsDescription :: String,-                        -- ^ The description for the view.-                        experimentSpecsWriter      :: ExperimentSpecsWriter-                        -- ^ It shows the specs.-                      }-  --- | This is the default view.-defaultExperimentSpecsView :: ExperimentSpecsView-defaultExperimentSpecsView =  -  ExperimentSpecsView { experimentSpecsTitle       = "Experiment Specs",-                        experimentSpecsDescription = "It shows the experiment specs.",-                        experimentSpecsWriter      = defaultExperimentSpecsWriter }--instance ExperimentView ExperimentSpecsView (WebPageRenderer a) where  -  -  outputView v = -    let reporter exp renderer dir =-          do st <- newExperimentSpecs v exp-             let context =-                   WebPageContext $-                   WebPageWriter { reporterWriteTOCHtml = experimentSpecsTOCHtml st,-                                   reporterWriteHtml    = experimentSpecsHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = const $ return mempty,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }-  --- | The state of the view.-data ExperimentSpecsViewState =-  ExperimentSpecsViewState { experimentSpecsView       :: ExperimentSpecsView,-                             experimentSpecsExperiment :: Experiment }-  --- | Create a new state of the view.-newExperimentSpecs :: ExperimentSpecsView -> Experiment -> ExperimentWriter ExperimentSpecsViewState-newExperimentSpecs view exp =-  return ExperimentSpecsViewState { experimentSpecsView       = view,-                                    experimentSpecsExperiment = exp }-       --- | Get the HTML code.     -experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()     -experimentSpecsHtml st index =-  do header st index-     let writer = experimentSpecsWriter (experimentSpecsView st)-         write  = experimentSpecsWrite writer-         exp    = experimentSpecsExperiment st-     write writer exp--header :: ExperimentSpecsViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $-       writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)-     let description = experimentSpecsDescription $ experimentSpecsView st-     unless (null description) $-       writeHtmlParagraph $-       writeHtmlText description---- | Get the TOC item     -experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()-experimentSpecsTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)

@@ -1,131 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.ExperimentSpecsWriter--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'ExperimentSpecsWriter' that knows how to write--- in HTML the experiment specs which include the simulation specs and --- the number of simulation runs.-----module Simulation.Aivika.Experiment.ExperimentSpecsWriter -       (ExperimentSpecsWriter(..),-        defaultExperimentSpecsWriter) where--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.HtmlWriter---- | Defines a writer that knows how to represent the--- experiment specs as the HTML table.-data ExperimentSpecsWriter =-  ExperimentSpecsWriter { experimentSpecsWidth         :: Int,-                          -- ^ The width of the HTML table.-                          experimentSpecsNameText     :: String,-                          -- ^ Translated text \"Experiment Specs\".-                          experimentSpecsStartTimeText :: String,-                          -- ^ Translated text \"start time\".-                          experimentSpecsStopTimeText  :: String,-                          -- ^ Translated text \"stop time\".-                          experimentSpecsDTText        :: String,-                          -- ^ Translated text \"time step\".-                          experimentSpecsRunCountText  :: String,-                          -- ^ Translated text \"run count\".-                          experimentSpecsIntegMethodText    :: String,-                          -- ^ Translated text \"integration method\".-                          experimentSpecsEulerText     :: String,-                          -- ^ Translated text \"Euler's\".-                          experimentSpecsRungeKutta2Text :: String,-                          -- ^ Translated text \"the 2-nd order Runge-Kutta\".-                          experimentSpecsRungeKutta4Text :: String,-                          -- ^ Translated text \"the 4-th order Runge-Kutta\".-                          experimentSpecsFormatter     :: ShowS,-                          -- ^ The formatter of numbers.-                          experimentSpecsWrite :: ExperimentSpecsWriter-                                                  -> Experiment-                                                  -> HtmlWriter ()-                          -- ^ This function creates HTML.-                        }---- | The default writer.-defaultExperimentSpecsWriter :: ExperimentSpecsWriter-defaultExperimentSpecsWriter =-  ExperimentSpecsWriter { -    experimentSpecsWidth = 400,-    experimentSpecsNameText = "Experiment Specs",-    experimentSpecsStartTimeText = "start time",-    experimentSpecsStopTimeText = "stop time",-    experimentSpecsDTText = "time step",-    experimentSpecsRunCountText = "run count",-    experimentSpecsIntegMethodText = "integration method",-    experimentSpecsEulerText = "Euler's",-    experimentSpecsRungeKutta2Text = "the 2-nd order Runge-Kutta",-    experimentSpecsRungeKutta4Text = "the 4-th order Runge-Kutta",-    experimentSpecsFormatter = id,-    experimentSpecsWrite = \writer exp ->-      do let format x = experimentSpecsFormatter writer x-         writeHtml "<p>"-         writeHtml "<table frame='border' cellspacing='4' width='"-         writeHtml $ show $ experimentSpecsWidth writer-         writeHtml "'>"-         writeHtml "<tr>"-         writeHtml "<td colspan='2'>"-         writeHtml "<p align='center'>"-         writeHtmlText $ experimentSpecsNameText writer-         writeHtml "</p>"-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ experimentSpecsStartTimeText writer -         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ spcStartTime $ experimentSpecs exp-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ experimentSpecsStopTimeText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ spcStopTime $ experimentSpecs exp-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ experimentSpecsDTText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ spcDT $ experimentSpecs exp-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ experimentSpecsRunCountText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ experimentRunCount exp-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ experimentSpecsIntegMethodText writer-         writeHtml "</td>"-         writeHtml "<td>"-         let method = spcMethod $ experimentSpecs exp-         writeHtml $ methodName method writer-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "</table>" -         writeHtml "</p>"-    }---- | Return the method name.-methodName :: Method -> ExperimentSpecsWriter -> String-methodName Euler       = experimentSpecsEulerText-methodName RungeKutta2 = experimentSpecsRungeKutta2Text-methodName RungeKutta4 = experimentSpecsRungeKutta4Text

@@ -1,129 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.ExperimentWriter--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ It defines the 'Exp' monad that allows providing computation with--- an ability to resolve file paths.----module Simulation.Aivika.Experiment.ExperimentWriter-       (ExperimentWriter,-        runExperimentWriter,-        ExperimentFilePath(..),-        resolveFilePath,-        expandFilePath,-        mapFilePath) where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans-import Control.Monad.State--import qualified Data.Map as M-import qualified Data.Set as S--import System.Directory-import System.FilePath--import Simulation.Aivika.Experiment.MRef-import Simulation.Aivika.Experiment.Utils (replace)-  --- | Specifies the file name, unique or writable, which can be appended with extension if required.-data ExperimentFilePath = WritableFilePath FilePath-                          -- ^ The file which is overwritten in -                          -- case if it existed before.-                        | UniqueFilePath FilePath-                          -- ^ The file which is always unique,-                          -- when an automatically generated suffix-                          -- is added to the name in case of need.-                --- | Resolve the file path relative to the specified directory passed in the first argument--- and taking into account a possible requirement to have an unique file name.-resolveFilePath :: FilePath -> ExperimentFilePath -> ExperimentWriter FilePath-resolveFilePath dir (WritableFilePath path) =-  return $ dir </> path-resolveFilePath dir (UniqueFilePath path)   =-  ExperimentWriter $ \r ->-  let (name, ext) = splitExtension path-      loop y i =-        do let n  = dir </> addExtension y ext-               y' = name ++ "(" ++ show i ++ ")"-           f1 <- doesFileExist n-           f2 <- doesDirectoryExist n-           if f1 || f2-             then loop y' (i + 1)-             else do n' <- liftIO $-                           modifyMRef r $ \s ->-                           if S.member n s-                           then return (s, Nothing)-                           else return (S.insert n s, Just n)-                     case n' of-                       Nothing -> loop y' (i + 1)-                       Just n' -> return n'-  in loop name 2---- | Expand the file path using the specified table of substitutions.-expandFilePath :: ExperimentFilePath -> M.Map String String -> ExperimentFilePath-expandFilePath (WritableFilePath path) map = WritableFilePath (expandTemplates path map)-expandFilePath (UniqueFilePath path) map = UniqueFilePath (expandTemplates path map)---- | Expand the string templates using the specified table of substitutions.-expandTemplates :: String -> M.Map String String -> String     -expandTemplates name map = name' where-  ((), name') = flip runState name $-                forM_ (M.assocs map) $ \(k, v) ->-                do a <- get-                   put $ replace k v a---- | Transform the file path using the specified function.-mapFilePath :: (FilePath -> FilePath) -> ExperimentFilePath -> ExperimentFilePath-mapFilePath f (WritableFilePath path) = WritableFilePath (f path)-mapFilePath f (UniqueFilePath path) = UniqueFilePath (f path) ----- | Defines an 'IO' derived computation whithin which we can resolve the unique file paths.-newtype ExperimentWriter a = ExperimentWriter (MRef (S.Set String) -> IO a)--instance Functor ExperimentWriter where--  {-# INLINE fmap #-}-  fmap f (ExperimentWriter m) =-    ExperimentWriter $ \r -> fmap f (m r)--instance Applicative ExperimentWriter where--  {-# INLINE pure #-}-  pure a =-    ExperimentWriter $ \r -> return a--  {-# INLINE (<*>) #-}-  (ExperimentWriter f) <*> (ExperimentWriter m) =-    ExperimentWriter $ \r -> f r <*> m r--instance Monad ExperimentWriter where--  {-# INLINE return #-}-  return a =-    ExperimentWriter $ \r -> return a--  {-# INLINE (>>=) #-}-  (ExperimentWriter m) >>= k =-    ExperimentWriter $ \r ->-    do a <- m r-       let ExperimentWriter b = k a-       b r-       -instance MonadIO ExperimentWriter where--  {-# INLINE liftIO #-}-  liftIO m = ExperimentWriter $ \r -> liftIO m---- | Run the 'ExperimentWriter' computation.-runExperimentWriter :: ExperimentWriter a -> IO a-runExperimentWriter (ExperimentWriter m) =-  do r <- newMRef S.empty-     m r

@@ -1,33 +0,0 @@--{-# LANGUAGE TypeFamilies #-}---- |--- Module     : Simulation.Aivika.Experiment.Types--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ It defines a renderer that saves the results in files when running the simulation experiment.-----module Simulation.Aivika.Experiment.FileRenderer where--import Simulation.Aivika.Experiment.Types---- | It defines a simulation 'Experiment' renderer that saves the results in files. -data FileRenderer a = FileRenderer a-                      -- ^ A file renderer that depends on the provided parameter.---- | A convenient type synonym for describing a file generator.-type FileGenerator a = ExperimentGenerator (FileRenderer a)---- | Saving the results of simulation in files when running the experiment.-instance ExperimentRendering (FileRenderer a) where--  -- | A file rendering context.-  data ExperimentContext (FileRenderer a) = FileContext-                                            -- ^ A file context constructor.-  -  renderExperiment e r reporters path = return ()

@@ -1,166 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.FinalStatsView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'FinalStatsView' gathers the statistics--- in the final time points for different simulation runs.-----module Simulation.Aivika.Experiment.FinalStatsView-       (FinalStatsView(..), -        defaultFinalStatsView) where--import Control.Monad-import Control.Monad.Trans-import Control.Concurrent.MVar--import Data.IORef-import Data.Maybe--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.SamplingStatsWriter-import Simulation.Aivika.Experiment.MRef---- | Defines the 'View' that gathers the statistics--- in the final time points.-data FinalStatsView =-  FinalStatsView { finalStatsTitle       :: String,-                   -- ^ This is a title for the view.-                   finalStatsDescription :: String,-                   -- ^ This is a description used in HTML.-                   finalStatsWriter      :: SamplingStatsWriter Double,-                   -- ^ It shows the sampling statistics.-                   finalStatsPredicate   :: Event Bool,-                   -- ^ It specifies the predicate that defines-                   -- when we count data when gathering the statistics.-                   finalStatsTransform   :: ResultTransform,-                   -- ^ The transform applied to the results before receiving series.-                   finalStatsSeries      :: ResultTransform -                   -- ^ It defines the series for which the statistics to be collected.-                 }-  --- | The default statistics view.  -defaultFinalStatsView :: FinalStatsView-defaultFinalStatsView = -  FinalStatsView { finalStatsTitle       = "Final Statistics",-                   finalStatsDescription = "Statistics is gathered in final time points for all runs.",-                   finalStatsWriter      = defaultSamplingStatsWriter,-                   finalStatsPredicate   = return True,-                   finalStatsTransform   = id,-                   finalStatsSeries      = id }--instance ExperimentView FinalStatsView (WebPageRenderer a) where-  -  outputView v = -    let reporter exp renderer dir =-          do st <- newFinalStats v exp dir-             let context =-                   WebPageContext $-                   WebPageWriter { reporterWriteTOCHtml = finalStatsTOCHtml st,-                                   reporterWriteHtml    = finalStatsHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = simulateFinalStats st,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }-  --- | The state of the view.-data FinalStatsViewState =-  FinalStatsViewState { finalStatsView       :: FinalStatsView,-                        finalStatsExperiment :: Experiment,-                        finalStatsResults    :: MRef (Maybe FinalStatsResults) }---- | The statistics results.-data FinalStatsResults =-  FinalStatsResults { finalStatsNames  :: [String],-                      finalStatsValues :: [IORef (SamplingStats Double)] }-  --- | Create a new state of the view.-newFinalStats :: FinalStatsView -> Experiment -> FilePath -> ExperimentWriter FinalStatsViewState-newFinalStats view exp dir =-  do r <- liftIO $ newMRef Nothing-     return FinalStatsViewState { finalStatsView       = view,-                                  finalStatsExperiment = exp,-                                  finalStatsResults    = r }-       --- | Create new statistics results.-newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults-newFinalStatsResults names exp =-  do values <- forM names $ \_ -> liftIO $ newIORef emptySamplingStats-     return FinalStatsResults { finalStatsNames  = names,-                                finalStatsValues = values }---- | Require to return unique final statistics results associated with the specified state. -requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults-requireFinalStatsResults st names =-  maybeWriteMRef (finalStatsResults st)-  (newFinalStatsResults names (finalStatsExperiment st)) $ \results ->-  if (names /= finalStatsNames results)-  then error "Series with different names are returned for different runs: requireFinalStatsResults"-  else return results-       --- | Simulate the specified series.-simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Event DisposableEvent-simulateFinalStats st expdata =-  do let view    = finalStatsView st-         rs      = finalStatsSeries view $-                   finalStatsTransform view $-                   experimentResults expdata-         exts    = resultsToDoubleStatsEitherValues rs-         signals = experimentPredefinedSignals expdata-         signal  = filterSignalM (const predicate) $-                   resultSignalInStopTime signals-         names   = map resultValueName exts-         predicate = finalStatsPredicate view-     results <- liftIO $ requireFinalStatsResults st names-     let values = finalStatsValues results -     handleSignal signal $ \_ ->-       forM_ (zip exts values) $ \(ext, value) ->-       do x <- resultValueData ext-          liftIO $-            do y <- readIORef value-               let y' = combineSamplingStatsEither x y-               y' `seq` writeIORef value y'---- | Get the HTML code.     -finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()-finalStatsHtml st index =-  do header st index-     results <- liftIO $ readMRef (finalStatsResults st)-     case results of-       Nothing -> return ()-       Just results ->-         do let names  = finalStatsNames results-                values = finalStatsValues results-                writer = finalStatsWriter (finalStatsView st)-                write  = samplingStatsWrite writer-            forM_ (zip names values) $ \(name, value) ->-              do stats <- liftIO $ readIORef value-                 write writer name stats--header :: FinalStatsViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $ -       writeHtmlText (finalStatsTitle $ finalStatsView st)-     let description = finalStatsDescription $ finalStatsView st-     unless (null description) $-       writeHtmlParagraph $ -       writeHtmlText description---- | Get the TOC item.-finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()-finalStatsTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (finalStatsTitle $ finalStatsView st)

@@ -1,253 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.FinalTableView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'FinalTableView' that saves the simulation--- results in the final time points for all simulation runs in--- the CSV file.-----module Simulation.Aivika.Experiment.FinalTableView-       (FinalTableView(..), -        defaultFinalTableView) where--import Control.Monad-import Control.Monad.Trans-import Control.Concurrent.MVar--import qualified Data.Map as M-import Data.IORef-import Data.Maybe--import System.IO-import System.FilePath--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.FileRenderer-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.MRef---- | Defines the 'View' that saves the simulation --- results in the final time points for all --- simulation runs in the CSV file.-data FinalTableView =-  FinalTableView { finalTableTitle       :: String,-                   -- ^ This is a title used in HTML.-                   finalTableDescription :: String,-                   -- ^ This is a description used in HTML.-                   finalTableRunText     :: String,-                   -- ^ Translated text \"Run\".-                   finalTableLinkText    :: String,-                   -- ^ It specifies the text for the link -                   -- which is displayed in the HTML page. -                   -- The link downloads the corresponded -                   -- CSV file in the browser. -                   ---                   -- An example is-                   ---                   -- @-                   --   finalTableLinkText = \"Download the CSV file\"-                   -- @-                   finalTableFileName    :: ExperimentFilePath,-                   -- ^ It defines the file name for the CSV file. -                   -- It may include special variable @$TITLE@.-                   ---                   -- An example is-                   ---                   -- @-                   --   finalTableFileName = UniqueFilePath \"$TITLE.csv\"-                   -- @-                   finalTableSeparator   :: String,-                   -- ^ It defines the separator for the view. -                   -- It delimits the cells in the rows of the CSV file.-                   finalTableFormatter   :: ShowS,-                   -- ^ It defines the formatter which is applied-                   -- to all values before they will be written-                   -- in the CSV file.-                   finalTablePredicate   :: Event Bool,-                   -- ^ It specifies the predicate that defines-                   -- when we can save data in the table.-                   finalTableTransform   :: ResultTransform,-                   -- ^ The transform applied to the results before receiving series.-                   finalTableSeries      :: ResultTransform -                   -- ^ It defines the series to save in the CSV file.-                 }-  --- | The default table view.  -defaultFinalTableView :: FinalTableView-defaultFinalTableView = -  FinalTableView { finalTableTitle       = "Final Table",-                   finalTableDescription = "It refers to the CSV file with the results in the final time points.",-                   finalTableRunText     = "Run",-                   finalTableLinkText    = "Download the CSV file",-                   finalTableFileName    = UniqueFilePath "FinalTable.csv",-                   finalTableSeparator   = ",",-                   finalTableFormatter   = id,-                   finalTablePredicate   = return True,-                   finalTableTransform   = expandResults,-                   finalTableSeries      = id }--instance ExperimentView FinalTableView (WebPageRenderer a) where-  -  outputView v = -    let reporter exp renderer dir =-          do st <- newFinalTable v exp dir-             let context =-                   WebPageContext-                   WebPageWriter { reporterWriteTOCHtml = finalTableTOCHtml st,-                                   reporterWriteHtml    = finalTableHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = finaliseFinalTable st,-                                         reporterSimulate   = simulateFinalTable st,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }--instance ExperimentView FinalTableView (FileRenderer a) where-  -  outputView v = -    let reporter exp renderer dir =-          do st <- newFinalTable v exp dir-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = finaliseFinalTable st,-                                         reporterSimulate   = simulateFinalTable st,-                                         reporterContext    = FileContext }-    in ExperimentGenerator { generateReporter = reporter }-  --- | The state of the view.-data FinalTableViewState =-  FinalTableViewState { finalTableView       :: FinalTableView,-                        finalTableExperiment :: Experiment,-                        finalTableDir        :: FilePath, -                        finalTableFile       :: IORef (Maybe FilePath),-                        finalTableResults    :: MRef (Maybe FinalTableResults) }---- | The table results.-data FinalTableResults =-  FinalTableResults { finalTableNames  :: [String],-                      finalTableValues :: MRef (M.Map Int [String]) }-  --- | Create a new state of the view.-newFinalTable :: FinalTableView -> Experiment -> FilePath -> ExperimentWriter FinalTableViewState-newFinalTable view exp dir =-  do f <- liftIO $ newIORef Nothing-     r <- liftIO $ newMRef Nothing-     return FinalTableViewState { finalTableView       = view,-                                  finalTableExperiment = exp,-                                  finalTableDir        = dir, -                                  finalTableFile       = f,-                                  finalTableResults    = r }-       --- | Create new table results.-newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults-newFinalTableResults names exp =-  do values <- newMRef M.empty -     return FinalTableResults { finalTableNames  = names,-                                finalTableValues = values }---- | Require to return unique final tables results associated with the specified state. -requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults-requireFinalTableResults st names =-  maybeWriteMRef (finalTableResults st)-  (newFinalTableResults names (finalTableExperiment st)) $ \results ->-  if (names /= finalTableNames results)-  then error "Series with different names are returned for different runs: requireFinalTableResults"-  else return results-       --- | Simulation of the specified series.-simulateFinalTable :: FinalTableViewState -> ExperimentData -> Event DisposableEvent-simulateFinalTable st expdata =-  do let view    = finalTableView st-         rs      = finalTableSeries view $-                   finalTableTransform view $-                   experimentResults expdata-         exts    = resultsToStringValues rs-         signals = experimentPredefinedSignals expdata-         signal  = filterSignalM (const predicate) $-                   resultSignalInStopTime signals-         names   = map resultValueName exts-         predicate = finalTablePredicate view-     results <- liftIO $ requireFinalTableResults st names-     let values = finalTableValues results -     handleSignal signal $ \_ ->-       do xs <- mapM resultValueData exts-          i  <- liftParameter simulationIndex-          liftIO $ modifyMRef_ values $ return . M.insert i xs-     --- | Save the results in the CSV file after the simulation is complete.-finaliseFinalTable :: FinalTableViewState -> ExperimentWriter ()-finaliseFinalTable st =-  do let view      = finalTableView st-         run       = finalTableRunText view-         formatter = finalTableFormatter view-         title     = finalTableTitle view-         separator = finalTableSeparator view-     results <- liftIO $ readMRef $ finalTableResults st-     case results of-       Nothing -> return ()-       Just results ->-         do let names  = finalTableNames results-                values = finalTableValues results-            m <- liftIO $ readMRef values -            file <- resolveFilePath (finalTableDir st) $-                    mapFilePath (flip replaceExtension ".csv") $-                    expandFilePath (finalTableFileName $ finalTableView st) $-                    M.fromList [("$TITLE", title)]-            liftIO $ do-              -- create a new file-              h <- openFile file WriteMode-              -- write a header-              hPutStr h $ show run-              forM_ names $ \name ->-                do hPutStr h separator-                   hPutStr h $ show name-              hPutStrLn h ""-              -- write data-              forM_ (M.assocs m) $ \(i, xs) ->-                do hPutStr h $ show i-                   forM_ xs $ \x ->-                     do hPutStr h separator-                        hPutStr h $ formatter x-                   hPutStrLn h ""-              -- close file-              hClose h -              when (experimentVerbose $ finalTableExperiment st) $-                putStr "Generated file " >> putStrLn file-              writeIORef (finalTableFile st) $ Just file-     --- | Get the HTML code.     -finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()-finalTableHtml st index =-  do header st index-     file <- liftIO $ readIORef (finalTableFile st)-     case file of-       Nothing -> return ()-       Just f  ->-         writeHtmlParagraph $-         writeHtmlLink (makeRelative (finalTableDir st) f) $-         writeHtmlText (finalTableLinkText $ finalTableView st)--header :: FinalTableViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $ -       writeHtmlText (finalTableTitle $ finalTableView st)-     let description = finalTableDescription $ finalTableView st-     unless (null description) $-       writeHtmlParagraph $ -       writeHtmlText description---- | Get the TOC item.-finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()-finalTableTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (finalTableTitle $ finalTableView st)

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.Histogram--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.10.1+-- Tested with: GHC 8.0.1 -- -- | This module computes the histogram by the  -- specified data and strategy applied for such computing.

@@ -1,397 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.HtmlWriter--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ This is an utility module that provides an HTML writer.-----module Simulation.Aivika.Experiment.HtmlWriter -       (HtmlWriter,-        runHtmlWriter,-        composeHtml,-        writeHtml,-        writeHtmlLn,-        writeHtmlText,-        writeHtmlParagraph,-        writeHtmlParagraphWithId,-        writeHtmlHeader1,-        writeHtmlHeader1WithId,-        writeHtmlHeader2,-        writeHtmlHeader2WithId,-        writeHtmlHeader3,-        writeHtmlHeader3WithId,-        writeHtmlHeader4,-        writeHtmlHeader4WithId,-        writeHtmlHeader5,-        writeHtmlHeader5WithId,-        writeHtmlHeader6,-        writeHtmlHeader6WithId,-        writeHtmlBreak,-        writeHtmlLink,-        writeHtmlImage,-        writeHtmlList,-        writeHtmlListItem,-        writeHtmlDocumentWithTitle,-        encodeHtmlText) where--import Control.Monad-import Control.Monad.Trans-import Control.Applicative--import Network.URI--import Simulation.Aivika.Experiment.ExperimentWriter---- | It writes fast an HTML code.-newtype HtmlWriter a = -  HtmlWriter { runHtmlWriter :: ShowS -> ExperimentWriter (a, ShowS)-               -- ^ Run the HTML writer monad.-             }--instance Monad HtmlWriter where-  -  return a = HtmlWriter $ \f -> return (a, f)-  -  (HtmlWriter m) >>= k = HtmlWriter $ \f ->-    do (a, f') <- m f-       let HtmlWriter m' = k a-       m' f'-       -instance MonadIO HtmlWriter where       -  -  liftIO m = HtmlWriter $ \f ->-    do x <- liftIO m-       return (x, f)--instance Functor HtmlWriter where--  fmap f m = m >>= \a -> return (f a)--instance Applicative HtmlWriter where--  pure = return-  (<*>) = ap-       --- | Write the HTML code.-writeHtml :: String -> HtmlWriter ()-writeHtml code = -  HtmlWriter $ \f -> return ((), f . (code ++))-                     --- | Write the HTML code.-writeHtmlLn :: String -> HtmlWriter ()-writeHtmlLn code = -  do writeHtml code-     writeHtml "\n"-                     --- | Write the text in HTML.                     -writeHtmlText :: String -> HtmlWriter ()                     -writeHtmlText text =-  HtmlWriter $ \f -> return ((), f . (encodeHtmlText text ++))-                     --- | Compose the HTML applying the corresponded transformation.                     -composeHtml :: ShowS -> HtmlWriter ()                     -composeHtml g =-  HtmlWriter $ \f -> return ((), f . g)---- | Write the HTML link with the specified URI and contents.-writeHtmlLink :: String -> HtmlWriter () -> HtmlWriter ()-writeHtmlLink uri inner =-  do writeHtml "<a href=\""-     writeHtml $ escapeURIString isUnescapedInURI uri-     writeHtml "\">"-     inner-     writeHtml "</a>"-     --- | Write the HTML image with the specified URI.-writeHtmlImage :: String -> HtmlWriter ()-writeHtmlImage uri =-  do writeHtml "<img src=\""-     writeHtml $ escapeURIString isUnescapedInURI uri-     writeHtml "\" />"---- | Write the @\<p\>@ element with the specified contents.     -writeHtmlParagraph :: HtmlWriter () -> HtmlWriter ()     -writeHtmlParagraph inner =-  do writeHtml "<p>"-     inner-     writeHtml "</p>"-     --- | Write the @\<h1\>@ element with the specified contents.     -writeHtmlHeader1 :: HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader1 inner =-  do writeHtml "<h1>"-     inner-     writeHtml "</h1>"-     --- | Write the @\<h2\>@ element with the specified contents.     -writeHtmlHeader2 :: HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader2 inner =-  do writeHtml "<h2>"-     inner-     writeHtml "</h2>"-     --- | Write the @\<h3\>@ element with the specified contents.     -writeHtmlHeader3 :: HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader3 inner =-  do writeHtml "<h3>"-     inner-     writeHtml "</h3>"-     --- | Write the @\<h4\>@ element with the specified contents.     -writeHtmlHeader4 :: HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader4 inner =-  do writeHtml "<h4>"-     inner-     writeHtml "</h4>"-     --- | Write the @\<h5\>@ element with the specified contents.     -writeHtmlHeader5 :: HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader5 inner =-  do writeHtml "<h5>"-     inner-     writeHtml "</h5>"-     --- | Write the @\<h6\>@ element with the specified contents.     -writeHtmlHeader6 :: HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader6 inner =-  do writeHtml "<h6>"-     inner-     writeHtml "</h6>"-     --- | Write the @\<p\>@ element with the specified id and contents.     -writeHtmlParagraphWithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlParagraphWithId id inner =-  do writeHtml "<p id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</p>"-     --- | Write the @\<h1\>@ element with the specified id and contents.     -writeHtmlHeader1WithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader1WithId id inner =-  do writeHtml "<h1 id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</h1>"-     --- | Write the @\<h2\>@ element with the specified id and contents.     -writeHtmlHeader2WithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader2WithId id inner =-  do writeHtml "<h2 id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</h2>"-     --- | Write the @\<h3\>@ element with the specified id and contents.     -writeHtmlHeader3WithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader3WithId id inner =-  do writeHtml "<h3 id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</h3>"-     --- | Write the @\<h4\>@ element with the specified id and contents.     -writeHtmlHeader4WithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader4WithId id inner =-  do writeHtml "<h4 id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</h4>"-     --- | Write the @\<h5\>@ element with the specified id and contents.     -writeHtmlHeader5WithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader5WithId id inner =-  do writeHtml "<h5 id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</h5>"-     --- | Write the @\<h6\>@ element with the specified id and contents.     -writeHtmlHeader6WithId :: String -> HtmlWriter () -> HtmlWriter ()     -writeHtmlHeader6WithId id inner =-  do writeHtml "<h6 id=\""-     writeHtml id-     writeHtml "\">"-     inner-     writeHtml "</h6>"-     --- | Write the @\<br\>@ element.-writeHtmlBreak :: HtmlWriter ()     -writeHtmlBreak =-  writeHtml "<br />"-     --- | Write the list of items wrapped in @\<ul\>@.  -writeHtmlList :: HtmlWriter () -> HtmlWriter ()-writeHtmlList inner =-  do writeHtml "<ul>"-     inner-     writeHtml "</ul>"---- | Write the item list wrapped in @\<li\>@.  -writeHtmlListItem :: HtmlWriter () -> HtmlWriter ()-writeHtmlListItem inner =-  do writeHtml "<li>"-     inner-     writeHtml "</li>"---- | Write the HTML document with the specified title and contents-writeHtmlDocumentWithTitle :: String -> HtmlWriter () -> HtmlWriter ()-writeHtmlDocumentWithTitle title inner =-  do writeHtml "<html>"-     writeHtml "<head>"-     writeHtml "<meta http-equiv='Content-Type' content='text/html; charset=utf-8' />"-     writeHtml "<title>"-     writeHtmlText title-     writeHtml "</title>"-     writeHtmlCss -     writeHtml "</head>"-     writeHtml "<body>"-     writeHtmlHeader1 $ -       writeHtmlText title-     writeHtml "</h1>"-     inner-     writeHtml "<br /><p><font size=\"-1\">Automatically generated by "-     writeHtml "<a href=\"https://github.com/dsorokin/aivika-experiment\">"-     writeHtml "Aivika Experiment</a>"-     writeHtml "</font></p>"-     writeHtml "</body>"-     writeHtml "</html>"---- | Escape special HTML characters in the 'String'.--- It is based on one function from package Web-Encodings,--- which is licensed under BSD3 but obsolete now.-encodeHtmlText :: String -> String-encodeHtmlText x = join $ map encodeHtmlChar x---- | Escape a character.-encodeHtmlChar :: Char -> String-encodeHtmlChar '<'  = "&lt;"-encodeHtmlChar '>'  = "&gt;"-encodeHtmlChar '&'  = "&amp;"-encodeHtmlChar '"'  = "&quot;"-encodeHtmlChar '\'' = "&#39;"-encodeHtmlChar c    = [c]---- | Write the CSS styles-writeHtmlCss :: HtmlWriter ()-writeHtmlCss =-  do writeHtmlLn "<style type=\"text/css\">"-     writeHtmlLn "* { margin: 0; padding: 0 }"-     writeHtmlLn ""-     writeHtmlLn "html {"-     writeHtmlLn "  background-color: white;"-     writeHtmlLn "  width: 100%;"-     writeHtmlLn "  height: 100%;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "body {"-     writeHtmlLn "  background: white;"-     writeHtmlLn "  color: black;"-     writeHtmlLn "  text-align: left;"-     writeHtmlLn "  min-height: 100%;"-     writeHtmlLn "  position: relative;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "p {"-     writeHtmlLn "  margin: 0.8em 0;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "ul, ol {"-     writeHtmlLn "  margin: 0.8em 0 0.8em 2em;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "dl {"-     writeHtmlLn "  margin: 0.8em 0;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "dt {"-     writeHtmlLn "  font-weight: bold;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "dd {"-     writeHtmlLn "  margin-left: 2em;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "a { text-decoration: none; }"-     writeHtmlLn "a[href]:link { color: rgb(196,69,29); }"-     writeHtmlLn "a[href]:visited { color: rgb(171,105,84); }"-     writeHtmlLn "a[href]:hover { text-decoration:underline; }"-     writeHtmlLn ""-     writeHtmlLn "body {"-     writeHtmlLn "  font:13px/1.4 sans-serif;"-     writeHtmlLn "  *font-size:small; /* for IE */"-     writeHtmlLn "  *font:x-small; /* for IE in quirks mode */"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "h1 { font-size: 146.5%; /* 19pt */ } "-     writeHtmlLn "h2 { font-size: 131%;   /* 17pt */ }"-     writeHtmlLn "h3 { font-size: 116%;   /* 15pt */ }"-     writeHtmlLn "h4 { font-size: 100%;   /* 13pt */ }"-     writeHtmlLn "h5 { font-size: 100%;   /* 13pt */ }"-     writeHtmlLn ""-     writeHtmlLn "select, input, button, textarea {"-     writeHtmlLn "  font:99% sans-serif;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "table {"-     writeHtmlLn "  font-size:inherit;"-     writeHtmlLn "  font:100%;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "pre, code, kbd, samp, tt, .src {"-     writeHtmlLn "  font-family:monospace;"-     writeHtmlLn "  *font-size:108%;"-     writeHtmlLn "  line-height: 124%;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn ".links, .link {"-     writeHtmlLn "  font-size: 85%; /* 11pt */"-     writeHtmlLn "}"-     writeHtmlLn ".info  {"-     writeHtmlLn "  font-size: 85%; /* 11pt */"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn ".caption, h1, h2, h3, h4, h5, h6 { "-     writeHtmlLn "  font-weight: bold;"-     writeHtmlLn "  color: rgb(78,98,114);"-     writeHtmlLn "  margin: 0.8em 0 0.4em;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "* + h1, * + h2, * + h3, * + h4, * + h5, * + h6 {"-     writeHtmlLn "  margin-top: 2em;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "h1 + h2, h2 + h3, h3 + h4, h4 + h5, h5 + h6 {"-     writeHtmlLn "  margin-top: inherit;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "ul.links {"-     writeHtmlLn "  list-style: none;"-     writeHtmlLn "  text-align: left;"-     writeHtmlLn "  float: right;"-     writeHtmlLn "  display: inline-table;"-     writeHtmlLn "  margin: 0 0 0 1em;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "ul.links li {"-     writeHtmlLn "  display: inline;"-     writeHtmlLn "  border-left: 1px solid #d5d5d5; "-     writeHtmlLn "  white-space: nowrap;"-     writeHtmlLn "  padding: 0;"-     writeHtmlLn "}"-     writeHtmlLn ""-     writeHtmlLn "ul.links li a {"-     writeHtmlLn "  padding: 0.2em 0.5em;"-     writeHtmlLn "}"-     writeHtmlLn "</style>"

@@ -1,175 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.InfoView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'InfoView' that shows the description of series.-----module Simulation.Aivika.Experiment.InfoView-       (InfoView(..), -        defaultInfoView) where--import Control.Monad-import Control.Monad.Trans-import Control.Concurrent.MVar--import Data.IORef-import Data.Maybe-import Data.Monoid--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.MRef---- | Defines the 'View' that shows the description of series.-data InfoView =-  InfoView { infoTitle        :: String,-             -- ^ This is a title for the view.-             infoDescription  :: String,-             -- ^ This is a text description used in HTML.-             infoTransform    :: ResultTransform,-             -- ^ The transform applied to the results before receiving series.-             infoSeries       :: ResultTransform, -             -- ^ It defines the series for which the description is shown.-             infoLocalisation :: ResultLocalisation-             -- ^ It specifies the localisation.-           }-  --- | The default description view.  -defaultInfoView :: InfoView-defaultInfoView = -  InfoView { infoTitle        = "Information",-             infoDescription  = "It shows the information about simulation entities:",-             infoTransform    = id,-             infoSeries       = id,-             infoLocalisation = englishResultLocalisation }--instance ExperimentView InfoView (WebPageRenderer a) where-  -  outputView v = -    let reporter exp renderer dir =-          do st <- newInfo v exp dir-             let context =-                   WebPageContext $-                   WebPageWriter { reporterWriteTOCHtml = infoTOCHtml st,-                                   reporterWriteHtml    = infoHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = simulateInfo st,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }-  --- | The state of the view.-data InfoViewState =-  InfoViewState { infoView       :: InfoView,-                  infoExperiment :: Experiment,-                  infoResults    :: MRef (Maybe InfoResults) }---- | The information table.-data InfoResults =-  InfoResults { infoNames  :: [String],-                infoValues :: [String] }-  --- | Create a new state of the view.-newInfo :: InfoView -> Experiment -> FilePath -> ExperimentWriter InfoViewState-newInfo view exp dir =-  do r <- liftIO $ newMRef Nothing-     return InfoViewState { infoView       = view,-                            infoExperiment = exp,-                            infoResults    = r }-       --- | Create a new information table.-newInfoResults :: [ResultSource] -> ResultLocalisation -> Experiment -> IO InfoResults-newInfoResults sources loc exp =-  do let xs =-           flip map sources $ \source ->-           case source of-             ResultItemSource (ResultItem x) ->-               [(resultItemName x, loc $ resultItemId x)]-             ResultObjectSource x ->-               [(resultObjectName x, loc $ resultObjectId x)]-             ResultVectorSource x ->-               [(resultVectorName x, loc $ resultVectorId x)]-             ResultSeparatorSource x ->-               []-         (names, values) = unzip $ concat xs-     return InfoResults { infoNames  = names,-                          infoValues = values }---- | Require to return the unique information table associated with the specified state. -requireInfoResults :: InfoViewState -> [ResultSource] -> IO InfoResults-requireInfoResults st sources =-  let view = infoView st-      loc  = infoLocalisation view-      exp  = infoExperiment st-  in maybeWriteMRef (infoResults st)-     (newInfoResults sources loc exp) $ \results ->-  do let xs =-           flip map sources $ \source ->-           case source of-             ResultItemSource (ResultItem x) ->-               [resultItemName x]-             ResultObjectSource x ->-               [resultObjectName x]-             ResultVectorSource x ->-               [resultVectorName x]-             ResultSeparatorSource x ->-               []-     let names = concat xs-     if (names /= infoNames results)-       then error "Series with different names are returned for different runs: requireInfoResults"-       else return results-       --- | Simulate the specified series.-simulateInfo :: InfoViewState -> ExperimentData -> Event DisposableEvent-simulateInfo st expdata =-  do let view    = infoView st-         rs      = infoSeries view $-                   infoTransform view $-                   experimentResults expdata-         sources = resultSourceList rs-     liftIO $ requireInfoResults st sources-     return mempty---- | Get the HTML code.     -infoHtml :: InfoViewState -> Int -> HtmlWriter ()-infoHtml st index =-  do header st index-     results <- liftIO $ readMRef (infoResults st)-     case results of-       Nothing -> return ()-       Just results ->-         do let names  = infoNames results-                values = infoValues results-            writeHtmlList $-              forM_ (zip names values) $ \(name, value) ->-              writeHtmlListItem $-              do writeHtmlText name-                 writeHtmlText " - "-                 writeHtmlText value--header :: InfoViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $ -       writeHtmlText (infoTitle $ infoView st)-     let description = infoDescription $ infoView st-     unless (null description) $-       writeHtmlParagraph $ -       writeHtmlText description---- | Get the TOC item.-infoTOCHtml :: InfoViewState -> Int -> HtmlWriter ()-infoTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (infoTitle $ infoView st)

@@ -1,174 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.LastValueView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'LastValueView' that shows the last values--- for the simulation variables.-----module Simulation.Aivika.Experiment.LastValueView -       (LastValueView(..),-        defaultLastValueView) where--import Control.Monad-import Control.Monad.Trans--import qualified Data.Map as M-import Data.IORef-import Data.Maybe--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (replace)---- | Defines the 'View' that shows the last values of the simulation--- variables.-data LastValueView =-  LastValueView { lastValueTitle       :: String,-                  -- ^ The title for the view.-                  lastValueRunTitle    :: String,-                  -- ^ The run title for the view. It may include-                  -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and -                  -- @$TITLE@.-                  ---                  -- An example is -                  ---                  -- @-                  --   lastValueRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"-                  -- @-                  lastValueDescription :: String,-                  -- ^ The description for the view.-                  lastValueFormatter   :: ShowS,-                  -- ^ It transforms data before they will be shown.-                  lastValueTransform   :: ResultTransform,-                  -- ^ The transform applied to the results before receiving series.-                  lastValueSeries      :: ResultTransform -                  -- ^ It defines the series for which the last values to be shown.-                }-  --- | This is the default view.-defaultLastValueView :: LastValueView-defaultLastValueView =  -  LastValueView { lastValueTitle       = "The Last Values",-                  lastValueRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",-                  lastValueDescription = "It shows the values in the final time point(s).",-                  lastValueFormatter   = id,-                  lastValueTransform   = id,-                  lastValueSeries      = id }-  -instance ExperimentView LastValueView (WebPageRenderer a) where  -  -  outputView v = -    let reporter exp renderer dir =-          do st <- newLastValues v exp-             let context =-                   WebPageContext $-                   WebPageWriter { reporterWriteTOCHtml = lastValueTOCHtml st,-                                   reporterWriteHtml    = lastValueHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = simulateLastValues st,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }---- | The state of the view.-data LastValueViewState =-  LastValueViewState { lastValueView       :: LastValueView,-                       lastValueExperiment :: Experiment,-                       lastValueMap        :: M.Map Int (IORef [(String, String)]) }-  --- | Create a new state of the view.-newLastValues :: LastValueView -> Experiment -> ExperimentWriter LastValueViewState-newLastValues view exp =-  do let n = experimentRunCount exp-     rs <- forM [0..(n - 1)] $ \i -> liftIO $ newIORef []    -     let m = M.fromList $ zip [0..(n - 1)] rs-     return LastValueViewState { lastValueView       = view,-                                 lastValueExperiment = exp,-                                 lastValueMap        = m }-       --- | Get the last values during the simulation.-simulateLastValues :: LastValueViewState -> ExperimentData -> Event DisposableEvent-simulateLastValues st expdata =-  do let view    = lastValueView st-         rs      = lastValueSeries view $-                   lastValueTransform view $-                   experimentResults expdata-         exts    = resultsToStringValues rs-         signals = experimentPredefinedSignals expdata-         signal  = resultSignalInStopTime signals-     i <- liftParameter simulationIndex-     handleSignal signal $ \t ->-       do let r = fromJust $ M.lookup (i - 1) (lastValueMap st)-          output <- forM exts $ \ext ->-            do x <- resultValueData ext-               return (resultValueName ext, x)-          liftIO $ writeIORef r output-     --- | Get the HTML code.     -lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()     -lastValueHtml st index =-  let n = experimentRunCount $ lastValueExperiment st-  in if n == 1-     then lastValueHtmlSingle st index-     else lastValueHtmlMultiple st index-     --- | Get the HTML code for a single run.-lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter ()-lastValueHtmlSingle st index =-  do header st index-     let r = fromJust $ M.lookup 0 (lastValueMap st)-     pairs <- liftIO $ readIORef r-     forM_ pairs $ \pair ->-       formatPair pair (lastValueFormatter $ lastValueView st)---- | Get the HTML code for multiple runs-lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter ()-lastValueHtmlMultiple st index =-  do header st index-     let n = experimentRunCount $ lastValueExperiment st-     forM_ [0..(n - 1)] $ \i ->-       do let subtitle = -                replace "$RUN_INDEX" (show $ i + 1) $-                replace "$RUN_COUNT" (show n) $-                replace "$TITLE" (lastValueTitle $ lastValueView st)-                (lastValueRunTitle $ lastValueView st)-          writeHtmlHeader4 $-            writeHtmlText subtitle-          let r = fromJust $ M.lookup i (lastValueMap st)-          pairs <- liftIO $ readIORef r-          forM_ pairs $ \pair ->-            formatPair pair (lastValueFormatter $ lastValueView st)--header :: LastValueViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $-       writeHtmlText (lastValueTitle $ lastValueView st)-     let description = lastValueDescription $ lastValueView st-     unless (null description) $-       writeHtmlParagraph $-       writeHtmlText description--formatPair :: (String, String) -> ShowS -> HtmlWriter ()-formatPair (name, value) formatter =-  writeHtmlParagraph $ -  do writeHtmlText name-     writeHtmlText " = "-     writeHtmlText $ formatter value-          --- | Get the TOC item     -lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()-lastValueTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (lastValueTitle $ lastValueView st)

@@ -1,107 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.MRef--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines a shared mutable reference accessible from different threads.-----module Simulation.Aivika.Experiment.MRef-       (MRef,-        newMRef,-        readMRef,-        maybeReadMRef,-        writeMRef,-        maybeWriteMRef,-        modifyMRef_,-        modifyMRef,-        withMRef) where--import Control.Concurrent.MVar--import Data.Maybe-import Data.IORef---- | This is a shared mutable reference accessible from different threads.-data MRef a =-  MRef { mrefLock :: MVar (),-         -- ^ A reference lock.-         mrefData :: IORef a-         -- ^ The reference itself.-       }---- | Create a new shared reference with the specified initial value.-newMRef :: a -> IO (MRef a)-newMRef a =-  do v <- newMVar ()-     r <- newIORef a-     return MRef { mrefLock = v,-                   mrefData = r }---- | Read the contents of the shared reference.-readMRef :: MRef a -> IO a-readMRef = readIORef . mrefData---- | Like 'maybe' but for the shared reference under assumption--- that the reference is updated only once by its initial value.-maybeReadMRef :: b -> (a -> IO b) -> MRef (Maybe a) -> IO b-maybeReadMRef b0 f x =-  do a <- readIORef (mrefData x)-     case a of-       Just a -> f a-       Nothing ->-         withMVar (mrefLock x) $ \() ->-         do a <- readIORef (mrefData x)-            case a of-              Just a -> f a-              Nothing -> return b0---- | Update the contents of the shared reference.-writeMRef :: MRef a -> a -> IO ()-writeMRef x a =-  withMVar (mrefLock x) $ \() ->-  writeIORef (mrefData x) a---- | Update the contents if the reference was empty and then return a result of--- applying the specified function to either the initial or current value.-maybeWriteMRef :: MRef (Maybe a) -> IO a -> (a -> IO b) -> IO b-maybeWriteMRef x m0 f =-  do a <- readIORef (mrefData x)-     case a of-       Just a -> f a-       Nothing ->-         withMVar (mrefLock x) $ \() ->-         do a <- readIORef (mrefData x)-            case a of-              Just a -> f a-              Nothing ->-                do a0 <- m0-                   writeIORef (mrefData x) (Just a0)-                   f a0---- | Modify the contents of the shared reference.-modifyMRef_ :: MRef a -> (a -> IO a) -> IO ()-modifyMRef_ x f =-  withMVar (mrefLock x) $ \() ->-  do a  <- readIORef (mrefData x)-     a' <- f a-     writeIORef (mrefData x) a'---- | Modify the contents of the shared reference but allow returning the result.-modifyMRef :: MRef a -> (a -> IO (a, b)) -> IO b-modifyMRef x f =-  withMVar (mrefLock x) $ \() ->-  do a <- readIORef (mrefData x)-     (a', b) <- f a-     writeIORef (mrefData x) a'-     return b---- | A safe wrapper for operating with the contents of shared reference.-withMRef :: MRef a -> (a -> IO b) -> IO b-withMRef x f =-  withMVar (mrefLock x) $ \() ->-  readIORef (mrefData x) >>= f

@@ -1,112 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.SamplingStatsWriter--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'SamplingStatsWriter' that knows how to write--- the sampling statistics in HTML.-----module Simulation.Aivika.Experiment.SamplingStatsWriter -       (SamplingStatsWriter(..),-        defaultSamplingStatsWriter) where--import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.HtmlWriter--import Simulation.Aivika.Statistics---- | Defines a writer that knows how to represent the 'SamplingStats'--- as the HTML table.-data SamplingStatsWriter a =-  SamplingStatsWriter { samplingStatsWidth         :: Int,-                        -- ^ The width of the HTML table.-                        samplingStatsMeanText      :: String,-                        -- ^ Translated text \"mean\".-                        samplingStatsDeviationText :: String,-                        -- ^ Translated text \"deviation\".-                        samplingStatsMinText       :: String,-                        -- ^ Translated text \"minimum\".-                        samplingStatsMaxText       :: String,-                        -- ^ Translated text \"maximum\".-                        samplingStatsCountText       :: String,-                        -- ^ Translated text \"count\".-                        samplingStatsFormatter     :: ShowS,-                        -- ^ The formatter of numbers.-                        samplingStatsWrite         :: SamplingStatsWriter a -> String ->-                                                      SamplingStats a -> HtmlWriter ()-                        -- ^ This function reprensents the named statistics-                        -- as the HTML table.-                      }---- | The default writer.-defaultSamplingStatsWriter :: Show a => SamplingStatsWriter a-defaultSamplingStatsWriter =-  SamplingStatsWriter { -    samplingStatsWidth = 400,-    samplingStatsMeanText = "mean",-    samplingStatsDeviationText = "deviation",-    samplingStatsMinText = "minimum",-    samplingStatsMaxText = "maximum",-    samplingStatsCountText = "count",-    samplingStatsFormatter = id,-    samplingStatsWrite = \writer name stats ->-      do let format x = samplingStatsFormatter writer x-         writeHtml "<p>"-         writeHtml "<table frame='border' cellspacing='4' width='"-         writeHtml $ show $ samplingStatsWidth writer-         writeHtml "'>"-         writeHtml "<tr>"-         writeHtml "<td colspan='2'>"-         writeHtml "<p align='center'>"-         writeHtmlText name-         writeHtml "</h4>"-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ samplingStatsMeanText writer -         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ samplingStatsMean stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ samplingStatsDeviationText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ samplingStatsDeviation stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ samplingStatsMinText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ samplingStatsMin stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ samplingStatsMaxText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ samplingStatsMax stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ samplingStatsCountText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtml $ format $ show $ samplingStatsCount stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "</table>" -         writeHtml "</p>"-    }

@@ -1,259 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.TableView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'TableView' that saves the simulation--- results in the CSV file(s).-----module Simulation.Aivika.Experiment.TableView -       (TableView(..), -        defaultTableView) where--import Control.Monad-import Control.Monad.Trans--import qualified Data.Map as M-import Data.IORef-import Data.Maybe-import Data.Monoid--import System.IO-import System.FilePath--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.FileRenderer-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (replace)---- | Defines the 'View' that saves the simulation results--- in the CSV file(s).-data TableView =-  TableView { tableTitle       :: String,-              -- ^ This is a title used in HTML.-              tableDescription :: String,-              -- ^ This is a description in the HTML.-              tableLinkText    :: String,-              -- ^ It specifies the text for the link -              -- which is displayed in the HTML page-              -- if there is only one simulation run. -              -- The link downloads the corresponded -              -- CSV file in the browser. If there are-              -- more simulation runs, then this link -              -- is not shown.-              ---              -- An example is-              ---              -- @-              --   tableLinkText = \"Download the CSV file\"-              -- @-              tableRunLinkText :: String,-              -- ^ It specifies the link text which is -              -- displayed in the HTML page if there are -              -- many simulation runs. Such a link downloads -              -- the CSV file for the corresponded run. -              -- To define the text, you can use special -              -- variables @$LINK@, @$RUN_INDEX@ and @$RUN_COUNT@.-              ---              -- An example is -              -- -              -- @-              --   tableRunLinkText = \"$LINK / Run $RUN_INDEX of $RUN_COUNT\"-              -- @-              -- -              -- If there is only one run, then the link of -              -- this kind is not displayed. Instead, only one -              -- link is shown, which text is defined by the -              -- 'tableLinkText' field.-              tableFileName    :: ExperimentFilePath,-              -- ^ It defines the file name for each CSV file. -              -- It may include special variables @$TITLE@, -              -- @$RUN_INDEX@ and @$RUN_COUNT@.-              ---              -- An example is-              ---              -- @-              --   tableFileName = UniqueFilePath \"$TITLE - $RUN_INDEX.csv\"-              -- @-              tableSeparator   :: String,-              -- ^ It defines the separator for the view. -              -- It delimits the cells in the rows of the CSV file.-              tableFormatter   :: ShowS,-              -- ^ It defines the formatter which is applied-              -- to all values before they will be written-              -- in the CSV file(s).-              tablePredicate   :: Event Bool,-              -- ^ It specifies the predicate that defines-              -- when we can save data in the table.-              tableTransform   :: ResultTransform,-              -- ^ The transform applied to the results before receiving series.-              tableSeries      :: ResultTransform -              -- ^ It defines the series to save in the CSV file(s).-            }-  --- | The default table view.  -defaultTableView :: TableView-defaultTableView = -  TableView { tableTitle       = "Table",-              tableDescription = "This section contains the CSV file(s) with the simulation results.",-              tableLinkText    = "Download the CSV file",-              tableRunLinkText = "$LINK / Run $RUN_INDEX of $RUN_COUNT",-              tableFileName    = UniqueFilePath "Table($RUN_INDEX).csv",-              tableSeparator   = ",",-              tableFormatter   = id,-              tablePredicate   = return True,-              tableTransform   = expandResults,-              tableSeries      = id }-  -instance ExperimentView TableView (WebPageRenderer a) where-  -  outputView v = -    let reporter exp renderer dir =-          do st <- newTable v exp dir-             let context =-                   WebPageContext $-                   WebPageWriter { reporterWriteTOCHtml = tableTOCHtml st,-                                   reporterWriteHtml    = tableHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = simulateTable st,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }-  -instance ExperimentView TableView (FileRenderer a) where-  -  outputView v = -    let reporter exp renderer dir =-          do st <- newTable v exp dir-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = simulateTable st,-                                         reporterContext    = FileContext }-    in ExperimentGenerator { generateReporter = reporter }-  --- | The state of the view.-data TableViewState =-  TableViewState { tableView       :: TableView,-                   tableExperiment :: Experiment,-                   tableDir        :: FilePath, -                   tableMap        :: M.Map Int FilePath }-  --- | Create a new state of the view.-newTable :: TableView -> Experiment -> FilePath -> ExperimentWriter TableViewState-newTable view exp dir =-  do let n = experimentRunCount exp-     fs <- forM [0..(n - 1)] $ \i ->-       resolveFilePath dir $-       mapFilePath (flip replaceExtension ".csv") $-       expandFilePath (tableFileName view) $-       M.fromList [("$TITLE", tableTitle view),-                   ("$RUN_INDEX", show $ i + 1),-                   ("$RUN_COUNT", show n)]-     liftIO $ forM_ fs $ flip writeFile []  -- reserve the file names-     let m = M.fromList $ zip [0..(n - 1)] fs-     return TableViewState { tableView       = view,-                             tableExperiment = exp,-                             tableDir          = dir, -                             tableMap          = m }-       --- | Write the tables during the simulation.-simulateTable :: TableViewState -> ExperimentData -> Event DisposableEvent-simulateTable st expdata =-  do let view    = tableView st-         rs      = tableSeries view $-                   tableTransform view $-                   experimentResults expdata-         exts    = resultsToStringValues rs-         signals = experimentPredefinedSignals expdata-         signal  = pureResultSignal signals $-                   resultSignal rs-         separator = tableSeparator view-         formatter = tableFormatter view-         predicate = tablePredicate view-     i <- liftParameter simulationIndex-     -- create a new file-     let f = fromJust $ M.lookup (i - 1) (tableMap st)-     h <- liftIO $ openFile f WriteMode-     -- write a header-     liftIO $-       do forM_ (zip [0..] exts) $ \(column, ext) ->-            do when (column > 0) $ -                 hPutStr h separator-               hPutStr h $ show $ resultValueName ext-          hPutStrLn h ""-     d1 <- handleSignal signal $ \t ->-       do p <- predicate-          when p $-            do forM_ (zip [0..] exts) $ \(column, ext) ->  -- write the row-                 do x <- resultValueData ext               -- write the column-                    liftIO $-                      do when (column > 0) $ -                           hPutStr h separator-                         hPutStr h $ formatter x-               liftIO $ hPutStrLn h ""-     let d2 =          -           DisposableEvent $-           liftIO $-           do when (experimentVerbose $ tableExperiment st) $-                putStr "Generated file " >> putStrLn f-              hClose h  -- close the file-     return $ d1 <> d2-     --- | Get the HTML code.     -tableHtml :: TableViewState -> Int -> HtmlWriter ()     -tableHtml st index =-  let n = experimentRunCount $ tableExperiment st-  in if n == 1-     then tableHtmlSingle st index-     else tableHtmlMultiple st index-     --- | Get the HTML code for a single run.-tableHtmlSingle :: TableViewState -> Int -> HtmlWriter ()-tableHtmlSingle st index =-  do header st index-     let f = fromJust $ M.lookup 0 (tableMap st)-     writeHtmlParagraph $-       writeHtmlLink (makeRelative (tableDir st) f) $-       writeHtmlText (tableLinkText $ tableView st)---- | Get the HTML code for multiple runs-tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter ()-tableHtmlMultiple st index =-  do header st index-     let n = experimentRunCount $ tableExperiment st-     forM_ [0..(n - 1)] $ \i ->-       do let f = fromJust $ M.lookup i (tableMap st)-              sublink = -                replace "$RUN_INDEX" (show $ i + 1) $-                replace "$RUN_COUNT" (show n) $-                replace "$LINK" (tableLinkText $ tableView st)-                (tableRunLinkText $ tableView st)-          writeHtmlParagraph $-            writeHtmlLink (makeRelative (tableDir st) f) $-            writeHtmlText sublink--header :: TableViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $ -       writeHtmlText (tableTitle $ tableView st)-     let description = tableDescription $ tableView st-     unless (null description) $-       writeHtmlParagraph $ -       writeHtmlText description---- | Get the TOC item     -tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()-tableTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (tableTitle $ tableView st)

@@ -1,188 +0,0 @@--{-# LANGUAGE MultiParamTypeClasses #-}---- |--- Module     : Simulation.Aivika.Experiment.TimingStatsView--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'TimingStatsView' that shows the timing statistics--- for the variables for every simulation run separately.-----module Simulation.Aivika.Experiment.TimingStatsView -       (TimingStatsView(..),-        defaultTimingStatsView) where--import Control.Monad-import Control.Monad.Trans--import qualified Data.Map as M-import Data.IORef-import Data.Maybe-import Data.Monoid--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.WebPageRenderer-import Simulation.Aivika.Experiment.ExperimentWriter-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.TimingStatsWriter-import Simulation.Aivika.Experiment.Utils (replace)---- | Defines the 'View' that shows the timing statistics--- for variables for every simulation run separately.-data TimingStatsView =-  TimingStatsView { timingStatsTitle       :: String,-                    -- ^ The title for the view.-                    timingStatsRunTitle    :: String,-                    -- ^ The run title for the view. It may include-                    -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and -                    -- @$TITLE@.-                    ---                    -- An example is -                    ---                    -- @-                    --   timingStatsRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"-                    -- @-                    timingStatsDescription :: String,-                    -- ^ The description for the view.-                    timingStatsWriter      :: TimingStatsWriter Double,-                    -- ^ It shows the timing statistics.-                    timingStatsPredicate   :: Event Bool,-                    -- ^ Specifies when gathering the statistics.-                    timingStatsTransform   :: ResultTransform,-                    -- ^ The transform applied to the results before receiving series.-                    timingStatsSeries      :: ResultTransform -                    -- ^ It defines the series for which the statistics to be collected.-                  }-  --- | This is the default view.-defaultTimingStatsView :: TimingStatsView-defaultTimingStatsView =  -  TimingStatsView { timingStatsTitle       = "Timing Statistics",-                    timingStatsRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",-                    timingStatsDescription = "The statistical data are gathered in the time points.",-                    timingStatsWriter      = defaultTimingStatsWriter,-                    timingStatsPredicate   = return True,-                    timingStatsTransform   = id,-                    timingStatsSeries      = id }--instance ExperimentView TimingStatsView (WebPageRenderer a) where  -  -  outputView v = -    let reporter exp renderer dir =-          do st <- newTimingStats v exp-             let context =-                   WebPageContext $-                   WebPageWriter { reporterWriteTOCHtml = timingStatsTOCHtml st,-                                   reporterWriteHtml    = timingStatsHtml st }-             return ExperimentReporter { reporterInitialise = return (),-                                         reporterFinalise   = return (),-                                         reporterSimulate   = simulateTimingStats st,-                                         reporterContext    = context }-    in ExperimentGenerator { generateReporter = reporter }-  --- | The state of the view.-data TimingStatsViewState =-  TimingStatsViewState { timingStatsView       :: TimingStatsView,-                         timingStatsExperiment :: Experiment,-                         timingStatsMap        :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }-  --- | Create a new state of the view.-newTimingStats :: TimingStatsView -> Experiment -> ExperimentWriter TimingStatsViewState-newTimingStats view exp =-  do let n = experimentRunCount exp-     rs <- forM [0..(n - 1)] $ \i -> liftIO $ newIORef []    -     let m = M.fromList $ zip [0..(n - 1)] rs-     return TimingStatsViewState { timingStatsView       = view,-                                   timingStatsExperiment = exp,-                                   timingStatsMap        = m }-       --- | Get the timing statistics during the simulation.-simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Event DisposableEvent-simulateTimingStats st expdata =-  do let view    = timingStatsView st-         rs      = timingStatsSeries view $-                   timingStatsTransform view $-                   experimentResults expdata-         exts    = resultsToDoubleValues rs-         signals = experimentPredefinedSignals expdata-         signal  = filterSignalM (const predicate) $-                   pureResultSignal signals $-                   resultSignal rs-         predicate = timingStatsPredicate view-     i <- liftParameter simulationIndex-     let r = fromJust $ M.lookup (i - 1) $ timingStatsMap st-     ds <- forM exts $ \ext ->-       do stats <- liftIO $ newIORef emptyTimingStats-          let name = resultValueName ext-          liftIO $ modifyIORef r ((:) (name, stats))-          handleSignal signal $ \_ ->-            do t <- liftDynamics time-               x <- resultValueData ext-               liftIO $-                 do y <- readIORef stats-                    let y' = addTimingStats t x y-                    y' `seq` writeIORef stats y'-     return $ mconcat ds-     --- | Get the HTML code.     -timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()     -timingStatsHtml st index =-  let n = experimentRunCount $ timingStatsExperiment st-  in if n == 1-     then timingStatsHtmlSingle st index-     else timingStatsHtmlMultiple st index-     --- | Get the HTML code for a single run.-timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()-timingStatsHtmlSingle st index =-  do header st index-     let r = fromJust $ M.lookup 0 (timingStatsMap st)-     pairs <- liftIO $ readIORef r-     forM_ (reverse pairs) $ \(name, r) ->-       do stats <- liftIO $ readIORef r-          let writer = timingStatsWriter (timingStatsView st)-              write  = timingStatsWrite writer-          write writer name stats---- | Get the HTML code for multiple runs-timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()-timingStatsHtmlMultiple st index =-  do header st index-     let n = experimentRunCount $ timingStatsExperiment st-     forM_ [0..(n - 1)] $ \i ->-       do let subtitle = -                replace "$RUN_INDEX" (show $ i + 1) $-                replace "$RUN_COUNT" (show n) $-                replace "$TITLE" (timingStatsTitle $ timingStatsView st)-                (timingStatsRunTitle $ timingStatsView st)-          writeHtmlHeader4 $-            writeHtmlText subtitle-          let r = fromJust $ M.lookup i (timingStatsMap st)-          pairs <- liftIO $ readIORef r-          forM_ (reverse pairs) $ \(name, r) ->-            do stats <- liftIO $ readIORef r-               let writer = timingStatsWriter (timingStatsView st)-                   write  = timingStatsWrite writer-               write writer name stats--header :: TimingStatsViewState -> Int -> HtmlWriter ()-header st index =-  do writeHtmlHeader3WithId ("id" ++ show index) $-       writeHtmlText (timingStatsTitle $ timingStatsView st)-     let description = timingStatsDescription $ timingStatsView st-     unless (null description) $-       writeHtmlParagraph $-       writeHtmlText description---- | Get the TOC item     -timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()-timingStatsTOCHtml st index =-  writeHtmlListItem $-  writeHtmlLink ("#id" ++ show index) $-  writeHtmlText (timingStatsTitle $ timingStatsView st)

@@ -1,130 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.TimingStatsWriter--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ The module defines 'TimingStatsWriter' that knows how to write--- the timing statistics in HTML.-----module Simulation.Aivika.Experiment.TimingStatsWriter -       (TimingStatsWriter(..),-        defaultTimingStatsWriter) where--import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.HtmlWriter--import Simulation.Aivika.Statistics---- | Defines a writer that knows how to represent the 'TimingStats'--- as the HTML table.-data TimingStatsWriter a =-  TimingStatsWriter { timingStatsWidth         :: Int,-                      -- ^ The width of the HTML table.-                      timingStatsTimeText      :: String,-                      -- ^ Translated text \"time\".-                      timingStatsMeanText      :: String,-                      -- ^ Translated text \"mean\".-                      timingStatsDeviationText :: String,-                      -- ^ Translated text \"deviation\".-                      timingStatsMinText       :: String,-                      -- ^ Translated text \"minimum\".-                      timingStatsMaxText       :: String,-                      -- ^ Translated text \"maximum\".-                      timingStatsFormatter     :: ShowS,-                      -- ^ The formatter of numbers.-                      timingStatsWrite         :: TimingStatsWriter a -> String ->-                                                  TimingStats a -> HtmlWriter ()-                      -- ^ This function reprensents the named statistics-                      -- as the HTML table.-                      }---- | The default writer.-defaultTimingStatsWriter :: (Show a, TimingData a) => TimingStatsWriter a-defaultTimingStatsWriter =-  TimingStatsWriter { -    timingStatsWidth = 400,-    timingStatsMeanText = "mean",-    timingStatsTimeText = "time",-    timingStatsDeviationText = "deviation",-    timingStatsMinText = "minimum",-    timingStatsMaxText = "maximum",-    timingStatsFormatter = id,-    timingStatsWrite = \writer name stats ->-      do let format x = timingStatsFormatter writer x-         writeHtml "<p>"-         writeHtml "<table frame='border' cellspacing='4' width='"-         writeHtml $ show $ timingStatsWidth writer-         writeHtml "'>"-         writeHtml "<tr>"-         writeHtml "<td colspan='3'>"-         writeHtml "<p align='center'>"-         writeHtmlText name-         writeHtml "</h4>"-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ timingStatsMeanText writer -         writeHtml "</td>"-         writeHtml "<td colspan='2'>"-         writeHtmlText $ format $ show $ timingStatsMean stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ timingStatsDeviationText writer-         writeHtml "</td>"-         writeHtml "<td colspan='2'>"-         writeHtmlText $ format $ show $ timingStatsDeviation stats-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ timingStatsMinText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ timingStatsMin stats-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText "("-         writeHtmlText $ timingStatsTimeText writer-         writeHtmlText " = "-         writeHtmlText $ format $ show $ timingStatsMinTime stats-         writeHtmlText ")"-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ timingStatsMaxText writer-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText $ format $ show $ timingStatsMax stats-         writeHtml "</td>"-         writeHtml "<td>"-         writeHtmlText "("-         writeHtmlText $ timingStatsTimeText writer-         writeHtmlText " = "-         writeHtmlText $ format $ show $ timingStatsMaxTime stats-         writeHtmlText ")"-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "<tr>"-         writeHtml "<td>"-         writeHtmlText $ timingStatsTimeText writer-         writeHtml "</td>"-         writeHtml "<td colspan='2'>"-         writeHtml "["-         writeHtml $ format $ show $ timingStatsStartTime stats-         writeHtml "; "-         writeHtml $ format $ show $ timingStatsLastTime stats-         writeHtml "]"-         writeHtml "</td>"-         writeHtml "</tr>"-         writeHtml "</table>" -         writeHtml "</p>"-    }

@@ -1,13 +1,13 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}  -- | -- Module     : Simulation.Aivika.Experiment.Types--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.10.1+-- Tested with: GHC 8.0.1 -- -- The module defines the simulation experiments. They automate -- the process of generating and analyzing the results. Moreover,@@ -22,19 +22,18 @@ module Simulation.Aivika.Experiment.Types where  import Control.Monad-import Control.Monad.State+import Control.Monad.Trans+import Control.Exception import Control.Concurrent.ParallelIO.Local  import Data.Maybe import Data.Monoid--import System.Directory-import System.FilePath+import Data.Either  import GHC.Conc (getNumCapabilities)  import Simulation.Aivika-import Simulation.Aivika.Experiment.ExperimentWriter+import Simulation.Aivika.Trans.Exception  -- | It defines the simulation experiment with the specified rendering backend and its bound data. data Experiment = @@ -46,8 +45,6 @@                -- ^ Specifies a localisation applied when rendering the experiment.                experimentRunCount      :: Int,                -- ^ How many simulation runs should be launched.-               experimentDirectoryName :: ExperimentFilePath,-               -- ^ The directory in which the output results should be saved.                experimentTitle         :: String,                -- ^ The experiment title.                experimentDescription   :: String,@@ -66,7 +63,6 @@                experimentTransform     = id,                experimentLocalisation  = englishResultLocalisation,                experimentRunCount      = 1,-               experimentDirectoryName = UniqueFilePath "experiment",                experimentTitle         = "Simulation Experiment",                experimentDescription   = "",                experimentVerbose       = True,@@ -78,14 +74,32 @@   -- | Defines a context used when rendering the experiment.   data ExperimentContext r :: * +  -- | Defines the experiment environment.+  type ExperimentEnvironment r :: *++  -- | Defines the experiment monad type.+  type ExperimentMonad r :: * -> *++  -- | Lift the experiment computation.+  liftExperiment :: r -> ExperimentMonad r a -> IO a++  -- | Prepare before rendering the experiment.+  prepareExperiment :: Experiment -> r -> ExperimentMonad r (ExperimentEnvironment r)+   -- | Render the experiment after the simulation is finished, for example,   -- creating the @index.html@ file in the specified directory.-  renderExperiment :: Experiment -> r -> [ExperimentReporter r] -> FilePath -> ExperimentWriter ()+  renderExperiment :: Experiment -> r -> [ExperimentReporter r] -> ExperimentEnvironment r -> ExperimentMonad r () +  -- | It is called when the experiment has been completed.+  onExperimentCompleted :: Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r () ++  -- | It is called when the experiment rendering has failed.+  onExperimentFailed :: Exception e => Experiment -> r -> ExperimentEnvironment r -> e -> ExperimentMonad r ()+ -- | This is a generator of the reporter with the specified rendering backend.                      data ExperimentGenerator r = -  ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter r)-                        -- ^ Generate a reporter bound up with the specified directory.+  ExperimentGenerator { generateReporter :: Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r (ExperimentReporter r)+                        -- ^ Generate a reporter.                       }  -- | Defines a view in which the simulation results should be saved.@@ -106,17 +120,14 @@  -- | Defines what creates the simulation reports by the specified renderer. data ExperimentReporter r =-  ExperimentReporter { reporterInitialise :: ExperimentWriter (),+  ExperimentReporter { reporterInitialise :: ExperimentMonad r (),                        -- ^ Initialise the reporting before                         -- the simulation runs are started.-                       reporterFinalise   :: ExperimentWriter (),+                       reporterFinalise   :: ExperimentMonad r (),                        -- ^ Finalise the reporting after                        -- all simulation runs are finished.-                       reporterSimulate   :: ExperimentData -> Event DisposableEvent,-                       -- ^ Start the simulation run in the start time-                       -- and return a finalizer that will be called -                       -- in the stop time after the last signal is -                       -- triggered and processed.+                       reporterSimulate   :: ExperimentData -> Composite (),+                       -- ^ Start the simulation run in the start time.                        reporterContext    :: ExperimentContext r                        -- ^ Return a context used by the renderer.                      }@@ -124,7 +135,10 @@ -- | Run the simulation experiment sequentially. For example,  -- it can be a Monte-Carlo simulation dependentent on the external -- 'Parameter' values.-runExperiment :: ExperimentRendering r+runExperiment :: (ExperimentRendering r,+                  Monad (ExperimentMonad r),+                  MonadIO (ExperimentMonad r),+                  MonadException (ExperimentMonad r))                  => Experiment                  -- ^ the simulation experiment to run                  -> [ExperimentGenerator r]@@ -133,8 +147,10 @@                  -- ^ the rendering backend                  -> Simulation Results                  -- ^ the simulation results received from the model-                 -> IO ()-runExperiment = runExperimentWithExecutor sequence_+                 -> IO (Either SomeException ())+{-# INLINABLE runExperiment #-}+runExperiment e generators r simulation =+  runExperimentWithExecutor sequence_ e generators r simulation    -- | Run the simulation experiment in parallel.  --@@ -148,7 +164,10 @@ -- threads directly with help of 'experimentNumCapabilities', -- although the real number of parallel threads can depend on many -- factors.-runExperimentParallel :: ExperimentRendering r+runExperimentParallel :: (ExperimentRendering r,+                          Monad (ExperimentMonad r),+                          MonadIO (ExperimentMonad r),+                          MonadException (ExperimentMonad r))                          => Experiment                          -- ^ the simulation experiment to run                          -> [ExperimentGenerator r]@@ -157,16 +176,22 @@                          -- ^ the rendering backend                          -> Simulation Results                          -- ^ the simulation results received from the model-                         -> IO ()-runExperimentParallel e = runExperimentWithExecutor executor e -  where executor tasks =-          do n <- experimentNumCapabilities e-             withPool n $ \pool ->-               parallel_ pool tasks+                         -> IO (Either SomeException ())+{-# INLINABLE runExperimentParallel #-}+runExperimentParallel e generators r simulation =+  do x <- runExperimentWithExecutor executor e generators r simulation+     return (x >> return ())+       where executor tasks =+               do n <- experimentNumCapabilities e+                  withPool n $ \pool ->+                    parallel_ pool tasks                          -- | Run the simulation experiment with the specified executor.-runExperimentWithExecutor :: ExperimentRendering r-                             => ([IO ()] -> IO ())+runExperimentWithExecutor :: (ExperimentRendering r,+                              Monad (ExperimentMonad r),+                              MonadIO (ExperimentMonad r),+                              MonadException (ExperimentMonad r))+                             => ([IO ()] -> IO a)                              -- ^ an executor that allows parallelizing the simulation if required                              -> Experiment                              -- ^ the simulation experiment to run@@ -176,45 +201,44 @@                              -- ^ the rendering backend                              -> Simulation Results                              -- ^ the simulation results received from the model-                             -> IO ()+                             -> IO (Either SomeException a)+{-# INLINABLE runExperimentWithExecutor #-} runExperimentWithExecutor executor e generators r simulation =-  runExperimentWriter $+  liftExperiment r $   do let specs      = experimentSpecs e          runCount   = experimentRunCount e-         dirName    = experimentDirectoryName e-     path <- resolveFilePath "" dirName-     liftIO $ do-       when (experimentVerbose e) $-         do putStr "Updating directory " -            putStrLn path-       createDirectoryIfMissing True path-     reporters <- mapM (\x -> generateReporter x e r path)-                  generators-     forM_ reporters reporterInitialise-     let simulate :: Simulation ()-         simulate =-           do signals <- newResultPredefinedSignals-              results <- simulation-              let d = ExperimentData { experimentResults = experimentTransform e results,-                                       experimentPredefinedSignals = signals }-              fs <- runDynamicsInStartTime $-                    runEventWith EarlierEvents $-                    forM reporters $ \reporter ->-                    reporterSimulate reporter d-              let m1 =-                    runEventInStopTime $-                    return ()-                  m2 =-                    runEventInStopTime $-                    disposeEvent $ mconcat fs-                  mh (SimulationException e') =-                    when (experimentVerbose e) $-                    liftIO $-                    do putStr "A simulation exception has been raised when running: " -                       putStrLn $ show e'-              finallySimulation (catchSimulation m1 mh) m2-     liftIO $-       executor $ runSimulations simulate specs runCount-     forM_ reporters reporterFinalise-     renderExperiment e r reporters path-     return ()+     env <- prepareExperiment e r+     let c1 =+           do reporters <- mapM (\x -> generateReporter x e r env)+                           generators+              forM_ reporters reporterInitialise+              let simulate :: Simulation ()+                  simulate =+                    do signals <- newResultPredefinedSignals+                       results <- simulation+                       let d = ExperimentData { experimentResults = experimentTransform e results,+                                                experimentPredefinedSignals = signals }+                       ((), fs) <- runDynamicsInStartTime $+                                   runEventWith EarlierEvents $+                                   flip runComposite mempty $+                                   forM_ reporters $ \reporter ->+                                   reporterSimulate reporter d+                       let m1 =+                             runEventInStopTime $+                             return ()+                           m2 =+                             runEventInStopTime $+                             disposeEvent fs+                           mh (SimulationAbort e') =+                             return ()+                       finallySimulation (catchSimulation m1 mh) m2+              a <- liftIO $+                executor $ runSimulations simulate specs runCount+              forM_ reporters reporterFinalise+              renderExperiment e r reporters env+              onExperimentCompleted e r env+              return (Right a)+         ch z@(SomeException e') =+           do onExperimentFailed e r env e'+              return (Left z)+     catchComp c1 ch

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.Utils--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.10.1+-- Tested with: GHC 8.0.1 -- -- It defines utility functions missed in the standard library. --

@@ -1,85 +0,0 @@--{-# LANGUAGE TypeFamilies #-}---- |--- Module     : Simulation.Aivika.Experiment.Types--- Copyright  : Copyright (c) 2012-2015, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.10.1------ It defines a renderer that creates a web page when running the simulation experiment.-----module Simulation.Aivika.Experiment.WebPageRenderer where--import Control.Monad-import Control.Monad.Trans--import System.IO-import System.Directory-import System.FilePath--import Simulation.Aivika-import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.ExperimentWriter---- | It defines the web page renderer for simulation 'Experiment'. -data WebPageRenderer a = WebPageRenderer a-                         -- ^ A renderer that depends on the provided parameter.---- | It replies to the requests made by the web page renderer.-data WebPageWriter =-  WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter (),-                  -- ^ Return a TOC (Table of Contents) item for -                  -- the HTML index file after the finalisation -                  -- function is called, i.e. in the very end. -                  -- The agument specifies the ordered number of -                  -- the item.-                  ---                  -- You should wrap your HTML in 'writeHtmlListItem'.-                  reporterWriteHtml :: Int -> HtmlWriter ()-                  -- ^ Return an HTML code for the index file-                  -- after the finalisation function is called,-                  -- i.e. in the very end. The agument specifies-                  -- the ordered number of the item.-                }---- | A convenient type synonym for describing a web page generator.-type WebPageGenerator a = ExperimentGenerator (WebPageRenderer a)---- | Rending a web page with results when running the simulation experiment.-instance ExperimentRendering (WebPageRenderer a) where--  -- | A web page context.-  newtype ExperimentContext (WebPageRenderer a) =-    WebPageContext { runWebPageContext :: WebPageWriter-                     -- ^ Run the web page context.-                   }--  renderExperiment e r reporters path = -    do let html :: HtmlWriter ()-           html = -             writeHtmlDocumentWithTitle (experimentTitle e) $-             do writeHtmlList $-                  forM_ (zip [1..] reporters) $ \(i, reporter) -> -                  reporterWriteTOCHtml (runWebPageContext $-                                        reporterContext reporter) i-                writeHtmlBreak-                unless (null $ experimentDescription e) $-                  writeHtmlParagraph $-                  writeHtmlText $ experimentDescription e-                forM_ (zip [1..] reporters) $ \(i, reporter) ->-                  reporterWriteHtml (runWebPageContext $-                                     reporterContext reporter) i-           file = combine path "index.html"-       ((), contents) <- runHtmlWriter html id-       liftIO $-         withFile file WriteMode $ \h ->-         do hSetEncoding h utf8-            hPutStr h (contents [])-            when (experimentVerbose e) $-              do putStr "Generated file "-                 putStrLn file

@@ -0,0 +1,17 @@++-- |+-- Module     : Simulation.Aivika.Trans.Experiment+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- This module re-exports the library functionality.+--++module Simulation.Aivika.Trans.Experiment+       (-- * Modules+        module Simulation.Aivika.Trans.Experiment.Types) where++import Simulation.Aivika.Trans.Experiment.Types

@@ -0,0 +1,197 @@++-- |+-- Module     : Simulation.Aivika.Trans.Experiment.Concurrent.MVar+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines helper functions for working with synchronized variable 'MVar'.+--++module Simulation.Aivika.Trans.Experiment.Concurrent.MVar+       (maybeReadMVarComp,+        maybeReadMVarParameter,+        maybeReadMVarSimulation,+        maybeReadMVarDynamics,+        maybeReadMVarEvent,+        maybeReadMVarProcess,+        maybePutMVarComp,+        maybePutMVarParameter,+        maybePutMVarSimulation,+        maybePutMVarDynamics,+        maybePutMVarEvent,+        maybePutMVarProcess) where++import Control.Exception+import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Trans++import Data.Maybe++import Simulation.Aivika.Trans++-- | Like 'maybe' but for the synchronized variable.+maybeReadMVarComp :: (MonadComp m, MonadIO m) => b -> (a -> m b) -> MVar (Maybe a) -> m b+{-# INLINABLE maybeReadMVarComp #-}+maybeReadMVarComp b0 f x =+  do a <- liftIO $ readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Like 'maybeReadMVarComp' but within the 'Parameter' computation.+maybeReadMVarParameter :: (MonadComp m, MonadIO m) => b -> (a -> Parameter m b) -> MVar (Maybe a) -> Parameter m b+{-# INLINABLE maybeReadMVarParameter #-}+maybeReadMVarParameter b0 f x =+  do a <- liftIO $ readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Like 'maybeReadMVarComp' but within the 'Simulation' computation.+maybeReadMVarSimulation :: (MonadComp m, MonadIO m) => b -> (a -> Simulation m b) -> MVar (Maybe a) -> Simulation m b+{-# INLINABLE maybeReadMVarSimulation #-}+maybeReadMVarSimulation b0 f x =+  do a <- liftIO $ readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Like 'maybeReadMVarComp' but within the 'Dynamics' computation.+maybeReadMVarDynamics :: (MonadComp m, MonadIO m) => b -> (a -> Dynamics m b) -> MVar (Maybe a) -> Dynamics m b+{-# INLINABLE maybeReadMVarDynamics #-}+maybeReadMVarDynamics b0 f x =+  do a <- liftIO $ readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Like 'maybeReadMVarComp' but within the 'Event' computation.+maybeReadMVarEvent :: (MonadComp m, MonadIO m) => b -> (a -> Event m b) -> MVar (Maybe a) -> Event m b+{-# INLINABLE maybeReadMVarEvent #-}+maybeReadMVarEvent b0 f x =+  do a <- liftIO $ readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Like 'maybeReadMVarComp' but within the 'Process' computation.+maybeReadMVarProcess :: (MonadDES m, MonadIO m) => b -> (a -> Process m b) -> MVar (Maybe a) -> Process m b+{-# INLINABLE maybeReadMVarProcess #-}+maybeReadMVarProcess b0 f x =+  do a <- liftIO $ readMVar x+     case a of+       Just a  -> f a+       Nothing -> return b0++-- | Update the contents if the variable was empty and then return a result of+-- applying the specified function to either the initial or current value.+maybePutMVarComp :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> m a -> (a -> m b) -> m b+{-# INLINABLE maybePutMVarComp #-}+maybePutMVarComp x m0 f =+  -- N.B. it should be actually masked to be protected from the asynchronous exceptions+  do a <- liftIO $ takeMVar x+     case a of+       Just a ->+         do liftIO $ putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: (MonadComp m, MonadIO m) => SomeException -> m a+                handle e = do liftIO $ putMVar x Nothing+                              throwComp e+            a0 <- catchComp m0 handle+            liftIO $ putMVar x (Just a0)+            f a0++-- | Like 'maybePutMVarComp' but within the 'Parameter' computation.+maybePutMVarParameter :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Parameter m a -> (a -> Parameter m b) -> Parameter m b+{-# INLINABLE maybePutMVarParameter #-}+maybePutMVarParameter x m0 f =+  -- N.B. it should be actually masked to be protected from the asynchronous exceptions+  do a <- liftIO $ takeMVar x+     case a of+       Just a ->+         do liftIO $ putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Parameter m a+                handle e = do liftIO $ putMVar x Nothing+                              throwParameter e+            a0 <- catchParameter m0 handle+            liftIO $ putMVar x (Just a0)+            f a0++-- | Like 'maybePutMVarComp' but within the 'Simulation' computation.+maybePutMVarSimulation :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Simulation m a -> (a -> Simulation m b) -> Simulation m b+{-# INLINABLE maybePutMVarSimulation #-}+maybePutMVarSimulation x m0 f =+  -- N.B. it should be actually masked to be protected from the asynchronous exceptions+  do a <- liftIO $ takeMVar x+     case a of+       Just a ->+         do liftIO $ putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Simulation m a+                handle e = do liftIO $ putMVar x Nothing+                              throwSimulation e+            a0 <- catchSimulation m0 handle+            liftIO $ putMVar x (Just a0)+            f a0++-- | Like 'maybePutMVarComp' but within the 'Dynamics' computation.+maybePutMVarDynamics :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Dynamics m a -> (a -> Dynamics m b) -> Dynamics m b+{-# INLINABLE maybePutMVarDynamics #-}+maybePutMVarDynamics x m0 f =+  -- N.B. it should be actually masked to be protected from the asynchronous exceptions+  do a <- liftIO $ takeMVar x+     case a of+       Just a ->+         do liftIO $ putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Dynamics m a+                handle e = do liftIO $ putMVar x Nothing+                              throwDynamics e+            a0 <- catchDynamics m0 handle+            liftIO $ putMVar x (Just a0)+            f a0++-- | Like 'maybePutMVarComp' but within the 'Event' computation.+maybePutMVarEvent :: (MonadComp m, MonadIO m) => MVar (Maybe a) -> Event m a -> (a -> Event m b) -> Event m b+{-# INLINABLE maybePutMVarEvent #-}+maybePutMVarEvent x m0 f =+  -- N.B. it should be actually masked to be protected from the asynchronous exceptions+  do a <- liftIO $ takeMVar x+     case a of+       Just a ->+         do liftIO $ putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: (MonadComp m, MonadIO m) => SomeException -> Event m a+                handle e = do liftIO $ putMVar x Nothing+                              throwEvent e+            a0 <- catchEvent m0 handle+            liftIO $ putMVar x (Just a0)+            f a0++-- | Like 'maybePutMVarComp' but within the 'Process' computation.+maybePutMVarProcess :: (MonadDES m, MonadIO m) => MVar (Maybe a) -> Process m a -> (a -> Process m b) -> Process m b+{-# INLINABLE maybePutMVarProcess #-}+maybePutMVarProcess x m0 f =+  -- N.B. it should be actually masked to be protected from the asynchronous exceptions+  do a <- liftIO $ takeMVar x+     case a of+       Just a ->+         do liftIO $ putMVar x (Just a)+            f a+       Nothing ->+         do let handle :: (MonadDES m, MonadIO m) => SomeException -> Process m a+                handle e = do liftIO $ putMVar x Nothing+                              throwProcess e+            a0 <- catchProcess m0 handle+            liftIO $ putMVar x (Just a0)+            f a0

@@ -0,0 +1,402 @@++{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}++-- |+-- Module     : Simulation.Aivika.Trans.Experiment.Types+-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 8.0.1+--+-- The module defines the simulation experiments. They automate+-- the process of generating and analyzing the results. Moreover,+-- this module is open to extensions, allowing you to define+-- your own output views for the simulation results, for example,+-- such views that would allow saving the results in PDF or as+-- charts. To decrease the number of dependencies, such possible  +-- extenstions are not included in this package, although simple+-- views are provided.+--++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++-- | It defines the simulation experiment with the specified rendering backend and its bound data.+data Experiment m = +  Experiment { experimentSpecs         :: Specs m,+               -- ^ The simulation specs for the experiment.+               experimentTransform     :: ResultTransform m,+               -- ^ How the results must be transformed before rendering.+               experimentLocalisation  :: ResultLocalisation,+               -- ^ Specifies a localisation applied when rendering the experiment.+               experimentRunCount      :: Int,+               -- ^ How many simulation runs should be launched.+               experimentTitle         :: String,+               -- ^ The experiment title.+               experimentDescription   :: String,+               -- ^ The experiment description.+               experimentVerbose       :: Bool,+               -- ^ Whether the process of generating the results is verbose.+               experimentNumCapabilities :: IO Int+               -- ^ The number of threads used for the Monte-Carlo simulation+               -- if the executable was compiled with the support of multi-threading.+             }++-- | The default experiment.+defaultExperiment :: Experiment m+defaultExperiment =+  Experiment { experimentSpecs         = Specs 0 10 0.01 RungeKutta4 SimpleGenerator,+               experimentTransform     = id,+               experimentLocalisation  = englishResultLocalisation,+               experimentRunCount      = 1,+               experimentTitle         = "Simulation Experiment",+               experimentDescription   = "",+               experimentVerbose       = True,+               experimentNumCapabilities = getNumCapabilities }++-- | Allows specifying the experiment monad.+class ExperimentMonadProviding r (m :: * -> *) where++  -- | Defines the experiment monad type.+  type ExperimentMonad r m :: * -> *++-- | Defines the experiment computation that tries to perform the calculation. +type ExperimentMonadTry r m a = ExperimentMonad r m (Either SomeException a)++-- | It allows rendering the simulation results in an arbitrary way.+class ExperimentMonadProviding r m => ExperimentRendering r m where++  -- | Defines a context used when rendering the experiment.+  data ExperimentContext r m :: *++  -- | Defines the experiment environment.+  type ExperimentEnvironment r m :: *++  -- | Prepare before rendering the experiment.+  prepareExperiment :: Experiment m -> r -> ExperimentMonad r m (ExperimentEnvironment r m)++  -- | Render the experiment after the simulation is finished, for example,+  -- creating the @index.html@ file in the specified directory.+  renderExperiment :: Experiment m -> r -> [ExperimentReporter r m] -> ExperimentEnvironment r m -> ExperimentMonad r m ()++  -- | It is called when the experiment has been completed.+  onExperimentCompleted :: Experiment m -> r -> ExperimentEnvironment r m -> ExperimentMonad r m () ++  -- | It is called when the experiment rendering has failed.+  onExperimentFailed :: Exception e => Experiment m -> r -> ExperimentEnvironment r m -> e -> ExperimentMonad r m ()++-- | This is a generator of the reporter with the specified rendering backend.                     +data ExperimentGenerator r m = +  ExperimentGenerator { generateReporter :: Experiment m -> r -> ExperimentEnvironment r m -> ExperimentMonad r m (ExperimentReporter r m)+                        -- ^ Generate a reporter.+                      }++-- | Defines a view in which the simulation results should be saved.+-- You should extend this type class to define your own views such+-- as the PDF document.+class ExperimentRendering r m => ExperimentView v r m where+  +  -- | Create a generator of the reporter.+  outputView :: v m -> ExperimentGenerator r m++-- | It describes the source simulation data used in the experiment.+data ExperimentData m =+  ExperimentData { experimentResults :: Results m,+                   -- ^ The simulation results used in the experiment.+                   experimentPredefinedSignals :: ResultPredefinedSignals m+                   -- ^ The predefined signals provided by every model.+                 }++-- | Defines what creates the simulation reports by the specified renderer.+data ExperimentReporter r m =+  ExperimentReporter { reporterInitialise :: ExperimentMonad r m (),+                       -- ^ Initialise the reporting before +                       -- the simulation runs are started.+                       reporterFinalise   :: ExperimentMonad r m (),+                       -- ^ Finalise the reporting after+                       -- all simulation runs are finished.+                       reporterSimulate   :: ExperimentData m -> Composite m (),+                       -- ^ Start the simulation run in the start time.+                       reporterContext    :: ExperimentContext r m+                       -- ^ Return a context used by the renderer.+                     }++-- | Run the simulation experiment sequentially.+runExperiment_ :: (MonadDES m,+                   ExperimentRendering r m,+                   Monad (ExperimentMonad r m),+                   MonadException (ExperimentMonad r m))+                  => (m () -> ExperimentMonad r m a)+                  -- ^ the function that actually starts the simulation run+                  -> Experiment m+                  -- ^ the simulation experiment to run+                  -> [ExperimentGenerator r m]+                  -- ^ generators used for rendering+                  -> r+                  -- ^ the rendering backend+                  -> Simulation m (Results m)+                  -- ^ the simulation results received from the model+                  -> ExperimentMonadTry r m ()+{-# INLINABLE runExperiment_ #-}+runExperiment_ executor0 e generators r simulation =+  do x <- runExperimentWithExecutor executor e generators r simulation+     return (x >> return ())+       where executor = sequence_ . map executor0++-- | Run the simulation experiment sequentially.+runExperiment :: (MonadDES m,+                  ExperimentRendering r m,+                  Monad (ExperimentMonad r m),+                  MonadException (ExperimentMonad r m))+                 => (m () -> ExperimentMonad r m a)+                 -- ^ the function that actually starts the simulation run+                 -> Experiment m+                 -- ^ the simulation experiment to run+                 -> [ExperimentGenerator r m]+                 -- ^ generators used for rendering+                 -> r+                 -- ^ the rendering backend+                 -> Simulation m (Results m)+                 -- ^ the simulation results received from the model+                 -> ExperimentMonadTry r m [a]+{-# INLINABLE runExperiment #-}+runExperiment executor0 = runExperimentWithExecutor executor+  where executor = sequence . map executor0++-- | Run the simulation experiment with the specified executor.+runExperimentWithExecutor :: (MonadDES m,+                              ExperimentRendering r m,+                              Monad (ExperimentMonad r m),+                              MonadException (ExperimentMonad r m))+                             => ([m ()] -> ExperimentMonad r m a)+                             -- ^ an executor that allows parallelizing the simulation if required+                             -> Experiment m+                             -- ^ the simulation experiment to run+                             -> [ExperimentGenerator r m]+                             -- ^ generators used for rendering+                             -> r+                             -- ^ the rendering backend+                             -> Simulation m (Results m)+                             -- ^ the simulation results received from the model+                             -> ExperimentMonadTry r m a+{-# INLINABLE runExperimentWithExecutor #-}+runExperimentWithExecutor executor e generators r simulation =+  do let specs      = experimentSpecs e+         runCount   = experimentRunCount e+     env <- prepareExperiment e r+     let c1 =+           do reporters <- mapM (\x -> generateReporter x e r env)+                           generators+              forM_ reporters reporterInitialise+              let simulate =+                    do signals <- newResultPredefinedSignals+                       results <- simulation+                       let d = ExperimentData { experimentResults = experimentTransform e results,+                                                experimentPredefinedSignals = signals }+                       ((), fs) <- runDynamicsInStartTime $+                                   runEventWith EarlierEvents $+                                   flip runComposite mempty $+                                   forM_ reporters $ \reporter ->+                                   reporterSimulate reporter d+                       let m1 =+                             runEventInStopTime $+                             return ()+                           m2 =+                             runEventInStopTime $+                             disposeEvent fs+                           mh (SimulationAbort e') =+                             return ()+                       finallySimulation (catchSimulation m1 mh) m2+              a <- executor $+                   runSimulations simulate specs runCount+              forM_ reporters reporterFinalise+              renderExperiment e r reporters env+              onExperimentCompleted e r env+              return (Right a)+         ch z@(SomeException e') =+           do onExperimentFailed e r env e'+              return (Left z)+     catchComp c1 ch++-- | Run the simulation experiment by the specified run index in series.+runExperimentByIndex :: (MonadDES m,+                         ExperimentRendering r m,+                         Monad (ExperimentMonad r m),+                         MonadException (ExperimentMonad r m))+                        => (m () -> ExperimentMonad r m a)+                        -- ^ the function that actually starts the simulation run+                        -> Experiment m+                        -- ^ the simulation experiment to run+                        -> [ExperimentGenerator r m]+                        -- ^ generators used for rendering+                        -> r+                        -- ^ the rendering backend+                        -> Simulation m (Results m)+                        -- ^ the simulation results received from the model+                        -> Int+                        -- ^ the index of the current run (started from 1)+                        -> ExperimentMonadTry r m a+{-# INLINABLE runExperimentByIndex #-}+runExperimentByIndex executor e generators r simulation runIndex =+  do let specs      = experimentSpecs e+         runCount   = experimentRunCount e+     env <- prepareExperiment e r+     let c1 =+           do reporters <- mapM (\x -> generateReporter x e r env)+                           generators+              forM_ reporters reporterInitialise+              let simulate =+                    do signals <- newResultPredefinedSignals+                       results <- simulation+                       let d = ExperimentData { experimentResults = experimentTransform e results,+                                                experimentPredefinedSignals = signals }+                       ((), fs) <- runDynamicsInStartTime $+                                   runEventWith EarlierEvents $+                                   flip runComposite mempty $+                                   forM_ reporters $ \reporter ->+                                   reporterSimulate reporter d+                       let m1 =+                             runEventInStopTime $+                             return ()+                           m2 =+                             runEventInStopTime $+                             disposeEvent fs+                           mh (SimulationAbort e') =+                             return ()+                       finallySimulation (catchSimulation m1 mh) m2+              a <- executor $+                   runSimulationByIndex simulate specs runCount runIndex+              forM_ reporters reporterFinalise+              renderExperiment e r reporters env+              onExperimentCompleted e r env+              return (Right a)+         ch z@(SomeException e') =+           do onExperimentFailed e r env e'+              return (Left z)+     catchComp c1 ch++-- | Run the simulation experiment by the specified run index in series.+runExperimentByIndex_ :: (MonadDES m,+                          ExperimentRendering r m,+                          Monad (ExperimentMonad r m),+                          MonadException (ExperimentMonad r m))+                         => (m () -> ExperimentMonad r m a)+                         -- ^ the function that actually starts the simulation run+                         -> Experiment m+                         -- ^ the simulation experiment to run+                         -> [ExperimentGenerator r m]+                         -- ^ generators used for rendering+                         -> r+                         -- ^ the rendering backend+                         -> Simulation m (Results m)+                         -- ^ the simulation results received from the model+                         -> Int+                         -- ^ the index of the current run (started from 1)+                         -> ExperimentMonadTry r m ()+{-# INLINABLE runExperimentByIndex_ #-}+runExperimentByIndex_ executor e generators r simulation runIndex =+  do x <- runExperimentByIndex executor e generators r simulation runIndex+     return (x >> return ())++-- | Run the simulation experiment by the specified run index in series+-- returning the continuation of the actual computation.+runExperimentContByIndex :: (MonadDES m,+                             ExperimentRendering r m,+                             Monad (ExperimentMonad r m),+                             MonadException (ExperimentMonad r m))+                            => (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))+                            -- ^ the function that actually starts the simulation run+                            -- and returns the corresponding continuation+                            -> Experiment m+                            -- ^ the simulation experiment to run+                            -> [ExperimentGenerator r m]+                            -- ^ generators used for rendering+                            -> r+                            -- ^ the rendering backend+                            -> Simulation m (Results m)+                            -- ^ the simulation results received from the model+                            -> Int+                            -- ^ the index of the current run (started from 1)+                            -> ExperimentMonadTry r m (a, ExperimentMonadTry r m b)+{-# INLINABLE runExperimentContByIndex #-}+runExperimentContByIndex executor e generators r simulation runIndex =+  do let specs      = experimentSpecs e+         runCount   = experimentRunCount e+     env <- prepareExperiment e r+     let c1 =+           do reporters <- mapM (\x -> generateReporter x e r env)+                           generators+              forM_ reporters reporterInitialise+              let simulate =+                    do signals <- newResultPredefinedSignals+                       results <- simulation+                       let d = ExperimentData { experimentResults = experimentTransform e results,+                                                experimentPredefinedSignals = signals }+                       ((), fs) <- runDynamicsInStartTime $+                                   runEventWith EarlierEvents $+                                   flip runComposite mempty $+                                   forM_ reporters $ \reporter ->+                                   reporterSimulate reporter d+                       let m1 =+                             runEventInStopTime $+                             return ()+                           m2 =+                             runEventInStopTime $+                             disposeEvent fs+                           mh (SimulationAbort e') =+                             return ()+                       finallySimulation (catchSimulation m1 mh) m2+              (a, m) <- executor $+                        runSimulationByIndex simulate specs runCount runIndex+              let m2 =+                    do b <- m+                       forM_ reporters reporterFinalise+                       renderExperiment e r reporters env+                       onExperimentCompleted e r env+                       return (Right b)+                  mh z@(SomeException e') =+                    do onExperimentFailed e r env e'+                       return (Left z)+              return (Right (a, catchComp m2 mh))+         ch z@(SomeException e') =+           do onExperimentFailed e r env e'+              return (Left z)+     catchComp c1 ch++-- | Run the simulation experiment by the specified run index in series+-- returning the continuation of the actual computation.+runExperimentContByIndex_ :: (MonadDES m,+                              ExperimentRendering r m,+                              Monad (ExperimentMonad r m),+                              MonadException (ExperimentMonad r m))+                             => (m () -> ExperimentMonad r m (a, ExperimentMonad r m b))+                             -- ^ the function that actually starts the simulation run+                             -- and returns the corresponding continuation+                             -> Experiment m+                             -- ^ the simulation experiment to run+                             -> [ExperimentGenerator r m]+                             -- ^ generators used for rendering+                             -> r+                             -- ^ the rendering backend+                             -> Simulation m (Results m)+                             -- ^ the simulation results received from the model+                             -> Int+                             -- ^ the index of the current run (started from 1)+                             -> ExperimentMonadTry r m (a, ExperimentMonadTry r m ())+{-# INLINABLE runExperimentContByIndex_ #-}+runExperimentContByIndex_ executor e generators r simulation runIndex =+  do x <- runExperimentContByIndex executor e generators r simulation runIndex+     case x of+       Left e -> return (Left e)+       Right (a, cont) -> return $ Right (a, cont >> return (Right ()))

@@ -1,21 +1,26 @@ name:            aivika-experiment-version:         4.0.3+version:         5.0 synopsis:        Simulation experiments for the Aivika library description:-    This package allows defining simulation experiments for the Aivika-    package. Such experiments define in declarative manner what should be-    simulated and in which view the simulation results should be -    generated. It can be charts, tables and so on.+    This package allows defining simulation experiments based on the aivika [1]+    and aivika-transformers [2] packages. Such experiments define in declarative +    manner what should be simulated and in which view the simulation results should +    be generated. It can directly return charts, tables and so on. Additionally, it+    can save the results in SQL databases.     .     The library is extensible and you can add new views for the results.     .+    \[1] <http://hackage.haskell.org/package/aivika>+    .+    \[2] <http://hackage.haskell.org/package/aivika-transformers>+    . category:        Simulation license:         BSD3 license-file:    LICENSE-copyright:       (c) 2012-2015. David Sorokin <david.sorokin@gmail.com>+copyright:       (c) 2012-2017. David Sorokin <david.sorokin@gmail.com> author:          David Sorokin maintainer:      David Sorokin <david.sorokin@gmail.com>-homepage:        http://github.com/dsorokin/aivika-experiment+homepage:        http://www.aivikasoft.com cabal-version:   >= 1.6 build-type:      Simple tested-with:     GHC == 7.10.1@@ -26,24 +31,28 @@ library      exposed-modules: Simulation.Aivika.Experiment+                     Simulation.Aivika.Experiment.Concurrent.MVar                      Simulation.Aivika.Experiment.Types-                     Simulation.Aivika.Experiment.HtmlWriter-                     Simulation.Aivika.Experiment.LastValueView-                     Simulation.Aivika.Experiment.TableView-                     Simulation.Aivika.Experiment.TimingStatsView-                     Simulation.Aivika.Experiment.TimingStatsWriter-                     Simulation.Aivika.Experiment.SamplingStatsWriter-                     Simulation.Aivika.Experiment.FinalStatsView+                     Simulation.Aivika.Experiment.Base+                     Simulation.Aivika.Experiment.Base.ExperimentSpecsView+                     Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter+                     Simulation.Aivika.Experiment.Base.ExperimentWriter+                     Simulation.Aivika.Experiment.Base.FileRenderer+                     Simulation.Aivika.Experiment.Base.FinalStatsView+                     Simulation.Aivika.Experiment.Base.FinalTableView+                     Simulation.Aivika.Experiment.Base.InfoView+                     Simulation.Aivika.Experiment.Base.HtmlWriter+                     Simulation.Aivika.Experiment.Base.LastValueView+                     Simulation.Aivika.Experiment.Base.SamplingStatsWriter+                     Simulation.Aivika.Experiment.Base.TableView+                     Simulation.Aivika.Experiment.Base.TimingStatsView+                     Simulation.Aivika.Experiment.Base.TimingStatsWriter+                     Simulation.Aivika.Experiment.Base.WebPageRenderer                      Simulation.Aivika.Experiment.Histogram-                     Simulation.Aivika.Experiment.ExperimentSpecsView-                     Simulation.Aivika.Experiment.ExperimentSpecsWriter-                     Simulation.Aivika.Experiment.ExperimentWriter-                     Simulation.Aivika.Experiment.FinalTableView-                     Simulation.Aivika.Experiment.InfoView                      Simulation.Aivika.Experiment.Utils-                     Simulation.Aivika.Experiment.MRef-                     Simulation.Aivika.Experiment.WebPageRenderer-                     Simulation.Aivika.Experiment.FileRenderer+                     Simulation.Aivika.Trans.Experiment+                     Simulation.Aivika.Trans.Experiment.Concurrent.MVar+                     Simulation.Aivika.Trans.Experiment.Types                           build-depends:   base >= 4.2 && < 6,                      mtl >= 1.1.0.2,@@ -53,9 +62,11 @@                      split >= 0.2.2,                      network-uri >= 2.6,                      parallel-io >= 0.3.2.1,-                     aivika >= 4.0.3+                     aivika >= 5.1,+                     aivika-transformers >= 5.1      extensions:      MultiParamTypeClasses,+                     FlexibleContexts,                      TypeFamilies                           ghc-options:     -O2

@@ -19,6 +19,7 @@ import Simulation.Aivika import Simulation.Aivika.SystemDynamics import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.Base  specs = Specs { spcStartTime = 0,                  spcStopTime = 500, @@ -59,31 +60,22 @@     experimentDescription = "Model Linear Array as described in " ++                             "the examples included in Berkeley-Madonna." } +t = resultByName "t"+m = resultByName "m"+c = resultByName "c"+ generators :: [WebPageGenerator a] generators =   [outputView defaultExperimentSpecsView,    outputView $ defaultTableView {-     tableSeries =-        resultByName "t" <>-        resultByName "m" <>-        resultByName "c" },+     tableSeries = t <> m <> c },    outputView $ defaultFinalTableView {-     finalTableSeries =-        resultByName "m" <>-        resultByName "c" },+     finalTableSeries = m <> c },    outputView $ defaultLastValueView {-     lastValueSeries =-        resultByName "t" <>-        resultByName "m" <>-        resultByName "c" },+     lastValueSeries = t <> m <> c },    outputView $ defaultTimingStatsView {-     timingStatsSeries =-        resultByName "t" <>-        resultByName "m" <>-        resultByName "c" },+     timingStatsSeries = t <> m <> c },    outputView $ defaultFinalStatsView {-     finalStatsSeries =-        resultByName "m" <>-        resultByName "c" } ]+     finalStatsSeries = m <> c } ] -main = runExperiment experiment generators (WebPageRenderer ()) (model 51)+main = runExperiment experiment generators (WebPageRenderer () experimentFilePath) (model 51)

@@ -18,6 +18,7 @@  import Simulation.Aivika import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.Base  meanUpTime = 1.0 meanRepairTime = 0.5@@ -43,20 +44,23 @@     experimentRunCount = 3,     experimentDescription = description } +x = resultByName "x"+t = resultByName "t"+ generators :: [WebPageGenerator a] generators =   [outputView defaultExperimentSpecsView,    outputView defaultInfoView,    outputView $ defaultLastValueView {-     lastValueSeries = resultByName "x" },+     lastValueSeries = x },    outputView $ defaultTimingStatsView {-     timingStatsSeries = resultByName "x" },+     timingStatsSeries = x },    outputView $ defaultFinalStatsView {-     finalStatsSeries = resultByName "x" },+     finalStatsSeries = x },    outputView $ defaultTableView {-     tableSeries = resultByName "x" }, +     tableSeries = x },     outputView $ defaultFinalTableView {-     finalTableSeries = resultByName "x" } ]+     finalTableSeries = x } ]  model :: Simulation Results model =@@ -116,4 +120,4 @@        [resultSource "x" "The proportion of up time" prop,         resultSource "t" "Simulation time" time] -main = runExperiment experiment generators (WebPageRenderer ()) model+main = runExperiment experiment generators (WebPageRenderer () experimentFilePath) model