Add shiny bslib dependency inside html_document_base pre-process (#2049)

NEWS.md

@@ -1,6 +1,7 @@
 rmarkdown 2.8
 ================================================================================
 
+- Provided a `runtime: shiny` fix for output formats that pass a modified `bslib::bs_theme()` object to `html_document_base()`'s `theme` (thanks, @cpsievert, #2049).
 
 rmarkdown 2.7
 ================================================================================

R/html_document_base.R

@@ -89,10 +89,16 @@ html_document_base <- function(theme = NULL,
     format_deps <- append(format_deps, html_dependency_header_attrs())
     if (!is.null(theme)) {
       format_deps <- append(format_deps, list(html_dependency_jquery()))
-      format_deps <- append(format_deps, bootstrap_dependencies(
-        # If TRUE, an as_bs_theme(theme) has been set globally (so users may customize it)
-        if (is_bs_theme(theme)) bslib::bs_global_get() else theme
-      ))
+      # theme was set globally pre-knit, and it may be modified during knit
+      if (is_bs_theme(theme)) {
+        theme <- bslib::bs_global_get()
+      }
+      bootstrap_deps <- if (is_bs_theme(theme) && is_shiny(runtime)) {
+        list(shiny_bootstrap_lib(theme))
+      } else {
+        bootstrap_dependencies(theme)
+      }
+      format_deps <- append(format_deps, htmltools::resolveDependencies(bootstrap_deps))
     }
     else if (isTRUE(bootstrap_compatible) && is_shiny(runtime)) {
       # If we can add bootstrap for Shiny, do it

R/shiny.R

@@ -134,16 +134,21 @@ run <- function(file = "index.Rmd", dir = dirname(file), default_file = NULL,
   yaml_front <- if (length(target_file)) yaml_front_matter(target_file)
   runtime <- yaml_front$runtime
   theme <- render_args$output_options$theme
+  # Let shiny::getCurrentTheme() know about the yaml's theme, so
+  # things like `bslib::bs_themer()` can work with prerendered documents.
+  # Also note that we add the actual shiny::bootstrapLib() dependency
+  # inside the document's pre-processing hook so the 'last' version of
+  # the theme wins out
   if (length(target_file)) {
     format <- output_format_from_yaml_front_matter(read_utf8(target_file))
-    theme <- format$options$theme
+    set_current_theme(resolve_theme(format$options$theme))
   }
 
   # run using the requested mode
   if (is_shiny_prerendered(runtime)) {
 
     # get the pre-rendered shiny app
-    app <- shiny_prerendered_app(target_file, render_args = render_args, theme = theme)
+    app <- shiny_prerendered_app(target_file, render_args = render_args)
   } else {
 
     # add rmd_resources handler on start
@@ -158,7 +163,7 @@ run <- function(file = "index.Rmd", dir = dirname(file), default_file = NULL,
     # combine the user-supplied list of Shiny arguments with our own and start
     # the Shiny server; handle requests for the root (/) and any R markdown files
     # within
-    app <- shiny::shinyApp(ui = rmarkdown_shiny_ui(dir, default_file, theme),
+    app <- shiny::shinyApp(ui = rmarkdown_shiny_ui(dir, default_file),
                            uiPattern = "^/$|^/index\\.html?$|^(/.*\\.[Rr][Mm][Dd])$",
                            onStart = onStart,
                            server = rmarkdown_shiny_server(
@@ -317,7 +322,7 @@ rmarkdown_shiny_server <- function(dir, file, auto_reload, render_args) {
 }
 
 # create the Shiny UI function
-rmarkdown_shiny_ui <- function(dir, file, theme) {
+rmarkdown_shiny_ui <- function(dir, file) {
   function(req) {
     # map requests to / to requests for the default--index.Rmd, or another if
     # specified
@@ -339,8 +344,7 @@ rmarkdown_shiny_ui <- function(dir, file, theme) {
     tags$div(
       tags$head(
         tags$script(src = "rmd_resources/rmd_loader.js"),
-        tags$link(href = "rmd_resources/rmd_loader.css", rel = "stylesheet"),
-        shiny_bootstrap_lib(theme)
+        tags$link(href = "rmd_resources/rmd_loader.css", rel = "stylesheet")
       ),
 
       # Shiny shows the outer conditionalPanel as long as the document hasn't
@@ -586,3 +590,10 @@ read_shiny_deps <- function(files_dir) {
     list()
   }
 }
+
+
+# shiny:::setCurrentTheme() was added in 1.6 (we may export in next version)
+set_current_theme <- function(theme) {
+  set_theme <- asNamespace("shiny")$setCurrentTheme
+  if (is.function(set_theme)) set_theme(theme)
+}

R/shiny_prerendered.R

@@ -1,13 +1,10 @@
 
 # Create a shiny app object from an Rmd w/ runtime: shiny_prerendered
-shiny_prerendered_app <- function(input_rmd, render_args, theme) {
+shiny_prerendered_app <- function(input_rmd, render_args) {
 
   # get rendered html and capture dependencies
   html <- shiny_prerendered_html(input_rmd, render_args)
-  deps <- c(
-    htmltools::htmlDependencies(html),
-    shiny_bootstrap_lib(theme)
-  )
+  deps <- htmltools::htmlDependencies(html)
 
   # create the server environment
   server_envir = new.env(parent = globalenv())
@@ -695,9 +692,9 @@ shiny_bootstrap_lib <- function(theme) {
   if (!is_bs_theme(theme)) {
     return(NULL)
   }
-  if (!is_available("shiny", "1.5.0.9007")) {
+  if (!is_available("shiny", "1.6.0")) {
     stop(
-      "Using a {bslib} theme with `runtime: shiny` requires shiny 1.5.0.9007 or higher."
+      "Using a {bslib} theme with `runtime: shiny` requires shiny 1.6.0 or higher."
     )
   }
   shiny::bootstrapLib(theme)

tests/testthat/test-shiny.R

@@ -16,3 +16,13 @@ test_that("file.path.ci returns correctly no matter the case", {
   expect_equal_file("global.R", "donotexist")
   expect_equal_file("global.Rmd", tmp_dir, "global.R")
 })
+
+
+test_that("set_current_theme() informs shiny::getCurrentTheme()", {
+  expect_null(shiny::getCurrentTheme())
+  theme <- bslib::bs_theme()
+  set_current_theme(theme)
+  expect_equal(theme, shiny::getCurrentTheme())
+  set_current_theme(NULL)
+  expect_null(shiny::getCurrentTheme())
+})