packages feed

aivika-experiment 1.4 → 2.1

raw patch · 12 files changed

+233/−115 lines, 12 filesdep ~aivikaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aivika

API changes (from Hackage documentation)

- Simulation.Aivika.Experiment.Types: UniqueFilePath :: FilePath -> ExperimentFilePath
- Simulation.Aivika.Experiment.Types: WritableFilePath :: FilePath -> ExperimentFilePath
- Simulation.Aivika.Experiment.Types: data ExperimentFilePath
- Simulation.Aivika.Experiment.Types: expandFilePath :: ExperimentFilePath -> Map String String -> ExperimentFilePath
- Simulation.Aivika.Experiment.Types: mapFilePath :: (FilePath -> FilePath) -> ExperimentFilePath -> ExperimentFilePath
- Simulation.Aivika.Experiment.Types: resolveFilePath :: FilePath -> ExperimentFilePath -> IO FilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: UniqueFilePath :: FilePath -> ExperimentFilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: WritableFilePath :: FilePath -> ExperimentFilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: data ExperimentFilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: data ExperimentWriter a
+ Simulation.Aivika.Experiment.ExperimentWriter: expandFilePath :: ExperimentFilePath -> Map String String -> ExperimentFilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: instance Applicative ExperimentWriter
+ Simulation.Aivika.Experiment.ExperimentWriter: instance Functor ExperimentWriter
+ Simulation.Aivika.Experiment.ExperimentWriter: instance Monad ExperimentWriter
+ Simulation.Aivika.Experiment.ExperimentWriter: instance MonadIO ExperimentWriter
+ Simulation.Aivika.Experiment.ExperimentWriter: mapFilePath :: (FilePath -> FilePath) -> ExperimentFilePath -> ExperimentFilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: resolveFilePath :: FilePath -> ExperimentFilePath -> ExperimentWriter FilePath
+ Simulation.Aivika.Experiment.ExperimentWriter: runExperimentWriter :: ExperimentWriter a -> IO a
+ Simulation.Aivika.Experiment.MRef: modifyMRef_ :: MRef a -> (a -> IO a) -> IO ()
+ Simulation.Aivika.Experiment.MRef: withMRef :: MRef a -> (a -> IO b) -> IO b
- Simulation.Aivika.Experiment.HtmlWriter: runHtmlWriter :: HtmlWriter a -> ShowS -> IO (a, ShowS)
+ Simulation.Aivika.Experiment.HtmlWriter: runHtmlWriter :: HtmlWriter a -> ShowS -> ExperimentWriter (a, ShowS)
- Simulation.Aivika.Experiment.MRef: maybeReadMRef :: b -> (a -> b) -> MRef (Maybe a) -> IO b
+ Simulation.Aivika.Experiment.MRef: maybeReadMRef :: b -> (a -> IO b) -> MRef (Maybe a) -> IO b
- Simulation.Aivika.Experiment.MRef: maybeWriteMRef :: MRef (Maybe a) -> IO a -> (a -> b) -> IO b
+ Simulation.Aivika.Experiment.MRef: maybeWriteMRef :: MRef (Maybe a) -> IO a -> (a -> IO b) -> IO b
- Simulation.Aivika.Experiment.MRef: modifyMRef :: MRef a -> (a -> a) -> IO ()
+ Simulation.Aivika.Experiment.MRef: modifyMRef :: MRef a -> (a -> IO (a, b)) -> IO b
- Simulation.Aivika.Experiment.Types: ExperimentGenerator :: (Experiment -> r -> FilePath -> IO (ExperimentReporter a)) -> ExperimentGenerator r a
+ Simulation.Aivika.Experiment.Types: ExperimentGenerator :: (Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter a)) -> ExperimentGenerator r a
- Simulation.Aivika.Experiment.Types: ExperimentReporter :: IO () -> IO () -> (ExperimentData -> Event DisposableEvent) -> a -> ExperimentReporter a
+ Simulation.Aivika.Experiment.Types: ExperimentReporter :: ExperimentWriter () -> ExperimentWriter () -> (ExperimentData -> Event DisposableEvent) -> a -> ExperimentReporter a
- Simulation.Aivika.Experiment.Types: generateReporter :: ExperimentGenerator r a -> Experiment -> r -> FilePath -> IO (ExperimentReporter a)
+ Simulation.Aivika.Experiment.Types: generateReporter :: ExperimentGenerator r a -> Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter a)
- Simulation.Aivika.Experiment.Types: renderExperiment :: ExperimentRendering r a => Experiment -> r -> [ExperimentReporter a] -> FilePath -> IO ()
+ Simulation.Aivika.Experiment.Types: renderExperiment :: ExperimentRendering r a => Experiment -> r -> [ExperimentReporter a] -> FilePath -> ExperimentWriter ()
- Simulation.Aivika.Experiment.Types: reporterFinalise :: ExperimentReporter a -> IO ()
+ Simulation.Aivika.Experiment.Types: reporterFinalise :: ExperimentReporter a -> ExperimentWriter ()
- Simulation.Aivika.Experiment.Types: reporterInitialise :: ExperimentReporter a -> IO ()
+ Simulation.Aivika.Experiment.Types: reporterInitialise :: ExperimentReporter a -> ExperimentWriter ()

