{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.InfoView
(InfoView(..),
defaultInfoView) where
import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar
import Data.IORef
import Data.Maybe
import Data.Monoid
import Simulation.Aivika
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.Base.WebPageRenderer
import Simulation.Aivika.Experiment.Base.ExperimentWriter
import Simulation.Aivika.Experiment.Base.HtmlWriter
import Simulation.Aivika.Experiment.Concurrent.MVar
data InfoView =
InfoView { InfoView -> ResultDescription
infoTitle :: String,
InfoView -> ResultDescription
infoDescription :: String,
InfoView -> ResultTransform
infoTransform :: ResultTransform,
InfoView -> ResultTransform
infoSeries :: ResultTransform
}
defaultInfoView :: InfoView
defaultInfoView :: InfoView
defaultInfoView =
InfoView { infoTitle :: ResultDescription
infoTitle = ResultDescription
"Information",
infoDescription :: ResultDescription
infoDescription = ResultDescription
"It shows the information about simulation entities:",
infoTransform :: ResultTransform
infoTransform = ResultTransform
forall a. a -> a
id,
infoSeries :: ResultTransform
infoSeries = ResultTransform
forall a. a -> a
id }
instance ExperimentView InfoView (WebPageRenderer a) where
outputView :: InfoView -> ExperimentGenerator (WebPageRenderer a)
outputView InfoView
v =
let reporter :: Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer ResultDescription
dir =
do InfoViewState
st <- InfoView
-> Experiment
-> ResultDescription
-> ExperimentWriter InfoViewState
newInfo InfoView
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 = InfoViewState -> Int -> HtmlWriter ()
infoTOCHtml InfoViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = InfoViewState -> Int -> HtmlWriter ()
infoHtml InfoViewState
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 = InfoViewState -> ExperimentData -> Composite ()
simulateInfo InfoViewState
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 }
data InfoViewState =
InfoViewState { InfoViewState -> InfoView
infoView :: InfoView,
InfoViewState -> Experiment
infoExperiment :: Experiment,
InfoViewState -> MVar (Maybe InfoResults)
infoResults :: MVar (Maybe InfoResults) }
data InfoResults =
InfoResults { InfoResults -> [ResultDescription]
infoNames :: [String],
InfoResults -> [ResultDescription]
infoValues :: [String] }
newInfo :: InfoView -> Experiment -> FilePath -> ExperimentWriter InfoViewState
newInfo :: InfoView
-> Experiment
-> ResultDescription
-> ExperimentWriter InfoViewState
newInfo InfoView
view Experiment
exp ResultDescription
dir =
do MVar (Maybe InfoResults)
r <- IO (MVar (Maybe InfoResults))
-> ExperimentWriter (MVar (Maybe InfoResults))
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Maybe InfoResults))
-> ExperimentWriter (MVar (Maybe InfoResults)))
-> IO (MVar (Maybe InfoResults))
-> ExperimentWriter (MVar (Maybe InfoResults))
forall a b. (a -> b) -> a -> b
$ Maybe InfoResults -> IO (MVar (Maybe InfoResults))
forall a. a -> IO (MVar a)
newMVar Maybe InfoResults
forall a. Maybe a
Nothing
InfoViewState -> ExperimentWriter InfoViewState
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoViewState { infoView :: InfoView
infoView = InfoView
view,
infoExperiment :: Experiment
infoExperiment = Experiment
exp,
infoResults :: MVar (Maybe InfoResults)
infoResults = MVar (Maybe InfoResults)
r }
newInfoResults :: [ResultSource] -> ResultLocalisation -> Experiment -> IO InfoResults
newInfoResults :: [ResultSource]
-> ResultLocalisation -> Experiment -> IO InfoResults
newInfoResults [ResultSource]
sources ResultLocalisation
loc Experiment
exp =
do let xs :: [[(ResultDescription, ResultDescription)]]
xs =
((ResultSource -> [(ResultDescription, ResultDescription)])
-> [ResultSource] -> [[(ResultDescription, ResultDescription)]])
-> [ResultSource]
-> (ResultSource -> [(ResultDescription, ResultDescription)])
-> [[(ResultDescription, ResultDescription)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResultSource -> [(ResultDescription, ResultDescription)])
-> [ResultSource] -> [[(ResultDescription, ResultDescription)]]
forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources ((ResultSource -> [(ResultDescription, ResultDescription)])
-> [[(ResultDescription, ResultDescription)]])
-> (ResultSource -> [(ResultDescription, ResultDescription)])
-> [[(ResultDescription, ResultDescription)]]
forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
case ResultSource
source of
ResultItemSource (ResultItem a
x) ->
[(ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ a -> ResultDescription
forall a. ResultItemable a => a -> ResultDescription
resultItemName a
x,
ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc (ResultId -> ResultDescription) -> ResultId -> ResultDescription
forall a b. (a -> b) -> a -> b
$ a -> ResultId
forall a. ResultItemable a => a -> ResultId
resultItemId a
x)]
ResultObjectSource ResultObject
x ->
[(ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultDescription
resultObjectName ResultObject
x,
ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc (ResultId -> ResultDescription) -> ResultId -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultId
resultObjectId ResultObject
x)]
ResultVectorSource ResultVector
x ->
[(ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultDescription
resultVectorName ResultVector
x,
ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc (ResultId -> ResultDescription) -> ResultId -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultId
resultVectorId ResultVector
x)]
ResultSeparatorSource ResultSeparator
x ->
[]
([ResultDescription]
names, [ResultDescription]
values) = [(ResultDescription, ResultDescription)]
-> ([ResultDescription], [ResultDescription])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ResultDescription, ResultDescription)]
-> ([ResultDescription], [ResultDescription]))
-> [(ResultDescription, ResultDescription)]
-> ([ResultDescription], [ResultDescription])
forall a b. (a -> b) -> a -> b
$ [[(ResultDescription, ResultDescription)]]
-> [(ResultDescription, ResultDescription)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(ResultDescription, ResultDescription)]]
xs
InfoResults -> IO InfoResults
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoResults { infoNames :: [ResultDescription]
infoNames = [ResultDescription]
names,
infoValues :: [ResultDescription]
infoValues = [ResultDescription]
values }
requireInfoResults :: InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults :: InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults InfoViewState
st [ResultSource]
sources =
let view :: InfoView
view = InfoViewState -> InfoView
infoView InfoViewState
st
exp :: Experiment
exp = InfoViewState -> Experiment
infoExperiment InfoViewState
st
loc :: ResultLocalisation
loc = Experiment -> ResultLocalisation
experimentLocalisation Experiment
exp
in MVar (Maybe InfoResults)
-> IO InfoResults
-> (InfoResults -> IO InfoResults)
-> IO InfoResults
forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (InfoViewState -> MVar (Maybe InfoResults)
infoResults InfoViewState
st)
([ResultSource]
-> ResultLocalisation -> Experiment -> IO InfoResults
newInfoResults [ResultSource]
sources ResultLocalisation
loc Experiment
exp) ((InfoResults -> IO InfoResults) -> IO InfoResults)
-> (InfoResults -> IO InfoResults) -> IO InfoResults
forall a b. (a -> b) -> a -> b
$ \InfoResults
results ->
do let xs :: [[ResultDescription]]
xs =
((ResultSource -> [ResultDescription])
-> [ResultSource] -> [[ResultDescription]])
-> [ResultSource]
-> (ResultSource -> [ResultDescription])
-> [[ResultDescription]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResultSource -> [ResultDescription])
-> [ResultSource] -> [[ResultDescription]]
forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources ((ResultSource -> [ResultDescription]) -> [[ResultDescription]])
-> (ResultSource -> [ResultDescription]) -> [[ResultDescription]]
forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
case ResultSource
source of
ResultItemSource (ResultItem a
x) ->
[ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ a -> ResultDescription
forall a. ResultItemable a => a -> ResultDescription
resultItemName a
x]
ResultObjectSource ResultObject
x ->
[ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultDescription
resultObjectName ResultObject
x]
ResultVectorSource ResultVector
x ->
[ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultDescription
resultVectorName ResultVector
x]
ResultSeparatorSource ResultSeparator
x ->
[]
let names :: [ResultDescription]
names = [[ResultDescription]] -> [ResultDescription]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ResultDescription]]
xs
if ([ResultDescription]
names [ResultDescription] -> [ResultDescription] -> Bool
forall a. Eq a => a -> a -> Bool
/= InfoResults -> [ResultDescription]
infoNames InfoResults
results)
then ResultDescription -> IO InfoResults
forall a. HasCallStack => ResultDescription -> a
error ResultDescription
"Series with different names are returned for different runs: requireInfoResults"
else InfoResults -> IO InfoResults
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoResults
results
simulateInfo :: InfoViewState -> ExperimentData -> Composite ()
simulateInfo :: InfoViewState -> ExperimentData -> Composite ()
simulateInfo InfoViewState
st ExperimentData
expdata =
do let view :: InfoView
view = InfoViewState -> InfoView
infoView InfoViewState
st
rs :: Results
rs = InfoView -> ResultTransform
infoSeries InfoView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
InfoView -> ResultTransform
infoTransform InfoView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
sources :: [ResultSource]
sources = Results -> [ResultSource]
resultSourceList Results
rs
IO InfoResults -> Composite InfoResults
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InfoResults -> Composite InfoResults)
-> IO InfoResults -> Composite InfoResults
forall a b. (a -> b) -> a -> b
$ InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults InfoViewState
st [ResultSource]
sources
() -> Composite ()
forall a. a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
infoHtml :: InfoViewState -> Int -> HtmlWriter ()
infoHtml :: InfoViewState -> Int -> HtmlWriter ()
infoHtml InfoViewState
st Int
index =
do InfoViewState -> Int -> HtmlWriter ()
header InfoViewState
st Int
index
Maybe InfoResults
results <- IO (Maybe InfoResults) -> HtmlWriter (Maybe InfoResults)
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InfoResults) -> HtmlWriter (Maybe InfoResults))
-> IO (Maybe InfoResults) -> HtmlWriter (Maybe InfoResults)
forall a b. (a -> b) -> a -> b
$ MVar (Maybe InfoResults) -> IO (Maybe InfoResults)
forall a. MVar a -> IO a
readMVar (InfoViewState -> MVar (Maybe InfoResults)
infoResults InfoViewState
st)
case Maybe InfoResults
results of
Maybe InfoResults
Nothing -> () -> HtmlWriter ()
forall a. a -> HtmlWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just InfoResults
results ->
do let names :: [ResultDescription]
names = InfoResults -> [ResultDescription]
infoNames InfoResults
results
values :: [ResultDescription]
values = InfoResults -> [ResultDescription]
infoValues InfoResults
results
HtmlWriter () -> HtmlWriter ()
writeHtmlList (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
[(ResultDescription, ResultDescription)]
-> ((ResultDescription, ResultDescription) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([ResultDescription]
-> [ResultDescription] -> [(ResultDescription, ResultDescription)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ResultDescription]
names [ResultDescription]
values) (((ResultDescription, ResultDescription) -> HtmlWriter ())
-> HtmlWriter ())
-> ((ResultDescription, ResultDescription) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(ResultDescription
name, ResultDescription
value) ->
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
do ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
name
ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
" - "
ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
value
header :: InfoViewState -> Int -> HtmlWriter ()
InfoViewState
st Int
index =
do ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (ResultDescription
"id" ResultDescription -> ResultDescription -> ResultDescription
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 (InfoView -> ResultDescription
infoTitle (InfoView -> ResultDescription) -> InfoView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)
let description :: ResultDescription
description = InfoView -> ResultDescription
infoDescription (InfoView -> ResultDescription) -> InfoView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
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
infoTOCHtml :: InfoViewState -> Int -> HtmlWriter ()
infoTOCHtml :: InfoViewState -> Int -> HtmlWriter ()
infoTOCHtml InfoViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription
"#id" ResultDescription -> ResultDescription -> ResultDescription
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 (InfoView -> ResultDescription
infoTitle (InfoView -> ResultDescription) -> InfoView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)