feat(admin): download and preview game initialisation report

This commit let the "admin" to see and download the game initaisation
report.

For that I also modify the behaviour of the app.
Now the `DATA_ROOT` folder **must** be present in order for the app to
start. The initialisation script will write in it this folder only if it
is empty (except for the `.gitkeep` file, and other hidden files that
are not checked).

.gitignore

@@ -4,12 +4,15 @@
 .Rhistory
 .RData
 .Ruserdata
-data
+
+/data/*
+!/data/.gitkeep
 data.zip
+
 .direnv
+
 node_modules/
 /test-results/
 /playwright-report/
 /blob-report/
 /playwright/.cache/
-plantbreedgame_setup.html

Dockerfile

@@ -15,23 +15,19 @@ RUN apt-get update && apt-get install -y \
 # remove sample-apps
 RUN rm -rf /srv/shiny-server/*
 
-# get app code
-# from host
-COPY ./tools/ /srv/shiny-server/PlantBreedGame/tools
 # install packages dependencies
+COPY ./tools/ /srv/shiny-server/PlantBreedGame/tools
 RUN Rscript /srv/shiny-server/PlantBreedGame/tools/installDeps.R
+
+# copy app code
 COPY ./src/ /srv/shiny-server/PlantBreedGame/src
 COPY ./www/ /srv/shiny-server/PlantBreedGame/www
 COPY ./global.R /srv/shiny-server/PlantBreedGame/.
 COPY ./ui.R /srv/shiny-server/PlantBreedGame/.
 COPY ./server.R /srv/shiny-server/PlantBreedGame/.
-COPY ./plantbreedgame_setup.Rmd /srv/shiny-server/PlantBreedGame/.
-
-# build data folder
 
-RUN R -e "rmarkdown::render('/srv/shiny-server/PlantBreedGame/plantbreedgame_setup.Rmd')"
+RUN mkdir srv/shiny-server/PlantBreedGame/data
 
-RUN chmod 664 srv/shiny-server/PlantBreedGame/data/breeding-game.sqlite
 RUN chown -R shiny.shiny srv/shiny-server/PlantBreedGame
 
 USER shiny

global.R

@@ -46,11 +46,17 @@ if (Sys.info()["sysname"] == "Windows") {
 ## -------------------------------------------------------------------
 ## variables
 
-DATA_ROOT <- "data"
+DATA_ROOT <- normalizePath("./data", mustWork = TRUE)
 DATA_TRUTH <- file.path(DATA_ROOT, "truth")
 DATA_SHARED <- file.path(DATA_ROOT, "shared")
 DATA_INITIAL_DATA <- file.path(DATA_SHARED, "initial_data")
 DATA_DB <- file.path(DATA_ROOT, "breeding-game.sqlite")
+DATA_REPORTS <- file.path(DATA_ROOT, "reports")
+GAME_INIT_REPORT <- file.path(DATA_REPORTS, "plantBreedGame_initialisation_report.html")
+
+if (dir.exists(DATA_REPORTS)) {
+  addResourcePath("reports", DATA_REPORTS)
+}
 
 url.repo <- "https://github.com/timflutre/PlantBreedGame"
 code.version <- getCodeVersion(url.repo)

server.R

@@ -36,8 +36,7 @@ shinyServer(function(input, output, session) {
   )
 
   gameInitialised <- function() {
-    (dir.exists(DATA_ROOT) &
-      dir.exists(DATA_TRUTH) &
+    (dir.exists(DATA_TRUTH) &
       dir.exists(DATA_SHARED) &
       dir.exists(DATA_INITIAL_DATA) &
       file.exists(DATA_DB))

src/fun/func_dbRequests.R

@@ -139,7 +139,15 @@ getBreedersIndividuals <- function(breeder) {
   return(db_get_request(query))
 }
 
-clean_data_root <- function(data_root = DATA_ROOT) {
+clean_data_root <- function(
+  data_root = DATA_ROOT,
+  data_truth = DATA_TRUTH,
+  data_shared = DATA_SHARED,
+  data_initial_data = DATA_INITIAL_DATA,
+  data_db = DATA_DB,
+  data_reports = DATA_REPORTS,
+  game_initialisation_report = GAME_INIT_REPORT
+) {
   # WARN / TODO --- IMPORTANT ! ---
   # the initialisation script do not allow its execution if "the data" folder
   # already exists.
@@ -159,11 +167,6 @@ clean_data_root <- function(data_root = DATA_ROOT) {
   #
   # WARN / TODO --- IMPORTANT ! ---
 
-  data_truth <- file.path(data_root, "truth")
-  data_shared <- file.path(data_root, "shared")
-  data_initial_data <- file.path(data_shared, "initial_data")
-  data_db <- file.path(data_root, "breeding-game.sqlite")
-
 
   # initial files.
   initial_haplo_files <- sprintf( # `Coll0001_haplos.RData` to `Coll1000_haplos.RData`
@@ -241,10 +244,10 @@ clean_data_root <- function(data_root = DATA_ROOT) {
   all_files <- c(
     initial_files_truth,
     initial_files_shared,
+    game_initialisation_report,
     breeders_files
   )
-  browser()
-  file.remove(all_files[file.exists(all_files)])
+  file.remove(all_files)
 
   lapply(getBreederList(data_db), function(breeder) {
     if (length(list.files(file.path(data_shared, breeder))) == 0) {
@@ -274,13 +277,16 @@ clean_data_root <- function(data_root = DATA_ROOT) {
   } else {
     stop(paste("can't remove", data_shared, "folder not empty."))
   }
+  if (length(list.files(data_reports)) == 0) {
+    file.remove(data_reports)
+  } else {
+    stop(paste("can't remove", data_reports, "folder not empty."))
+  }
 
   file.remove(data_db)
 
-  if (length(list.files(data_root)) == 0) {
-    file.remove(data_root)
-  } else {
-    stop(paste("can't remove", data_root, "folder not empty."))
+  if (length(list.files(data_root)) != 0) {
+    stop(paste0("Problem occured when cleaning `", data_root, "`, folder is not empty."))
   }
 }
 

src/plantbreedgame_setup.Rmd

@@ -93,22 +93,33 @@ Set up directories:
 ```{r setup_dir}
 root.dir <- file.path("../data")
 root.dir <- path.expand(root.dir)
+truth.dir <- file.path(root.dir, "truth")
+shared.dir <- file.path(root.dir, "shared")
+init.dir <- file.path(shared.dir, "initial_data")
+reports.dir <- file.path(root.dir, "reports")
+dbname <- file.path(root.dir, "breeding-game.sqlite")
+
 if (dir.exists(root.dir)) {
-  stop(paste0("`data` directory (", root.dir, ") already exists. Please remove this directory before running this script."))
+  if (length(list.files(root.dir)) != 0) {
+    stop(paste0("`data` directory (", root.dir, ") is not empty. Please empty this directory before running this script."))
+  }
+} else {
+  dir.create(root.dir)
 }
-dir.create(root.dir)
-truth.dir <- file.path(root.dir, "truth")
+
 if (!dir.exists(truth.dir)) {
   dir.create(truth.dir)
 }
-shared.dir <- file.path(root.dir, "shared")
 if (!dir.exists(shared.dir)) {
   dir.create(shared.dir)
 }
-init.dir <- file.path(shared.dir, "initial_data")
 if (!dir.exists(init.dir)) {
   dir.create(init.dir)
 }
+if (!dir.exists(reports.dir)) {
+  dir.create(reports.dir)
+}
+
 ```
 
 Create the "admin" and "test" players (other players are created via the interface):
@@ -127,12 +138,6 @@ for (breeder in breeders) {
 }
 ```
 
-Set up the name of the database:
-```{r}
-dbname <- paste0(root.dir, "/breeding-game.sqlite")
-```
-
-
 # Simulate haplotypes and genotypes
 
 ## Use the sequential coalescent with recombination

src/server/server_admin.R

@@ -625,6 +625,11 @@ output$admin_T1T2GameProgress <- renderPlotly({
 })
 
 
+output$download_game_init_report <- downloadHandler(
+  filename = paste0("plantBreedGame_initialisation_report_", strftime(Sys.time(),format = "%Y-%M-%d"), ".html"), # lambda function
+  content = function(file) file.copy(GAME_INIT_REPORT, file),
+  contentType = "text/html"
+)
 
 output$initialisation_button <- renderUI({
   if (!gameInitialised()) {
@@ -676,7 +681,7 @@ observeEvent(input$initialiseGame, {
     message = "Game Initialisation:",
     detail = "Initialisation..."
   )
-  if (dir.exists(DATA_ROOT)) {
+  if (gameInitialised()) {
     # WARN / TODO --- IMPORTANT ! ---
     # the initialisation script do not allow its execution if "the data" folder
     # already exists.
@@ -702,16 +707,27 @@ observeEvent(input$initialiseGame, {
       detail = "Delete existing data..."
     )
     clean_data_root()
+  } else {
+    # even when the game is not initialised, the data-base can be created if
+    # any request is attempted. This is the case when the user is on the app's
+    # welcome page.
+    file.remove(DATA_DB)
   }
+
   progress_bar$set(
     value = 2 / 4,
     message = "Game Initialisation:",
     detail = "game setup..."
   )
-  rmarkdown::render("./plantbreedgame_setup.Rmd",
-    output_file = "./plantbreedgame_setup.html",
+
+  out_report <- rmarkdown::render("./src/plantbreedgame_setup.Rmd",
+    output_file = tempfile(),
     encoding = "UTF-8"
   )
+  file.copy(from = out_report, to = GAME_INIT_REPORT)
+
+  addResourcePath("reports", DATA_REPORTS)
+
   progress_bar$set(
     value = 1,
     message = "Game Initialisation:",

src/ui/ui_admin_loggedIn.R

@@ -26,6 +26,7 @@
 
 
 if (gameInitialised()) {
+  default_tab <- "Manage sessions"
   manage_sessions_tab_content <- div(
     div(
       style = "margin-bottom:50px;",
@@ -303,7 +304,27 @@ if (gameInitialised()) {
   )
 
 
+  game_initialisation_report_part <- div(
+    h2("Game initialisation report"),
+
+    p("The game is initialised. You can download the related report that contains",
+    "some informations about the game intialisation by clicking on the button bellow.",
+    "Below this button you can preview this report."),
+
+    downloadButton("download_game_init_report", "Download game's initialisation report (html)"),
+
+    h3("Preview:"),
+    tags$iframe(seamless = "seamless",
+                src = file.path("reports", basename(GAME_INIT_REPORT)),
+                height = 700,
+                width = "100%")
+  )
+
+
 } else {
+
+  default_tab <- "Game Initialisation"
+
   game_not_initialised_msg <- div(
     h3("Game not initialised"),
     p("The game have not been initialised. It is therefore currently impossible to play.")
@@ -313,28 +334,35 @@ if (gameInitialised()) {
   manage_constants_tab_content <- game_not_initialised_msg
   disk_usage_tab_content <- game_not_initialised_msg
   game_progress_tab_content <- game_not_initialised_msg
+
+
+  game_initialisation_report_part <- div()
 }
 
 
 game_initialisation_tab_content <- div(
-  p("By pressing the button below, you can initialise the game."),
-  p("Once the initialisation is completed (which takes about 2 minutes), the page will automatically reload and you will be able to connect and play the game."),
-  div(
-    h2("Information:"),
-    p("Some breeders accounts will be automatically created:"),
-    tags$ul(
-      tags$li(code("Admin"), "with the default password", code("1234")),
-      tags$li(code("Tester"), "(this breeder do not have a password, you can leave the password field empty to connect)")
-    )
-  ),
-  uiOutput("initialisation_button")
+  game_initialisation_report_part,
+  div (
+    h2("Game (re)-initialisation"),
+    p("By pressing the button below, you can initialise the game."),
+    p("Once the initialisation is completed (which takes about 2 minutes), the page will automatically reload and you will be able to connect and play the game."),
+    div(
+      h3("Information:"),
+      p("Some breeders accounts will be automatically created:"),
+      tags$ul(
+        tags$li(code("Admin"), "with the default password", code("1234")),
+        tags$li(code("Tester"), "(this breeder do not have a password, you can leave the password field empty to connect)")
+      )
+    ),
+    uiOutput("initialisation_button")
+  )
 )
 
 
 
 list(
   shinydashboard::tabBox(
-    width = 12, title = "Admin", id = "admin_tabset", side = "left",
+    width = 13, title = "Admin", id = "admin_tabset", side = "left", selected = default_tab,
     tabPanel(
       "Manage sessions",
       manage_sessions_tab_content