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 +2/−0
- Simulation/Aivika/Experiment/ExperimentSpecsView.hs +2/−1
- Simulation/Aivika/Experiment/ExperimentWriter.hs +129/−0
- Simulation/Aivika/Experiment/FinalStatsView.hs +4/−3
- Simulation/Aivika/Experiment/FinalTableView.hs +31/−29
- Simulation/Aivika/Experiment/HtmlWriter.hs +4/−2
- Simulation/Aivika/Experiment/LastValueView.hs +3/−2
- Simulation/Aivika/Experiment/MRef.hs +29/−10
- Simulation/Aivika/Experiment/TableView.hs +4/−3
- Simulation/Aivika/Experiment/TimingStatsView.hs +3/−2
- Simulation/Aivika/Experiment/Types.hs +19/−61
- aivika-experiment.cabal +3/−2
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,