module Simulation.Aivika.Experiment.TableView
(TableView(..),
defaultTableView) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Monoid
import System.IO
import System.FilePath
import Simulation.Aivika
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.WebPageRenderer
import Simulation.Aivika.Experiment.FileRenderer
import Simulation.Aivika.Experiment.ExperimentWriter
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.Utils (replace)
data TableView =
TableView { tableTitle :: String,
tableDescription :: String,
tableLinkText :: String,
tableRunLinkText :: String,
tableFileName :: ExperimentFilePath,
tableSeparator :: String,
tableFormatter :: ShowS,
tablePredicate :: Event Bool,
tableTransform :: ResultTransform,
tableSeries :: ResultTransform
}
defaultTableView :: TableView
defaultTableView =
TableView { tableTitle = "Table",
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 "Table($RUN_INDEX).csv",
tableSeparator = ",",
tableFormatter = id,
tablePredicate = return True,
tableTransform = expandResults,
tableSeries = id }
instance ExperimentView TableView (WebPageRenderer a) where
outputView v =
let reporter exp renderer dir =
do st <- newTable v exp dir
let context =
WebPageContext $
WebPageWriter { reporterWriteTOCHtml = tableTOCHtml st,
reporterWriteHtml = tableHtml st }
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTable st,
reporterContext = context }
in ExperimentGenerator { generateReporter = reporter }
instance ExperimentView TableView (FileRenderer a) where
outputView v =
let reporter exp renderer dir =
do st <- newTable v exp dir
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTable st,
reporterContext = FileContext }
in ExperimentGenerator { generateReporter = reporter }
data TableViewState =
TableViewState { tableView :: TableView,
tableExperiment :: Experiment,
tableDir :: FilePath,
tableMap :: M.Map Int FilePath }
newTable :: TableView -> Experiment -> FilePath -> ExperimentWriter TableViewState
newTable view exp dir =
do let n = experimentRunCount exp
fs <- forM [0..(n 1)] $ \i ->
resolveFilePath dir $
mapFilePath (flip replaceExtension ".csv") $
expandFilePath (tableFileName view) $
M.fromList [("$TITLE", tableTitle view),
("$RUN_INDEX", show $ i + 1),
("$RUN_COUNT", show n)]
liftIO $ forM_ fs $ flip writeFile []
let m = M.fromList $ zip [0..(n 1)] fs
return TableViewState { tableView = view,
tableExperiment = exp,
tableDir = dir,
tableMap = m }
simulateTable :: TableViewState -> ExperimentData -> Event DisposableEvent
simulateTable st expdata =
do let view = tableView st
rs = tableSeries view $
tableTransform view $
experimentResults expdata
exts = resultsToStringValues rs
signals = experimentPredefinedSignals expdata
signal = pureResultSignal signals $
resultSignal rs
separator = tableSeparator view
formatter = tableFormatter view
predicate = tablePredicate view
i <- liftParameter simulationIndex
let f = fromJust $ M.lookup (i 1) (tableMap st)
h <- liftIO $ openFile f WriteMode
liftIO $
do forM_ (zip [0..] exts) $ \(column, ext) ->
do when (column > 0) $
hPutStr h separator
hPutStr h $ show $ resultValueName ext
hPutStrLn h ""
d1 <- handleSignal signal $ \t ->
do p <- predicate
when p $
do forM_ (zip [0..] exts) $ \(column, ext) ->
do x <- resultValueData ext
liftIO $
do when (column > 0) $
hPutStr h separator
hPutStr h $ formatter x
liftIO $ hPutStrLn h ""
let d2 =
DisposableEvent $
liftIO $
do when (experimentVerbose $ tableExperiment st) $
putStr "Generated file " >> putStrLn f
hClose h
return $ d1 <> d2
tableHtml :: TableViewState -> Int -> HtmlWriter ()
tableHtml st index =
let n = experimentRunCount $ tableExperiment st
in if n == 1
then tableHtmlSingle st index
else tableHtmlMultiple st index
tableHtmlSingle :: TableViewState -> Int -> HtmlWriter ()
tableHtmlSingle st index =
do header st index
let f = fromJust $ M.lookup 0 (tableMap st)
writeHtmlParagraph $
writeHtmlLink (makeRelative (tableDir st) f) $
writeHtmlText (tableLinkText $ tableView st)
tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter ()
tableHtmlMultiple st index =
do header st index
let n = experimentRunCount $ tableExperiment st
forM_ [0..(n 1)] $ \i ->
do let f = fromJust $ M.lookup i (tableMap st)
sublink =
replace "$RUN_INDEX" (show $ i + 1) $
replace "$RUN_COUNT" (show n) $
replace "$LINK" (tableLinkText $ tableView st)
(tableRunLinkText $ tableView st)
writeHtmlParagraph $
writeHtmlLink (makeRelative (tableDir st) f) $
writeHtmlText sublink
header :: TableViewState -> Int -> HtmlWriter ()
header st index =
do writeHtmlHeader3WithId ("id" ++ show index) $
writeHtmlText (tableTitle $ tableView st)
let description = tableDescription $ tableView st
unless (null description) $
writeHtmlParagraph $
writeHtmlText description
tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()
tableTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (tableTitle $ tableView st)