{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Base.TableView
-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines 'TableView' that saves the simulation
-- results in the CSV file(s).
--

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)

-- | Defines the 'View' that saves the simulation results
-- in the CSV file(s).
data TableView =
  TableView { TableView -> ResultDescription
tableTitle       :: String,
              -- ^ This is a title used in HTML.
              TableView -> ResultDescription
tableDescription :: String,
              -- ^ This is a description in the HTML.
              TableView -> ResultDescription
tableLinkText    :: String,
              -- ^ It specifies the text for the link 
              -- which is displayed in the HTML page
              -- if there is only one simulation run. 
              -- The link downloads the corresponded 
              -- CSV file in the browser. If there are
              -- more simulation runs, then this link 
              -- is not shown.
              --
              -- An example is
              --
              -- @
              --   tableLinkText = \"Download the CSV file\"
              -- @
              TableView -> ResultDescription
tableRunLinkText :: String,
              -- ^ It specifies the link text which is 
              -- displayed in the HTML page if there are 
              -- many simulation runs. Such a link downloads 
              -- the CSV file for the corresponded run. 
              -- To define the text, you can use special 
              -- variables @$LINK@, @$RUN_INDEX@ and @$RUN_COUNT@.
              --
              -- An example is 
              -- 
              -- @
              --   tableRunLinkText = \"$LINK / Run $RUN_INDEX of $RUN_COUNT\"
              -- @
              -- 
              -- If there is only one run, then the link of 
              -- this kind is not displayed. Instead, only one 
              -- link is shown, which text is defined by the 
              -- 'tableLinkText' field.
              TableView -> ExperimentFilePath
tableFileName    :: ExperimentFilePath,
              -- ^ It defines the file name for each CSV file. 
              -- It may include special variables @$TITLE@, 
              -- @$RUN_INDEX@ and @$RUN_COUNT@.
              --
              -- An example is
              --
              -- @
              --   tableFileName = UniqueFilePath \"$TITLE - $RUN_INDEX.csv\"
              -- @
              TableView -> ResultDescription
tableSeparator   :: String,
              -- ^ It defines the separator for the view. 
              -- It delimits the cells in the rows of the CSV file.
              TableView -> ShowS
tableFormatter   :: ShowS,
              -- ^ It defines the formatter which is applied
              -- to all values before they will be written
              -- in the CSV file(s).
              TableView -> Event Bool
tablePredicate   :: Event Bool,
              -- ^ It specifies the predicate that defines
              -- when we can save data in the table.
              TableView -> ResultTransform
tableTransform   :: ResultTransform,
              -- ^ The transform applied to the results before receiving series.
              TableView -> ResultTransform
tableSeries      :: ResultTransform, 
              -- ^ It defines the series to save in the CSV file(s).
              TableView -> Maybe Int
tableSeriesGridSize :: Maybe Int
              -- ^ The size of the grid, where the series data are saved.
            }
  
-- | The default table view.  
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   = ShowS
forall a. a -> a
id,
              tablePredicate :: Event Bool
tablePredicate   = Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
              tableTransform :: ResultTransform
tableTransform   = ResultTransform
expandResults,
              tableSeries :: ResultTransform
tableSeries      = ResultTransform
forall a. a -> a
id,
              tableSeriesGridSize :: Maybe Int
tableSeriesGridSize = Maybe Int
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 =
                   WebPageWriter -> ExperimentContext (WebPageRenderer a)
forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext (WebPageWriter -> ExperimentContext (WebPageRenderer a))
-> WebPageWriter -> ExperimentContext (WebPageRenderer a)
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 }
             ExperimentReporter (WebPageRenderer a)
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = () -> ExperimentWriter ()
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise   = () -> ExperimentWriter ()
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = TableViewState -> ExperimentData -> Composite ()
simulateTable TableViewState
st,
                                         reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext    = ExperimentContext (WebPageRenderer a)
forall {a}. ExperimentContext (WebPageRenderer a)
context }
    in ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
generateReporter = Experiment
-> WebPageRenderer a
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
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
             ExperimentReporter (FileRenderer a)
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (FileRenderer a) ()
reporterInitialise = () -> ExperimentWriter ()
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterFinalise :: ExperimentMonad (FileRenderer a) ()
reporterFinalise   = () -> ExperimentWriter ()
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = TableViewState -> ExperimentData -> Composite ()
simulateTable TableViewState
st,
                                         reporterContext :: ExperimentContext (FileRenderer a)
