{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.FinalTableView
(FinalTableView(..),
defaultFinalTableView) where
import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import System.IO
import System.FilePath
import Simulation.Aivika
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.Base.WebPageRenderer
import Simulation.Aivika.Experiment.Base.FileRenderer
import Simulation.Aivika.Experiment.Base.ExperimentWriter
import Simulation.Aivika.Experiment.Base.HtmlWriter
import Simulation.Aivika.Experiment.Concurrent.MVar
data FinalTableView =
FinalTableView { FinalTableView -> String
finalTableTitle :: String,
FinalTableView -> String
finalTableDescription :: String,
FinalTableView -> String
finalTableRunText :: String,
FinalTableView -> String
finalTableLinkText :: String,
FinalTableView -> ExperimentFilePath
finalTableFileName :: ExperimentFilePath,
FinalTableView -> String
finalTableSeparator :: String,
FinalTableView -> ShowS
finalTableFormatter :: ShowS,
FinalTableView -> Event Bool
finalTablePredicate :: Event Bool,
FinalTableView -> ResultTransform
finalTableTransform :: ResultTransform,
FinalTableView -> ResultTransform
finalTableSeries :: ResultTransform
}
defaultFinalTableView :: FinalTableView
defaultFinalTableView :: FinalTableView
defaultFinalTableView =
FinalTableView { finalTableTitle :: String
finalTableTitle = String
"Final Table",
finalTableDescription :: String
finalTableDescription = String
"It refers to the CSV file with the results in the final time points.",
finalTableRunText :: String
finalTableRunText = String
"Run",
finalTableLinkText :: String
finalTableLinkText = String
"Download the CSV file",
finalTableFileName :: ExperimentFilePath
finalTableFileName = String -> ExperimentFilePath
UniqueFilePath String
"FinalTable.csv",
finalTableSeparator :: String
finalTableSeparator = String
",",
finalTableFormatter :: ShowS
finalTableFormatter = ShowS
forall a. a -> a
id,
finalTablePredicate :: Event Bool
finalTablePredicate = Bool -> Event Bool
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
finalTableTransform :: ResultTransform
finalTableTransform = ResultTransform
expandResults,
finalTableSeries :: ResultTransform
finalTableSeries = ResultTransform
forall a. a -> a
id }
instance ExperimentView FinalTableView (WebPageRenderer a) where
outputView :: FinalTableView -> ExperimentGenerator (WebPageRenderer a)
outputView FinalTableView
v =
let reporter :: Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer String
dir =
do FinalTableViewState
st <- FinalTableView
-> Experiment -> String -> ExperimentWriter FinalTableViewState
newFinalTable FinalTableView
v Experiment
exp String
dir
let context :: ExperimentContext (WebPageRenderer a)
context =
WebPageWriter -> ExperimentContext (WebPageRenderer a)
forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext
WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter ()
reporterWriteTOCHtml = FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml FinalTableViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = FinalTableViewState -> Int -> HtmlWriter ()
finalTableHtml FinalTableViewState
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 = FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable FinalTableViewState
st,
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable FinalTableViewState
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
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
(WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
forall {p} {a}.
Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
instance ExperimentView FinalTableView (FileRenderer a) where
outputView :: FinalTableView -> ExperimentGenerator (FileRenderer a)
outputView FinalTableView
v =
let reporter :: Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp p
renderer String
dir =
do FinalTableViewState
st <- FinalTableView
-> Experiment -> String -> ExperimentWriter FinalTableViewState
newFinalTable FinalTableView
v Experiment
exp String
dir
ExperimentReporter (FileRenderer a)
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (FileRenderer a) ()
reporterInitialise = () -> ExperimentWriter ()
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterFinalise :: ExperimentMonad (FileRenderer a) ()
reporterFinalise = FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable FinalTableViewState
st,
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable FinalTableViewState
st,
reporterContext :: ExperimentContext (FileRenderer a)
reporterContext = ExperimentContext (FileRenderer a)
forall a. ExperimentContext (FileRenderer a)
FileContext }
in ExperimentGenerator { generateReporter :: Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad
(FileRenderer a) (ExperimentReporter (FileRenderer a))
generateReporter = Experiment
-> FileRenderer a
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
Experiment
-> FileRenderer a
-> ExperimentEnvironment (FileRenderer a)
-> ExperimentMonad
(FileRenderer a) (ExperimentReporter (FileRenderer a))
forall {p} {a}.
Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter }
data FinalTableViewState =
FinalTableViewState { FinalTableViewState -> FinalTableView
finalTableView :: FinalTableView,
FinalTableViewState -> Experiment
finalTableExperiment :: Experiment,
FinalTableViewState -> String
finalTableDir :: FilePath,
FinalTableViewState -> IORef (Maybe String)
finalTableFile :: IORef (Maybe FilePath),
FinalTableViewState -> MVar (Maybe FinalTableResults)
finalTableResults :: MVar (Maybe FinalTableResults) }
data FinalTableResults =
FinalTableResults { FinalTableResults -> [String]
finalTableNames :: [String],
FinalTableResults -> MVar (Map Int [String])
finalTableValues :: MVar (M.Map Int [String]) }
newFinalTable :: FinalTableView -> Experiment -> FilePath -> ExperimentWriter FinalTableViewState
newFinalTable :: FinalTableView
-> Experiment -> String -> ExperimentWriter FinalTableViewState
newFinalTable FinalTableView
view Experiment
exp String
dir =
do IORef (Maybe String)
f <- IO (IORef (Maybe String))
-> ExperimentWriter (IORef (Maybe String))
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe String))
-> ExperimentWriter (IORef (Maybe String)))
-> IO (IORef (Maybe String))
-> ExperimentWriter (IORef (Maybe String))
forall a b. (a -> b) -> a -> b
$ Maybe String -> IO (IORef (Maybe String))
forall a. a -> IO (IORef a)
newIORef Maybe String
forall a. Maybe a
Nothing
MVar (Maybe FinalTableResults)
r <- IO (MVar (Maybe FinalTableResults))
-> ExperimentWriter (MVar (Maybe FinalTableResults))
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Maybe FinalTableResults))
-> ExperimentWriter (MVar (Maybe FinalTableResults)))
-> IO (MVar (Maybe FinalTableResults))
-> ExperimentWriter (MVar (Maybe FinalTableResults))
forall a b. (a -> b) -> a -> b
$ Maybe FinalTableResults -> IO (MVar (Maybe FinalTableResults))
forall a. a -> IO (MVar a)
newMVar Maybe FinalTableResults
forall a. Maybe a
Nothing
FinalTableViewState -> ExperimentWriter FinalTableViewState
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return FinalTableViewState { finalTableView :: FinalTableView
finalTableView = FinalTableView
view,
finalTableExperiment :: Experiment
finalTableExperiment = Experiment
exp,
finalTableDir :: String
finalTableDir = String
dir,
finalTableFile :: IORef (Maybe String)
finalTableFile = IORef (Maybe String)
f,
finalTableResults :: MVar (Maybe FinalTableResults)
finalTableResults = MVar (Maybe FinalTableResults)
r }
newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults
newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults
newFinalTableResults [String]
names Experiment
exp =
do MVar (Map Int [String])
values <- Map Int [String] -> IO (MVar (Map Int [String]))
forall a. a -> IO (MVar a)
newMVar Map Int [String]
forall k a. Map k a
M.empty
FinalTableResults -> IO FinalTableResults
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FinalTableResults { finalTableNames :: [String]
finalTableNames = [String]
names,
finalTableValues :: MVar (Map Int [String])
finalTableValues = MVar (Map Int [String])
values }
requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults
requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults
requireFinalTableResults FinalTableViewState
st [String]
names =
MVar (Maybe FinalTableResults)
-> IO FinalTableResults
-> (FinalTableResults -> IO FinalTableResults)
-> IO FinalTableResults
forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (FinalTableViewState -> MVar (Maybe FinalTableResults)
finalTableResults FinalTableViewState
st)
([String] -> Experiment -> IO FinalTableResults
newFinalTableResults [String]
names (FinalTableViewState -> Experiment
finalTableExperiment FinalTableViewState
st)) ((FinalTableResults -> IO FinalTableResults)
-> IO FinalTableResults)
-> (FinalTableResults -> IO FinalTableResults)
-> IO FinalTableResults
forall a b. (a -> b) -> a -> b
$ \FinalTableResults
results ->
if ([String]
names [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= FinalTableResults -> [String]
finalTableNames FinalTableResults
results)
then String -> IO FinalTableResults
forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireFinalTableResults"
else FinalTableResults -> IO FinalTableResults
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FinalTableResults
results
simulateFinalTable :: FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable :: FinalTableViewState -> ExperimentData -> Composite ()
simulateFinalTable FinalTableViewState
st ExperimentData
expdata =
do let view :: FinalTableView
view = FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st
rs :: Results
rs = FinalTableView -> ResultTransform
finalTableSeries FinalTableView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
FinalTableView -> ResultTransform
finalTableTransform FinalTableView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
loc :: [ResultId] -> String
loc = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle (ResultLocalisation -> [ResultId] -> String)
-> ResultLocalisation -> [ResultId] -> String
forall a b. (a -> b) -> a -> b
$
Experiment -> ResultLocalisation
experimentLocalisation (Experiment -> ResultLocalisation)
-> Experiment -> ResultLocalisation
forall a b. (a -> b) -> a -> b
$
FinalTableViewState -> Experiment
finalTableExperiment FinalTableViewState
st
exts :: [ResultValue String]
exts = Results -> [ResultValue String]
resultsToStringValues Results
rs
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
signal :: Signal Double
signal = (Double -> Event Bool) -> Signal Double -> Signal Double
forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (Event Bool -> Double -> Event Bool
forall a b. a -> b -> a
const Event Bool
predicate) (Signal Double -> Signal Double) -> Signal Double -> Signal Double
forall a b. (a -> b) -> a -> b
$
ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
names :: [String]
names = (ResultValue String -> String) -> [ResultValue String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc ([ResultId] -> String)
-> (ResultValue String -> [ResultId])
-> ResultValue String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultValue String -> [ResultId]
forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue String]
exts
predicate :: Event Bool
predicate = FinalTableView -> Event Bool
finalTablePredicate FinalTableView
view
FinalTableResults
results <- IO FinalTableResults -> Composite FinalTableResults
forall a. IO a -> Composite a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FinalTableResults -> Composite FinalTableResults)
-> IO FinalTableResults -> Composite FinalTableResults
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> [String] -> IO FinalTableResults
requireFinalTableResults FinalTableViewState
st [String]
names
let values :: MVar (Map Int [String])
values = FinalTableResults -> MVar (Map Int [String])
finalTableValues FinalTableResults
results
Signal Double -> (Double -> Event ()) -> Composite ()
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal ((Double -> Event ()) -> Composite ())
-> (Double -> Event ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \Double
_ ->
do [String]
xs <- (ResultValue String -> Event String)
-> [ResultValue String] -> Event [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ResultValue String -> Event String
forall e. ResultValue e -> ResultData e
resultValueData [ResultValue String]
exts
Int
i <- Parameter Int -> Event Int
forall a. Parameter a -> Event a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
IO () -> Event ()
forall a. IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$ MVar (Map Int [String])
-> (Map Int [String] -> IO (Map Int [String])) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map Int [String])
values ((Map Int [String] -> IO (Map Int [String])) -> IO ())
-> (Map Int [String] -> IO (Map Int [String])) -> IO ()
forall a b. (a -> b) -> a -> b
$ Map Int [String] -> IO (Map Int [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Int [String] -> IO (Map Int [String]))
-> (Map Int [String] -> Map Int [String])
-> Map Int [String]
-> IO (Map Int [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> Map Int [String] -> Map Int [String]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
i [String]
xs
finaliseFinalTable :: FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable :: FinalTableViewState -> ExperimentWriter ()
finaliseFinalTable FinalTableViewState
st =
do let view :: FinalTableView
view = FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st
run :: String
run = FinalTableView -> String
finalTableRunText FinalTableView
view
formatter :: ShowS
formatter = FinalTableView -> ShowS
finalTableFormatter FinalTableView
view
title :: String
title = FinalTableView -> String
finalTableTitle FinalTableView
view
separator :: String
separator = FinalTableView -> String
finalTableSeparator FinalTableView
view
Maybe FinalTableResults
results <- IO (Maybe FinalTableResults)
-> ExperimentWriter (Maybe FinalTableResults)
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FinalTableResults)
-> ExperimentWriter (Maybe FinalTableResults))
-> IO (Maybe FinalTableResults)
-> ExperimentWriter (Maybe FinalTableResults)
forall a b. (a -> b) -> a -> b
$ MVar (Maybe FinalTableResults) -> IO (Maybe FinalTableResults)
forall a. MVar a -> IO a
readMVar (MVar (Maybe FinalTableResults) -> IO (Maybe FinalTableResults))
-> MVar (Maybe FinalTableResults) -> IO (Maybe FinalTableResults)
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> MVar (Maybe FinalTableResults)
finalTableResults FinalTableViewState
st
case Maybe FinalTableResults
results of
Maybe FinalTableResults
Nothing -> () -> ExperimentWriter ()
forall a. a -> ExperimentWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FinalTableResults
results ->
do let names :: [String]
names = FinalTableResults -> [String]
finalTableNames FinalTableResults
results
values :: MVar (Map Int [String])
values = FinalTableResults -> MVar (Map Int [String])
finalTableValues FinalTableResults
results
Map Int [String]
m <- IO (Map Int [String]) -> ExperimentWriter (Map Int [String])
forall a. IO a -> ExperimentWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Int [String]) -> ExperimentWriter (Map Int [String]))
-> IO (Map Int [String]) -> ExperimentWriter (Map Int [String])
forall a b. (a -> b) -> a -> b
$ MVar (Map Int [String]) -> IO (Map Int [String])
forall a. MVar a -> IO a
readMVar MVar (Map Int [String])
values
String
file <- String -> ExperimentFilePath -> ExperimentWriter String
resolveFilePath (FinalTableViewState -> String
finalTableDir FinalTableViewState
st) (ExperimentFilePath -> ExperimentWriter String)
-> ExperimentFilePath -> ExperimentWriter String
forall a b. (a -> b) -> a -> b
$
ShowS -> ExperimentFilePath -> ExperimentFilePath
mapFilePath ((String -> ShowS) -> String -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> ShowS
replaceExtension String
".csv") (ExperimentFilePath -> ExperimentFilePath)
-> ExperimentFilePath -> ExperimentFilePath
forall a b. (a -> b) -> a -> b
$
ExperimentFilePath -> Map String String -> ExperimentFilePath
expandFilePath (FinalTableView -> ExperimentFilePath
finalTableFileName (FinalTableView -> ExperimentFilePath)
-> FinalTableView -> ExperimentFilePath
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st) (Map String String -> ExperimentFilePath)
-> Map String String -> ExperimentFilePath
forall a b. (a -> b) -> a -> b
$
[(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
"$TITLE", String
title)]
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
Handle
h <- String -> IOMode -> IO Handle
openFile String
file IOMode
WriteMode
Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
run
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
names ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
name ->
do Handle -> String -> IO ()
hPutStr Handle
h String
separator
Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
name
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
[(Int, [String])] -> ((Int, [String]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Int [String] -> [(Int, [String])]
forall k a. Map k a -> [(k, a)]
M.assocs Map Int [String]
m) (((Int, [String]) -> IO ()) -> IO ())
-> ((Int, [String]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, [String]
xs) ->
do Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
xs ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
x ->
do Handle -> String -> IO ()
hPutStr Handle
h String
separator
Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
formatter String
x
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> IO ()
hClose Handle
h
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose (Experiment -> Bool) -> Experiment -> Bool
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> Experiment
finalTableExperiment FinalTableViewState
st) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStr String
"Generated file " IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
file
IORef (Maybe String) -> Maybe String -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FinalTableViewState -> IORef (Maybe String)
finalTableFile FinalTableViewState
st) (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
file
finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableHtml FinalTableViewState
st Int
index =
do FinalTableViewState -> Int -> HtmlWriter ()
header FinalTableViewState
st Int
index
Maybe String
file <- IO (Maybe String) -> HtmlWriter (Maybe String)
forall a. IO a -> HtmlWriter a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> HtmlWriter (Maybe String))
-> IO (Maybe String) -> HtmlWriter (Maybe String)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe String) -> IO (Maybe String)
forall a. IORef a -> IO a
readIORef (FinalTableViewState -> IORef (Maybe String)
finalTableFile FinalTableViewState
st)
case Maybe String
file of
Maybe String
Nothing -> () -> HtmlWriter ()
forall a. a -> HtmlWriter a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
f ->
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String -> ShowS
makeRelative (FinalTableViewState -> String
finalTableDir FinalTableViewState
st) String
f) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalTableView -> String
finalTableLinkText (FinalTableView -> String) -> FinalTableView -> String
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st)
header :: FinalTableViewState -> Int -> HtmlWriter ()
FinalTableViewState
st Int
index =
do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" String -> ShowS
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 (FinalTableView -> String
finalTableTitle (FinalTableView -> String) -> FinalTableView -> String
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st)
let description :: String
description = FinalTableView -> String
finalTableDescription (FinalTableView -> String) -> FinalTableView -> String
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st
Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> 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
finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()
finalTableTOCHtml FinalTableViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" String -> ShowS
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 (FinalTableView -> String
finalTableTitle (FinalTableView -> String) -> FinalTableView -> String
forall a b. (a -> b) -> a -> b
$ FinalTableViewState -> FinalTableView
finalTableView FinalTableViewState
st)