Files

Simulation/Aivika/Experiment.hs view
@@ -23,6 +23,7 @@         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.Utils) where @@ -37,5 +38,6 @@ 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.Utils
Simulation/Aivika/Experiment/ExperimentSpecsView.hs view
@@ -24,6 +24,7 @@  import Simulation.Aivika.Experiment.Types import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.ExperimentWriter import Simulation.Aivika.Experiment.ExperimentSpecsWriter  -- | Defines the 'View' that shows the experiment specs.@@ -63,7 +64,7 @@                              experimentSpecsExperiment :: Experiment }    -- | Create a new state of the view.-newExperimentSpecs :: ExperimentSpecsView -> Experiment -> IO ExperimentSpecsViewState+newExperimentSpecs :: ExperimentSpecsView -> Experiment -> ExperimentWriter ExperimentSpecsViewState newExperimentSpecs view exp =   return ExperimentSpecsViewState { experimentSpecsView       = view,                                     experimentSpecsExperiment = exp }
+ Simulation/Aivika/Experiment/ExperimentWriter.hs view
@@ -0,0 +1,129 @@++-- |+-- Module     : Simulation.Aivika.Experiment.ExperimentWriter+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.8.3+--+-- 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
Simulation/Aivika/Experiment/FinalStatsView.hs view
@@ -26,6 +26,7 @@  import Simulation.Aivika import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.ExperimentWriter import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.SamplingStatsWriter import Simulation.Aivika.Experiment.MRef@@ -84,9 +85,9 @@                       finalStatsValues :: [IORef (SamplingStats Double)] }    -- | Create a new state of the view.-newFinalStats :: FinalStatsView -> Experiment -> FilePath -> IO FinalStatsViewState+newFinalStats :: FinalStatsView -> Experiment -> FilePath -> ExperimentWriter FinalStatsViewState newFinalStats view exp dir =-  do r <- newMRef Nothing+  do r <- liftIO $ newMRef Nothing      return FinalStatsViewState { finalStatsView       = view,                                   finalStatsExperiment = exp,                                   finalStatsResults    = r }@@ -105,7 +106,7 @@   (newFinalStatsResults names (finalStatsExperiment st)) $ \results ->   if (names /= finalStatsNames results)   then error "Series with different names are returned for different runs: requireFinalStatsResults"-  else results+  else return results         -- | Simulate the specified series. simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Event DisposableEvent
Simulation/Aivika/Experiment/FinalTableView.hs view
@@ -31,6 +31,7 @@  import Simulation.Aivika import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.ExperimentWriter import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.MRef @@ -87,7 +88,7 @@                    finalTableDescription = "It refers to the CSV file with the results in the final time points.",                    finalTableRunText     = "Run",                    finalTableLinkText    = "Download the CSV file",-                   finalTableFileName    = UniqueFilePath "$TITLE.csv",+                   finalTableFileName    = UniqueFilePath "FinalTable.csv",                    finalTableSeparator   = ",",                    finalTableFormatter   = id,                    finalTablePredicate   = return True,@@ -122,10 +123,10 @@                       finalTableValues :: MRef (M.Map Int [String]) }    -- | Create a new state of the view.-newFinalTable :: FinalTableView -> Experiment -> FilePath -> IO FinalTableViewState+newFinalTable :: FinalTableView -> Experiment -> FilePath -> ExperimentWriter FinalTableViewState newFinalTable view exp dir =-  do f <- newIORef Nothing-     r <- newMRef Nothing+  do f <- liftIO $ newIORef Nothing+     r <- liftIO $ newMRef Nothing      return FinalTableViewState { finalTableView       = view,                                   finalTableExperiment = exp,                                   finalTableDir        = dir, @@ -146,7 +147,7 @@   (newFinalTableResults names (finalTableExperiment st)) $ \results ->   if (names /= finalTableNames results)   then error "Series with different names are returned for different runs: requireFinalTableResults"-  else results+  else return results         -- | Simulation of the specified series. simulateFinalTable :: FinalTableViewState -> ExperimentData -> Event DisposableEvent@@ -166,47 +167,48 @@      handleSignal signal $ \_ ->        do xs <- mapM resultExtractData exts           i  <- liftParameter simulationIndex-          liftIO $ modifyMRef values $ M.insert i xs+          liftIO $ modifyMRef_ values $ return . M.insert i xs       -- | Save the results in the CSV file after the simulation is complete.-finaliseFinalTable :: FinalTableViewState -> IO ()+finaliseFinalTable :: FinalTableViewState -> ExperimentWriter () finaliseFinalTable st =   do let view      = finalTableView st          run       = finalTableRunText view          formatter = finalTableFormatter view          title     = finalTableTitle view          separator = finalTableSeparator view-     results <- readMRef $ finalTableResults st+     results <- liftIO $ readMRef $ finalTableResults st      case results of        Nothing -> return ()        Just results ->          do let names  = finalTableNames results                 values = finalTableValues results-            m <- readMRef values +            m <- liftIO $ readMRef values              file <- resolveFilePath (finalTableDir st) $                     mapFilePath (flip replaceExtension ".csv") $                     expandFilePath (finalTableFileName $ finalTableView st) $                     M.fromList [("$TITLE", title)]-            -- create a new file-            h <- liftIO $ 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+            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 ()
Simulation/Aivika/Experiment/HtmlWriter.hs view
@@ -45,9 +45,11 @@  import Network.URI +import Simulation.Aivika.Experiment.ExperimentWriter+ -- | It writes fast an HTML code. newtype HtmlWriter a = -  HtmlWriter { runHtmlWriter :: ShowS -> IO (a, ShowS)+  HtmlWriter { runHtmlWriter :: ShowS -> ExperimentWriter (a, ShowS)                -- ^ Run the HTML writer monad.              } @@ -63,7 +65,7 @@ instance MonadIO HtmlWriter where             liftIO m = HtmlWriter $ \f ->-    do x <- m+    do x <- liftIO m        return (x, f)  instance Functor HtmlWriter where
Simulation/Aivika/Experiment/LastValueView.hs view
@@ -26,6 +26,7 @@  import Simulation.Aivika import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.ExperimentWriter import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) @@ -85,10 +86,10 @@                        lastValueMap        :: M.Map Int (IORef [(String, String)]) }    -- | Create a new state of the view.-newLastValues :: LastValueView -> Experiment -> IO LastValueViewState+newLastValues :: LastValueView -> Experiment -> ExperimentWriter LastValueViewState newLastValues view exp =   do let n = experimentRunCount exp-     rs <- forM [0..(n - 1)] $ \i -> newIORef []    +     rs <- forM [0..(n - 1)] $ \i -> liftIO $ newIORef []          let m = M.fromList $ zip [0..(n - 1)] rs      return LastValueViewState { lastValueView       = view,                                  lastValueExperiment = exp,
Simulation/Aivika/Experiment/MRef.hs view
@@ -17,7 +17,9 @@         maybeReadMRef,         writeMRef,         maybeWriteMRef,-        modifyMRef) where+        modifyMRef_,+        modifyMRef,+        withMRef) where  import Control.Concurrent.MVar @@ -46,16 +48,16 @@  -- | Like 'maybe' but for the shared reference under assumption -- that the reference is updated only once by its initial value.-maybeReadMRef :: b -> (a -> b) -> MRef (Maybe a) -> IO b+maybeReadMRef :: b -> (a -> IO b) -> MRef (Maybe a) -> IO b maybeReadMRef b0 f x =   do a <- readIORef (mrefData x)      case a of-       Just a -> return (f a)+       Just a -> f a        Nothing ->          withMVar (mrefLock x) $ \() ->          do a <- readIORef (mrefData x)             case a of-              Just a -> return (f a)+              Just a -> f a               Nothing -> return b0  -- | Update the contents of the shared reference.@@ -66,23 +68,40 @@  -- | 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 -> b) -> IO b+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 -> return (f a)+       Just a -> f a        Nothing ->          withMVar (mrefLock x) $ \() ->          do a <- readIORef (mrefData x)             case a of-              Just a -> return (f a)+              Just a -> f a               Nothing ->                 do a0 <- m0                    writeIORef (mrefData x) (Just a0)-                   return (f a0)+                   f a0  -- | Modify the contents of the shared reference.-modifyMRef :: MRef a -> (a -> a) -> IO ()+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) $ \() ->-  modifyIORef (mrefData x) f+  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
Simulation/Aivika/Experiment/TableView.hs view
@@ -30,6 +30,7 @@  import Simulation.Aivika import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.ExperimentWriter import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) @@ -105,7 +106,7 @@               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 "$TITLE - $RUN_INDEX.csv",+              tableFileName    = UniqueFilePath "Table($RUN_INDEX).csv",               tableSeparator   = ",",               tableFormatter   = id,               tablePredicate   = return True,@@ -134,7 +135,7 @@                    tableMap        :: M.Map Int FilePath }    -- | Create a new state of the view.-newTable :: TableView -> Experiment -> FilePath -> IO TableViewState+newTable :: TableView -> Experiment -> FilePath -> ExperimentWriter TableViewState newTable view exp dir =   do let n = experimentRunCount exp      fs <- forM [0..(n - 1)] $ \i ->@@ -144,7 +145,7 @@        M.fromList [("$TITLE", tableTitle view),                    ("$RUN_INDEX", show $ i + 1),                    ("$RUN_COUNT", show n)]-     forM_ fs $ flip writeFile []  -- reserve the file names+     liftIO $ forM_ fs $ flip writeFile []  -- reserve the file names      let m = M.fromList $ zip [0..(n - 1)] fs      return TableViewState { tableView       = view,                              tableExperiment = exp,
Simulation/Aivika/Experiment/TimingStatsView.hs view
@@ -27,6 +27,7 @@  import Simulation.Aivika import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.ExperimentWriter import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.TimingStatsWriter import Simulation.Aivika.Experiment.Utils (replace)@@ -90,10 +91,10 @@                          timingStatsMap        :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }    -- | Create a new state of the view.-newTimingStats :: TimingStatsView -> Experiment -> IO TimingStatsViewState+newTimingStats :: TimingStatsView -> Experiment -> ExperimentWriter TimingStatsViewState newTimingStats view exp =   do let n = experimentRunCount exp-     rs <- forM [0..(n - 1)] $ \i -> newIORef []    +     rs <- forM [0..(n - 1)] $ \i -> liftIO $ newIORef []          let m = M.fromList $ zip [0..(n - 1)] rs      return TimingStatsViewState { timingStatsView       = view,                                    timingStatsExperiment = exp,
Simulation/Aivika/Experiment/Types.hs view
@@ -30,10 +30,6 @@         ExperimentView(..),         ExperimentGenerator(..),         ExperimentReporter(..),-        ExperimentFilePath(..),-        resolveFilePath,-        expandFilePath,-        mapFilePath,         -- * Web Page Rendering         WebPageRendering(..),         WebPageRenderer(..),@@ -59,6 +55,7 @@ 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. data Experiment = @@ -101,11 +98,11 @@    -- | 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 -> IO ()+  renderExperiment :: Experiment -> r -> [ExperimentReporter a] -> FilePath -> ExperimentWriter ()  -- | This is a generator of the reporter with the specified rendering backend.                      data ExperimentGenerator r a = -  ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> IO (ExperimentReporter a)+  ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter a)                         -- ^ Generate a reporter bound up with the specified directory.                       } @@ -127,10 +124,10 @@  -- | Defines what creates the simulation reports by the specified renderer. data ExperimentReporter a =-  ExperimentReporter { reporterInitialise :: IO (),+  ExperimentReporter { reporterInitialise :: ExperimentWriter (),                        -- ^ Initialise the reporting before                         -- the simulation runs are started.-                       reporterFinalise   :: IO (),+                       reporterFinalise   :: ExperimentWriter (),                        -- ^ Finalise the reporting after                        -- all simulation runs are finished.                        reporterSimulate   :: ExperimentData -> Event DisposableEvent,@@ -198,15 +195,17 @@                              -> Simulation Results                              -- ^ the simulation results received from the model                              -> IO ()-runExperimentWithExecutor executor e generators r simulation = +runExperimentWithExecutor executor e generators r simulation =+  runExperimentWriter $   do let specs      = experimentSpecs e          runCount   = experimentRunCount e          dirName    = experimentDirectoryName e      path <- resolveFilePath "" dirName-     when (experimentVerbose e) $-       do putStr "Updating directory " -          putStrLn path-     createDirectoryIfMissing True path+     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@@ -222,7 +221,8 @@                     reporterSimulate reporter d               runEventInStopTime $                 disposeEvent $ mconcat fs-     executor $ runSimulations simulate specs runCount+     liftIO $+       executor $ runSimulations simulate specs runCount      forM_ reporters reporterFinalise      renderExperiment e r reporters path      return ()@@ -273,50 +273,8 @@                   reporterWriteHtml (reporterRequest reporter) i            file = combine path "index.html"        ((), contents) <- runHtmlWriter html id-       UTF8.writeFile file (contents [])-       when (experimentVerbose e) $-         do putStr "Generated file "-            putStrLn file-  --- | 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 -> IO FilePath-resolveFilePath dir (WritableFilePath path) =-  return $ dir </> path-resolveFilePath dir (UniqueFilePath path)   =-  let (name, ext) = splitExtension path-      loop y i =-        do let n = dir </> addExtension y ext-           f1 <- doesFileExist n-           f2 <- doesDirectoryExist n-           if f1 || f2-             then loop (name ++ "(" ++ show i ++ ")") (i + 1)-             else 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) +       liftIO $ do+         UTF8.writeFile file (contents [])+         when (experimentVerbose e) $+           do putStr "Generated file "+              putStrLn file
aivika-experiment.cabal view
@@ -1,5 +1,5 @@ name:            aivika-experiment-version:         1.4+version:         2.1 synopsis:        Simulation experiments for the Aivika library description:     This package allows defining simulation experiments for the Aivika@@ -37,6 +37,7 @@                      Simulation.Aivika.Experiment.Histogram                      Simulation.Aivika.Experiment.ExperimentSpecsView                      Simulation.Aivika.Experiment.ExperimentSpecsWriter+                     Simulation.Aivika.Experiment.ExperimentWriter                      Simulation.Aivika.Experiment.FinalTableView                      Simulation.Aivika.Experiment.Utils                      Simulation.Aivika.Experiment.MRef@@ -50,7 +51,7 @@                      split >= 0.2.2,                      network-uri >= 2.6,                      parallel-io >= 0.3.2.1,-                     aivika >= 1.4+                     aivika >= 2.1      extensions:      FlexibleInstances,                      FlexibleContexts,