{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.ExperimentSpecsView
(ExperimentSpecsView(..),
defaultExperimentSpecsView) where
import Control.Monad
import Control.Monad.Trans
import Data.Monoid
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.Base.WebPageRenderer
import Simulation.Aivika.Experiment.Base.HtmlWriter
import Simulation.Aivika.Experiment.Base.ExperimentWriter
import Simulation.Aivika.Experiment.Base.ExperimentSpecsWriter
data ExperimentSpecsView =
ExperimentSpecsView { ExperimentSpecsView -> String
experimentSpecsTitle :: String,
ExperimentSpecsView -> String
experimentSpecsDescription :: String,
ExperimentSpecsView -> ExperimentSpecsWriter
experimentSpecsWriter :: ExperimentSpecsWriter
}
defaultExperimentSpecsView :: ExperimentSpecsView
defaultExperimentSpecsView :: ExperimentSpecsView
defaultExperimentSpecsView =
ExperimentSpecsView { experimentSpecsTitle :: String
experimentSpecsTitle = String
"Experiment Specs",
experimentSpecsDescription :: String
experimentSpecsDescription = String
"It shows the experiment specs.",
experimentSpecsWriter :: ExperimentSpecsWriter
experimentSpecsWriter = ExperimentSpecsWriter
defaultExperimentSpecsWriter }
instance ExperimentView ExperimentSpecsView (WebPageRenderer a) where
outputView :: ExperimentSpecsView -> ExperimentGenerator (WebPageRenderer a)
outputView ExperimentSpecsView
v =
let reporter :: Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer p
dir =
do ExperimentSpecsViewState
st <- ExperimentSpecsView
-> Experiment -> ExperimentWriter ExperimentSpecsViewState
newExperimentSpecs ExperimentSpecsView
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 = ExperimentSpecsViewState -> Int -> HtmlWriter ()
experimentSpecsTOCHtml ExperimentSpecsViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = ExperimentSpecsViewState -> Int -> HtmlWriter ()
experimentSpecsHtml ExperimentSpecsViewState
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 = Composite () -> ExperimentData -> Composite ()
forall a b. a -> b -> a
const (Composite () -> ExperimentData -> Composite ())
-> Composite () -> ExperimentData -> Composite ()
forall a b. (a -> b) -> a -> b
$ () -> Composite ()
forall a. a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall a. Monoid a => a
mempty,
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 ExperimentSpecsViewState =
ExperimentSpecsViewState { ExperimentSpecsViewState -> ExperimentSpecsView
experimentSpecsView :: ExperimentSpecsView,
ExperimentSpecsViewState -> Experiment
experimentSpecsExperiment :: Experiment }
newExperimentSpecs :: ExperimentSpecsView -> Experiment -> ExperimentWriter ExperimentSpecsViewState
newExperimentSpecs :: ExperimentSpecsView
-> Experiment -> ExperimentWriter ExperimentSpecsViewState
newExperimentSpecs ExperimentSpecsView
view Experiment
exp =
ExperimentSpecsViewState
-> ExperimentWriter ExperimentSpecsViewState
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentSpecsViewState { experimentSpecsView :: ExperimentSpecsView
experimentSpecsView = ExperimentSpecsView
view,
experimentSpecsExperiment :: Experiment
experimentSpecsExperiment = Experiment
exp }
experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()
experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()
experimentSpecsHtml ExperimentSpecsViewState
st Int
index =
do ExperimentSpecsViewState -> Int -> HtmlWriter ()
header ExperimentSpecsViewState
st Int
index
let writer :: ExperimentSpecsWriter
writer = ExperimentSpecsView -> ExperimentSpecsWriter
experimentSpecsWriter (ExperimentSpecsViewState -> ExperimentSpecsView
experimentSpecsView ExperimentSpecsViewState
st)
write :: ExperimentSpecsWriter -> Experiment -> HtmlWriter ()
write = ExperimentSpecsWriter
-> ExperimentSpecsWriter -> Experiment -> HtmlWriter ()
experimentSpecsWrite ExperimentSpecsWriter
writer
exp :: Experiment
exp = ExperimentSpecsViewState -> Experiment
experimentSpecsExperiment ExperimentSpecsViewState
st
ExperimentSpecsWriter -> Experiment -> HtmlWriter ()
write ExperimentSpecsWriter
writer Experiment
exp
header :: ExperimentSpecsViewState -> Int -> HtmlWriter ()
ExperimentSpecsViewState
st Int
index =
do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" String -> String -> String
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 (ExperimentSpecsView -> String
experimentSpecsTitle (ExperimentSpecsView -> String) -> ExperimentSpecsView -> String
forall a b. (a -> b) -> a -> b
$ ExperimentSpecsViewState -> ExperimentSpecsView
experimentSpecsView ExperimentSpecsViewState
st)
let description :: String
description = ExperimentSpecsView -> String
experimentSpecsDescription (ExperimentSpecsView -> String) -> ExperimentSpecsView -> String
forall a b. (a -> b) -> a -> b
$ ExperimentSpecsViewState -> ExperimentSpecsView
experimentSpecsView ExperimentSpecsViewState
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
experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()
experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()
experimentSpecsTOCHtml ExperimentSpecsViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" String -> String -> String
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 (ExperimentSpecsView -> String
experimentSpecsTitle (ExperimentSpecsView -> String) -> ExperimentSpecsView -> String
forall a b. (a -> b) -> a -> b
$ ExperimentSpecsViewState -> ExperimentSpecsView
experimentSpecsView ExperimentSpecsViewState
st)