{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Base.LastValueView
-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines 'LastValueView' that shows the last values
-- for the simulation variables.
--

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)

-- | Defines the 'View' that shows the last values of the simulation
-- variables.
data LastValueView =
  LastValueView { LastValueView -> String
lastValueTitle       :: String,
                  -- ^ The title for the view.
                  LastValueView -> String
lastValueRunTitle    :: String,
                  -- ^ The run title for the view. It may include
                  -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and 
                  -- @$TITLE@.
                  --
                  -- An example is 
                  --
                  -- @
                  --   lastValueRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"
                  -- @
                  LastValueView -> String
lastValueDescription :: String,
                  -- ^ The description for the view.
                  LastValueView -> ShowS
lastValueFormatter   :: ShowS,
                  -- ^ It transforms data before they will be shown.
                  LastValueView -> ResultTransform
lastValueTransform   :: ResultTransform,
                  -- ^ The transform applied to the results before receiving series.
                  LastValueView -> ResultTransform
lastValueSeries      :: ResultTransform 
                  -- ^ It defines the series for which the last values to be shown.
                }
  
-- | This is the default view.
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   = forall a. a -> a
id,
                  lastValueTransform :: ResultTransform
lastValueTransform   = forall a. a -> a
id,
                  lastValueSeries :: ResultTransform
lastValueSeries      = 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 =
                   forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext 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 }
             forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise   = forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = LastValueViewState -> ExperimentData -> Composite ()
simulateLastValues LastValueViewState
st,
                                         reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext    = forall {a}. ExperimentContext (WebPageRenderer a)
context }
    in ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
generateReporter = forall {p} {p} {a}.
Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }

-- | The state of the view.
data LastValueViewState =
  LastValueViewState { LastValueViewState -> LastValueView
lastValueView       :: LastValueView,
                       LastValueViewState -> Experiment
lastValueExperiment :: Experiment,
                       LastValueViewState -> Map Int (IORef [(String, String)])
lastValueMap        :: M.Map Int (IORef [(String, String)]) }
  
-- | Create a new state of the view.
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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []    
     let m :: Map Int (IORef [(String, String)])
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] [IORef [(String, String)]]
rs
     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 }
       
-- | Get the last values during the simulation.
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 forall a b. (a -> b) -> a -> b
$
                   LastValueView -> ResultTransform
lastValueTransform LastValueView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         loc :: [ResultId] -> String
loc     = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle forall a b. (a -> b) -> a -> b
$
                   Experiment -> ResultLocalisation
experimentLocalisation 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 <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
     forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal forall a b. (a -> b) -> a -> b
$ \Double
t ->
       do let r :: IORef [(String, String)]
r = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
i forall a. Num a => a -> a -> a
- Int
1) (LastValueViewState -> Map Int (IORef [(String, String)])
lastValueMap LastValueViewState
st)
          [(String, String)]
output <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResultValue String]
exts forall a b. (a -> b) -> a -> b
$ \ResultValue String
ext ->
            do String
x <- forall e. ResultValue e -> ResultData e
resultValueData ResultValue String
ext
               forall (m :: * -> *) a. Monad m => a -> m a
return ([ResultId] -> String
loc forall a b. (a -> b) -> a -> b
$ forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue String
ext, String
x)
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef [(String, String)]
r [(String, String)]
output
     
-- | Get the HTML code.     
lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()     
lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtml LastValueViewState
st Int
index =
  let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ LastValueViewState -> Experiment
lastValueExperiment LastValueViewState
st
  in if Int
n 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
     
-- | Get the HTML code for a single run.
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 = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef [(String, String)]
r
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
pairs forall a b. (a -> b) -> a -> b
$ \(String, String)
pair ->
       (String, String) -> ShowS -> HtmlWriter ()
formatPair (String, String)
pair (LastValueView -> ShowS
lastValueFormatter forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)

-- | Get the HTML code for multiple runs
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 forall a b. (a -> b) -> a -> b
$ LastValueViewState -> Experiment
lastValueExperiment LastValueViewState
st
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i ->
       do let subtitle :: String
subtitle = 
                String -> String -> ShowS
replace String
"$RUN_INDEX" (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$
                String -> String -> ShowS
replace String
"$RUN_COUNT" (forall a. Show a => a -> String
show Int
n) forall a b. (a -> b) -> a -> b
$
                String -> String -> ShowS
replace String
"$TITLE" (LastValueView -> String
lastValueTitle forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
                (LastValueView -> String
lastValueRunTitle forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
          HtmlWriter () -> HtmlWriter ()
writeHtmlHeader4 forall a b. (a -> b) -> a -> b
$
            String -> HtmlWriter ()
writeHtmlText String
subtitle
          let r :: IORef [(String, String)]
r = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef [(String, String)]
r
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
pairs forall a b. (a -> b) -> a -> b
$ \(String, String)
pair ->
            (String, String) -> ShowS -> HtmlWriter ()
formatPair (String, String)
pair (LastValueView -> ShowS
lastValueFormatter forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)

header :: LastValueViewState -> Int -> HtmlWriter ()
header :: LastValueViewState -> Int -> HtmlWriter ()
header LastValueViewState
st Int
index =
  do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
       String -> HtmlWriter ()
writeHtmlText (LastValueView -> String
lastValueTitle forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)
     let description :: String
description = LastValueView -> String
lastValueDescription forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
description) forall a b. (a -> b) -> a -> b
$
       HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph 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 forall a b. (a -> b) -> a -> b
$ 
  do String -> HtmlWriter ()
writeHtmlText String
name
     String -> HtmlWriter ()
writeHtmlText String
" = "
     String -> HtmlWriter ()
writeHtmlText forall a b. (a -> b) -> a -> b
$ ShowS
formatter String
value
          
-- | Get the TOC item     
lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueTOCHtml LastValueViewState
st Int
index =
  HtmlWriter () -> HtmlWriter ()
writeHtmlListItem forall a b. (a -> b) -> a -> b
$
  String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
  String -> HtmlWriter ()
writeHtmlText (LastValueView -> String
lastValueTitle forall a b. (a -> b) -> a -> b
$ LastValueViewState -> LastValueView
lastValueView LastValueViewState
st)