{-# LANGUAGE TypeFamilies #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Base.WebPageRenderer
-- 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
--
-- It defines a renderer that creates a web page when running the simulation experiment.
--

module Simulation.Aivika.Experiment.Base.WebPageRenderer where

import Control.Monad
import Control.Monad.Trans

import System.IO
import System.Directory
import System.FilePath

import Simulation.Aivika
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.Base.HtmlWriter
import Simulation.Aivika.Experiment.Base.ExperimentWriter

-- | It defines the web page renderer for simulation 'Experiment'. 
data WebPageRenderer a = WebPageRenderer a ExperimentFilePath
                         -- ^ A renderer that depends on the provided parameter and
                         -- a directory path, where the simulation results are saved in.

-- | It replies to the requests made by the web page renderer.
data WebPageWriter =
  WebPageWriter { WebPageWriter -> Int -> HtmlWriter ()
reporterWriteTOCHtml :: Int -> HtmlWriter (),
                  -- ^ Return a TOC (Table of Contents) item for 
                  -- the HTML index file after the finalisation 
                  -- function is called, i.e. in the very end. 
                  -- The agument specifies the ordered number of 
                  -- the item.
                  --
                  -- You should wrap your HTML in 'writeHtmlListItem'.
                  WebPageWriter -> Int -> HtmlWriter ()
reporterWriteHtml :: Int -> HtmlWriter ()
                  -- ^ Return an HTML code for the index file
                  -- after the finalisation function is called,
                  -- i.e. in the very end. The agument specifies
                  -- the ordered number of the item.
                }

-- | A convenient type synonym for describing a web page generator.
type WebPageGenerator a = ExperimentGenerator (WebPageRenderer a)

-- | Rendering a web page with results when running the simulation experiment.
instance ExperimentRendering (WebPageRenderer a) where

  -- | A web page context.
  newtype ExperimentContext (WebPageRenderer a) =
    WebPageContext { ExperimentContext (WebPageRenderer a) -> WebPageWriter
runWebPageContext :: WebPageWriter
                     -- ^ Run the web page context.
                   }

  -- | A web page environment.
  type ExperimentEnvironment (WebPageRenderer a) = FilePath

  -- | A web page rendering monad.
  type ExperimentMonad (WebPageRenderer a) = ExperimentWriter

  liftExperiment :: WebPageRenderer a -> ExperimentMonad (WebPageRenderer a) a -> IO a
liftExperiment WebPageRenderer a
r = ExperimentMonad (WebPageRenderer a) a -> IO a
forall a. ExperimentWriter a -> IO a
runExperimentWriter

  prepareExperiment :: Experiment
-> WebPageRenderer a
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentEnvironment (WebPageRenderer a))
prepareExperiment Experiment
e (WebPageRenderer a
_ ExperimentFilePath
path0) =
    do FilePath
path <- FilePath -> ExperimentFilePath -> ExperimentWriter FilePath
resolveFilePath FilePath
"" ExperimentFilePath
path0
       IO () -> ExperimentWriter ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExperimentWriter ()) -> IO () -> ExperimentWriter ()
forall a b. (a -> b) -> a -> b
$ do
         Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose Experiment
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
           do FilePath -> IO ()
putStr FilePath
"Updating directory " 
              FilePath -> IO ()
putStrLn FilePath
path
         Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
path
       FilePath -> ExperimentWriter FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path

  renderExperiment :: Experiment
-> WebPageRenderer a
-> [ExperimentReporter (WebPageRenderer a)]
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad (WebPageRenderer a) ()
renderExperiment Experiment
e WebPageRenderer a
r [ExperimentReporter (WebPageRenderer a)]
reporters ExperimentEnvironment (WebPageRenderer a)
path = 
    do let html :: HtmlWriter ()
           html :: HtmlWriter ()
html = 
             FilePath -> HtmlWriter () -> HtmlWriter ()
writeHtmlDocumentWithTitle (Experiment -> FilePath
experimentTitle Experiment
e) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
             do HtmlWriter () -> HtmlWriter ()
