{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Base.InfoView
-- 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 'InfoView' that shows the description of series.
--

module Simulation.Aivika.Experiment.Base.InfoView
       (InfoView(..), 
        defaultInfoView) where

import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar

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.Concurrent.MVar

-- | Defines the 'View' that shows the description of series.
data InfoView =
  InfoView { InfoView -> ResultDescription
infoTitle        :: String,
             -- ^ This is a title for the view.
             InfoView -> ResultDescription
infoDescription  :: String,
             -- ^ This is a text description used in HTML.
             InfoView -> ResultTransform
infoTransform    :: ResultTransform,
             -- ^ The transform applied to the results before receiving series.
             InfoView -> ResultTransform
infoSeries       :: ResultTransform
             -- ^ It defines the series for which the description is shown.
           }
  
-- | The default description view.  
defaultInfoView :: InfoView
defaultInfoView :: InfoView
defaultInfoView = 
  InfoView { infoTitle :: ResultDescription
infoTitle        = ResultDescription
"Information",
             infoDescription :: ResultDescription
infoDescription  = ResultDescription
"It shows the information about simulation entities:",
             infoTransform :: ResultTransform
infoTransform    = ResultTransform
forall a. a -> a
id,
             infoSeries :: ResultTransform
infoSeries       = ResultTransform
forall a. a -> a
id }

instance ExperimentView InfoView (WebPageRenderer a) where
  
  outputView :: InfoView -> ExperimentGenerator (WebPageRenderer a)
outputView InfoView
v = 
    let reporter :: Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer ResultDescription
dir =
          do InfoViewState
st <- InfoView
-> Experiment
-> ResultDescription
-> ExperimentWriter InfoViewState
newInfo InfoView
v Experiment
exp ResultDescription
dir
             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 = InfoViewState -> Int -> HtmlWriter ()
infoTOCHtml InfoViewState
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = InfoViewState -> Int -> HtmlWriter ()
infoHtml InfoViewState
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   = InfoViewState -> ExperimentData -> Composite ()
simulateInfo InfoViewState
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
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
forall {p} {a}.
Experiment
-> p
-> ResultDescription
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
  
-- | The state of the view.
data InfoViewState =
  InfoViewState { InfoViewState -> InfoView
infoView       :: InfoView,
                  InfoViewState -> Experiment
infoExperiment :: Experiment,
                  InfoViewState -> MVar (Maybe InfoResults)
infoResults    :: MVar (Maybe InfoResults) }

-- | The information table.
data InfoResults =
  InfoResults { InfoResults -> [ResultDescription]
infoNames  :: [String],
                InfoResults -> [ResultDescription]
infoValues :: [String] }
  
-- | Create a new state of the view.
newInfo :: InfoView -> Experiment -> FilePath -> ExperimentWriter InfoViewState
newInfo :: InfoView
-> Experiment
-> ResultDescription
-> ExperimentWriter InfoViewState
newInfo InfoView
view Experiment
exp ResultDescription
dir =
  do MVar (Maybe InfoResults)
r <- IO (MVar (Maybe InfoResults))
-> ExperimentWriter (MVar (Maybe InfoResults))
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Maybe InfoResults))
 -> ExperimentWriter (MVar (Maybe InfoResults)))
-> IO (MVar (Maybe InfoResults))
-> ExperimentWriter (MVar (Maybe InfoResults))
forall a b. (a -> b) -> a -> b
$ Maybe InfoResults -> IO (MVar (Maybe InfoResults))
forall a. a -> IO (MVar a)
newMVar Maybe InfoResults
forall a. Maybe a
Nothing
     InfoViewState -> ExperimentWriter InfoViewState
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoViewState { infoView :: InfoView
infoView       = InfoView
view,
                            infoExperiment :: Experiment
infoExperiment = Experiment
exp,
                            infoResults :: MVar (Maybe InfoResults)
infoResults    = MVar (Maybe InfoResults)
r }
       
-- | Create a new information table.
newInfoResults :: [ResultSource] -> ResultLocalisation -> Experiment -> IO InfoResults
newInfoResults :: [ResultSource]
-> ResultLocalisation -> Experiment -> IO InfoResults
newInfoResults [ResultSource]
sources ResultLocalisation
loc Experiment
exp =
  do let xs :: [[(ResultDescription, ResultDescription)]]
xs =
           ((ResultSource -> [(ResultDescription, ResultDescription)])
 -> [ResultSource] -> [[(ResultDescription, ResultDescription)]])
