Skip to content

Commit daf5438

Browse files
gadenbuiegadenbuie
committed
Programmatically test sidebar transition
1 parent eac7185 commit daf5438

File tree

4 files changed

+284
-13
lines changed

4 files changed

+284
-13
lines changed

‎inst/apps/312-bslib-sidebar-resize/app.R‎

Lines changed: 24 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,12 @@ lorem2 <- p(
1818

1919
ui <- page_navbar(
2020
title = "312 | bslib-sidebar-resize",
21-
theme = bs_theme("bslib-sidebar-transition-duration" = "3s"),
21+
theme = bs_theme(
22+
"bslib-sidebar-transition-duration" = Sys.getenv("SIDEBAR_TRANSITION_TIME", "0.5s")
23+
),
2224
sidebar = sidebar(
2325
title = "Shared Sidebar",
26+
id = "sidebar-shared",
2427
open = "open",
2528
p("The plots should resize smoothly when this sidebar or the local sidebar are toggled.")
2629
),
@@ -33,9 +36,13 @@ ui <- page_navbar(
3336
"update the plot with the final dimensions."
3437
),
3538
layout_sidebar(
36-
sidebar = sidebar(title = "Toggle me", lorem1, lorem2, lorem1),
39+
sidebar = sidebar(
40+
title = "Toggle me",
41+
id = "sidebar-local-static",
42+
lorem1, lorem2, lorem1
43+
),
3744
lorem1,
38-
plotOutput("plot_static1"),
45+
plotOutput("plot_static_local"),
3946
lorem2
4047
),
4148
h2("Shared only", class = "my-3"),
@@ -44,8 +51,8 @@ ui <- page_navbar(
4451
),
4552
div(
4653
class = "row",
47-
div(class = "col", plotOutput("plot_static2")),
48-
div(class = "col", p(lorem2, lorem1))
54+
div(class = "col-6", plotOutput("plot_static_shared")),
55+
div(class = "col-6", lorem2, lorem1)
4956
)
5057
),
5158
nav(
@@ -57,9 +64,13 @@ ui <- page_navbar(
5764
"complete."
5865
),
5966
layout_sidebar(
60-
sidebar = sidebar(title = "Toggle me", lorem1, lorem2, lorem1),
67+
sidebar = sidebar(
68+
title = "Toggle me",
69+
id = "sidebar-local-widget",
70+
lorem1, lorem2, lorem1
71+
),
6172
lorem1,
62-
plotlyOutput("plot_widget1"),
73+
plotlyOutput("plot_widget_local"),
6374
lorem2
6475
),
6576
h2("Shared only", class = "my-3"),
@@ -68,8 +79,8 @@ ui <- page_navbar(
6879
),
6980
div(
7081
class = "row",
71-
div(class = "col", plotlyOutput("plot_widget2")),
72-
div(class = "col", p(lorem2, lorem1))
82+
div(class = "col-6", plotlyOutput("plot_widget_shared")),
83+
div(class = "col-6", lorem2, lorem1)
7384
)
7485
),
7586
footer = div(style = "min-height: 100vh")
@@ -88,11 +99,11 @@ server <- function(input, output, session) {
8899
theme_gray(base_size = 16)
89100
})
90101

91-
output$plot_static1 <- renderPlot(plot())
92-
output$plot_static2 <- renderPlot(plot())
102+
output$plot_static_local <- renderPlot(plot())
103+
output$plot_static_shared <- renderPlot(plot())
93104

94-
output$plot_widget1 <- renderPlotly(ggplotly(plot()))
95-
output$plot_widget2 <- renderPlotly(ggplotly(plot()))
105+
output$plot_widget_local <- renderPlotly(ggplotly(plot()))
106+
output$plot_widget_shared <- renderPlotly(ggplotly(plot()))
96107
}
97108

98109
shinyApp(ui, server)

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
shinytest2::test_app()

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
# Load application support files into testing environment
2+
shinytest2::load_app_env()

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

