Add teal app modifiers and deprecate init args

NAMESPACE

@@ -14,6 +14,8 @@ S3method(ui_teal_module,teal_module)
 S3method(ui_teal_module,teal_modules)
 S3method(within,teal_data_module)
 export(TealReportCard)
+export(add_custom_server)
+export(add_landing_popup)
 export(as.teal_slices)
 export(as_tdata)
 export(build_app_title)
@@ -23,6 +25,9 @@ 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)

NEWS.md

@@ -9,13 +9,16 @@
 * Introduced a function `set_datanames()` to change a `datanames` of the `teal_module`.
 * 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 app.
 * `teal` no longer re-export `%>%`. Please load `library(magrittr)` instead or use `|>` from `base`.
+* `build_app_title` will stop being exported in the future release. Please use the `modify_title()` function to change the title for your teal app.
+* 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

@@ -45,10 +45,6 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
     initialize = function(data,
                           modules,
                           filter = teal_slices(),
-                          title = build_app_title(),
-                          header = tags$p(),
-                          footer = tags$p(),
-                          landing_popup = NULL,
                           timeout = rlang::missing_arg(),
                           load_timeout = rlang::missing_arg(),
                           ...) {
@@ -58,11 +54,7 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
       app <- init(
         data = data,
         modules = modules,
-        filter = filter,
-        title = title,
-        header = header,
-        footer = footer,
-        landing_popup = landing_popup,
+        filter = filter
       )
 
       # Default timeout is hardcoded to 4s in shinytest2:::resolve_timeout

R/init.R

@@ -20,19 +20,20 @@
 #'   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 (`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.
-#' @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.
 #'
@@ -94,17 +95,15 @@
 init <- function(data,
                  modules,
                  filter = teal_slices(),
-                 title = build_app_title(),
-                 header = tags$p(),
-                 footer = tags$p(),
-                 id = character(0),
-                 landing_popup = NULL) {
+                 title = NULL,
+                 header = NULL,
+                 footer = NULL,
+                 id = character(0)) {
   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(
@@ -121,46 +120,11 @@ 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"))
-  )
   checkmate::assert_character(id, max.len = 1, any.missing = FALSE)
 
   # 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,27 +186,235 @@ init <- function(data,
     )
   }
 
-  ns <- NS(id)
+  if (!is.null(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."
+    )
+  } else {
+    title <- build_app_title()
+  }
+  if (!is.null(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."
+      )
+    )
+  } else {
+    header <- tags$p()
+  }
+  if (!is.null(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."
+      )
+    )
+  } else {
+    footer <- tags$p()
+  }
+
+  # argument transformations
+  ## `modules` - landing module
+  landing <- extract_module(modules, "teal_module_landing")
+  modules <- drop_module(modules, "teal_module_landing")
+
   # Note: UI must be a function to support bookmarking.
   res <- list(
     ui = function(request) {
       ui_teal(
-        id = ns("teal"),
+        id = "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))
-      }
-      srv_teal(id = ns("teal"), data = data, modules = modules, filter = deep_copy_filter(filter))
+      srv_teal(id = "teal", data = data, modules = modules, filter = deep_copy_filter(filter))
     }
   )
 
+  if (length(landing) == 1L) {
+    res <- add_custom_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
 }