-> [ResultSource]
-> (ResultSource -> [(ResultDescription, ResultDescription)])
-> [[(ResultDescription, ResultDescription)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResultSource -> [(ResultDescription, ResultDescription)])
-> [ResultSource] -> [[(ResultDescription, ResultDescription)]]
forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources ((ResultSource -> [(ResultDescription, ResultDescription)])
 -> [[(ResultDescription, ResultDescription)]])
-> (ResultSource -> [(ResultDescription, ResultDescription)])
-> [[(ResultDescription, ResultDescription)]]
forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
           case ResultSource
source of
             ResultItemSource (ResultItem a
x) ->
               [(ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ a -> ResultDescription
forall a. ResultItemable a => a -> ResultDescription
resultItemName a
x,
                 ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc (ResultId -> ResultDescription) -> ResultId -> ResultDescription
forall a b. (a -> b) -> a -> b
$ a -> ResultId
forall a. ResultItemable a => a -> ResultId
resultItemId a
x)]
             ResultObjectSource ResultObject
x ->
               [(ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultDescription
resultObjectName ResultObject
x,
                 ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc (ResultId -> ResultDescription) -> ResultId -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultId
resultObjectId ResultObject
x)]
             ResultVectorSource ResultVector
x ->
               [(ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultDescription
resultVectorName ResultVector
x,
                 ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc (ResultId -> ResultDescription) -> ResultId -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultId
resultVectorId ResultVector
x)]
             ResultSeparatorSource ResultSeparator
x ->
               []
         ([ResultDescription]
names, [ResultDescription]
values) = [(ResultDescription, ResultDescription)]
-> ([ResultDescription], [ResultDescription])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ResultDescription, ResultDescription)]
 -> ([ResultDescription], [ResultDescription]))
-> [(ResultDescription, ResultDescription)]
-> ([ResultDescription], [ResultDescription])
forall a b. (a -> b) -> a -> b
$ [[(ResultDescription, ResultDescription)]]
-> [(ResultDescription, ResultDescription)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(ResultDescription, ResultDescription)]]
xs
     InfoResults -> IO InfoResults
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoResults { infoNames :: [ResultDescription]
infoNames  = [ResultDescription]
names,
                          infoValues :: [ResultDescription]
infoValues = [ResultDescription]
values }

-- | Require to return the unique information table associated with the specified state. 
requireInfoResults :: InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults :: InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults InfoViewState
st [ResultSource]
sources =
  let view :: InfoView
view = InfoViewState -> InfoView
infoView InfoViewState
st
      exp :: Experiment
exp  = InfoViewState -> Experiment
infoExperiment InfoViewState
st
      loc :: ResultLocalisation
loc  = Experiment -> ResultLocalisation
experimentLocalisation Experiment
exp
  in MVar (Maybe InfoResults)
-> IO InfoResults
-> (InfoResults -> IO InfoResults)
-> IO InfoResults
forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (InfoViewState -> MVar (Maybe InfoResults)
infoResults InfoViewState
st)
     ([ResultSource]
-> ResultLocalisation -> Experiment -> IO InfoResults
newInfoResults [ResultSource]
sources ResultLocalisation
loc Experiment
exp) ((InfoResults -> IO InfoResults) -> IO InfoResults)
-> (InfoResults -> IO InfoResults) -> IO InfoResults
forall a b. (a -> b) -> a -> b
$ \InfoResults
results ->
  do let xs :: [[ResultDescription]]
xs =
           ((ResultSource -> [ResultDescription])
 -> [ResultSource] -> [[ResultDescription]])
-> [ResultSource]
-> (ResultSource -> [ResultDescription])
-> [[ResultDescription]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResultSource -> [ResultDescription])
-> [ResultSource] -> [[ResultDescription]]
forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources ((ResultSource -> [ResultDescription]) -> [[ResultDescription]])
-> (ResultSource -> [ResultDescription]) -> [[ResultDescription]]
forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
           case ResultSource
source of
             ResultItemSource (ResultItem a
x) ->
               [ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ a -> ResultDescription
forall a. ResultItemable a => a -> ResultDescription
resultItemName a
x]
             ResultObjectSource ResultObject
x ->
               [ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultDescription
resultObjectName ResultObject
x]
             ResultVectorSource ResultVector
x ->
               [ResultDescription -> ResultDescription
resultNameToTitle (ResultDescription -> ResultDescription)
-> ResultDescription -> ResultDescription
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultDescription
resultVectorName ResultVector
x]
             ResultSeparatorSource ResultSeparator
x ->
               []
     let names :: [ResultDescription]
