{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.LastValueView
(LastValueView(..),
defaultLastValueView) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
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.Utils (replace)
data LastValueView =
LastValueView { LastValueView -> String
lastValueTitle :: String,
LastValueView -> String
lastValueRunTitle :: String,
LastValueView -> String
lastValueDescription :: String,
LastValueView -> ShowS
lastValueFormatter :: ShowS,
LastValueView -> ResultTransform
lastValueTransform :: ResultTransform,
LastValueView -> ResultTransform
lastValueSeries :: ResultTransform
}
defaultLastValueView :: LastValueView
defaultLastValueView :: LastValueView
defaultLastValueView =
LastValueView { lastValueTitle :: String
lastValueTitle = String
"Last Values",
lastValueRunTitle :: String
lastValueRunTitle = String
"$TITLE / Run $RUN_INDEX of $RUN_COUNT",
lastValueDescription :: String
lastValueDescription = String
"It shows the values in the final time point(s).",
lastValueFormatter :: ShowS
lastValueFormatter = ShowS
forall a. a -> a
id,
lastValueTransform :: ResultTransform
lastValueTransform = ResultTransform
forall a. a -> a
id,
lastValueSeries :: ResultTransform
lastValueSeries = ResultTransform
forall a. a -> a
id }
instance ExperimentView LastValueView (WebPageRenderer a) where
outputView :: LastValueView -> ExperimentGenerator (WebPageRenderer a)
outputView LastValueView
v =
let reporter :: Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer p
dir =
do LastValueViewState
st <- LastValueView -> Experiment -> ExperimentWriter LastValueViewState
newLastValues LastValueView
v Experiment
exp
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 = LastValueViewState -> Int -> HtmlWriter ()
lastValueTOCHtml LastValueViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = LastValueViewState -> Int -> HtmlWriter ()
lastValueHtml LastValueViewState
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 = LastValueViewState -> ExperimentData -> Composite ()
simulateLastValues LastValueViewState
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
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
(WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
forall {p} {p} {a}.
Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
data LastValueViewState =
LastValueViewState { LastValueViewState -> LastValueView
lastValueView :: LastValueView,
LastValueViewState -> Experiment
lastValueExperiment :: Experiment,
LastValueViewState -> Map Int (IORef [(String, String)])
lastValueMap :: M.Map Int (IORef [(String, String)]) }
newLastValues :: LastValueView -> Experiment -> ExperimentWriter LastValueViewState
newLastValues :: LastValueView -> Experiment -> ExperimentWriter LastValueViewState
newLastValues LastValueView
view Experiment
exp =
do let n :: Int
n = Experiment -> Int
experimentRunCount Experiment
exp
[IORef [(String, String)]]
rs <- [Int]
-> (Int -> ExperimentWriter (IORef [(String, String)]))
-> ExperimentWriter [IORef [(String, String)]]
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 (IORef [(String, String)]))
-> ExperimentWriter [IORef [(String, String)]])
-> (Int -> ExperimentWriter (IORef [(String, String)]))
-> ExperimentWriter [IORef [(String, String)]]
forall a b. (a -> b) -> a -> b
$ \Int
i -> IO (IORef [(String, String)])
-> ExperimentWriter (IORef [(String, String)])
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [(String, String)])
-> ExperimentWriter (IORef [(String, String)]))
-> IO (IORef [(String, String)])
-> ExperimentWriter (IORef [(String, String)])
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> IO (IORef [(String, String)])
forall a. a -> IO (IORef a)
newIORef []
let m :: Map Int (IORef [(String, String)])
m = [(Int, IORef [(String, String)])]
-> Map Int (IORef [(String, String)])
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, IORef [(String, String)])]
-> Map Int (IORef [(String, String)]))
-> [(Int, IORef [(String, String)])]
-> Map Int (IORef [(String, String)])
forall a b. (a -> b) -> a -> b
$ [Int]
-> [IORef [(String, String)]] -> [(Int, IORef [(String, String)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] [IORef [(String, String)]]
rs
LastValueViewState -> ExperimentWriter LastValueViewState
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return LastValueViewState { lastValueView :: LastValueView
lastValueView = LastValueView
view,
lastValueExperiment :: Experiment
lastValueExperiment = Experiment
exp,
lastValueMap :: Map Int (IORef [(String, String)])
lastValueMap = Map Int (IORef [(String, String)])
m }
simulateLastValues :: LastValueViewState -> ExperimentData -> Composite ()
simulateLastValues :: LastValueViewState -> ExperimentData -> Composite ()
simulateLastValues LastValueViewState
st ExperimentData
expdata =
do let view :: LastValueView
view = LastValueViewState -> LastValueView
lastValueView LastValueViewState
st
rs :: Results
rs = LastValueView -> ResultTransform
lastValueSeries LastValueView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
LastValueView -> ResultTransform
lastValueTransform LastValueView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
loc :: [ResultId] -> String
loc = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle (ResultLocalisation -> [ResultId] -> String)
-> ResultLocalisation -> [ResultId] -> String
forall a b. (a -> b) -> a -> b
$
Experiment -> ResultLocalisation
experimentLocalisation (Experiment -> ResultLocalisation)
-> Experiment -> ResultLocalisation
forall a b. (a -> b) -> a -> b
$
LastValueViewState -> Experiment
lastValueExperiment LastValueViewState
st
exts :: [ResultValue String]
exts = Results -> [ResultValue String]
resultsToStringValues Results
rs
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
signal :: Signal Double
signal = ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
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 Double -> (Double -> Event ()) -> Composite ()
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal ((Double -> Event ()) -> Composite ())
-> (Double -> Event ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \Double
t ->
do let r :: IORef [(String, String)]
r = Maybe (IORef [(String, String)]) -> IORef [(String, String)]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IORef [(String, String)]) -> IORef [(String, String)])
-> Maybe (IORef [(String, String)]) -> IORef [(String, String)]
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (IORef [(String, String)])
-> Maybe (IORef [(String, String)])
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) (LastValueViewState -> Map Int (IORef [(String, String)])
lastValueMap LastValueViewState
st)
[(String, String)]
output <- [ResultValue String]
-> (ResultValue String -> Event (String, String))
-> Event [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResultValue String]
exts ((ResultValue String -> Event (String, String))
-> Event [(String, String)])
-> (ResultValue String -> Event (String, String))
-> Event [(String, String)]
forall a b. (a -> b) -> a -> b
$ \ResultValue String
ext ->
do String
x <- ResultValue String -> ResultData String
forall e. ResultValue e -> ResultData e
resultValueData ResultValue String
ext
(String, String) -> Event (String, String)
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ResultId] -> String
loc ([ResultId] -> String) -> [ResultId] -> String
forall a b. (a -> b) -> a -> b
$ ResultValue String -> [ResultId]
forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue String
ext, String
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
$ IORef [(String, String)] -> [(String, String)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(String, String)]
r [(String, String)]
output
lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtml LastValueViewState
st Int
index =
let n :: Int
n = Experiment -> Int
experimentRunCount (Experiment -> Int) -> Experiment -> Int
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> Experiment
lastValueExperiment LastValueViewState
st
in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlSingle LastValueViewState
st Int
index
else LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlMultiple LastValueViewState
st Int
index
lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlSingle LastValueViewState
st Int
index =
do LastValueViewState -> Int -> HtmlWriter ()
header LastValueViewState
st Int
index
let r :: IORef [(String, String)]
r = Maybe (IORef [(String, String)]) -> IORef [(String, String)]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IORef [(String, String)]) -> IORef [(String, String)])
-> Maybe (IORef [(String, String)]) -> IORef [(String, String)]
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (IORef [(String, String)])
-> Maybe (IORef [(String, String)])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
0 (LastValueViewState -> Map Int (IORef [(String, String)])
lastValueMap LastValueViewState
st)
[(String, String)]
pairs <- IO [(String, String)] -> HtmlWriter [(String, String)]
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, String)] -> HtmlWriter [(String, String)])
-> IO [(String, String)] -> HtmlWriter [(String, String)]
forall a b. (a -> b) -> a -> b
$ IORef [(String, String)] -> IO [(String, String)]
forall a. IORef a -> IO a
readIORef IORef [(String, String)]
r
[(String, String)]
-> ((String, String) -> HtmlWriter ()) -> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
pairs (((String, String) -> HtmlWriter ()) -> HtmlWriter ())
-> ((String, String) -> HtmlWriter ()) -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(String, String)
pair ->
(String, String) -> ShowS -> HtmlWriter ()
formatPair (String, String)
pair (LastValueView -> ShowS
lastValueFormatter (LastValueView -> ShowS) -> LastValueView -> ShowS
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlMultiple LastValueViewState
st Int
index =
do LastValueViewState -> Int -> HtmlWriter ()
header LastValueViewState
st Int
index
let n :: Int
n = Experiment -> Int
experimentRunCount (Experiment -> Int) -> Experiment -> Int
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> Experiment
lastValueExperiment LastValueViewState
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 subtitle :: String
subtitle =
String -> String -> ShowS
replace String
"$RUN_INDEX" (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
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
$
String -> String -> ShowS
replace String
"$RUN_COUNT" (Int -> String
forall a. Show a => a -> String
show Int
n) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> String -> ShowS
replace String
"$TITLE" (LastValueView -> String
lastValueTitle (LastValueView -> String) -> LastValueView -> String
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
(LastValueView -> String
lastValueRunTitle (LastValueView -> String) -> LastValueView -> String
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
HtmlWriter () -> HtmlWriter ()
writeHtmlHeader4 (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText String
subtitle
let r :: IORef [(String, String)]
r = Maybe (IORef [(String, String)]) -> IORef [(String, String)]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IORef [(String, String)]) -> IORef [(String, String)])
-> Maybe (IORef [(String, String)]) -> IORef [(String, String)]
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (IORef [(String, String)])
-> Maybe (IORef [(String, String)])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
i (LastValueViewState -> Map Int (IORef [(String, String)])
lastValueMap LastValueViewState
st)
[(String, String)]
pairs <- IO [(String, String)] -> HtmlWriter [(String, String)]
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, String)] -> HtmlWriter [(String, String)])
-> IO [(String, String)] -> HtmlWriter [(String, String)]
forall a b. (a -> b) -> a -> b
$ IORef [(String, String)] -> IO [(String, String)]
forall a. IORef a -> IO a
readIORef IORef [(String, String)]
r
[(String, String)]
-> ((String, String) -> HtmlWriter ()) -> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
pairs (((String, String) -> HtmlWriter ()) -> HtmlWriter ())
-> ((String, String) -> HtmlWriter ()) -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(String, String)
pair ->
(String, String) -> ShowS -> HtmlWriter ()
formatPair (String, String)
pair (LastValueView -> ShowS
lastValueFormatter (LastValueView -> ShowS) -> LastValueView -> ShowS
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
header :: LastValueViewState -> Int -> HtmlWriter ()
LastValueViewState
st Int
index =
do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (LastValueView -> String
lastValueTitle (LastValueView -> String) -> LastValueView -> String
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
let description :: String
description = LastValueView -> String
lastValueDescription (LastValueView -> String) -> LastValueView -> String
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st
Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
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
$
String -> HtmlWriter ()
writeHtmlText String
description
formatPair :: (String, String) -> ShowS -> HtmlWriter ()
formatPair :: (String, String) -> ShowS -> HtmlWriter ()
formatPair (String
name, String
value) ShowS
formatter =
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
do String -> HtmlWriter ()
writeHtmlText String
name
String -> HtmlWriter ()
writeHtmlText String
" = "
String -> HtmlWriter ()
writeHtmlText (String -> HtmlWriter ()) -> String -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ ShowS
formatter String
value
lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueTOCHtml LastValueViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (LastValueView -> String
lastValueTitle (LastValueView -> String) -> LastValueView -> String
forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)