{-# LANGUAGE TypeFamilies #-}
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
data a = a ExperimentFilePath
data WebPageWriter =
WebPageWriter { WebPageWriter -> Int -> HtmlWriter ()
reporterWriteTOCHtml :: Int -> HtmlWriter (),
WebPageWriter -> Int -> HtmlWriter ()
reporterWriteHtml :: Int -> HtmlWriter ()
}
type WebPageGenerator a = ExperimentGenerator (WebPageRenderer a)
instance ExperimentRendering (WebPageRenderer a) where
newtype ExperimentContext (WebPageRenderer a) =
WebPageContext { forall a. ExperimentContext (WebPageRenderer a) -> WebPageWriter
runWebPageContext :: WebPageWriter
}
type ExperimentEnvironment (WebPageRenderer a) = FilePath
type ExperimentMonad (WebPageRenderer a) = ExperimentWriter
liftExperiment :: forall a.
WebPageRenderer a -> ExperimentMonad (WebPageRenderer a) a -> IO a
liftExperiment WebPageRenderer a
r = ExperimentMonad (WebPageRenderer a) a -> IO a
ExperimentWriter 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 a. IO a -> ExperimentWriter a
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 a. a -> ExperimentWriter a
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 a. [a] -> 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 a. IO a -> ExperimentWriter a
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 a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onExperimentFailed :: forall e.
Exception e =>
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 e a. Exception e => e -> ExperimentWriter a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
e'