reporterContext    = ExperimentContext (FileRenderer a)
forall a. ExperimentContext (FileRenderer a)
FileContext }
    in ExperimentGenerator { generateReporter :: Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad
     (FileRenderer a) (ExperimentReporter (FileRenderer a))
generateReporter = Experiment
-> FileRenderer a
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad
     (FileRenderer a) (ExperimentReporter (FileRenderer a))
forall {p} {a}.
Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter }
  
-- | The state of the view.
data TableViewState =
  TableViewState { TableViewState -> TableView
tableView       :: TableView,
                   TableViewState -> Experiment
tableExperiment :: Experiment,
                   TableViewState -> ResultDescription
tableDir        :: FilePath, 
                   TableViewState -> Map Int ResultDescription
tableMap        :: M.Map Int FilePath }
  
-- | Create a new state of the view.
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 <- [Int]
-> (Int -> ExperimentWriter ResultDescription)
-> ExperimentWriter [ResultDescription]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> ExperimentWriter ResultDescription)
 -> ExperimentWriter [ResultDescription])
-> (Int -> ExperimentWriter ResultDescription)
-> ExperimentWriter [ResultDescription]
forall a b. (a -> b) -> a -> b
$ \Int
i ->
       ResultDescription
-> ExperimentFilePath -> ExperimentWriter ResultDescription
resolveFilePath ResultDescription
dir (ExperimentFilePath -> ExperimentWriter ResultDescription)
-> ExperimentFilePath -> ExperimentWriter ResultDescription
forall a b. (a -> b) -> a -> b
$
       ShowS -> ExperimentFilePath -> ExperimentFilePath
mapFilePath ((ResultDescription -> ShowS) -> ResultDescription -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ResultDescription -> ShowS
replaceExtension ResultDescription
".csv") (ExperimentFilePath -> ExperimentFilePath)
-> ExperimentFilePath -> ExperimentFilePath
forall a b. (a -> b) -> a -> b
$
       ExperimentFilePath
-> Map ResultDescription ResultDescription -> ExperimentFilePath
expandFilePath (TableView -> ExperimentFilePath
tableFileName TableView
view) (Map ResultDescription ResultDescription -> ExperimentFilePath)
-> Map ResultDescription ResultDescription -> ExperimentFilePath
forall a b. (a -> b) -> a -> b
$
       [(ResultDescription, ResultDescription)]
-> Map ResultDescription ResultDescription
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ResultDescription
"$TITLE", TableView -> ResultDescription
tableTitle TableView
view),
                   (ResultDescription
"$RUN_INDEX", Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show (Int -> ResultDescription) -> Int -> ResultDescription
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1),
                   (ResultDescription
"$RUN_COUNT", Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show Int
n)]
     IO () -> ExperimentWriter ()
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExperimentWriter ()) -> IO () -> ExperimentWriter ()
forall a b. (a -> b) -> a -> b
$ [ResultDescription] -> (ResultDescription -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ResultDescription]
fs ((ResultDescription -> IO ()) -> IO ())
-> (ResultDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (ResultDescription -> ResultDescription -> IO ())
-> ResultDescription -> ResultDescription -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ResultDescription -> ResultDescription -> IO ()
writeFile []  -- reserve the file names
     let m :: Map Int ResultDescription
m = [(Int, ResultDescription)] -> Map Int ResultDescription
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, ResultDescription)] -> Map Int ResultDescription)
-> [(Int, ResultDescription)] -> Map Int ResultDescription
forall a b. (a -> b) -> a -> b
$ [Int] -> [ResultDescription] -> [(Int, ResultDescription)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] [ResultDescription]
fs
     TableViewState -> ExperimentWriter TableViewState
forall a. a -> ExperimentWriter a
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 }
       
-- | Write the tables during the simulation.
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 ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
                   TableView -> ResultTransform
tableTransform TableView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         loc :: [ResultId] -> ResultDescription
loc     = ResultLocalisation -> [ResultId] -> ResultDescription
localisePathResultTitle (ResultLocalisation -> [ResultId] -> ResultDescription)
-> ResultLocalisation -> [ResultId] -> ResultDescription
forall a b. (a -> b) -> a -> b
$
                   Experiment -> ResultLocalisation
