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 System.IO
import System.FilePath
import Data.String.Utils (replace)
import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Dynamics.Simulation
import Simulation.Aivika.Dynamics.Signal
import Simulation.Aivika.Dynamics.EventQueue
import Simulation.Aivika.Dynamics.Base
data TableView =
TableView { tableTitle :: String,
tableDescription :: String,
tableLinkText :: String,
tableRunLinkText :: String,
tableFileName :: FileName,
tableSeparator :: String,
tableFormatter :: ShowS,
tablePredicate :: Dynamics Bool,
tableSeries :: [String]
}
defaultTableView :: TableView
defaultTableView =
TableView { tableTitle = "Table",
tableDescription = [],
tableLinkText = "Download the CSV file",
tableRunLinkText = "$LINK / Run $RUN_INDEX of $RUN_COUNT",
tableFileName = UniqueFileName "$TITLE - $RUN_INDEX" ".csv",
tableSeparator = ",",
tableFormatter = id,
tablePredicate = return True,
tableSeries = [] }
instance View TableView where
outputView v =
let reporter exp dir =
do st <- newTable v exp dir
return Reporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTable st,
reporterTOCHtml = tableTOCHtml st,
reporterHtml = tableHtml st }
in Generator { generateReporter = reporter }
data TableViewState =
TableViewState { tableView :: TableView,
tableExperiment :: Experiment,
tableDir :: FilePath,
tableMap :: M.Map Int FilePath }
newTable :: TableView -> Experiment -> FilePath -> IO TableViewState
newTable view exp dir =
do let n = experimentRunCount exp
fs <- forM [0..(n 1)] $ \i ->
resolveFileName (Just dir) (tableFileName view) $
M.fromList [("$TITLE", tableTitle view),
("$RUN_INDEX", show $ i + 1),
("$RUN_COUNT", show n)]
let m = M.fromList $ zip [0..(n 1)] fs
return TableViewState { tableView = view,
tableExperiment = exp,
tableDir = dir,
tableMap = m }
simulateTable :: TableViewState -> ExperimentData -> Dynamics (Dynamics ())
simulateTable st expdata =
do let labels = tableSeries $ tableView st
providers = experimentSeriesProviders expdata labels
input =
flip map providers $ \provider ->
case providerToString provider of
Nothing -> error $
"Cannot represent series " ++
providerName provider ++
" as a string: simulateTable"
Just input -> input
separator = tableSeparator $ tableView st
formatter = tableFormatter $ tableView st
predicate = tablePredicate $ tableView st
i <- liftSimulation simulationIndex
let f = fromJust $ M.lookup (i 1) (tableMap st)
h <- liftIO $ openFile f WriteMode
liftIO $
do forM_ (zip [0..] providers) $ \(column, provider) ->
do when (column > 0) $
hPutStr h separator
hPutStr h $ providerName provider
hPutStrLn h ""
t <- time
enqueue (experimentQueue expdata) t $
handleSignal_ (experimentMixedSignal expdata providers) $ \t ->
do p <- predicate
when p $
do forM_ (zip [0..] input) $ \(column, input) ->
do x <- input
liftIO $
do when (column > 0) $
hPutStr h separator
hPutStr h $ formatter x
liftIO $ hPutStrLn h ""
return $
liftIO $
do when (experimentVerbose $ tableExperiment st) $
putStr "Generated file " >> putStrLn f
hClose h
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)