Add teal app modifiers and deprecate init args

.pre-commit-config.yaml

@@ -20,6 +20,7 @@ repos:
           - mirai
           - checkmate
           - cli
+          - htmltools
           - jsonlite
           - lifecycle
           - logger

DESCRIPTION

@@ -35,13 +35,14 @@ URL: https://insightsengineering.github.io/teal/,
     https://github.com/insightsengineering/teal/
 BugReports: https://github.com/insightsengineering/teal/issues
 Depends:
-    R (>= 4.0),
+    R (>= 4.1),
     shiny (>= 1.8.1),
     teal.data (>= 0.6.0.9017),
     teal.slice (>= 0.5.1.9015)
 Imports:
     checkmate (>= 2.1.0),
     cli,
+    htmltools,
     jsonlite,
     lifecycle (>= 0.2.0),
     logger (>= 0.2.0),
@@ -84,7 +85,7 @@ Config/Needs/verdepcheck: rstudio/shiny, insightsengineering/teal.data,
     rstudio/bslib, yihui/knitr, bioc::MultiAssayExperiment, r-lib/R6,
     rstudio/rmarkdown, tidyverse/rvest, rstudio/shinytest2,
     rstudio/shinyvalidate, r-lib/testthat, r-lib/withr,
-    yaml=vubiostat/r-yaml
+    yaml=vubiostat/r-yaml, rstudio/htmltools
 Config/Needs/website: insightsengineering/nesttemplate
 Encoding: UTF-8
 Language: en-US
@@ -106,6 +107,7 @@ Collate:
     'module_filter_manager.R'
     'module_init_data.R'
     'module_nested_tabs.R'
+    'module_session_info.R'
     'module_snapshot_manager.R'
     'module_teal.R'
     'module_teal_data.R'
@@ -120,6 +122,7 @@ Collate:
     'teal_data_module-eval_code.R'
     'teal_data_module-within.R'
     'teal_data_utils.R'
+    'teal_modifiers.R'
     'teal_reporter.R'
     'teal_slices-store.R'
     'teal_slices.R'

NAMESPACE

@@ -14,6 +14,7 @@ S3method(ui_teal_module,teal_module)
 S3method(ui_teal_module,teal_modules)
 S3method(within,teal_data_module)
 export(TealReportCard)
+export(add_landing_popup)
 export(as.teal_slices)
 export(as_tdata)
 export(build_app_title)
@@ -23,19 +24,24 @@ export(get_metadata)
 export(init)
 export(landing_popup_module)
 export(make_teal_transform_server)
+export(modify_footer)
+export(modify_header)
+export(modify_title)
 export(module)
 export(modules)
 export(new_tdata)
 export(report_card_template)
 export(reporter_previewer_module)
 export(show_rcode_modal)
+export(srv_session_info)
 export(srv_teal)
 export(srv_teal_with_splash)
 export(srv_transform_teal_data)
 export(tdata2env)
 export(teal_data_module)
 export(teal_slices)
 export(teal_transform_module)
+export(ui_session_info)
 export(ui_teal)
 export(ui_teal_with_splash)
 export(ui_transform_teal_data)

NEWS.md

@@ -9,13 +9,16 @@
 * Possibility to download lockfile to restore app session for reproducibility. #479
 * Datasets which name starts with `.` are ignored when `module`'s `datanames` is set as `"all"`.
 * Added warning when reserved `datanames`, such as `all` and `.raw_data` are being used. 
+* Added `add_custom_server()` to allow adding custom server logic to the main shiny server function of a teal app.
 
 ### Breaking changes
 
 * Setting `datanames()` on `data` passed to teal application no longer has effect. In order to change `teal_module`'s 
 `datanames` one should modify `module$datanames`.
-* The `landing_popup_module()` needs to be passed as the `landing_popup` argument of `init` instead of being passed as a module of the `modules` argument of `init`.
+* `landing_popup_module()` is deprecated. Please use `add_landing_popup()` function to add a landing popup for your teal application.
 * `teal` no longer re-export `%>%`. Please load `library(magrittr)` instead or use `|>` from `base`.
+* `build_app_title` will be removed in the future release. Please use the `modify_title()` function to change the title for your teal application.
+* The `title`, `header`, and `footer` arguments of the `init()` function are deprecated. Please use the `modify_title`, `modify_header`, and `modify_footer` respectively.
 
 ### Enhancement
 

R/TealAppDriver.R

@@ -26,7 +26,8 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
     #' @description
     #' Initialize a `TealAppDriver` object for testing a `teal` application.
     #'
-    #' @param data,modules,filter,title,header,footer,landing_popup arguments passed to `init`
+    #' @param data,modules,filter arguments passed to `init`
+    #' @param title_args,header,footer,landing_popup_args to pass into the modifier functions.
     #' @param timeout (`numeric`) Default number of milliseconds for any timeout or
     #' timeout_ parameter in the `TealAppDriver` class.
     #' Defaults to 20s.
