{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.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.Base.WebPageRenderer
import Simulation.Aivika.Experiment.Base.FileRenderer
import Simulation.Aivika.Experiment.Base.ExperimentWriter
import Simulation.Aivika.Experiment.Base.HtmlWriter
import Simulation.Aivika.Experiment.Utils (replace)
data TableView =
TableView { TableView -> ResultDescription
tableTitle :: String,
TableView -> ResultDescription
tableDescription :: String,
TableView -> ResultDescription
tableLinkText :: String,
TableView -> ResultDescription
tableRunLinkText :: String,
TableView -> ExperimentFilePath
tableFileName :: ExperimentFilePath,
TableView -> ResultDescription
tableSeparator :: String,
TableView -> ShowS
tableFormatter :: ShowS,
TableView -> Event Bool
tablePredicate :: Event Bool,
TableView -> ResultTransform
tableTransform :: ResultTransform,
TableView -> ResultTransform
tableSeries :: ResultTransform,
TableView -> Maybe Int
tableSeriesGridSize :: Maybe Int
}
defaultTableView :: TableView
defaultTableView :: TableView
defaultTableView =
TableView { tableTitle :: ResultDescription
tableTitle = ResultDescription
"Table",
tableDescription :: ResultDescription
tableDescription = ResultDescription
"This section contains the CSV file(s) with the simulation results.",
tableLinkText :: ResultDescription
tableLinkText = ResultDescription
"Download the CSV file",
tableRunLinkText :: ResultDescription
tableRunLinkText = ResultDescription
"$LINK / Run $RUN_INDEX of $RUN_COUNT",
tableFileName :: ExperimentFilePath
tableFileName = ResultDescription -> ExperimentFilePath
UniqueFilePath ResultDescription
"Table($RUN_INDEX).csv",
tableSeparator :: ResultDescription
tableSeparator = ResultDescription
",",
tableFormatter :: ShowS
tableFormatter = forall a. a -> a
id,
tablePredicate :: Event Bool
tablePredicate = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
tableTransform :: ResultTransform
tableTransform = ResultTransform
expandResults,
tableSeries :: ResultTransform
tableSeries = forall a. a -> a
id,
tableSeriesGridSize :: Maybe Int
tableSeriesGridSize = forall a. Maybe a
Nothing }
instance ExperimentView TableView (WebPageRenderer a) where
outputView :: TableView -> ExperimentGenerator (WebPageRenderer a)
outputView TableView
v =
let reporter :: Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer ResultDescription
dir =
do TableViewState
st <- TableView
-> Experiment
-> ResultDescription
-> ExperimentWriter TableViewState
newTable TableView
v Experiment
exp ResultDescription
dir
let context :: ExperimentContext (WebPageRenderer a)
context =
forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext forall a b. (a -> b) -> a -> b
$
WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter ()
reporterWriteTOCHtml = TableViewState -> Int -> HtmlWriter ()
tableTOCHtml TableViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = TableViewState -> Int -> HtmlWriter ()
tableHtml TableViewState
st }
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = TableViewState -> ExperimentData -> Composite ()
simulateTable TableViewState
st,
reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext = forall {a}. ExperimentContext (WebPageRenderer a)
context }
in ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
(WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
generateReporter = forall {p} {a}.
Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
instance ExperimentView TableView (FileRenderer a) where
outputView :: TableView -> ExperimentGenerator (FileRenderer a)
outputView TableView
v =
let reporter :: Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp p
renderer ResultDescription
dir =
do TableViewState
st <- TableView
-> Experiment
-> ResultDescription
-> ExperimentWriter TableViewState
newTable TableView
v Experiment
exp ResultDescription
dir
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (FileRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterFinalise :: ExperimentMonad (FileRenderer a) ()
reporterFinalise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = TableViewState -> ExperimentData -> Composite ()
simulateTable TableViewState
st,
reporterContext :: ExperimentContext (FileRenderer a)
reporterContext = forall a. ExperimentContext (FileRenderer a)
FileContext }
in ExperimentGenerator { generateReporter :: Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad
(FileRenderer a) (ExperimentReporter (FileRenderer a))
generateReporter = forall {p} {a}.
Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter }
data TableViewState =
TableViewState { TableViewState -> TableView
tableView :: TableView,
TableViewState -> Experiment
tableExperiment :: Experiment,
TableViewState -> ResultDescription
tableDir :: FilePath,
TableViewState -> Map Int ResultDescription
tableMap :: M.Map Int FilePath }
newTable :: TableView -> Experiment -> FilePath -> ExperimentWriter TableViewState
newTable :: TableView
-> Experiment
-> ResultDescription
-> ExperimentWriter TableViewState
newTable TableView
view Experiment
exp ResultDescription
dir =
do let n :: Int
n = Experiment -> Int
experimentRunCount Experiment
exp
[ResultDescription]
fs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i ->
ResultDescription
-> ExperimentFilePath -> ExperimentWriter ResultDescription
resolveFilePath ResultDescription
dir forall a b. (a -> b) -> a -> b
$
ShowS -> ExperimentFilePath -> ExperimentFilePath
mapFilePath (forall a b c. (a -> b -> c) -> b -> a -> c
flip ResultDescription -> ShowS
replaceExtension ResultDescription
".csv") forall a b. (a -> b) -> a -> b
$
ExperimentFilePath
-> Map ResultDescription ResultDescription -> ExperimentFilePath
expandFilePath (TableView -> ExperimentFilePath
tableFileName TableView
view) forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ResultDescription
"$TITLE", TableView -> ResultDescription
tableTitle TableView
view),
(ResultDescription
"$RUN_INDEX", forall a. Show a => a -> ResultDescription
show forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1),
(ResultDescription
"$RUN_COUNT", forall a. Show a => a -> ResultDescription
show Int
n)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ResultDescription]
fs forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip ResultDescription -> ResultDescription -> IO ()
writeFile []
let m :: Map Int ResultDescription
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] [ResultDescription]
fs
forall (m :: * -> *) a. Monad m => a -> m a
return TableViewState { tableView :: TableView
tableView = TableView
view,
tableExperiment :: Experiment
tableExperiment = Experiment
exp,
tableDir :: ResultDescription
tableDir = ResultDescription
dir,
tableMap :: Map Int ResultDescription
tableMap = Map Int ResultDescription
m }
simulateTable :: TableViewState -> ExperimentData -> Composite ()
simulateTable :: TableViewState -> ExperimentData -> Composite ()
simulateTable TableViewState
st ExperimentData
expdata =
do let view :: TableView
view = TableViewState -> TableView
tableView TableViewState
st
rs :: Results
rs = TableView -> ResultTransform
tableSeries TableView
view forall a b. (a -> b) -> a -> b
$
TableView -> ResultTransform
tableTransform TableView
view forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
loc :: [ResultId] -> ResultDescription
loc = ResultLocalisation -> [ResultId] -> ResultDescription
localisePathResultTitle forall a b. (a -> b) -> a -> b
$
Experiment -> ResultLocalisation
experimentLocalisation forall a b. (a -> b) -> a -> b
$
TableViewState -> Experiment
tableExperiment TableViewState
st
exts :: [ResultValue ResultDescription]
exts = Results -> [ResultValue ResultDescription]
resultsToStringValues Results
rs
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
separator :: ResultDescription
separator = TableView -> ResultDescription
tableSeparator TableView
view
formatter :: ShowS
formatter = TableView -> ShowS
tableFormatter TableView
view
predicate :: Event Bool
predicate = TableView -> Event Bool
tablePredicate TableView
view
Int
i <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
Signal ()
signal <-
case TableView -> Maybe Int
tableSeriesGridSize TableView
view of
Just Int
m ->
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> Signal a -> Signal b
mapSignal forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ()) forall a b. (a -> b) -> a -> b
$
Int -> Event (Signal Int)
newSignalInTimeGrid Int
m
Maybe Int
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
ResultPredefinedSignals -> ResultSignal -> Signal ()
pureResultSignal ResultPredefinedSignals
signals forall a b. (a -> b) -> a -> b
$
Results -> ResultSignal
resultSignal Results
rs
let f :: ResultDescription
f = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
i forall a. Num a => a -> a -> a
- Int
1) (TableViewState -> Map Int ResultDescription
tableMap TableViewState
st)
Handle
h <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ResultDescription -> IOMode -> IO Handle
openFile ResultDescription
f IOMode
WriteMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [ResultValue ResultDescription]
exts) forall a b. (a -> b) -> a -> b
$ \(Integer
column, ResultValue ResultDescription
ext) ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
column forall a. Ord a => a -> a -> Bool
> Integer
0) forall a b. (a -> b) -> a -> b
$
Handle -> ResultDescription -> IO ()
hPutStr Handle
h ResultDescription
separator
Handle -> ResultDescription -> IO ()
hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> ResultDescription
show forall a b. (a -> b) -> a -> b
$ [ResultId] -> ResultDescription
loc forall a b. (a -> b) -> a -> b
$ forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue ResultDescription
ext
Handle -> ResultDescription -> IO ()
hPutStrLn Handle
h ResultDescription
""
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal ()
signal forall a b. (a -> b) -> a -> b
$ \()
t ->
do Bool
p <- Event Bool
predicate
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
p forall a b. (a -> b) -> a -> b
$
do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [ResultValue ResultDescription]
exts) forall a b. (a -> b) -> a -> b
$ \(Integer
column, ResultValue ResultDescription
ext) ->
do ResultDescription
x <- forall e. ResultValue e -> ResultData e
resultValueData ResultValue ResultDescription
ext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
column forall a. Ord a => a -> a -> Bool
> Integer
0) forall a b. (a -> b) -> a -> b
$
Handle -> ResultDescription -> IO ()
hPutStr Handle
h ResultDescription
separator
Handle -> ResultDescription -> IO ()
hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ ShowS
formatter ResultDescription
x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> ResultDescription -> IO ()
hPutStrLn Handle
h ResultDescription
""
DisposableEvent -> Composite ()
disposableComposite forall a b. (a -> b) -> a -> b
$
Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose forall a b. (a -> b) -> a -> b
$ TableViewState -> Experiment
tableExperiment TableViewState
st) forall a b. (a -> b) -> a -> b
$
ResultDescription -> IO ()
putStr ResultDescription
"Generated file " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResultDescription -> IO ()
putStrLn ResultDescription
f
Handle -> IO ()
hClose Handle
h
tableHtml :: TableViewState -> Int -> HtmlWriter ()
tableHtml :: TableViewState -> Int -> HtmlWriter ()
tableHtml TableViewState
st Int
index =
let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ TableViewState -> Experiment
tableExperiment TableViewState
st
in if Int
n forall a. Eq a => a -> a -> Bool
== Int
1
then TableViewState -> Int -> HtmlWriter ()
tableHtmlSingle TableViewState
st Int
index
else TableViewState -> Int -> HtmlWriter ()
tableHtmlMultiple TableViewState
st Int
index
tableHtmlSingle :: TableViewState -> Int -> HtmlWriter ()
tableHtmlSingle :: TableViewState -> Int -> HtmlWriter ()
tableHtmlSingle TableViewState
st Int
index =
do TableViewState -> Int -> HtmlWriter ()
header TableViewState
st Int
index
let f :: ResultDescription
f = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
0 (TableViewState -> Map Int ResultDescription
tableMap TableViewState
st)
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription -> ShowS
makeRelative (TableViewState -> ResultDescription
tableDir TableViewState
st) ResultDescription
f) forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter ()
writeHtmlText (TableView -> ResultDescription
tableLinkText forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter ()
tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter ()
tableHtmlMultiple TableViewState
st Int
index =
do TableViewState -> Int -> HtmlWriter ()
header TableViewState
st Int
index
let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ TableViewState -> Experiment
tableExperiment TableViewState
st
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i ->
do let f :: ResultDescription
f = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
i (TableViewState -> Map Int ResultDescription
tableMap TableViewState
st)
sublink :: ResultDescription
sublink =
ResultDescription -> ResultDescription -> ShowS
replace ResultDescription
"$RUN_INDEX" (forall a. Show a => a -> ResultDescription
show forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$
ResultDescription -> ResultDescription -> ShowS
replace ResultDescription
"$RUN_COUNT" (forall a. Show a => a -> ResultDescription
show Int
n) forall a b. (a -> b) -> a -> b
$
ResultDescription -> ResultDescription -> ShowS
replace ResultDescription
"$LINK" (TableView -> ResultDescription
tableLinkText forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
(TableView -> ResultDescription
tableRunLinkText forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription -> ShowS
makeRelative (TableViewState -> ResultDescription
tableDir TableViewState
st) ResultDescription
f) forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
sublink
header :: TableViewState -> Int -> HtmlWriter ()
TableViewState
st Int
index =
do ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (ResultDescription
"id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ResultDescription
show Int
index) forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter ()
writeHtmlText (TableView -> ResultDescription
tableTitle forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
let description :: ResultDescription
description = TableView -> ResultDescription
tableDescription forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultDescription
description) forall a b. (a -> b) -> a -> b
$
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
description
tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()
tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()
tableTOCHtml TableViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription
"#id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ResultDescription
show Int
index) forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter ()
writeHtmlText (TableView -> ResultDescription
tableTitle forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)