{-# 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 -> String
infoTitle        :: String,
             -- ^ This is a title for the view.
             InfoView -> String
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 :: String -> String -> ResultTransform -> ResultTransform -> InfoView
InfoView { infoTitle :: String
infoTitle        = String
"Information",
             infoDescription :: String
infoDescription  = String
"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
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer String
dir =
          do InfoViewState
st <- InfoView -> Experiment -> String -> ExperimentWriter InfoViewState
newInfo InfoView
v Experiment
exp String
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 :: (Int -> HtmlWriter ()) -> (Int -> HtmlWriter ()) -> WebPageWriter
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 (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter :: forall r.
ExperimentMonad r ()
-> ExperimentMonad r ()
-> (ExperimentData -> Composite ())
-> ExperimentContext r
-> ExperimentReporter r
ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = () -> ExperimentWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise   = () -> ExperimentWriter ()
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 :: forall r.
(Experiment
 -> r
 -> ExperimentEnvironment r
 -> ExperimentMonad r (ExperimentReporter r))
-> ExperimentGenerator r
ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
generateReporter = Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
forall p a.
Experiment
-> p
-> String
-> 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 -> [String]
infoNames  :: [String],
                InfoResults -> [String]
infoValues :: [String] }
  
-- | Create a new state of the view.
newInfo :: InfoView -> Experiment -> FilePath -> ExperimentWriter InfoViewState
newInfo :: InfoView -> Experiment -> String -> ExperimentWriter InfoViewState
newInfo InfoView
view Experiment
exp String
dir =
  do MVar (Maybe InfoResults)
r <- IO (MVar (Maybe InfoResults))
-> ExperimentWriter (MVar (Maybe InfoResults))
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 (m :: * -> *) a. Monad m => a -> m a
return InfoViewState :: InfoView -> Experiment -> MVar (Maybe InfoResults) -> InfoViewState
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 :: [[(String, String)]]
xs =
           ((ResultSource -> [(String, String)])
 -> [ResultSource] -> [[(String, String)]])
-> [ResultSource]
-> (ResultSource -> [(String, String)])
-> [[(String, String)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResultSource -> [(String, String)])
-> [ResultSource] -> [[(String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources ((ResultSource -> [(String, String)]) -> [[(String, String)]])
-> (ResultSource -> [(String, String)]) -> [[(String, String)]]
forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
           case ResultSource
source of
             ResultItemSource (ResultItem a
x) ->
               [(String -> String
resultNameToTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. ResultItemable a => a -> String
resultItemName a
x,
                 ResultLocalisation -> ResultId -> String
localiseResultDescription ResultLocalisation
loc (ResultId -> String) -> ResultId -> String
forall a b. (a -> b) -> a -> b
$ a -> ResultId
forall a. ResultItemable a => a -> ResultId
resultItemId a
x)]
             ResultObjectSource ResultObject
x ->
               [(String -> String
resultNameToTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ResultObject -> String
resultObjectName ResultObject
x,
                 ResultLocalisation -> ResultId -> String
localiseResultDescription ResultLocalisation
loc (ResultId -> String) -> ResultId -> String
forall a b. (a -> b) -> a -> b
$ ResultObject -> ResultId
resultObjectId ResultObject
x)]
             ResultVectorSource ResultVector
x ->
               [(String -> String
resultNameToTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ResultVector -> String
resultVectorName ResultVector
x,
                 ResultLocalisation -> ResultId -> String
localiseResultDescription ResultLocalisation
loc (ResultId -> String) -> ResultId -> String
forall a b. (a -> b) -> a -> b
$ ResultVector -> ResultId
resultVectorId ResultVector
x)]
             ResultSeparatorSource ResultSeparator
x ->
               []
         ([String]
names, [String]
values) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, String)] -> ([String], [String]))
-> [(String, String)] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String)]]
xs
     InfoResults -> IO InfoResults
forall (m :: * -> *) a. Monad m => a -> m a
return InfoResults :: [String] -> [String] -> InfoResults
InfoResults { infoNames :: [String]
infoNames  = [String]
names,
                          infoValues :: [String]
infoValues = [String]
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 :: [[String]]
xs =
           ((ResultSource -> [String]) -> [ResultSource] -> [[String]])
-> [ResultSource] -> (ResultSource -> [String]) -> [[String]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ResultSource -> [String]) -> [ResultSource] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map [ResultSource]
sources ((ResultSource -> [String]) -> [[String]])
-> (ResultSource -> [String]) -> [[String]]
forall a b. (a -> b) -> a -> b
$ \ResultSource
source ->
           case ResultSource
source of
             ResultItemSource (ResultItem a
x) ->
               [String -> String
resultNameToTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. ResultItemable a => a -> String
resultItemName a
x]
             ResultObjectSource ResultObject
x ->
               [String -> String
resultNameToTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ResultObject -> String
resultObjectName ResultObject
x]
             ResultVectorSource ResultVector
x ->
               [String -> String
resultNameToTitle (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ResultVector -> String
resultVectorName ResultVector
x]
             ResultSeparatorSource ResultSeparator
x ->
               []
     let names :: [String]
names = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
xs
     if ([String]
names [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= InfoResults -> [String]
infoNames InfoResults
results)
       then String -> IO InfoResults
forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireInfoResults"
       else InfoResults -> IO InfoResults
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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
       Just InfoResults
results ->
         do let names :: [String]
names  = InfoResults -> [String]
infoNames InfoResults
results
                values :: [String]
values = InfoResults -> [String]
infoValues InfoResults
results
            HtmlWriter () -> HtmlWriter ()
writeHtmlList (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
              [(String, String)]
-> ((String, String) -> HtmlWriter ()) -> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [String]
values) (((String, String) -> HtmlWriter ()) -> HtmlWriter ())
-> ((String, String) -> HtmlWriter ()) -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(String
name, String
value) ->
              HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
              do String -> HtmlWriter ()
writeHtmlText String
name
                 String -> HtmlWriter ()
writeHtmlText String
" - "
                 String -> HtmlWriter ()
writeHtmlText String
value

header :: InfoViewState -> Int -> HtmlWriter ()
header :: InfoViewState -> Int -> HtmlWriter ()
header InfoViewState
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 (InfoView -> String
infoTitle (InfoView -> String) -> InfoView -> String
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)
     let description :: String
description = InfoView -> String
infoDescription (InfoView -> String) -> InfoView -> String
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st
     Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> 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

-- | 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
$
  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 (InfoView -> String
infoTitle (InfoView -> String) -> InfoView -> String
forall a b. (a -> b) -> a -> b
$ InfoViewState -> InfoView
infoView InfoViewState
st)