@@ -45,25 +46,51 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
     initialize = function(data,
                           modules,
                           filter = teal_slices(),
-                          title = build_app_title(),
+                          title_args = list(),
                           header = tags$p(),
                           footer = tags$p(),
-                          landing_popup = NULL,
+                          landing_popup_args = NULL,
                           timeout = rlang::missing_arg(),
                           load_timeout = rlang::missing_arg(),
                           ...) {
       private$data <- data
       private$modules <- modules
       private$filter <- filter
+
+      new_title <- modifyList(
+        list(
+          title = "Custom Teal App Title",
+          favicon = "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/teal.png"
+        ),
+        title_args
+      )
       app <- init(
         data = data,
         modules = modules,
-        filter = filter,
-        title = title,
-        header = header,
-        footer = footer,
-        landing_popup = landing_popup,
-      )
+        filter = filter
+      ) |>
+        modify_title(title = new_title$title, favicon = new_title$favicon) |>
+        modify_header(header) |>
+        modify_footer(footer)
+
+      if (!is.null(landing_popup_args)) {
+        default_args <- list(
+          title = NULL,
+          content = NULL,
+          buttons = modalButton("Accept")
+        )
+        landing_popup_args[names(default_args)] <- Map(
+          function(x, y) if (is.null(y)) x else y,
+          default_args,
+          landing_popup_args[names(default_args)]
+        )
+        app <- add_landing_popup(
+          app,
+          title = landing_popup_args$title,
+          content = landing_popup_args$content,
+          buttons = landing_popup_args$button
+        )
+      }
 
       # Default timeout is hardcoded to 4s in shinytest2:::resolve_timeout
       # It must be set as parameter to the AppDriver

R/init.R

@@ -19,21 +19,25 @@
 #'   more details.
 #' @param filter (`teal_slices`) Optionally,
 #'   specifies the initial filter using [teal_slices()].
-#' @param title (`shiny.tag` or `character(1)`) Optionally,
+#' @param title (`shiny.tag` or `character(1)`) `r lifecycle::badge("deprecated")` Optionally,
 #'   the browser window title. Defaults to a title "teal app" with the icon of NEST.
 #'   Can be created using the `build_app_title()` or
 #'   by passing a valid `shiny.tag` which is a head tag with title and link tag.
-#' @param header (`shiny.tag` or `character(1)`) Optionally,
+#'   This parameter is deprecated. Use `modify_title()` on the teal app object instead.
+#' @param header (`shiny.tag` or `character(1)`) `r lifecycle::badge("deprecated")` Optionally,
 #'   the header of the app.
-#' @param footer (`shiny.tag` or `character(1)`) Optionally,
+#'   This parameter is deprecated. Use `modify_header()` on the teal app object instead.
+#' @param footer (`shiny.tag` or `character(1)`) `r lifecycle::badge("deprecated")` Optionally,
 #'   the footer of the app.
+#'   This parameter is deprecated. Use `modify_footer()` on the teal app object instead.
+#' @param id `r lifecycle::badge("deprecated")` (`character`) Optionally,
+#'   a string specifying the `shiny` module id in cases it is used as a `shiny` module
+#'   rather than a standalone `shiny` app. This is a legacy feature. Deprecated since v0.15.3
+#'   please use [ui_teal()] and [srv_teal()] instead.
 #' @param id `r lifecycle::badge("deprecated")` (`character`) Optionally,
 #'   a string specifying the `shiny` module id in cases it is used as a `shiny` module
 #'   rather than a standalone `shiny` app. This is a legacy feature. Deprecated since v0.15.3
 #'   please use [ui_teal()] and [srv_teal()] instead.
-#'
-#' @param landing_popup (`teal_module_landing`) Optionally,
-#'   a `landing_popup_module` to show up as soon as the teal app is initialized.
 #'
 #' @return Named list containing server and UI functions.
 #'