+
+#' Add a custom title to the app
+#'
+#' @param title The title to add
+#' @return The modified app object
+#' @export
+#' @examples
+#' app <- init(
+#'   data = teal_data(IRIS = iris, MTCARS = mtcars),
+#'   modules = modules(example_module())
+#' ) |>
+#'   modify_title("Custom title")
+#'
+#' shinyApp(app$ui, app$server)
+modify_title <- function(
+    app,
+    title = "teal app",
+    favicon = "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png") {
+  res <- app
+  res$ui <- function(request) {
+    title <- tags$div(
+      id = "teal-title",
+      build_app_title(title, favicon)
+    )
+    ui_tq <- htmltools::tagQuery(app$ui(request = request))
+    ui_tq$find("#teal-title")$replaceWith(title)$allTags()
+  }
+  res
+}
+
+#' Add a Header to a `teal` App
+#'
+#' @description Adds a header to the `teal` app.
+#'
+#' @param app (`environment`) The `teal` app environment.
+#' @param header (`shiny.tag` or `character(1)`) The header content to set. Defaults to an empty paragraph tag.
+#' @export
+#' @examples
+#' app <- init(
+#'   data = teal_data(IRIS = iris),
+#'   modules = modules(example_module())
+#' ) |>
+#'   modify_header(
+#'     tags$div(
+#'       h3("Custom header")
+#'     )
+#'   )
+#'
+#' shinyApp(app$ui, app$server)
+modify_header <- function(app, header = tags$p()) {
+  res <- app
+  res$ui <- function(request) {
+    ui_tq <- htmltools::tagQuery(app$ui(request = request))
+    ui_tq$find("#teal-header")$replaceWith(tags$header(id = "teal-header", header))$allTags()
+  }
+  res
+}
+
+#' Add a Footer to a `teal` App
+#'
+#' @description Adds a footer to the `teal` app.
+#'
+#' @param app (`environment`) The `teal` app environment.
+#' @param footer (`shiny.tag` or `character(1)`) The footer content to set. Defaults to an empty paragraph tag.
+#' @export
+#' @examples
+#' app <- init(
+#'   data = teal_data(IRIS = iris),
+#'   modules = modules(example_module())
+#' ) |>
+#'   modify_footer("Custom footer")
+#'
+#' shinyApp(app$ui, app$server)
+modify_footer <- function(app, footer = tags$p()) {
+  res <- app
+  res$ui <- function(request) {
+    ui_tq <- htmltools::tagQuery(app$ui(request = request))
+    ui_tq$find("#teal-footer")$replaceWith(tags$div(id = "teal-footer", footer))$allTags()
+  }
+  res
+}
+
+#' Add a Landing Popup to a `teal` App
+#'
+#' @description Adds a landing popup to the `teal` app. This popup will be shown when the app starts.
+#'
+#' This modifier is used to display a popup dialog when the application starts.
+#' The dialog blocks access to the application and must be closed with a button before the application can be viewed.
+#'
+#' @param app (`environment`) The `teal` app environment.
+#' @param id (`character(1)`) The ID of the modal dialog.
+#' @param label (`character(1)`) Label of the module.
+#' @param title (`character(1)`) Text to be displayed as popup title.
+#' @param content (`character(1)`, `shiny.tag` or `shiny.tag.list`) with the content of the popup.
+#'  Passed to `...` of `shiny::modalDialog`. See examples.
+#' @param buttons (`shiny.tag` or `shiny.tag.list`) Typically a `modalButton` or `actionButton`. See examples.
+#' @export
+#' @examples
+#' app <- init(
+#'   data = teal_data(IRIS = iris, MTCARS = mtcars),
+#'   modules = modules(example_module())
+#' ) |>
+#'   add_landing_popup(
+#'     title = "Welcome",
+#'     content = "This is a landing popup.",
+#'     buttons = modalButton("Accept")
+#'   )
+#'
+#' shinyApp(app$ui, app$server)
+add_landing_popup <- function(
+    app,
+    id = "landingpopup",
+    title = NULL,
+    content = NULL,
+    buttons = modalButton("Accept")) {
+  old_server <- app$server
+
+  app$server <- function(input, output, session) {
+    old_server(input, output, session)
+    showModal(
+      modalDialog(
+        id = id,
+        title = title,
+        content,
+        footer = buttons
+      )
+    )
+  }
+  app
+}
+
+#' Add a Custom Server Logic to a `teal` App
+#'
+#' @description Adds a custom server function to the `teal` app. This function can define additional server logic.
+#'
+#' @param app (`environment`) The `teal` app environment.
+#' @param custom_server (`function`) The custom server function to set.
+#' @export
+#' @examples
+#' app <- init(
+#'   data = teal_data(IRIS = iris),
+#'   modules = modules(example_module())
+#' ) |>
+#'   add_custom_server(function(input, output, session) {
+#'   })
+#'
+#' shinyApp(app$ui, app$server)
+add_custom_server <- function(app, custom_server) {
+  old_server <- app$server
+
+  app$server <- function(input, output, session) {
+    old_server(input, output, session)
+    custom_server(input, output, session)
+  }
+  app
+}