{-# 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    = forall a. a -> a
id,
             infoSeries :: ResultTransform
infoSeries       = 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 =
                   forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext 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 }
             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   = InfoViewState -> ExperimentData -> Composite ()
simulateInfo InfoViewState
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} {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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
     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 =
           forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
           case ResultSource
source of
             ResultItemSource (ResultItem a
x) ->
               [(ResultDescription -> ResultDescription
resultNameToTitle forall a b. (a -> b) -> a -> b
$ forall a. ResultItemable a => a -> ResultDescription
resultItemName a
x,
                 ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc forall a b. (a -> b) -> a -> b
$ forall a. ResultItemable a => a -> ResultId
resultItemId a
x)]
             ResultObjectSource ResultObject
x ->
               [(ResultDescription -> ResultDescription
resultNameToTitle forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultDescription
resultObjectName ResultObject
x,
                 ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultId
resultObjectId ResultObject
x)]
             ResultVectorSource ResultVector
x ->
               [(ResultDescription -> ResultDescription
resultNameToTitle forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultDescription
resultVectorName ResultVector
x,
                 ResultLocalisation -> ResultId -> ResultDescription
localiseResultDescription ResultLocalisation
loc forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultId
resultVectorId ResultVector
x)]
             ResultSeparatorSource ResultSeparator
x ->
               []
         ([ResultDescription]
names, [ResultDescription]
values) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(ResultDescription, ResultDescription)]]
xs
     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 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) forall a b. (a -> b) -> a -> b
$ \InfoResults
results ->
  do let xs :: [[ResultDescription]]
xs =
           forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
           case ResultSource
source of
             ResultItemSource (ResultItem a
x) ->
               [ResultDescription -> ResultDescription
resultNameToTitle forall a b. (a -> b) -> a -> b
$ forall a. ResultItemable a => a -> ResultDescription
resultItemName a
x]
             ResultObjectSource ResultObject
x ->
               [ResultDescription -> ResultDescription
resultNameToTitle forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultDescription
resultObjectName ResultObject
x]
             ResultVectorSource ResultVector
x ->
               [ResultDescription -> ResultDescription
resultNameToTitle forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultDescription
resultVectorName ResultVector
x]
             ResultSeparatorSource ResultSeparator
x ->
               []
     let names :: [ResultDescription]
names = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ResultDescription]]
xs
     if ([ResultDescription]
names forall a. Eq a => a -> a -> Bool
/= InfoResults -> [ResultDescription]
infoNames InfoResults
results)
       then forall a. HasCallStack => ResultDescription -> a
error ResultDescription
"Series with different names are returned for different runs: requireInfoResults"
       else 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 forall a b. (a -> b) -> a -> b
$
                   InfoView -> ResultTransform
infoTransform InfoView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         sources :: [ResultSource]
sources = Results -> [ResultSource]
resultSourceList Results
rs
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ InfoViewState -> [ResultSource] -> IO InfoResults
requireInfoResults InfoViewState
st [ResultSource]
sources
     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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar (InfoViewState -> MVar (Maybe InfoResults)
infoResults InfoViewState
st)
     case Maybe InfoResults
results of
       Maybe InfoResults
Nothing -> 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 forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [ResultDescription]
names [ResultDescription]
values) forall a b. (a -> b) -> a -> b
$ \(ResultDescription
name, ResultDescription
value) ->
              HtmlWriter () -> HtmlWriter ()
writeHtmlListItem 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" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ResultDescription
show Int
index) forall a b. (a -> b) -> a -> b
$ 
       ResultDescription -> HtmlWriter ()
writeHtmlText (InfoView -> ResultDescription
infoTitle forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)
     let description :: ResultDescription
description = InfoView -> ResultDescription
infoDescription forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultDescription
description) forall a b. (a -> b) -> a -> b
$
       HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph 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 forall a b. (a -> b) -> a -> b
$
  ResultDescription -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (ResultDescription
"#id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ResultDescription
show Int
index) forall a b. (a -> b) -> a -> b
$
  ResultDescription -> HtmlWriter ()
writeHtmlText (InfoView -> ResultDescription
infoTitle forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)