{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.TimingStatsView
(TimingStatsView(..),
defaultTimingStatsView) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
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.Base.TimingStatsWriter
import Simulation.Aivika.Experiment.Utils (replace)
data TimingStatsView =
TimingStatsView { TimingStatsView -> String
timingStatsTitle :: String,
TimingStatsView -> String
timingStatsRunTitle :: String,
TimingStatsView -> String
timingStatsDescription :: String,
TimingStatsView -> TimingStatsWriter Double
timingStatsWriter :: TimingStatsWriter Double,
TimingStatsView -> Event Bool
timingStatsPredicate :: Event Bool,
TimingStatsView -> ResultTransform
timingStatsTransform :: ResultTransform,
TimingStatsView -> ResultTransform
timingStatsSeries :: ResultTransform
}
defaultTimingStatsView :: TimingStatsView
defaultTimingStatsView :: TimingStatsView
defaultTimingStatsView =
TimingStatsView { timingStatsTitle :: String
timingStatsTitle = String
"Statistics for Time-Persistent Variables",
timingStatsRunTitle :: String
timingStatsRunTitle = String
"$TITLE / Run $RUN_INDEX of $RUN_COUNT",
timingStatsDescription :: String
timingStatsDescription = String
"The statistical data are gathered in the time points.",
timingStatsWriter :: TimingStatsWriter Double
timingStatsWriter = TimingStatsWriter Double
forall a. (Show a, TimingData a) => TimingStatsWriter a
defaultTimingStatsWriter,
timingStatsPredicate :: Event Bool
timingStatsPredicate = Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
timingStatsTransform :: ResultTransform
timingStatsTransform = ResultTransform
forall a. a -> a
id,
timingStatsSeries :: ResultTransform
timingStatsSeries = ResultTransform
forall a. a -> a
id }
instance ExperimentView TimingStatsView (WebPageRenderer a) where
outputView :: TimingStatsView -> ExperimentGenerator (WebPageRenderer a)
outputView TimingStatsView
v =
let reporter :: Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer p
dir =
do TimingStatsViewState
st <- TimingStatsView
-> Experiment -> ExperimentWriter TimingStatsViewState
newTimingStats TimingStatsView
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 = TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsTOCHtml TimingStatsViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtml TimingStatsViewState
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 = TimingStatsViewState -> ExperimentData -> Composite ()
simulateTimingStats TimingStatsViewState
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 TimingStatsViewState =
TimingStatsViewState { TimingStatsViewState -> TimingStatsView
timingStatsView :: TimingStatsView,
TimingStatsViewState -> Experiment
timingStatsExperiment :: Experiment,
TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }
newTimingStats :: TimingStatsView -> Experiment -> ExperimentWriter TimingStatsViewState
newTimingStats :: TimingStatsView
-> Experiment -> ExperimentWriter TimingStatsViewState
newTimingStats TimingStatsView
view Experiment
exp =
do let n :: Int
n = Experiment -> Int
experimentRunCount Experiment
exp
[IORef [(String, IORef (TimingStats Double))]]
rs <- [Int]
-> (Int
-> ExperimentWriter (IORef [(String, IORef (TimingStats Double))]))
-> ExperimentWriter [IORef [(String, IORef (TimingStats Double))]]
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, IORef (TimingStats Double))]))
-> ExperimentWriter [IORef [(String, IORef (TimingStats Double))]])
-> (Int
-> ExperimentWriter (IORef [(String, IORef (TimingStats Double))]))
-> ExperimentWriter [IORef [(String, IORef (TimingStats Double))]]
forall a b. (a -> b) -> a -> b
$ \Int
i -> IO (IORef [(String, IORef (TimingStats Double))])
-> ExperimentWriter (IORef [(String, IORef (TimingStats Double))])
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [(String, IORef (TimingStats Double))])
-> ExperimentWriter (IORef [(String, IORef (TimingStats Double))]))
-> IO (IORef [(String, IORef (TimingStats Double))])
-> ExperimentWriter (IORef [(String, IORef (TimingStats Double))])
forall a b. (a -> b) -> a -> b
$ [(String, IORef (TimingStats Double))]
-> IO (IORef [(String, IORef (TimingStats Double))])
forall a. a -> IO (IORef a)
newIORef []
let m :: Map Int (IORef [(String, IORef (TimingStats Double))])
m = [(Int, IORef [(String, IORef (TimingStats Double))])]
-> Map Int (IORef [(String, IORef (TimingStats Double))])
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, IORef [(String, IORef (TimingStats Double))])]
-> Map Int (IORef [(String, IORef (TimingStats Double))]))
-> [(Int, IORef [(String, IORef (TimingStats Double))])]
-> Map Int (IORef [(String, IORef (TimingStats Double))])
forall a b. (a -> b) -> a -> b
$ [Int]
-> [IORef [(String, IORef (TimingStats Double))]]
-> [(Int, IORef [(String, IORef (TimingStats Double))])]
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, IORef (TimingStats Double))]]
rs
TimingStatsViewState -> ExperimentWriter TimingStatsViewState
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return TimingStatsViewState { timingStatsView :: TimingStatsView
timingStatsView = TimingStatsView
view,
timingStatsExperiment :: Experiment
timingStatsExperiment = Experiment
exp,
timingStatsMap :: Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap = Map Int (IORef [(String, IORef (TimingStats Double))])
m }
simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Composite ()
simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Composite ()
simulateTimingStats TimingStatsViewState
st ExperimentData
expdata =
do let view :: TimingStatsView
view = TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st
rs :: Results
rs = TimingStatsView -> ResultTransform
timingStatsSeries TimingStatsView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
TimingStatsView -> ResultTransform
timingStatsTransform TimingStatsView
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
$
TimingStatsViewState -> Experiment
timingStatsExperiment TimingStatsViewState
st
exts :: [ResultValue Double]
exts = Results -> [ResultValue Double]
resultsToDoubleValues Results
rs
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
signal :: Signal ()
signal = (() -> Event Bool) -> Signal () -> Signal ()
forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (Event Bool -> () -> Event Bool
forall a b. a -> b -> a
const Event Bool
predicate) (Signal () -> Signal ()) -> Signal () -> Signal ()
forall a b. (a -> b) -> a -> b
$
ResultPredefinedSignals -> ResultSignal -> Signal ()
pureResultSignal ResultPredefinedSignals
signals (ResultSignal -> Signal ()) -> ResultSignal -> Signal ()
forall a b. (a -> b) -> a -> b
$
Results -> ResultSignal
resultSignal Results
rs
predicate :: Event Bool
predicate = TimingStatsView -> Event Bool
timingStatsPredicate TimingStatsView
view
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
let r :: IORef [(String, IORef (TimingStats Double))]
r = Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))]
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
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) (Map Int (IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))]))
-> Map Int (IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap TimingStatsViewState
st
[ResultValue Double]
-> (ResultValue Double -> Composite ()) -> Composite ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ResultValue Double]
exts ((ResultValue Double -> Composite ()) -> Composite ())
-> (ResultValue Double -> Composite ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \ResultValue Double
ext ->
do IORef (TimingStats Double)
stats <- IO (IORef (TimingStats Double))
-> Composite (IORef (TimingStats Double))
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (TimingStats Double))
-> Composite (IORef (TimingStats Double)))
-> IO (IORef (TimingStats Double))
-> Composite (IORef (TimingStats Double))
forall a b. (a -> b) -> a -> b
$ TimingStats Double -> IO (IORef (TimingStats Double))
forall a. a -> IO (IORef a)
newIORef TimingStats Double
forall a. TimingData a => TimingStats a
emptyTimingStats
let name :: String
name = [ResultId] -> String
loc ([ResultId] -> String) -> [ResultId] -> String
forall a b. (a -> b) -> a -> b
$ ResultValue Double -> [ResultId]
forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue Double
ext
IO () -> Composite ()
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Composite ()) -> IO () -> Composite ()
forall a b. (a -> b) -> a -> b
$ IORef [(String, IORef (TimingStats Double))]
-> ([(String, IORef (TimingStats Double))]
-> [(String, IORef (TimingStats Double))])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, IORef (TimingStats Double))]
r ((:) (String
name, IORef (TimingStats Double)
stats))
Signal () -> (() -> Event ()) -> Composite ()
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal ()
signal ((() -> Event ()) -> Composite ())
-> (() -> Event ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \()
_ ->
do Double
t <- Dynamics Double -> Event Double
forall a. Dynamics a -> Event a
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
Double
x <- ResultValue Double -> Event Double
forall e. ResultValue e -> ResultData e
resultValueData ResultValue Double
ext
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
$
do TimingStats Double
y <- IORef (TimingStats Double) -> IO (TimingStats Double)
forall a. IORef a -> IO a
readIORef IORef (TimingStats Double)
stats
let y' :: TimingStats Double
y' = Double -> Double -> TimingStats Double -> TimingStats Double
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Double
x TimingStats Double
y
TimingStats Double
y' TimingStats Double -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef (TimingStats Double) -> TimingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (TimingStats Double)
stats TimingStats Double
y'
timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtml TimingStatsViewState
st Int
index =
let n :: Int
n = Experiment -> Int
experimentRunCount (Experiment -> Int) -> Experiment -> Int
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> Experiment
timingStatsExperiment TimingStatsViewState
st
in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlSingle TimingStatsViewState
st Int
index
else TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlMultiple TimingStatsViewState
st Int
index
timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlSingle TimingStatsViewState
st Int
index =
do TimingStatsViewState -> Int -> HtmlWriter ()
header TimingStatsViewState
st Int
index
let r :: IORef [(String, IORef (TimingStats Double))]
r = Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))]
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
0 (TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap TimingStatsViewState
st)
[(String, IORef (TimingStats Double))]
pairs <- IO [(String, IORef (TimingStats Double))]
-> HtmlWriter [(String, IORef (TimingStats Double))]
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, IORef (TimingStats Double))]
-> HtmlWriter [(String, IORef (TimingStats Double))])
-> IO [(String, IORef (TimingStats Double))]
-> HtmlWriter [(String, IORef (TimingStats Double))]
forall a b. (a -> b) -> a -> b
$ IORef [(String, IORef (TimingStats Double))]
-> IO [(String, IORef (TimingStats Double))]
forall a. IORef a -> IO a
readIORef IORef [(String, IORef (TimingStats Double))]
r
[(String, IORef (TimingStats Double))]
-> ((String, IORef (TimingStats Double)) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(String, IORef (TimingStats Double))]
-> [(String, IORef (TimingStats Double))]
forall a. [a] -> [a]
reverse [(String, IORef (TimingStats Double))]
pairs) (((String, IORef (TimingStats Double)) -> HtmlWriter ())
-> HtmlWriter ())
-> ((String, IORef (TimingStats Double)) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(String
name, IORef (TimingStats Double)
r) ->
do TimingStats Double
stats <- IO (TimingStats Double) -> HtmlWriter (TimingStats Double)
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TimingStats Double) -> HtmlWriter (TimingStats Double))
-> IO (TimingStats Double) -> HtmlWriter (TimingStats Double)
forall a b. (a -> b) -> a -> b
$ IORef (TimingStats Double) -> IO (TimingStats Double)
forall a. IORef a -> IO a
readIORef IORef (TimingStats Double)
r
let writer :: TimingStatsWriter Double
writer = TimingStatsView -> TimingStatsWriter Double
timingStatsWriter (TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
write :: TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write = TimingStatsWriter Double
-> TimingStatsWriter Double
-> String
-> TimingStats Double
-> HtmlWriter ()
forall a.
TimingStatsWriter a
-> TimingStatsWriter a -> String -> TimingStats a -> HtmlWriter ()
timingStatsWrite TimingStatsWriter Double
writer
TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write TimingStatsWriter Double
writer String
name TimingStats Double
stats
timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlMultiple TimingStatsViewState
st Int
index =
do TimingStatsViewState -> Int -> HtmlWriter ()
header TimingStatsViewState
st Int
index
let n :: Int
n = Experiment -> Int
experimentRunCount (Experiment -> Int) -> Experiment -> Int
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> Experiment
timingStatsExperiment TimingStatsViewState
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 -> String -> String
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) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> String
replace String
"$RUN_COUNT" (Int -> String
forall a. Show a => a -> String
show Int
n) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> String
replace String
"$TITLE" (TimingStatsView -> String
timingStatsTitle (TimingStatsView -> String) -> TimingStatsView -> String
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
(TimingStatsView -> String
timingStatsRunTitle (TimingStatsView -> String) -> TimingStatsView -> String
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
HtmlWriter () -> HtmlWriter ()
writeHtmlHeader4 (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText String
subtitle
let r :: IORef [(String, IORef (TimingStats Double))]
r = Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
-> IORef [(String, IORef (TimingStats Double))]
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (IORef [(String, IORef (TimingStats Double))])
-> Maybe (IORef [(String, IORef (TimingStats Double))])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
i (TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap TimingStatsViewState
st)
[(String, IORef (TimingStats Double))]
pairs <- IO [(String, IORef (TimingStats Double))]
-> HtmlWriter [(String, IORef (TimingStats Double))]
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, IORef (TimingStats Double))]
-> HtmlWriter [(String, IORef (TimingStats Double))])
-> IO [(String, IORef (TimingStats Double))]
-> HtmlWriter [(String, IORef (TimingStats Double))]
forall a b. (a -> b) -> a -> b
$ IORef [(String, IORef (TimingStats Double))]
-> IO [(String, IORef (TimingStats Double))]
forall a. IORef a -> IO a
readIORef IORef [(String, IORef (TimingStats Double))]
r
[(String, IORef (TimingStats Double))]
-> ((String, IORef (TimingStats Double)) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(String, IORef (TimingStats Double))]
-> [(String, IORef (TimingStats Double))]
forall a. [a] -> [a]
reverse [(String, IORef (TimingStats Double))]
pairs) (((String, IORef (TimingStats Double)) -> HtmlWriter ())
-> HtmlWriter ())
-> ((String, IORef (TimingStats Double)) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(String
name, IORef (TimingStats Double)
r) ->
do TimingStats Double
stats <- IO (TimingStats Double) -> HtmlWriter (TimingStats Double)
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TimingStats Double) -> HtmlWriter (TimingStats Double))
-> IO (TimingStats Double) -> HtmlWriter (TimingStats Double)
forall a b. (a -> b) -> a -> b
$ IORef (TimingStats Double) -> IO (TimingStats Double)
forall a. IORef a -> IO a
readIORef IORef (TimingStats Double)
r
let writer :: TimingStatsWriter Double
writer = TimingStatsView -> TimingStatsWriter Double
timingStatsWriter (TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
write :: TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write = TimingStatsWriter Double
-> TimingStatsWriter Double
-> String
-> TimingStats Double
-> HtmlWriter ()
forall a.
TimingStatsWriter a
-> TimingStatsWriter a -> String -> TimingStats a -> HtmlWriter ()
timingStatsWrite TimingStatsWriter Double
writer
TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write TimingStatsWriter Double
writer String
name TimingStats Double
stats
header :: TimingStatsViewState -> Int -> HtmlWriter ()
TimingStatsViewState
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 (TimingStatsView -> String
timingStatsTitle (TimingStatsView -> String) -> TimingStatsView -> String
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
let description :: String
description = TimingStatsView -> String
timingStatsDescription (TimingStatsView -> String) -> TimingStatsView -> String
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
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
timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsTOCHtml TimingStatsViewState
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 (TimingStatsView -> String
timingStatsTitle (TimingStatsView -> String) -> TimingStatsView -> String
forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)