319-auto-reload-support

DESCRIPTION

@@ -43,3 +43,5 @@ Config/Needs/website: tidyverse/tidytemplate
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Remotes:
+    rstudio/shiny@feat/full-reload

R/data-apps-deps.R

@@ -176,6 +176,7 @@ apps_deps_map <- list(
   `316-bslib-popovers` = c("bsicons", "bslib", "plotly", "rversions", "shiny", "shinycoreci", "shinytest2", "testthat", "withr"),
   `317-nav-insert` = c("bslib", "htmltools", "leaflet", "rversions", "shiny", "shinycoreci", "shinytest2", "testthat", "withr"),
   `318-navbar-colors` = c("bslib", "jsonlite", "rlang", "rprojroot", "shiny", "shinytest2", "testthat", "withr"),
+  `319-auto-reload-support` = c("rprojroot", "shiny", "shinytest2", "withr"),
   `900-text-jster` = c("shiny", "shinyjster", "shinytest2"),
   `901-button-jster` = c("shiny", "shinyjster", "shinytest2")
 )

inst/apps/319-auto-reload-support/01-app-dot-R/app.R

@@ -0,0 +1,40 @@
+library(shiny)
+options(shiny.autoreload = TRUE)
+
+reset_test_supporting_file <- function() {
+  message("Writing initial title.R")
+  writeLines(
+    "title <- 'Test start'",
+    "title.R"
+  )
+}
+
+if (!file.exists("title.R")) {
+  reset_test_supporting_file()
+}
+
+source("title.R") # provides title
+
+ui <- fluidPage(
+  h2(id = "title", title),
+  actionButton("update_title", "Update title")
+)
+
+server <- function(input, output, session) {
+  observeEvent(input$update_title, {
+    message("updating title.R")
+    writeLines(
+      'title <- "Test passed"',
+      "title.R"
+    )
+  })
+}
+
+shiny::onStop(function() {
+  if (file.exists("title.R")) {
+    message("cleaning up title.R")
+    unlink("title.R")
+  }
+})
+
+shinyApp(ui, server)

inst/apps/319-auto-reload-support/01-app-dot-R/title.R

@@ -0,0 +1 @@
+title <- 'Test start'

inst/apps/319-auto-reload-support/02-ui-server/global.R

@@ -0,0 +1,21 @@
+library(shiny)
+options(shiny.autoreload = TRUE)
+
+reset_test_supporting_files <- function() {
+  message("Writing initial supporting files")
+  writeLines('ui_text <- "UI test start"', "test-ui.R")
+  writeLines('server_text <- "Server test start"', "test-server.R")
+  writeLines('global_text <- "Global test start"', "test-global.R")
+}
+
+if (!file.exists("test-ui.R")) {
+  reset_test_supporting_files()
+}
+
+source("test-global.R") # provides global_text
+
+shiny::onStop(function() {
+  unlink("test-ui.R")
+  unlink("test-server.R")
+  unlink("test-global.R")
+})

inst/apps/319-auto-reload-support/02-ui-server/server.R

@@ -0,0 +1,11 @@
+source("test-server.R") # server_text
+
+server <- function(input, output, session) {
+  observeEvent(input$update_files, {
+    writeLines('ui_text <- "UI test passed"', "test-ui.R")
+    writeLines('server_text <- "Server test passed"', "test-server.R")
+    writeLines('global_text <- "Global failed"', "test-global.R")
+  })
+
+  output$server_test <- renderText(server_text)
+}

inst/apps/319-auto-reload-support/02-ui-server/ui.R

@@ -0,0 +1,10 @@
+library(shiny)
+
+source("test-ui.R") # provides ui_text
+
+fluidPage(
+  h2(id = "ui_test", ui_text),
+  textOutput("server_test"),
+  p("Global: ", span(id = "global_test", global_text)),
+  actionButton("update_files", "Update files")
+)

inst/apps/319-auto-reload-support/tests/testthat.R

@@ -0,0 +1 @@
+shinytest2::test_app()

inst/apps/319-auto-reload-support/tests/testthat/setup-shinytest2.R

@@ -0,0 +1,3 @@
+# Load application support files into testing environment
+shinytest2::load_app_env()
+

inst/apps/319-auto-reload-support/tests/testthat/test-319-auto-reload-support.R

@@ -0,0 +1,73 @@
+library(shinytest2)
+
+app_path <- function(...) {
+  rprojroot::find_package_root_file(
+    "inst",
+    "apps",
+    "319-auto-reload-support",
+    ...
+  )
+}
+
+click_and_wait_for_reload <- function(app, id) {
+  b <- app$get_chromote_session()
+  p <- b$Runtime$evaluate(
+    sprintf("document.querySelector('#%s').click()", id),
+    wait_ = FALSE
+  )$then(function(value) {
+    b$Page$loadEventFired(wait_ = FALSE)
+  })
+  b$wait_for(p)
+}
+
+# app.R variant ----------------------------------------------------------------
+test_that("Test that auto-reload works with app.R", {
+  app <- AppDriver$new(
+    app_dir = app_path("01-app-dot-R"),
+    variant = platform_variant(),
+    height = 800,
+    width = 1200,
+    seed = 20250224,
+    view = interactive(),
+    options = list(bslib.precompiled = FALSE, shiny.autoreload = TRUE),
+    expect_values_screenshot_args = FALSE,
+    screenshot_args = list(selector = "viewport", delay = 0.5)
+  )
+  withr::defer(app$stop())
+
+  app$wait_for_idle()
+  expect_equal(app$get_text("#title"), "Test start")
+
+  click_and_wait_for_reload(app, "update_title")
+
+  expect_equal(app$get_text("#title"), "Test passed")
+})
+
+# ui/server variant ------------------------------------------------------------
+test_that("Test that auto-reload works with ui/server", {
+  app <- AppDriver$new(
+    app_dir = app_path("02-ui-server"),
+    variant = platform_variant(),
+    height = 800,
+    width = 1200,
+    seed = 20250224,
+    view = interactive(),
+    options = list(bslib.precompiled = FALSE, shiny.autoreload = TRUE),
+    expect_values_screenshot_args = FALSE,
+    screenshot_args = list(selector = "viewport", delay = 0.5)
+  )
+  withr::defer(app$stop())
+
+  app$wait_for_idle()
+  expect_equal(app$get_text("#ui_test"), "UI test start")
+  expect_equal(app$get_text("#server_test"), "Server test start")
+  expect_equal(app$get_text("#global_test"), "Global test start")
+
+  click_and_wait_for_reload(app, "update_files")
+
+  app$wait_for_js("document.querySelector('#server_test').innerText !== '';")
+
+  expect_equal(app$get_text("#ui_test"), "UI test passed")
+  expect_equal(app$get_text("#server_test"), "Server test passed")
+  expect_equal(app$get_text("#global_test"), "Global test start")
+})