diff --git a/R/data-apps-deps.R b/R/data-apps-deps.R index d69d8d3193..c7a7d68690 100644 --- a/R/data-apps-deps.R +++ b/R/data-apps-deps.R @@ -60,5 +60,6 @@ apps_deps_map <- list(`001-hello` = "rsconnect", `012-datatables` = "ggplot2", "rversions"), `305-bslib-value-box` = c("rlang", "rversions" ), `309-flexdashboard-tabs-navs` = "rmarkdown", `310-bslib-sidebar-dynamic` = c("rversions", "testthat"), `311-bslib-sidebar-toggle-methods` = c("rversions", - "testthat"), `313-bslib-card-tab-focus` = c("rversions", - "testthat", "withr")) + "testthat"), `312-bslib-sidebar-resize` = c("ggplot2", "withr" + ), `313-bslib-card-tab-focus` = c("rversions", "testthat", + "withr")) diff --git a/inst/apps/312-bslib-sidebar-resize/README.md b/inst/apps/312-bslib-sidebar-resize/README.md new file mode 100644 index 0000000000..87913675bc --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/README.md @@ -0,0 +1,15 @@ +# 312-bslib-sidebar-resize + +## Description + +`312-bslib-sidebar-resize` tests that outputs and htmlwidgets inside the main content area of sidebar layouts animate through the sidebar resizing transition. The test app includes three pages: + +1. A layout with two ggplot2 plots created via `plotOutput()`. During the sidebar resizing transition, the plots should stretch. This causes some visible distortion of the image. When the transition is complete, the server updates the plot at the new resolution and the image should "snap" into place. + +2. A layout with two plotly plots created via `plotlyOutput()`. During the sidebar resizing transition, the plots should grow or shrink smoothly to match the available space in the content area of the layout. + +3. A layout with two htmlwidgets created via `plot_ly()`. During the sidebar resizing transition, the widgets should grow or shrink smoothly to match the available space in the content area of the layout. + +## Notes + +The animation is not smooth on Windows, at least on CI. The test suite currently skips testing around the plot animation on Windows, but does test the sidebar state. Manual testing on Windows should confirm that the animation is smooth. diff --git a/inst/apps/312-bslib-sidebar-resize/app.R b/inst/apps/312-bslib-sidebar-resize/app.R new file mode 100644 index 0000000000..9873addb26 --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/app.R @@ -0,0 +1,144 @@ +library(shiny) +library(bslib) +library(ggplot2) +library(plotly) + +lorem1 <- p( + "Dolor cursus quis sociis, tempus laoreet integer vel,", + "nam suscipit sodales curabitur tristique. Hac massa", + "fames auctor ac posuere, non: primis semper egestas!", + "Porttitor interdum lobortis elementum arcu." +) + +lorem2 <- p( + "Elit aptent vivamus, eu habitasse fringilla venenatis", + "viverra tellus metus. Maecenas ultrices fermentum", + "nunc turpis libero nascetur!" +) + +ui <- page_navbar( + title = "312 | bslib-sidebar-resize", + theme = bs_theme( + "bslib-sidebar-transition-duration" = Sys.getenv("SIDEBAR_TRANSITION_TIME", "0.5s") + ), + sidebar = sidebar( + title = "Shared Sidebar", + id = "sidebar-shared", + open = "open", + p("The plots should resize smoothly when this sidebar or the local sidebar are toggled.") + ), + nav_panel( + "Static", + h2("Static plot resizing"), + p( + "The plot in the layout below should stretch while the sidebar is", + "opening or closing. After the transition is complete, the server will", + "update the plot with the final dimensions." + ), + layout_sidebar( + sidebar = sidebar( + title = "Toggle me", + id = "sidebar-local-static", + lorem1, lorem2, lorem1 + ), + lorem1, + plotOutput("plot_static_local"), + lorem2 + ), + h2("Shared only", class = "my-3"), + p( + "The next plot should resize smoothly only when the shared sidebar is transitioning." + ), + div( + class = "row", + div(class = "col-6", plotOutput("plot_static_shared")), + div(class = "col-6", lorem2, lorem1) + ) + ), + nav_panel( + "Widget", + h2("Widget plot resizing"), + p( + "The plot in the layout below should stretch while the sidebar is opening", + "or closing. There should be no layout shift after the transition is", + "complete." + ), + layout_sidebar( + sidebar = sidebar( + title = "Toggle me", + id = "sidebar-local-widget", + lorem1, lorem2, lorem1 + ), + lorem1, + plotlyOutput("plot_widget_local"), + lorem2 + ), + h2("Shared only", class = "my-3"), + p( + "The next plot should resize smoothly only when the shared sidebar is transitioning." + ), + div( + class = "row", + div(class = "col-6", plotlyOutput("plot_widget_shared")), + div(class = "col-6", lorem2, lorem1) + ) + ), + nav_panel( + "Client", + h2("Client-side htmlwidget resizing"), + p( + "The plot in the layout below should stretch while the sidebar is opening", + "or closing. There should be no layout shift after the transition is", + "complete." + ), + layout_sidebar( + sidebar = sidebar( + title = "Toggle me", + id = "sidebar-local-client", + lorem1, lorem2, lorem1 + ), + lorem1, + div(id = "plot_client_local", plot_ly(x = rnorm(100))), + lorem2 + ), + h2("Shared only", class = "my-3"), + p( + "The next plot should resize smoothly only when the shared sidebar is transitioning." + ), + div( + class = "row", + div( + class = "col-6", + div(id = "plot_client_shared", plot_ly(x = rnorm(100))) + ), + div(class = "col-6", lorem2, lorem1) + ) + ), + footer = div(style = "min-height: 100vh") +) + +server <- function(input, output, session) { + observeEvent(input$open_sidebar_shared, { + sidebar_toggle("sidebar-shared", open = "open") + }) + + plot <- reactive({ + ggplot(mtcars, aes(mpg, wt)) + + geom_point(aes(color = factor(cyl))) + + labs( + title = "Cars go brrrrr", + x = "Miles per gallon", + y = "Weight (tons)", + color = "Cylinders" + ) + + theme_gray(base_size = 16) + }) + + output$plot_static_local <- renderPlot(plot()) + output$plot_static_shared <- renderPlot(plot()) + + output$plot_widget_local <- renderPlotly(ggplotly(plot())) + output$plot_widget_shared <- renderPlotly(ggplotly(plot())) +} + +shinyApp(ui, server) diff --git a/inst/apps/312-bslib-sidebar-resize/tests/testthat.R b/inst/apps/312-bslib-sidebar-resize/tests/testthat.R new file mode 100644 index 0000000000..7d25b5b9e4 --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/tests/testthat.R @@ -0,0 +1 @@ +shinytest2::test_app() diff --git a/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-js.R b/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-js.R new file mode 100644 index 0000000000..2fd2826edc --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-js.R @@ -0,0 +1,29 @@ +js_sidebar_transition_complete <- function(id) { + paste0("!", js_sidebar_is_transitioning(id)) +} + +js_sidebar_is_transitioning <- function(id) { + sprintf( + "document.getElementById('%s').parentElement.classList.contains('transitioning');", + id + ) +} + +js_sidebar_state <- function(id) { + sprintf( + "(function() { + return { + layout_classes: Array.from(document.getElementById('%s').closest('.bslib-sidebar-layout').classList), + content_display: window.getComputedStyle(document.querySelector('#%s .sidebar-content')).getPropertyValue('display'), + sidebar_hidden: document.getElementById('%s').hidden + }})();", + id, id, id + ) +} + +js_element_width <- function(selector) { + sprintf( + "document.querySelector('%s').getBoundingClientRect().width;", + selector + ) +} diff --git a/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-sidebar-animation.R b/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-sidebar-animation.R new file mode 100644 index 0000000000..3a4bc27f6c --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-sidebar-animation.R @@ -0,0 +1,250 @@ + +# Gather width measurements of plots during the sidebar transition +# +# 1. Measures the `initial` width of plots prior to transition +# 2. Clicks the sidebar toggle +# 3. Samples width of plots `during` transition +# 4. Waits for transition to complete +# 5. Measures the `final` width of plots after transition +# 6. Captures updated shiny `outputs` during the measurement period +watch_sidebar_transition <- function( + app, + sidebar = c("shared", "local"), + page = c("static", "widget", "client") +) { + sidebar <- match.arg(sidebar) + page <- match.arg(page) + + id_sidebar <- switch( + sidebar, + shared = "sidebar-shared", + paste0("sidebar-local-", page) + ) + + sel_plot <- function(which = c("shared", "local" , "client")) { + plot_container <- switch( + page, + static = "img", + widget = ".plot-container > .svg-container", + client = ".plotly > .plot-container > .svg-container" + ) + paste0("#plot_", page, "_", which, " > ", plot_container) + } + sel_plot_img_local <- sel_plot("local") + sel_plot_img_shared <- sel_plot("shared") + + initial <- list( + local = app$get_js(js_element_width(sel_plot_img_local)), + shared = app$get_js(js_element_width(sel_plot_img_shared)) + ) + + during <- list(local = c(), shared = c()) + + app$run_js(" +if (!window.updatedOutputs) { + $(document).on('shiny:value', function(event) { + window.updatedOutputs.push(event.target.id); + }) +} +window.updatedOutputs = []; +") + app$ + click(selector = sprintf("#%s + .collapse-toggle", id_sidebar))$ + wait_for_js(js_sidebar_is_transitioning(id_sidebar)) + + while (!app$get_js(js_sidebar_transition_complete(id_sidebar))) { + Sys.sleep(0.1) + during$local <- c(during$local, app$get_js(js_element_width(sel_plot_img_local))) + during$shared <- c(during$shared, app$get_js(js_element_width(sel_plot_img_shared))) + } + + if (page == "static") { + app$wait_for_js("window.updatedOutputs.length > 0") + Sys.sleep(0.25) + } else { + # widget plots don't trigger shiny:value events, so we just have to wait + Sys.sleep(1) + } + + outputs <- app$get_js("window.updatedOutputs") + final <- list( + local = app$get_js(js_element_width(sel_plot_img_local)), + shared = app$get_js(js_element_width(sel_plot_img_shared)) + ) + + if (identical(Sys.getenv("DEBUG_APP_312"), "true")) { + cat("\n----- Recording", sidebar, "sidebar on", page, "page transition -----") + cat_item <- function(which) { + value <- get(which) + cat("\n", which, ":", sep = "") + cat("\n shared:", paste(value[["shared"]], collapse = ", ")) + cat("\n local: ", paste(value[["local"]], collapse = ", ")) + } + cat_item("initial") + cat_item("during") + cat_item("final") + cat_item("outputs") + cat("\n-----------------------------------------------------------------\n\n") + } + + + # we only need unique observations between initial and final + during$local <- unique(during$local) + during$shared <- unique(during$shared) + + list( + initial = initial, + during = during, + final = final, + outputs = unlist(outputs) + ) +} + +expect_sidebar_transition <- function( + app, + sidebar = c("shared", "local"), + page = c("static", "widget", "client"), + open_end = c("open", "closed") +) { + sidebar <- match.arg(sidebar) + page <- match.arg(page) + open_end <- match.arg(open_end) + + expect_sidebar_shown <- expect_sidebar_shown_factory(app) + expect_sidebar_hidden <- expect_sidebar_hidden_factory(app) + + sidebar_id <- + if (sidebar == "shared") { + "sidebar-shared" + } else { + paste0("sidebar-local-", page) + } + + will_transition <- c("local", if (sidebar == "shared") "shared") + change_dir <- if (open_end == "open") "expand" else "collapse" + + # test sidebar state before transition + switch( + open_end, + open = expect_sidebar_hidden(sidebar_id), + closed = expect_sidebar_shown(sidebar_id) + ) + + # toggle the sidebar and measure the transition + res <- watch_sidebar_transition(app, sidebar = sidebar, page = page) + + # test sidebar state after transition + switch( + open_end, + open = expect_sidebar_shown(sidebar_id), + closed = expect_sidebar_hidden(sidebar_id) + ) + + # NOTE: transition isn't animated on Windows in CI, test manually + is_windows_on_ci <- + identical(.Platform$OS.type, "windows") && + identical(Sys.getenv("CI"), "true") + + # test plot output size changes during the transition + if (!is_windows_on_ci) { + expect_sidebar_changes_during_transition(res, open_end, will_transition) + } + + if (page == "static") { + # plots update at the end of the transition + expected_updates <- paste0("plot_static_", will_transition) + expect_setequal(res$outputs, !!expected_updates) + } +} + +expect_sidebar_changes_during_transition <- function(res, open_end, will_transition) { + + # Plot output size changes during the transition + if ("local" %in% will_transition) { + expect_gt( + length(res$during$local), + expected = 1, + label = "local plot output size changes during transition" + ) + } + + if ("shared" %in% will_transition) { + expect_gt( + length(res$during$shared), + expected = 1, + label = "shared plot output size changes during transition" + ) + } + + expect_plot_grows <- function(plot = c("local", "shared")) { + plot <- match.arg(plot) + + + # initial size is a lower bound, plots grow as sidebar collapses + expect_gt( + min(res$during[[plot]]), + res$initial[[!!plot]], + label = sprintf("minimum %s plot output size during transition", plot) + ) + has_size_changes <- expect_true( + length(res$during[[plot]]) > 1, + label = sprintf("has %s plot output size changes during transition", plot) + ) + if (has_size_changes) { + expect_true( + all(diff(res$during[[plot]]) > 0), + label = sprintf("%s plot output size was growing during transition", plot) + ) + } + } + + expect_plot_shrinks <- function(plot = c("local", "shared")) { + plot <- match.arg(plot) + + # initial size is the upper bound, plots shrink as sidebar expands + expect_lt( + max(res$during[[plot]]), + res$initial[[!!plot]], + label = sprintf("maximum %s plot output size during transition", plot) + ) + has_size_changes <- expect_true( + length(res$during[[plot]]) > 1, + label = sprintf("has %s plot output size changes during transition", plot) + ) + if (has_size_changes) { + expect_true( + all(diff(res$during[[plot]]) < 0), + label = sprintf("%s plot output size was growing during transition", plot) + ) + } + } + + # plot output image size was growing/shrinking during transition + if ("local" %in% will_transition) { + switch( + open_end, + open = expect_plot_shrinks("local"), + closed = expect_plot_grows("local") + ) + } else { + expect_equal( + res$during$local, + res$initial$local, + label = "local plot output size did not change during transition" + ) + } + + if ("shared" %in% will_transition) { + switch( + open_end, + open = expect_plot_shrinks("shared"), + closed = expect_plot_grows("shared") + ) + } else { + expect_equal( + res$during$shared, + res$initial$shared, + label = "shared plot output size did not change during transition" + ) + } +} diff --git a/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-sidebar-state.R b/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-sidebar-state.R new file mode 100644 index 0000000000..c67028850a --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/tests/testthat/helpers-sidebar-state.R @@ -0,0 +1,17 @@ +expect_sidebar_hidden_factory <- function(app) { + function(id) { + state <- app$get_js(js_sidebar_state(id = id)) + expect_true("sidebar-collapsed" %in% state$layout_classes) + expect_equal(state$content_display, "none") + expect_true(state$sidebar_hidden) + } +} + +expect_sidebar_shown_factory <- function(app) { + function(id) { + state <- app$get_js(js_sidebar_state(id = id)) + expect_false("sidebar-collapsed" %in% state$layout_classes) + expect_false(identical(state$content_display, "none")) + expect_false(state$sidebar_hidden) + } +} diff --git a/inst/apps/312-bslib-sidebar-resize/tests/testthat/setup-shinytest2.R b/inst/apps/312-bslib-sidebar-resize/tests/testthat/setup-shinytest2.R new file mode 100644 index 0000000000..be65b4f035 --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/tests/testthat/setup-shinytest2.R @@ -0,0 +1,2 @@ +# Load application support files into testing environment +shinytest2::load_app_env() diff --git a/inst/apps/312-bslib-sidebar-resize/tests/testthat/test-312-bslib-sidebar-resize.R b/inst/apps/312-bslib-sidebar-resize/tests/testthat/test-312-bslib-sidebar-resize.R new file mode 100644 index 0000000000..86bcab27d5 --- /dev/null +++ b/inst/apps/312-bslib-sidebar-resize/tests/testthat/test-312-bslib-sidebar-resize.R @@ -0,0 +1,69 @@ +library(shinytest2) + +withr::local_envvar(list(SIDEBAR_TRANSITION_TIME = "1s")) + +app <- AppDriver$new( + name = "312-bslib-sidebar-resize", + variant = platform_variant(), + height = 1600, + width = 1200, + view = interactive(), + options = list(bslib.precompiled = FALSE), + expect_values_screenshot_args = FALSE +) + +withr::defer(app$stop()) + +# STATIC PAGE ================================================================ +test_that("Resizing sidebars on page with ggplot2 plots", { + # collapse static shared sidebar -------------------------------------------- + expect_sidebar_transition(app, "shared", "static", open_end = "closed") + + # collapse static local sidebar --------------------------------------------- + expect_sidebar_transition(app, "local", "static", open_end = "closed") + + # expand static shared sidebar ---------------------------------------------- + expect_sidebar_transition(app, "shared", "static", open_end = "open") +}) + +# SWITCH TO WIDGET PAGE ====================================================== +test_that("Resizing sidebars on page with shiny-backed htmlwidgets", { + app$ + click(selector = '.nav-link[data-value="Widget"]')$ + wait_for_js("$('#plot_widget_local:visible .svg-container').length > 0")$ + run_js("Shiny.setInputValue('open_sidebar_shared', Date.now())")$ + wait_for_js(js_sidebar_transition_complete("sidebar-shared")) + + # now we repeat all of the same tests above, except that the widget resizing + # won't trigger a 'shiny:value' event. + + # collapse widget shared sidebar -------------------------------------------- + expect_sidebar_transition(app, "shared", "widget", open_end = "closed") + + # collapse widget local sidebar --------------------------------------------- + expect_sidebar_transition(app, "local", "widget", open_end = "closed") + + # expand widget shared sidebar ---------------------------------------------- + expect_sidebar_transition(app, "shared", "widget", open_end = "open") +}) + +# SWITCH TO CLIENT PAGE ====================================================== +test_that("Resizing sidebars on page with static htmlwidgets", { + app$ + click(selector = '.nav-link[data-value="Client"]')$ + wait_for_js("$('#plot_client_local:visible .svg-container').length > 0")$ + run_js("Shiny.setInputValue('open_sidebar_shared', Date.now())")$ + wait_for_js(js_sidebar_transition_complete("sidebar-shared")) + + # now we repeat all of the same tests above, except that the widget resizing + # won't trigger a 'shiny:value' event. + + # collapse widget shared sidebar -------------------------------------------- + expect_sidebar_transition(app, "shared", "client", open_end = "closed") + + # collapse widget local sidebar --------------------------------------------- + expect_sidebar_transition(app, "local", "client", open_end = "closed") + + # expand widget shared sidebar ---------------------------------------------- + expect_sidebar_transition(app, "shared", "client", open_end = "open") +})