@@ -95,17 +99,15 @@
 init <- function(data,
                  modules,
                  filter = teal_slices(),
-                 title = build_app_title(),
-                 header = tags$p(),
-                 footer = tags$p(),
-                 id = lifecycle::deprecated(),
-                 landing_popup = NULL) {
+                 title = lifecycle::deprecated(),
+                 header = lifecycle::deprecated(),
+                 footer = lifecycle::deprecated(),
+                 id = lifecycle::deprecated()) {
   logger::log_debug("init initializing teal app with: data ('{ class(data) }').")
 
   # argument checking (independent)
   ## `data`
   checkmate::assert_multi_class(data, c("teal_data", "teal_data_module"))
-  checkmate::assert_class(landing_popup, "teal_module_landing", null.ok = TRUE)
 
   ## `modules`
   checkmate::assert(
@@ -123,44 +125,9 @@ init <- function(data,
   ## `filter`
   checkmate::assert_class(filter, "teal_slices")
 
-  ## all other arguments
-  checkmate::assert(
-    .var.name = "title",
-    checkmate::check_string(title),
-    checkmate::check_multi_class(title, c("shiny.tag", "shiny.tag.list", "html"))
-  )
-  checkmate::assert(
-    .var.name = "header",
-    checkmate::check_string(header),
-    checkmate::check_multi_class(header, c("shiny.tag", "shiny.tag.list", "html"))
-  )
-  checkmate::assert(
-    .var.name = "footer",
-    checkmate::check_string(footer),
-    checkmate::check_multi_class(footer, c("shiny.tag", "shiny.tag.list", "html"))
-  )
-
   # log
   teal.logger::log_system_info()
 
-  # argument transformations
-  ## `modules` - landing module
-  landing <- extract_module(modules, "teal_module_landing")
-  if (length(landing) == 1L) {
-    landing_popup <- landing[[1L]]
-    modules <- drop_module(modules, "teal_module_landing")
-    lifecycle::deprecate_soft(
-      when = "0.15.3",
-      what = "landing_popup_module()",
-      details = paste(
-        "Pass `landing_popup_module` to the `landing_popup` argument of the `init` ",
-        "instead of wrapping it into `modules()` and passing to the `modules` argument"
-      )
-    )
-  } else if (length(landing) > 1L) {
-    stop("Only one `landing_popup_module` can be used.")
-  }
-
   ## `filter` - set app_id attribute unless present (when restoring bookmark)
   if (is.null(attr(filter, "app_id", exact = TRUE))) attr(filter, "app_id") <- create_app_id(data, modules)
 
@@ -222,6 +189,11 @@ init <- function(data,
     )
   }
 
+  # argument transformations
+  ## `modules` - landing module
+  landing <- extract_module(modules, "teal_module_landing")
+  modules <- drop_module(modules, "teal_module_landing")
+
 
   if (lifecycle::is_present(id)) {
     lifecycle::deprecate_soft(
@@ -237,25 +209,94 @@ init <- function(data,
     id <- character(0)
   }
   ns <- NS(id)
+
   # Note: UI must be a function to support bookmarking.
-  res <- list(
-    ui = function(request) {
-      ui_teal(
-        id = ns("teal"),
-        modules = modules,
-        title = title,
-        header = header,
-        footer = footer
-      )
-    },
-    server = function(input, output, session) {
-      if (!is.null(landing_popup)) {
-        do.call(landing_popup$server, c(list(id = "landing_module_shiny_id"), landing_popup$server_args))
+  res <- structure(
+    list(
+      ui = function(request) {
+        fluidPage(
+          title = tags$div(
+            id = "teal-app-title",
+            tags$head(
+              tags$title("teal app"),
+              tags$link(
+                rel = "icon",
+                href = "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png",
+                sizes = "any"
+              )
+            )
+          ),
+          tags$header(
+            id = "teal-header",
+            tags$div(id = "teal-header-content")
+          ),
+          ui_teal(
+            id = "teal",
+            modules = modules
+          ),
+          tags$footer(
+            id = "teal-footer",
+            tags$div(id = "teal-footer-content"),
+            ui_session_info("session_info")
+          )
+        )
+      },
+      server = function(input, output, session) {
+        srv_teal(id = "teal", data = data, modules = modules, filter = deep_copy_filter(filter))
+        srv_session_info("session_info")
       }
-      srv_teal(id = ns("teal"), data = data, modules = modules, filter = deep_copy_filter(filter))
-    }
+    ),
+    class = "teal_app"
   )
 
+  if (lifecycle::is_present(title)) {
+    checkmate::assert_multi_class(title, c("shiny.tag", "shiny.tag.list", "html", "character"))
+    lifecycle::deprecate_warn(
+      when = "0.15.3",
+      what = "init(title)",
+      details = "Use `modify_title()` on the teal app object instead."
+    )
+    res <- modify_title(res, title)
+  }
+  if (lifecycle::is_present(header)) {
+    checkmate::assert_multi_class(header, c("shiny.tag", "shiny.tag.list", "html", "character"))
+    lifecycle::deprecate_warn(
+      when = "0.15.3",
+      what = "init(header)",
+      details = paste(
+        "Use `modify_header()` on the teal app object instead."
+      )
+    )
+    res <- modify_header(res, header)
+  }
+  if (lifecycle::is_present(footer)) {
+    checkmate::assert_multi_class(footer, c("shiny.tag", "shiny.tag.list", "html", "character"))
+    lifecycle::deprecate_warn(
+      when = "0.15.3",
+      what = "init(footer)",
+      details = paste(
+        "Use `modify_footer()` on the teal app object instead."
+      )
+    )
+    res <- modify_footer(res, footer)
+  }
+
+  if (length(landing) == 1L) {
+    res <- teal_extend_server(res, function(input, output, session) {
+      do.call(landing[[1L]]$server, c(list(id = "landing_module_shiny_id")))
+    })
+    lifecycle::deprecate_warn(
+      when = "0.15.3",
+      what = "landing_popup_module()",
+      details = paste(
+        "landing_popup_module() is deprecated.",
+        "Use add_landing_popup() on the teal app object instead."
+      )
+    )
+  } else if (length(landing) > 1L) {
+    stop("Only one `landing_popup_module` can be used.")
+  }
+
   logger::log_debug("init teal app has been initialized.")
 
   res