Add 312-bslib-sidebar-resize

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"))

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.

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)

inst/apps/312-bslib-sidebar-resize/tests/testthat.R

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

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
+  )
+}