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.Experiment.Types
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Specs
import Simulation.Aivika.Parameter
import Simulation.Aivika.Simulation
import Simulation.Aivika.Event
import Simulation.Aivika.Signal
data FinalTableView =
FinalTableView { finalTableTitle :: String,
finalTableDescription :: String,
finalTableRunText :: String,
finalTableLinkText :: String,
finalTableFileName :: FileName,
finalTableSeparator :: String,
finalTableFormatter :: ShowS,
finalTablePredicate :: Event Bool,
finalTableSeries :: [String]
}
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 = UniqueFileName "$TITLE" ".csv",
finalTableSeparator = ",",
finalTableFormatter = id,
finalTablePredicate = return True,
finalTableSeries = [] }
instance ExperimentView FinalTableView where
outputView v =
let reporter exp dir =
do st <- newFinalTable v exp dir
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = finaliseFinalTable st,
reporterSimulate = simulateFinalTable st,
reporterTOCHtml = finalTableTOCHtml st,
reporterHtml = finalTableHtml st }
in ExperimentGenerator { generateReporter = reporter }
data FinalTableViewState =
FinalTableViewState { finalTableView :: FinalTableView,
finalTableExperiment :: Experiment,
finalTableDir :: FilePath,
finalTableFile :: IORef (Maybe FilePath),
finalTableLock :: MVar (),
finalTableResults :: IORef (Maybe FinalTableResults) }
data FinalTableResults =
FinalTableResults { finalTableNames :: [String],
finalTableValues :: IORef (M.Map Int [String]) }
newFinalTable :: FinalTableView -> Experiment -> FilePath -> IO FinalTableViewState
newFinalTable view exp dir =
do f <- newIORef Nothing
l <- newMVar ()
r <- newIORef Nothing
return FinalTableViewState { finalTableView = view,
finalTableExperiment = exp,
finalTableDir = dir,
finalTableFile = f,
finalTableLock = l,
finalTableResults = r }
newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults
newFinalTableResults names exp =
do values <- newIORef M.empty
return FinalTableResults { finalTableNames = names,
finalTableValues = values }
simulateFinalTable :: FinalTableViewState -> ExperimentData -> Event (Event ())
simulateFinalTable st expdata =
do let labels = finalTableSeries $ finalTableView st
providers = experimentSeriesProviders expdata labels
input =
flip map providers $ \provider ->
case providerToString provider of
Nothing -> error $
"Cannot represent series " ++
providerName provider ++
" as string values: simulateFinalTable"
Just input -> input
names = map providerName providers
predicate = finalTablePredicate $ finalTableView st
exp = finalTableExperiment st
lock = finalTableLock st
results <- liftIO $ readIORef (finalTableResults st)
case results of
Nothing ->
liftIO $
do results <- newFinalTableResults names exp
writeIORef (finalTableResults st) $ Just results
Just results ->
when (names /= finalTableNames results) $
error "Series with different names are returned for different runs: simulateFinalTable"
results <- liftIO $ fmap fromJust $ readIORef (finalTableResults st)
let values = finalTableValues results
h = filterSignalM (const predicate) $
experimentSignalInStopTime expdata
handleSignal_ h $ \_ ->
do xs <- sequence input
i <- liftParameter simulationIndex
liftIO $ withMVar lock $ \() ->
modifyIORef values $ M.insert i xs
return $ return ()
finaliseFinalTable :: FinalTableViewState -> IO ()
finaliseFinalTable st =
do let run = finalTableRunText $ finalTableView st
formatter = finalTableFormatter $ finalTableView st
title = finalTableTitle $ finalTableView st
separator = finalTableSeparator $ finalTableView st
results <- readIORef $ finalTableResults st
case results of
Nothing -> return ()
Just results ->
do let names = finalTableNames results
values = finalTableValues results
m <- readIORef values
file <- resolveFileName
(Just $ finalTableDir st)
(finalTableFileName $ finalTableView st) $
M.fromList [("$TITLE", title)]
h <- liftIO $ openFile file WriteMode
hPutStr h $ show run
forM_ names $ \name ->
do hPutStr h separator
hPutStr h $ show name
hPutStrLn h ""
forM_ (M.assocs m) $ \(i, xs) ->
do hPutStr h $ show i
forM_ xs $ \x ->
do hPutStr h separator
hPutStr h $ formatter x
hPutStrLn h ""
hClose h
when (experimentVerbose $ finalTableExperiment st) $
putStr "Generated file " >> putStrLn file
writeIORef (finalTableFile st) $ Just file
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
finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (finalTableTitle $ finalTableView st)