experimentLocalisation (Experiment -> ResultLocalisation)
-> Experiment -> ResultLocalisation
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 <- Parameter Int -> Composite Int
forall a. Parameter a -> Composite a
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 ->
           Event (Signal ()) -> Composite (Signal ())
forall a. Event a -> Composite a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event (Signal ()) -> Composite (Signal ()))
-> Event (Signal ()) -> Composite (Signal ())
forall a b. (a -> b) -> a -> b
$
           (Signal Int -> Signal ())
-> Event (Signal Int) -> Event (Signal ())
forall a b. (a -> b) -> Event a -> Event b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal ((Int -> ()) -> Signal Int -> Signal ())
-> (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ () -> Int -> ()
forall a b. a -> b -> a
const ()) (Event (Signal Int) -> Event (Signal ()))
-> Event (Signal Int) -> Event (Signal ())
forall a b. (a -> b) -> a -> b
$
           Int -> Event (Signal Int)
newSignalInTimeGrid Int
m
         Maybe Int
Nothing ->
           Signal () -> Composite (Signal ())
forall a. a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signal () -> Composite (Signal ()))
-> Signal () -> Composite (Signal ())
forall a b. (a -> b) -> a -> b
$
           ResultPredefinedSignals -> ResultSignal -> Signal ()
pureResultSignal ResultPredefinedSignals
signals (ResultSignal -> Signal ()) -> ResultSignal -> Signal ()
forall a b. (a -> b) -> a -> b
$
           Results -> ResultSignal
resultSignal Results
rs
     -- create a new file
     let f :: ResultDescription
f = Maybe ResultDescription -> ResultDescription
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ResultDescription -> ResultDescription)
-> Maybe ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ Int -> Map Int ResultDescription -> Maybe ResultDescription
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (TableViewState -> Map Int ResultDescription
tableMap TableViewState
st)
     Handle
h <- IO Handle -> Composite Handle
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> Composite Handle) -> IO Handle -> Composite Handle
forall a b. (a -> b) -> a -> b
$ ResultDescription -> IOMode -> IO Handle
openFile ResultDescription
f IOMode
WriteMode
     -- write a header
     IO () -> Composite ()
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Composite ()) -> IO () -> Composite ()
forall a b. (a -> b) -> a -> b
$
       do [(Integer, ResultValue ResultDescription)]
-> ((Integer, ResultValue ResultDescription) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Integer]
-> [ResultValue ResultDescription]
-> [(Integer, ResultValue ResultDescription)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [ResultValue ResultDescription]
exts) (((Integer, ResultValue ResultDescription) -> IO ()) -> IO ())
-> ((Integer, ResultValue ResultDescription) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Integer
column, ResultValue ResultDescription
ext) ->
            do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
column Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
                 Handle -> ResultDescription -> IO ()
hPutStr Handle
h ResultDescription
separator
               Handle -> ResultDescription -> IO ()
hPutStr Handle
h (ResultDescription -> IO ()) -> ResultDescription -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> ResultDescription
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [ResultId] -> ResultDescription
loc ([ResultId] -> ResultDescription)
-> [ResultId] -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultValue ResultDescription -> [ResultId]
forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue ResultDescription
ext
          Handle -> ResultDescription -> IO ()
hPutStrLn Handle
h ResultDescription
""
     Signal () -> (() -> Event ()) -> Composite ()
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal ()
signal ((() -> Event ()) -> Composite ())
-> (() -> Event ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \()
t ->
       do Bool
p <- Event Bool
predicate
          Bool -> Event () -> Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
p (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
            do [(Integer, ResultValue ResultDescription)]
-> ((Integer, ResultValue ResultDescription) -> Event ())
-> Event ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Integer]
-> [ResultValue ResultDescription]
-> [(Integer, ResultValue ResultDescription)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [ResultValue ResultDescription]
exts) (((Integer, ResultValue ResultDescription) -> Event ())
 -> Event ())
-> ((Integer, ResultValue ResultDescription) -> Event ())
-> Event ()
forall a b. (a -> b) -> a -> b
$ \(Integer
column, ResultValue ResultDescription
ext) ->  -- write the row
                 do ResultDescription
x <- ResultValue ResultDescription -> ResultData ResultDescription
forall e. ResultValue e -> ResultData e
resultValueData ResultValue ResultDescription
ext               -- write the column
                    IO () -> Event ()
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
                      do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
column Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
                           Handle -> ResultDescription -> IO ()
hPutStr Handle
h ResultDescription
separator
                         Handle -> ResultDescription -> IO ()
hPutStr Handle
h (ResultDescription -> IO ()) -> ResultDescription -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
formatter ResultDescription
x
               IO () -> Event ()
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ Handle -> ResultDescription -> IO ()
hPutStrLn Handle
h ResultDescription
""
     DisposableEvent -> Composite ()
disposableComposite (DisposableEvent -> Composite ())
-> DisposableEvent -> Composite ()
forall a b. (a -> b) -> a -> b
$
       Event () -> DisposableEvent
DisposableEvent (Event () -> DisposableEvent) -> Event () -> DisposableEvent
forall a b. (a -> b) -> a -> b
$
       IO () -> Event ()
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
       do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose (Experiment -> Bool) -> Experiment -> Bool
forall a b. (a -> b) -> a -> b
$ TableViewState -> Experiment
tableExperiment TableViewState
st) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            ResultDescription -> IO ()
putStr ResultDescription
"Generated file " IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ResultDescription -> IO ()
putStrLn ResultDescription
f
          Handle -> IO ()
