" writeHtml "
| " - writeHtmlText $ format $ timingStatsDeviation stats + writeHtmlText $ format $ show $ timingStatsDeviation stats writeHtml " | " writeHtml "|
| " - writeHtmlText $ format $ timingStatsMin stats + writeHtmlText $ format $ show $ timingStatsMin stats writeHtml " | " writeHtml "" writeHtmlText "(" writeHtmlText $ timingStatsTimeText writer writeHtmlText " = " - writeHtmlText $ format $ timingStatsMinTime stats + writeHtmlText $ format $ show $ timingStatsMinTime stats writeHtmlText ")" writeHtml " | " writeHtml "" - writeHtmlText $ format $ timingStatsMax stats + writeHtmlText $ format $ show $ timingStatsMax stats writeHtml " | " writeHtml "" writeHtmlText "(" writeHtmlText $ timingStatsTimeText writer writeHtmlText " = " - writeHtmlText $ format $ timingStatsMaxTime stats + writeHtmlText $ format $ show $ timingStatsMaxTime stats writeHtmlText ")" writeHtml " | " writeHtml "" @@ -119,9 +119,9 @@ writeHtml "" writeHtml "" writeHtml "[" - writeHtml $ format $ timingStatsStartTime stats + writeHtml $ format $ show $ timingStatsStartTime stats writeHtml "; " - writeHtml $ format $ timingStatsLastTime stats + writeHtml $ format $ show $ timingStatsLastTime stats writeHtml "]" writeHtml " | " writeHtml "" diff --git a/Simulation/Aivika/Experiment/Types.hs b/Simulation/Aivika/Experiment/Types.hs --- a/Simulation/Aivika/Experiment/Types.hs +++ b/Simulation/Aivika/Experiment/Types.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-} +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} -- | -- Module : Simulation.Aivika.Experiment.Types @@ -19,42 +19,21 @@ -- views are provided. -- -module Simulation.Aivika.Experiment.Types - (-- * General Definitions - Experiment(..), - ExperimentRendering(..), - defaultExperiment, - runExperiment, - runExperimentParallel, - ExperimentData(..), - ExperimentView(..), - ExperimentGenerator(..), - ExperimentReporter(..), - -- * Web Page Rendering - WebPageRendering(..), - WebPageRenderer(..), - WebPageWriter(..), - WebPageGenerator(..)) where +module Simulation.Aivika.Experiment.Types where import Control.Monad import Control.Monad.State import Control.Concurrent.ParallelIO.Local -import qualified Data.Map as M - -import Data.Ix import Data.Maybe import Data.Monoid -import qualified System.IO.UTF8 as UTF8 import System.Directory import System.FilePath import GHC.Conc (getNumCapabilities) import Simulation.Aivika -import Simulation.Aivika.Experiment.HtmlWriter -import Simulation.Aivika.Experiment.Utils (replace) import Simulation.Aivika.Experiment.ExperimentWriter -- | It defines the simulation experiment with the specified rendering backend and its bound data. @@ -94,25 +73,28 @@ experimentNumCapabilities = getNumCapabilities } -- | It allows rendering the simulation results in an arbitrary way. -class ExperimentRendering r a | r -> a where +class ExperimentRendering r where + -- | Defines a context used when rendering the experiment. + data ExperimentContext r :: * + -- | Render the experiment after the simulation is finished, for example, -- creating the @index.html@ file in the specified directory. - renderExperiment :: Experiment -> r -> [ExperimentReporter a] -> FilePath -> ExperimentWriter () + renderExperiment :: Experiment -> r -> [ExperimentReporter r] -> FilePath -> ExperimentWriter () -- | This is a generator of the reporter with the specified rendering backend. -data ExperimentGenerator r a = - ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter a) +data ExperimentGenerator r = + ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter r) -- ^ Generate a reporter bound up with the specified directory. } -- | 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 a => ExperimentView v r a | r -> a where +class ExperimentRendering r => ExperimentView v r where -- | Create a generator of the reporter. - outputView :: v -> ExperimentGenerator r a + outputView :: v -> ExperimentGenerator r -- | It describes the source simulation data used in the experiment. data ExperimentData = @@ -123,7 +105,7 @@ } -- | Defines what creates the simulation reports by the specified renderer. -data ExperimentReporter a = +data ExperimentReporter r = ExperimentReporter { reporterInitialise :: ExperimentWriter (), -- ^ Initialise the reporting before -- the simulation runs are started. @@ -135,17 +117,17 @@ -- and return a finalizer that will be called -- in the stop time after the last signal is -- triggered and processed. - reporterRequest :: a - -- ^ Return data requested by the renderer. + reporterContext :: ExperimentContext r + -- ^ Return a context used by the renderer. } -- | Run the simulation experiment sequentially. For example, -- it can be a Monte-Carlo simulation dependentent on the external -- 'Parameter' values. -runExperiment :: ExperimentRendering r a +runExperiment :: ExperimentRendering r => Experiment -- ^ the simulation experiment to run - -> [ExperimentGenerator r a] + -> [ExperimentGenerator r] -- ^ generators used for rendering -> r -- ^ the rendering backend @@ -166,10 +148,10 @@ -- threads directly with help of 'experimentNumCapabilities', -- although the real number of parallel threads can depend on many -- factors. -runExperimentParallel :: ExperimentRendering r a +runExperimentParallel :: ExperimentRendering r => Experiment -- ^ the simulation experiment to run - -> [ExperimentGenerator r a] + -> [ExperimentGenerator r] -- ^ generators used for rendering -> r -- ^ the rendering backend @@ -183,12 +165,12 @@ parallel_ pool tasks -- | Run the simulation experiment with the specified executor. -runExperimentWithExecutor :: ExperimentRendering r a +runExperimentWithExecutor :: ExperimentRendering r => ([IO ()] -> IO ()) -- ^ an executor that allows parallelizing the simulation if required -> Experiment -- ^ the simulation experiment to run - -> [ExperimentGenerator r a] + -> [ExperimentGenerator r] -- ^ generators used for rendering -> r -- ^ the rendering backend @@ -219,62 +201,20 @@ runEventWith EarlierEvents $ forM reporters $ \reporter -> reporterSimulate reporter d - runEventInStopTime $ - disposeEvent $ mconcat fs + 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 () - --- | It defines the web page renderer for simulation 'Experiment'. -data WebPageRenderer = WebPageRenderer - --- | 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 subclass of renderers that know how to save the @index.html@ file --- when rendering the simulation experiment. -class ExperimentRendering r WebPageWriter => WebPageRendering r - --- | A convenient type synonym for describing the web page generators. -type WebPageGenerator r = ExperimentGenerator r WebPageWriter - -instance WebPageRendering WebPageRenderer - -instance ExperimentRendering WebPageRenderer WebPageWriter where - - renderExperiment e r reporters path = - do let html :: HtmlWriter () - html = - writeHtmlDocumentWithTitle (experimentTitle e) $ - do writeHtmlList $ - forM_ (zip [1..] reporters) $ \(i, reporter) -> - reporterWriteTOCHtml (reporterRequest reporter) i - writeHtmlBreak - unless (null $ experimentDescription e) $ - writeHtmlParagraph $ - writeHtmlText $ experimentDescription e - forM_ (zip [1..] reporters) $ \(i, reporter) -> - reporterWriteHtml (reporterRequest reporter) i - file = combine path "index.html" - ((), contents) <- runHtmlWriter html id - liftIO $ do - UTF8.writeFile file (contents []) - when (experimentVerbose e) $ - do putStr "Generated file " - putStrLn file diff --git a/Simulation/Aivika/Experiment/WebPageRenderer.hs b/Simulation/Aivika/Experiment/WebPageRenderer.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Experiment/WebPageRenderer.hs @@ -0,0 +1,83 @@ + +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Simulation.Aivika.Experiment.Types +-- Copyright : Copyright (c) 2012-2014, David Sorokin