{-# LANGUAGE TypeFamilies #-}
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
data FileRenderer a = FileRenderer a ExperimentFilePath
type FileGenerator a = ExperimentGenerator (FileRenderer a)
instance ExperimentRendering (FileRenderer a) where
data ExperimentContext (FileRenderer a) = FileContext
type ExperimentEnvironment (FileRenderer a) = FilePath
type ExperimentMonad (FileRenderer a) = ExperimentWriter
liftExperiment :: FileRenderer a -> ExperimentMonad (FileRenderer a) a -> IO a
liftExperiment FileRenderer a
r = ExperimentMonad (FileRenderer a) a -> IO a
forall a. ExperimentWriter a -> IO a
runExperimentWriter
prepareExperiment :: Experiment
-> FileRenderer a
-> ExperimentMonad
(FileRenderer a) (ExperimentEnvironment (FileRenderer a))
prepareExperiment Experiment
e (FileRenderer a
_ ExperimentFilePath
path0) =
do FilePath
path <- FilePath -> ExperimentFilePath -> ExperimentWriter FilePath
resolveFilePath FilePath
"" ExperimentFilePath
path0
IO () -> ExperimentWriter ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExperimentWriter ()) -> IO () -> ExperimentWriter ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose Experiment
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do FilePath -> IO ()
putStr FilePath
"Updating directory "
FilePath -> IO ()
putStrLn FilePath
path
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
path
FilePath -> ExperimentWriter FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
renderExperiment :: Experiment
-> FileRenderer a
-> [ExperimentReporter (FileRenderer a)]
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad (FileRenderer a) ()
renderExperiment Experiment
e FileRenderer a
r [ExperimentReporter (FileRenderer a)]
reporters ExperimentEnvironment (FileRenderer a)
path = () -> ExperimentWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onExperimentCompleted :: Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad (FileRenderer a) ()
onExperimentCompleted Experiment
e FileRenderer a
r ExperimentEnvironment (FileRenderer a)
path = () -> ExperimentWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onExperimentFailed :: Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> e
-> ExperimentMonad (FileRenderer a) ()
onExperimentFailed Experiment
e FileRenderer a
r ExperimentEnvironment (FileRenderer a)
path e
e' = e -> ExperimentWriter ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
e'