hClose Handle
h  -- close the file
     
-- | Get the HTML code.     
tableHtml :: TableViewState -> Int -> HtmlWriter ()     
tableHtml :: TableViewState -> Int -> HtmlWriter ()
tableHtml TableViewState
st Int
index =
  let n :: Int
n = Experiment -> Int
experimentRunCount (Experiment -> Int) -> Experiment -> Int
forall a b. (a -> b) -> a -> b
$ TableViewState -> Experiment
tableExperiment TableViewState
st
  in if Int
n Int -> Int -> Bool
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
     
-- | Get the HTML code for a single run.
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 = Maybe ResultDescription -> ResultDescription
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ResultDescription -> ResultDescription)
-> Maybe ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ Int -> Map Int ResultDescription -> Maybe ResultDescription
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 (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
       ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription -> ShowS
makeRelative (TableViewState -> ResultDescription
tableDir TableViewState
st) ResultDescription
f) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
       ResultDescription -> HtmlWriter ()
writeHtmlText (TableView -> ResultDescription
tableLinkText (TableView -> ResultDescription) -> TableView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)

-- | Get the HTML code for multiple runs
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 (Experiment -> Int) -> Experiment -> Int
forall a b. (a -> b) -> a -> b
$ TableViewState -> Experiment
tableExperiment TableViewState
st
     [Int] -> (Int -> HtmlWriter ()) -> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> HtmlWriter ()) -> HtmlWriter ())
-> (Int -> HtmlWriter ()) -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
       do let f :: ResultDescription
f = Maybe ResultDescription -> ResultDescription
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ResultDescription -> ResultDescription)
-> Maybe ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ Int -> Map Int ResultDescription -> Maybe ResultDescription
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" (Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show (Int -> ResultDescription) -> Int -> ResultDescription
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                ResultDescription -> ResultDescription -> ShowS
replace ResultDescription
"$RUN_COUNT" (Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show Int
n) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                ResultDescription -> ResultDescription -> ShowS
replace ResultDescription
"$LINK" (TableView -> ResultDescription
tableLinkText (TableView -> ResultDescription) -> TableView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
                (TableView -> ResultDescription
tableRunLinkText (TableView -> ResultDescription) -> TableView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
          HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
            ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription -> ShowS
makeRelative (TableViewState -> ResultDescription
tableDir TableViewState
st) ResultDescription
f) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
            ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
sublink

header :: TableViewState -> Int -> HtmlWriter ()
header :: TableViewState -> Int -> HtmlWriter ()
header TableViewState
st Int
index =
  do ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (ResultDescription
"id" ResultDescription -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ 
       ResultDescription -> HtmlWriter ()
writeHtmlText (TableView -> ResultDescription
tableTitle (TableView -> ResultDescription) -> TableView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)
     let description :: ResultDescription
description = TableView -> ResultDescription
tableDescription (TableView -> ResultDescription) -> TableView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st
     Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ResultDescription -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultDescription
description) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
       HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ 
       ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
description

-- | Get the TOC item     
tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()
tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()
tableTOCHtml TableViewState
st Int
index =
  HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
  ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription
"#id" ResultDescription -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
  ResultDescription -> HtmlWriter ()
writeHtmlText (TableView -> ResultDescription
tableTitle (TableView -> ResultDescription) -> TableView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ TableViewState -> TableView
tableView TableViewState
st)