Lines changed: 257 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,257 @@
1+
library(shinytest2)
2+
3+
expect_sidebar_hidden_factory <- function(app) {
4+
function(id) {
5+
state <- app$get_js(js_sidebar_state(id = id))
6+
expect_true("sidebar-collapsed" %in% state$layout_classes)
7+
expect_equal(state$content_display, "none")
8+
expect_true(state$sidebar_hidden)
9+
}
10+
}
11+
12+
expect_sidebar_shown_factory <- function(app) {
13+
function(id) {
14+
state <- app$get_js(js_sidebar_state(id = id))
15+
expect_false("sidebar-collapsed" %in% state$layout_classes)
16+
expect_false(identical(state$content_display, "none"))
17+
expect_false(state$sidebar_hidden)
18+
}
19+
}
20+
21+
js_sidebar_transition_complete <- function(id) {
22+
sprintf(
23+
"!document.getElementById('%s').parentElement.classList.contains('transitioning');",
24+
id
25+
)
26+
}
27+
28+
js_sidebar_state <- function(id) {
29+
sprintf(
30+
"(function() {
31+
return {
32+
layout_classes: Array.from(document.getElementById('%s').closest('.bslib-sidebar-layout').classList),
33+
content_display: window.getComputedStyle(document.querySelector('#%s .sidebar-content')).getPropertyValue('display'),
34+
sidebar_hidden: document.getElementById('%s').hidden
35+
}})();",
36+
id, id, id
37+
)
38+
}
39+
40+
js_element_width <- function(selector) {
41+
sprintf(
42+
"document.querySelector('%s').getBoundingClientRect().width;",
43+
selector
44+
)
45+
}
46+
47+
# Gather width measurements of plots during the sidebar transition
48+
#
49+
# 1. Measures the `initial` width of plots prior to transition
50+
# 2. Clicks the sidebar toggle
51+
# 3. Samples width of plots `during` transition
52+
# 4. Waits for transition to complete
53+
# 5. Measures the `final` width of plots after transition
54+
# 6. Captures updated shiny `outputs` during the measurement period
55+
watch_sidebar_transition <- function(
56+
app,
57+
sidebar = c("shared", "local"),
58+
page = c("static", "widget")
59+
) {
60+
sidebar <- match.arg(sidebar)
61+
page <- match.arg(page)
62+
63+
id_sidebar <- if (sidebar == "shared") "sidebar-shared" else paste0("sidebar-local-", page)
64+
sel_plot <- function(which = c("shared", "local")) {
65+
plot_container <-
66+
if (page == "static") {
67+
"img"
68+
} else {
69+
".plot-container > .svg-container"
70+
}
71+
paste0("#plot_", page, "_", which, " > ", plot_container)
72+
}
73+
sel_plot_img_local <- sel_plot("local")
74+
sel_plot_img_shared <- sel_plot("shared")
75+
76+
initial <- list(
77+
local = app$get_js(js_element_width(sel_plot_img_local)),
78+
shared = app$get_js(js_element_width(sel_plot_img_shared))
79+
)
80+
81+
during <- list(local = c(), shared = c())
82+
83+
app$run_js("
84+
if (!window.updatedOutputs) {
85+
$(document).on('shiny:value', function(event) {
86+
window.updatedOutputs.push(event.target.id);
87+
})
88+
}
89+
window.updatedOutputs = [];
90+
")
91+
app$click(selector = sprintf("#%s + .collapse-toggle", id_sidebar))
92+
93+
while (!app$get_js(js_sidebar_transition_complete(id_sidebar))) {
94+
Sys.sleep(0.1)
95+
during$local <- c(during$local, app$get_js(js_element_width(sel_plot_img_local)))
96+
during$shared <- c(during$shared, app$get_js(js_element_width(sel_plot_img_shared)))
97+
}
98+
99+
if (page == "static") {
100+
app$wait_for_js("window.updatedOutputs.length > 0")
101+
Sys.sleep(0.25)
102+
} else {
103+
# widget plots don't trigger shiny:value events, so we just have to wait
104+
Sys.sleep(1)
105+
}
106+
107+
outputs <- app$get_js("window.updatedOutputs")
108+
final <- list(
109+
local = app$get_js(js_element_width(sel_plot_img_local)),
110+
shared = app$get_js(js_element_width(sel_plot_img_shared))
111+
)
112+
113+
list(
114+
initial = initial,
115+
during = during,
116+
final = final,
117+
outputs = unlist(outputs)
118+
)
119+
}
120+
121+
# 312-bslib-sidebar-resize ----------------------------------------------------
122+
test_that("312-bslib-sidebar-resize", {
123+
app <- AppDriver$new(
124+
name = "312-bslib-sidebar-resize",
125+
variant = platform_variant(),
126+
height = 1600,
127+
width = 1200,
128+
view = interactive(),
129+
options = list(bslib.precompiled = FALSE),
130+
expect_values_screenshot_args = FALSE
131+
)
132+
133+
expect_sidebar_hidden <- expect_sidebar_hidden_factory(app)
134+
expect_sidebar_shown <- expect_sidebar_shown_factory(app)
135+
136+
# STATIC PAGE ================================================================
137+
138+
# collapse static shared sidebar --------
139+
close_static_shared <- watch_sidebar_transition(
140+
app,
141+
sidebar = "shared",
142+
page = "static"
143+
)
144+
145+
expect_sidebar_hidden("sidebar-shared")
146+
147+
# plot output image size changed during collapse for both plots
148+
expect_gt(length(unique(close_static_shared$during$local)), 1)
149+
expect_gt(length(unique(close_static_shared$during$shared)), 1)
150+
151+
# plot output image size was growing during transition
152+
expect_gt(min(close_static_shared$during$local), close_static_shared$initial$local)
153+
expect_gt(min(close_static_shared$during$shared), close_static_shared$initial$shared)
154+
155+
# both plots updated at the end of the transition
156+
expect_setequal(close_static_shared$outputs, c("plot_static_local", "plot_static_shared"))
157+
158+
# collapse static local sidebar --------
159+
close_static_local <- watch_sidebar_transition(
160+
app,
161+
sidebar = "local",
162+
page = "static"
163+
)
164+
165+
expect_sidebar_hidden("sidebar-local-static")
166+
167+
# plot output image size changed during collapse for local plot only
168+
expect_gt(length(unique(close_static_local$during$local)), 1)
169+
expect_equal(length(unique(close_static_local$during$shared)), 1)
170+
171+
# plot output image size was growing during transition for local only
172+
expect_gt(min(close_static_local$during$local), close_static_local$initial$local)
173+
expect_equal(unique(close_static_local$during$shared), close_static_local$initial$shared)
174+
175+
# local plot updated at the end of the transition
176+
expect_equal(close_static_local$outputs, "plot_static_local")
177+
178+
# expand static shared sidebar --------
179+
open_static_shared <- watch_sidebar_transition(
180+
app,
181+
sidebar = "shared",
182+
page = "static"
183+
)
184+
185+
expect_sidebar_shown("sidebar-shared")
186+
187+
# plot output image size changed during expand for both plots
188+
expect_gt(length(unique(open_static_shared$during$local)), 1)
189+
expect_gt(length(unique(open_static_shared$during$shared)), 1)
190+
191+
# plot output image size was shrinking during transition
192+
expect_lt(max(open_static_shared$during$local), open_static_shared$initial$local)
193+
expect_lt(max(open_static_shared$during$shared), open_static_shared$initial$shared)
194+
195+
# both plots updated at the end of the transition
196+
expect_setequal(open_static_shared$outputs, c("plot_static_local", "plot_static_shared"))
197+
198+
# SWITCH TO WIDGET PAGE ======================================================
199+
app$
200+
click(selector = '.nav-link[data-value="Widget"]')$
201+
wait_for_js("document.getElementById('js-plotly-tester') ? true : false")
202+
203+
# now we repeat all of the same tests above, except that the widget resizing
204+
# won't trigger a 'shiny:value' event.
205+
206+
# collapse widget shared sidebar --------
207+
close_widget_shared <- watch_sidebar_transition(
208+
app,
209+
sidebar = "shared",
210+
page = "widget"
211+
)
212+
213+
expect_sidebar_hidden("sidebar-shared")
214+
215+
# plot output image size changed during collapse for both plots
216+
expect_gt(length(unique(close_widget_shared$during$local)), 1)
217+
expect_gt(length(unique(close_widget_shared$during$shared)), 1)
218+
219+
# plot output image size was growing during transition
220+
expect_gt(min(close_widget_shared$during$local), close_widget_shared$initial$local)
221+
expect_gt(min(close_widget_shared$during$shared), close_widget_shared$initial$shared)
222+
223+
# collapse widget local sidebar --------
224+
close_widget_local <- watch_sidebar_transition(
225+
app,
226+
sidebar = "local",
227+
page = "widget"
228+
)
229+
230+
expect_sidebar_hidden("sidebar-local-widget")
231+
232+
# plot output image size changed during collapse for local plot only
233+
expect_gt(length(unique(close_widget_local$during$local)), 1)
234+
expect_equal(length(unique(close_widget_local$during$shared)), 1)
235+
236+
# plot output image size was growing during transition for local only
237+
expect_gt(min(close_widget_local$during$local), close_widget_local$initial$local)
238+
expect_equal(unique(close_widget_local$during$shared), close_widget_local$initial$shared)
239+
240+
# expand widget shared sidebar --------
241+
open_widget_shared <- watch_sidebar_transition(
242+
app,
243+
sidebar = "shared",
244+
page = "widget"
245+
)
246+
247+
expect_sidebar_shown("sidebar-shared")
248+
249+
# plot output image size changed during expand for both plots
250+
expect_gt(length(unique(open_widget_shared$during$local)), 1)
251+
expect_gt(length(unique(open_widget_shared$during$shared)), 1)
252+
253+
# plot output image size was shrinking during transition
254+
expect_lt(max(open_widget_shared$during$local), open_widget_shared$initial$local)
255+
expect_lt(max(open_widget_shared$during$shared), open_widget_shared$initial$shared)
256+
257+
})

0 commit comments

Comments
 (0)