names = [[ResultDescription]] -> [ResultDescription]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ResultDescription]]
xs
     if ([ResultDescription]
names [ResultDescription] -> [ResultDescription] -> Bool
forall a. Eq a => a -> a -> Bool
/= InfoResults -> [ResultDescription]
infoNames InfoResults
results)
       then ResultDescription -> IO InfoResults
forall a. HasCallStack => ResultDescription -> a
error ResultDescription
"Series with different names are returned for different runs: requireInfoResults"
       else InfoResults -> IO InfoResults
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoResults
results
       
-- | Simulate the specified series.
simulateInfo :: InfoViewState -> ExperimentData -> Composite ()
simulateInfo :: InfoViewState -> ExperimentData -> Composite ()
simulateInfo InfoViewState
st ExperimentData
expdata =
  do let view :: InfoView
view    = InfoViewState -> InfoView
infoView InfoViewState
st
         rs :: Results
rs      = InfoView -> ResultTransform
infoSeries InfoView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
                   InfoView -> ResultTransform
infoTransform InfoView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         sources :: [ResultSource]
sources = Results -> [ResultSource]
resultSourceList Results
rs
     IO InfoResults -> Composite InfoResults
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InfoResults -> Composite InfoResults)
-> IO InfoResults -> Composite InfoResults
forall a b. (a -> b) -> a -> b
$ InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults InfoViewState
st [ResultSource]
sources
     () -> Composite ()
forall a. a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Get the HTML code.     
infoHtml :: InfoViewState -> Int -> HtmlWriter ()
infoHtml :: InfoViewState -> Int -> HtmlWriter ()
infoHtml InfoViewState
st Int
index =
  do InfoViewState -> Int -> HtmlWriter ()
header InfoViewState
st Int
index
     Maybe InfoResults
results <- IO (Maybe InfoResults) -> HtmlWriter (Maybe InfoResults)
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InfoResults) -> HtmlWriter (Maybe InfoResults))
-> IO (Maybe InfoResults) -> HtmlWriter (Maybe InfoResults)
forall a b. (a -> b) -> a -> b
$ MVar (Maybe InfoResults) -> IO (Maybe InfoResults)
forall a. MVar a -> IO a
readMVar (InfoViewState -> MVar (Maybe InfoResults)
infoResults InfoViewState
st)
     case Maybe InfoResults
results of
       Maybe InfoResults
Nothing -> () -> HtmlWriter ()
forall a. a -> HtmlWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just InfoResults
results ->
         do let names :: [ResultDescription]
names  = InfoResults -> [ResultDescription]
infoNames InfoResults
results
                values :: [ResultDescription]
values = InfoResults -> [ResultDescription]
infoValues InfoResults
results
            HtmlWriter () -> HtmlWriter ()
writeHtmlList (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
              [(ResultDescription, ResultDescription)]
-> ((ResultDescription, ResultDescription) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([ResultDescription]
-> [ResultDescription] -> [(ResultDescription, ResultDescription)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ResultDescription]
names [ResultDescription]
values) (((ResultDescription, ResultDescription) -> HtmlWriter ())
 -> HtmlWriter ())
-> ((ResultDescription, ResultDescription) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(ResultDescription
name, ResultDescription
value) ->
              HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
              do ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
name
                 ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
" - "
                 ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
value

header :: InfoViewState -> Int -> HtmlWriter ()
header :: InfoViewState -> Int -> HtmlWriter ()
header InfoViewState
st Int
index =
  do ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (ResultDescription
"id" ResultDescription -> ResultDescription -> ResultDescription
forall a. [a] -> [a] -> [a]
++ Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ 
       ResultDescription -> HtmlWriter ()
writeHtmlText (InfoView -> ResultDescription
infoTitle (InfoView -> ResultDescription) -> InfoView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)
     let description :: ResultDescription
description = InfoView -> ResultDescription
infoDescription (InfoView -> ResultDescription) -> InfoView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st
     Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ResultDescription -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultDescription
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
$ 
       ResultDescription -> HtmlWriter ()
writeHtmlText ResultDescription
description

-- | Get the TOC item.
infoTOCHtml :: InfoViewState -> Int -> HtmlWriter ()
infoTOCHtml :: InfoViewState -> Int -> HtmlWriter ()
infoTOCHtml InfoViewState
st Int
index =
  HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
  ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription
"#id" ResultDescription -> ResultDescription -> ResultDescription
forall a. [a] -> [a] -> [a]
++ Int -> ResultDescription
forall a. Show a => a -> ResultDescription
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
  ResultDescription -> HtmlWriter ()
writeHtmlText (InfoView -> ResultDescription
infoTitle (InfoView -> ResultDescription) -> InfoView -> ResultDescription
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)