{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.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
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.Concurrent.MVar
data FinalTableView =
FinalTableView { FinalTableView -> String
finalTableTitle :: String,
FinalTableView -> String
finalTableDescription :: String,
FinalTableView -> String
finalTableRunText :: String,
FinalTableView -> String
finalTableLinkText :: String,
FinalTableView -> ExperimentFilePath
finalTableFileName :: ExperimentFilePath,
FinalTableView -> String
finalTableSeparator :: String,
FinalTableView -> ShowS
finalTableFormatter :: ShowS,
FinalTableView -> Event Bool
finalTablePredicate :: Event Bool,
FinalTableView -> ResultTransform
finalTableTransform :: ResultTransform,
FinalTableView -> ResultTransform
finalTableSeries :: ResultTransform
}
defaultFinalTableView :: FinalTableView
defaultFinalTableView :: FinalTableView
defaultFinalTableView =
FinalTableView { finalTableTitle :: String
finalTableTitle = String
"Final Table",
finalTableDescription :: String
finalTableDescription = String
"It refers to the CSV file with the results in the final time points.",
finalTableRunText :: String
finalTableRunText = String
"Run",
finalTableLinkText :: String
finalTableLinkText = String
"Download the CSV file",
finalTableFileName :: ExperimentFilePath
finalTableFileName = String -> ExperimentFilePath
UniqueFilePath String
"FinalTable.csv",
finalTableSeparator :: String
finalTableSeparator = String
",",
finalTableFormatter :: ShowS
finalTableFormatter = forall a. a -> a
id,
finalTablePredicate :: Event Bool
finalTablePredicate = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
finalTableTransform :: ResultTransform
finalTableTransform = ResultTransform
expandResults,
finalTableSeries :: ResultTransform
finalTableSeries = forall a. a -> a
id }
instance ExperimentView FinalTableView (WebPageRenderer a) where
outputView :: FinalTableView -> ExperimentGenerator (WebPageRenderer a)
outputView FinalTableView
v =
let reporter :: Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer String
dir =
do FinalTableViewState
st <- FinalTableView
-> Experiment -> String -> ExperimentWriter FinalTableViewState
newFinalTable FinalTableView
v Experiment
exp String
dir
let context :: ExperimentContext (WebPageRenderer a)
context =
forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext
WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter ()
reporterWriteTOCHtml = FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml FinalTableViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = FinalTableViewState -> Int -> HtmlWriter ()
finalTableHtml FinalTableViewState
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 = FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable FinalTableViewState
st,
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable FinalTableViewState
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
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
instance ExperimentView FinalTableView (FileRenderer a) where
outputView :: FinalTableView -> ExperimentGenerator (FileRenderer a)
outputView FinalTableView
v =
let reporter :: Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp p
renderer String
dir =
do FinalTableViewState
st <- FinalTableView
-> Experiment -> String -> ExperimentWriter FinalTableViewState
newFinalTable FinalTableView
v Experiment
exp String
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 = FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable FinalTableViewState
st,
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable FinalTableViewState
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
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter }
data FinalTableViewState =
FinalTableViewState { FinalTableViewState -> FinalTableView
finalTableView :: FinalTableView,
FinalTableViewState -> Experiment
finalTableExperiment :: Experiment,
FinalTableViewState -> String
finalTableDir :: FilePath,
FinalTableViewState -> IORef (Maybe String)
finalTableFile :: IORef (Maybe FilePath),
FinalTableViewState -> MVar (Maybe FinalTableResults)
finalTableResults :: MVar (Maybe FinalTableResults) }
data FinalTableResults =
FinalTableResults { FinalTableResults -> [String]
finalTableNames :: [String],
FinalTableResults -> MVar (Map Int [String])
finalTableValues :: MVar (M.Map Int [String]) }
newFinalTable :: FinalTableView -> Experiment -> FilePath -> ExperimentWriter FinalTableViewState
newFinalTable :: FinalTableView
-> Experiment -> String -> ExperimentWriter FinalTableViewState
newFinalTable FinalTableView
view Experiment
exp String
dir =
do IORef (Maybe String)
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
MVar (Maybe FinalTableResults)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return FinalTableViewState { finalTableView :: FinalTableView
finalTableView = FinalTableView
view,
finalTableExperiment :: Experiment
finalTableExperiment = Experiment
exp,
finalTableDir :: String
finalTableDir = String
dir,
finalTableFile :: IORef (Maybe String)
finalTableFile = IORef (Maybe String)
f,
finalTableResults :: MVar (Maybe FinalTableResults)
finalTableResults = MVar (Maybe FinalTableResults)
r }
newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults
newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults
newFinalTableResults [String]
names Experiment
exp =
do MVar (Map Int [String])
values <- forall a. a -> IO (MVar a)
newMVar forall k a. Map k a
M.empty
forall (m :: * -> *) a. Monad m => a -> m a
return FinalTableResults { finalTableNames :: [String]
finalTableNames = [String]
names,
finalTableValues :: MVar (Map Int [String])
finalTableValues = MVar (Map Int [String])
values }
requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults
requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults
requireFinalTableResults FinalTableViewState
st [String]
names =
forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (FinalTableViewState -> MVar (Maybe FinalTableResults)
finalTableResults FinalTableViewState
st)
([String] -> Experiment -> IO FinalTableResults
newFinalTableResults [String]
names (FinalTableViewState -> Experiment
finalTableExperiment FinalTableViewState
st)) forall a b. (a -> b) -> a -> b
$ \FinalTableResults
results ->
if ([String]
names forall a. Eq a => a -> a -> Bool
/= FinalTableResults -> [String]
finalTableNames FinalTableResults
results)
then forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireFinalTableResults"
else forall (m :: * -> *) a. Monad m => a -> m a
return FinalTableResults
results
simulateFinalTable :: FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable :: FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable FinalTableViewState
st ExperimentData
expdata =
do let view :: FinalTableView
view = FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st
rs :: Results
rs = FinalTableView -> ResultTransform
finalTableSeries FinalTableView
view forall a b. (a -> b) -> a -> b
$
FinalTableView -> ResultTransform
finalTableTransform FinalTableView
view forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
loc :: [ResultId] -> String
loc = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle forall a b. (a -> b) -> a -> b
$
Experiment -> ResultLocalisation
experimentLocalisation forall a b. (a -> b) -> a -> b
$
FinalTableViewState -> Experiment
finalTableExperiment FinalTableViewState
st
exts :: [ResultValue String]
exts = Results -> [ResultValue String]
resultsToStringValues Results
rs
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
signal :: Signal Double
signal = forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (forall a b. a -> b -> a
const Event Bool
predicate) forall a b. (a -> b) -> a -> b
$
ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
names :: [String]
names = forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue String]
exts
predicate :: Event Bool
predicate = FinalTableView -> Event Bool
finalTablePredicate FinalTableView
view
FinalTableResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> [String] -> IO FinalTableResults
requireFinalTableResults FinalTableViewState
st [String]
names
let values :: MVar (Map Int [String])
values = FinalTableResults -> MVar (Map Int [String])
finalTableValues FinalTableResults
results
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal forall a b. (a -> b) -> a -> b
$ \Double
_ ->
do [String]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall e. ResultValue e -> ResultData e
resultValueData [ResultValue String]
exts
Int
i <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map Int [String])
values forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
i [String]
xs
finaliseFinalTable :: FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable :: FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable FinalTableViewState
st =
do let view :: FinalTableView
view = FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st
run :: String
run = FinalTableView -> String
finalTableRunText FinalTableView
view
formatter :: ShowS
formatter = FinalTableView -> ShowS
finalTableFormatter FinalTableView
view
title :: String
title = FinalTableView -> String
finalTableTitle FinalTableView
view
separator :: String
separator = FinalTableView -> String
finalTableSeparator FinalTableView
view
Maybe FinalTableResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> MVar (Maybe FinalTableResults)
finalTableResults FinalTableViewState
st
case Maybe FinalTableResults
results of
Maybe FinalTableResults
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FinalTableResults
results ->
do let names :: [String]
names = FinalTableResults -> [String]
finalTableNames FinalTableResults
results
values :: MVar (Map Int [String])
values = FinalTableResults -> MVar (Map Int [String])
finalTableValues FinalTableResults
results
Map Int [String]
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar (Map Int [String])
values
String
file <- String -> ExperimentFilePath -> ExperimentWriter String
resolveFilePath (FinalTableViewState -> String
finalTableDir FinalTableViewState
st) forall a b. (a -> b) -> a -> b
$
ShowS -> ExperimentFilePath -> ExperimentFilePath
mapFilePath (forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> ShowS
replaceExtension String
".csv") forall a b. (a -> b) -> a -> b
$
ExperimentFilePath -> Map String String -> ExperimentFilePath
expandFilePath (FinalTableView -> ExperimentFilePath
finalTableFileName forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st) forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
"$TITLE", String
title)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle
h <- String -> IOMode -> IO Handle
openFile String
file IOMode
WriteMode
Handle -> String -> IO ()
hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
run
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
names forall a b. (a -> b) -> a -> b
$ \String
name ->
do Handle -> String -> IO ()
hPutStr Handle
h String
separator
Handle -> String -> IO ()
hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
name
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.assocs Map Int [String]
m) forall a b. (a -> b) -> a -> b
$ \(Int
i, [String]
xs) ->
do Handle -> String -> IO ()
hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
i
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
xs forall a b. (a -> b) -> a -> b
$ \String
x ->
do Handle -> String -> IO ()
hPutStr Handle
h String
separator
Handle -> String -> IO ()
hPutStr Handle
h forall a b. (a -> b) -> a -> b
$ ShowS
formatter String
x
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> IO ()
hClose Handle
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> Experiment
finalTableExperiment FinalTableViewState
st) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStr String
"Generated file " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
file
forall a. IORef a -> a -> IO ()
writeIORef (FinalTableViewState -> IORef (Maybe String)
finalTableFile FinalTableViewState
st) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
file
finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableHtml FinalTableViewState
st Int
index =
do FinalTableViewState -> Int -> HtmlWriter ()
header FinalTableViewState
st Int
index
Maybe String
file <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (FinalTableViewState -> IORef (Maybe String)
finalTableFile FinalTableViewState
st)
case Maybe String
file of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
f ->
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String -> ShowS
makeRelative (FinalTableViewState -> String
finalTableDir FinalTableViewState
st) String
f) forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalTableView -> String
finalTableLinkText forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st)
header :: FinalTableViewState -> Int -> HtmlWriter ()
FinalTableViewState
st Int
index =
do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalTableView -> String
finalTableTitle forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st)
let description :: String
description = FinalTableView -> String
finalTableDescription forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
description) forall a b. (a -> b) -> a -> b
$
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText String
description
finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml FinalTableViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalTableView -> String
finalTableTitle forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st)