writeHtmlList (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
                  [(Int, ExperimentReporter (WebPageRenderer a))]
-> ((Int, ExperimentReporter (WebPageRenderer a)) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [ExperimentReporter (WebPageRenderer a)]
-> [(Int, ExperimentReporter (WebPageRenderer a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [ExperimentReporter (WebPageRenderer a)]
reporters) (((Int, ExperimentReporter (WebPageRenderer a)) -> HtmlWriter ())
 -> HtmlWriter ())
-> ((Int, ExperimentReporter (WebPageRenderer a)) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, ExperimentReporter (WebPageRenderer a)
reporter) -> 
                  WebPageWriter -> Int -> HtmlWriter ()
reporterWriteTOCHtml (ExperimentContext (WebPageRenderer a) -> WebPageWriter
forall a. ExperimentContext (WebPageRenderer a) -> WebPageWriter
runWebPageContext (ExperimentContext (WebPageRenderer a) -> WebPageWriter)
-> ExperimentContext (WebPageRenderer a) -> WebPageWriter
forall a b. (a -> b) -> a -> b
$
                                        ExperimentReporter (WebPageRenderer a)
-> ExperimentContext (WebPageRenderer a)
forall r. ExperimentReporter r -> ExperimentContext r
reporterContext ExperimentReporter (WebPageRenderer a)
reporter) Int
i
                HtmlWriter ()
writeHtmlBreak
                Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ Experiment -> FilePath
experimentDescription Experiment
e) (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
$
                  FilePath -> HtmlWriter ()
writeHtmlText (FilePath -> HtmlWriter ()) -> FilePath -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ Experiment -> FilePath
experimentDescription Experiment
e
                [(Int, ExperimentReporter (WebPageRenderer a))]
-> ((Int, ExperimentReporter (WebPageRenderer a)) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [ExperimentReporter (WebPageRenderer a)]
-> [(Int, ExperimentReporter (WebPageRenderer a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [ExperimentReporter (WebPageRenderer a)]
reporters) (((Int, ExperimentReporter (WebPageRenderer a)) -> HtmlWriter ())
 -> HtmlWriter ())
-> ((Int, ExperimentReporter (WebPageRenderer a)) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, ExperimentReporter (WebPageRenderer a)
reporter) ->
                  WebPageWriter -> Int -> HtmlWriter ()
reporterWriteHtml (ExperimentContext (WebPageRenderer a) -> WebPageWriter
forall a. ExperimentContext (WebPageRenderer a) -> WebPageWriter
runWebPageContext (ExperimentContext (WebPageRenderer a) -> WebPageWriter)
-> ExperimentContext (WebPageRenderer a) -> WebPageWriter
forall a b. (a -> b) -> a -> b
$
                                     ExperimentReporter (WebPageRenderer a)
-> ExperimentContext (WebPageRenderer a)
forall r. ExperimentReporter r -> ExperimentContext r
reporterContext ExperimentReporter (WebPageRenderer a)
reporter) Int
i
           file :: FilePath
file = FilePath -> FilePath -> FilePath
combine FilePath
ExperimentEnvironment (WebPageRenderer a)
path FilePath
"index.html"
       ((), FilePath -> FilePath
contents) <- HtmlWriter ()
-> (FilePath -> FilePath)
-> ExperimentWriter ((), FilePath -> FilePath)
forall a.
HtmlWriter a
-> (FilePath -> FilePath)
-> ExperimentWriter (a, FilePath -> FilePath)
runHtmlWriter HtmlWriter ()
html FilePath -> FilePath
forall a. a -> a
id
       IO () -> ExperimentWriter ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExperimentWriter ()) -> IO () -> ExperimentWriter ()
forall a b. (a -> b) -> a -> b
$
         FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
file IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
         do Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
            Handle -> FilePath -> IO ()
hPutStr Handle
h (FilePath -> FilePath
contents [])
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose Experiment
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              do FilePath -> IO ()
putStr FilePath
"Generated file "
                 FilePath -> IO ()
putStrLn FilePath
file

  onExperimentCompleted :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad (WebPageRenderer a) ()
onExperimentCompleted Experiment
e WebPageRenderer a
r ExperimentEnvironment (WebPageRenderer a)
path = () -> ExperimentWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  onExperimentFailed :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> e
-> ExperimentMonad (WebPageRenderer a) ()
onExperimentFailed Experiment
e WebPageRenderer a
r ExperimentEnvironment (WebPageRenderer a)
path e
e' = e -> ExperimentWriter ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
e'