-
Notifications
You must be signed in to change notification settings - Fork 0
/
ExperimentSpecsView.hs
94 lines (79 loc) · 3.79 KB
/
ExperimentSpecsView.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-- |
-- Module : Simulation.Aivika.Experiment.ExperimentSpecsView
-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>
-- License : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability : experimental
-- Tested with: GHC 7.6.3
--
-- The module defines 'ExperimentSpecsView' that shows the
-- experiment specs.
--
module Simulation.Aivika.Experiment.ExperimentSpecsView
(ExperimentSpecsView(..),
defaultExperimentSpecsView) where
import Control.Monad
import Control.Monad.Trans
import Data.Monoid
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.ExperimentSpecsWriter
-- | Defines the 'View' that shows the experiment specs.
data ExperimentSpecsView =
ExperimentSpecsView { experimentSpecsTitle :: String,
-- ^ The title for the view.
experimentSpecsDescription :: String,
-- ^ The description for the view.
experimentSpecsWriter :: ExperimentSpecsWriter
-- ^ It shows the specs.
}
-- | This is the default view.
defaultExperimentSpecsView :: ExperimentSpecsView
defaultExperimentSpecsView =
ExperimentSpecsView { experimentSpecsTitle = "Experiment Specs",
experimentSpecsDescription = "It shows the experiment specs.",
experimentSpecsWriter = defaultExperimentSpecsWriter }
instance WebPageRendering r => ExperimentView ExperimentSpecsView r WebPageWriter where
outputView v =
let reporter exp renderer dir =
do st <- newExperimentSpecs v exp
let writer =
WebPageWriter { reporterWriteTOCHtml = experimentSpecsTOCHtml st,
reporterWriteHtml = experimentSpecsHtml st }
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = const $ return mempty,
reporterRequest = const writer }
in ExperimentGenerator { generateReporter = reporter }
-- | The state of the view.
data ExperimentSpecsViewState r a =
ExperimentSpecsViewState { experimentSpecsView :: ExperimentSpecsView,
experimentSpecsExperiment :: Experiment r a }
-- | Create a new state of the view.
newExperimentSpecs :: ExperimentSpecsView -> Experiment r a -> IO (ExperimentSpecsViewState r a)
newExperimentSpecs view exp =
return ExperimentSpecsViewState { experimentSpecsView = view,
experimentSpecsExperiment = exp }
-- | Get the HTML code.
experimentSpecsHtml :: ExperimentSpecsViewState r a -> Int -> HtmlWriter ()
experimentSpecsHtml st index =
do header st index
let writer = experimentSpecsWriter (experimentSpecsView st)
write = experimentSpecsWrite writer
exp = experimentSpecsExperiment st
write writer exp
header :: ExperimentSpecsViewState r a -> Int -> HtmlWriter ()
header st index =
do writeHtmlHeader3WithId ("id" ++ show index) $
writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)
let description = experimentSpecsDescription $ experimentSpecsView st
unless (null description) $
writeHtmlParagraph $
writeHtmlText description
-- | Get the TOC item
experimentSpecsTOCHtml :: ExperimentSpecsViewState r a -> Int -> HtmlWriter ()
experimentSpecsTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)