Add a helper function to add app title with a favicon (#1018)

Closes #1017 Adds a helper function for easy title in teal. ### What titles are created in these scenarios now? Title - "teal title" Image - from the remote link ```r nest_logo <- "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png" teal::init( title = build_app_title(title = "teal title", nest_logo) ) ``` --- Title - "teal title" Image - from the local path, provided the path is hosted in the static paths of shiny, by default it is `www/` ```r nest_logo <- "nest.png" teal::init( title = build_app_title(title = "teal title", nest_logo) ) ``` --- Title - "teal title" Image - NEST logo from GitHub ```r teal::init( title = "teal title" ) ``` --- Title - "Teal app" Image - NEST logo from GitHub ```r teal::init() ``` --- After this is merged, we can update the examples in `teal.gallery` with the title in the dev branch. What do you think about the defaults @lcd2yyz and @donyunardi --------- Signed-off-by: Vedha Viyash <[email protected]> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Aleksander Chlebowski <[email protected]>
insightsengineering · Jan 2, 2024 · d5fa2d0 · d5fa2d0
1 parent 3d69c60
commit d5fa2d0
Show file tree

Hide file tree

Showing 11 changed files with 150 additions and 15 deletions.
diff --git a/R/init.R b/R/init.R
@@ -16,15 +16,17 @@
 #'
 #' @param data (`teal_data`, `teal_data_module`, `named list`)\cr
 #' `teal_data` object as returned by [teal.data::teal_data()] or
-#' `teal_data_modules` or simply a list of a named list of objects
+#' `teal_data_module` or simply a list of a named list of objects
 #' (`data.frame` or `MultiAssayExperiment`).
 #' @param modules (`list`, `teal_modules` or `teal_module`)\cr
 #'   nested list of `teal_modules` or `teal_module` objects or a single
 #'   `teal_modules` or `teal_module` object. These are the specific output modules which
 #'   will be displayed in the teal application. See [modules()] and [module()] for
 #'   more details.
-#' @param title (`NULL` or `character`)\cr
-#'   The browser window title (defaults to the host URL of the page).
+#' @param title (`shiny.tag` or `character`)\cr
+#'   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 filter (`teal_slices`)\cr
 #'   Specification of initial filter. Filters can be specified using [teal::teal_slices()].
 #'   Old way of specifying filters through a list is deprecated and will be removed in the
@@ -100,7 +102,7 @@
 #'
 init <- function(data,
                  modules,
-                 title = NULL,
+                 title = build_app_title(),
                  filter = teal_slices(),
                  header = tags$p(),
                  footer = tags$p(),
@@ -123,17 +125,23 @@ init <- function(data,
 
   checkmate::assert_multi_class(data, c("teal_data", "teal_data_module"))
   checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules"))
-  checkmate::assert_string(title, null.ok = TRUE)
   checkmate::assert(
     checkmate::check_class(filter, "teal_slices"),
     checkmate::check_list(filter, names = "named")
   )
+  checkmate::assert_multi_class(title, c("shiny.tag", "character"))
   checkmate::assert_multi_class(header, c("shiny.tag", "character"))
   checkmate::assert_multi_class(footer, c("shiny.tag", "character"))
   checkmate::assert_character(id, max.len = 1, any.missing = FALSE)
 
   teal.logger::log_system_info()
 
+  if (is.character(title)) {
+    title <- build_app_title(title)
+  } else {
+    validate_app_title_tag(title)
+  }
+
   if (inherits(modules, "teal_module")) {
     modules <- list(modules)
   }

diff --git a/R/utils.R b/R/utils.R
@@ -230,3 +230,43 @@ teal_data_datanames <- function(data) {
     ls(teal.code::get_env(data), all.names = TRUE)
   }
 }
+
+#' Function for validating the title parameter of `teal::init`
+#'
+#' Checks if the input of the title from `teal::init` will create a valid title and favicon tag.
+#' @param shiny_tag (`shiny.tag`) Object to validate for a valid title.
+#' @keywords internal
+validate_app_title_tag <- function(shiny_tag) {
+  checkmate::assert_class(shiny_tag, "shiny.tag")
+  checkmate::assert_true(shiny_tag$name == "head")
+  child_names <- vapply(shiny_tag$children, `[[`, character(1L), "name")
+  checkmate::assert_subset(c("title", "link"), child_names, .var.name = "child tags")
+  rel_attr <- shiny_tag$children[[which(child_names == "link")]]$attribs$rel
+  checkmate::assert_subset(
+    rel_attr, c("icon", "shortcut icon"),
+    .var.name = "Link tag's rel attribute",
+    empty.ok = FALSE
+  )
+}
+
+#' Build app title with favicon
+#'
+#' A helper function to create the browser title along with a logo.
+#'
+#' @param title (`character`) The browser title for the teal app
+#' @param favicon (`character`) The path for the icon for the title.
+#' The image/icon path can be remote or the static path accessible by shiny, like the `www/`
+#'
+#' @return A `shiny.tag` containing the element that adds the title and logo to the shiny app
+build_app_title <- function(title = "Teal app", favicon = "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png") { # nolint
+  checkmate::assert_string(title, null.ok = TRUE)
+  checkmate::assert_string(favicon, null.ok = TRUE)
+  tags$head(
+    tags$title(title),
+    tags$link(
+      rel = "icon",
+      href = favicon,
+      sizes = "any"
+    )
+  )
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -97,6 +97,10 @@ reference:
       - srv_teal_with_splash
       - ui_teal_with_splash
       - teal_slices
+  - title: Helper Functions
+    desc: Helper functions for `teal`
+    contents:
+      - build_app_title
   - title: Example Module
     desc: A simple `teal` module
     contents:

diff --git a/inst/WORDLIST b/inst/WORDLIST
@@ -11,6 +11,7 @@ analysing
 cloneable
 customizable
 dropdown
+favicon
 funder
 omics
 pharmaverse

diff --git a/man/build_app_title.Rd b/man/build_app_title.Rd
diff --git a/man/init.Rd b/man/init.Rd
diff --git a/man/module_teal.Rd b/man/module_teal.Rd
diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd
diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd
diff --git a/man/validate_app_title_tag.Rd b/man/validate_app_title_tag.Rd
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -63,3 +63,40 @@ test_that("teal_data_datanames returns datanames which are set by teal.data::dat
   datanames(teal_data) <- "iris"
   testthat::expect_equal(teal_data_datanames(teal_data), "iris")
 })
+
+test_that("validate_app_title_tag works on validating the title tag", {
+  valid_title <- tags$head(
+    tags$title("title"),
+    tags$link(rel = "icon", href = "favicon.ico"),
+    tags$div("Secret")
+  )
+
+  head_missing <- tags$div(
+    tags$title(title),
+    tags$link(rel = "icon", href = "favicon.ico")
+  )
+  title_missing <- tags$head(
+    tags$link(rel = "icon", href = "favicon.ico")
+  )
+  icon_missing <- tags$head(
+    tags$title(title)
+  )
+  invalid_link <- tags$head(
+    tags$title("title"),
+    tags$link(href = "favicon.ico"),
+    tags$div("Secret")
+  )
+
+  expect_silent(validate_app_title_tag(valid_title))
+  expect_error(validate_app_title_tag(head_missing))
+  expect_error(validate_app_title_tag(title_missing))
+  expect_error(validate_app_title_tag(icon_missing))
+  expect_error(validate_app_title_tag(invalid_link))
+})
+
+test_that("build_app_title builts a valid tag", {
+  valid_title_local <- build_app_title("title", "logo.png")
+  valid_title_remote <- build_app_title("title", "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png") # nolint
+  expect_silent(validate_app_title_tag(valid_title_local))
+  expect_silent(validate_app_title_tag(valid_title_remote))
+})