Skip to content

Commit 8d2b6a3

Browse files
tomjemmetttomjemmett
committed
adds tests for mod_select_strategy
1 parent b5a7ec1 commit 8d2b6a3

File tree

3 files changed

+213
-25
lines changed

3 files changed

+213
-25
lines changed

‎R/mod_select_strategy.R‎

Lines changed: 25 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -21,47 +21,47 @@ mod_select_strategy_ui <- function(id) {
2121
)
2222
}
2323

24+
mod_select_strategy_get_strategies <- function() {
25+
strategies <- jsonlite::read_json(
26+
app_sys("app", "data", "mitigators.json"),
27+
simplify_vector = TRUE
28+
)
29+
30+
strategies |>
31+
unlist() |>
32+
tibble::enframe("strategy", "name") |>
33+
dplyr::mutate(
34+
category = stringr::str_extract(
35+
.data$name,
36+
"(?<= \\()(IP|OP|AE)(?=-(AA|EF))" # e.g. 'IP' in 'IP-AA-001'
37+
) |>
38+
stringr::str_to_lower()
39+
) |>
40+
dplyr::nest_by(.data$category) |>
41+
tibble::deframe()
42+
}
43+
2444
#' Select Strategy Server
2545
#' @param id Internal parameter for `shiny`.
2646
#' @noRd
2747
mod_select_strategy_server <- function(id) {
2848
# load static data items
29-
strategies <- jsonlite::read_json(
30-
app_sys("app", "data", "mitigators.json"),
31-
simplify_vector = TRUE
32-
)
49+
strategies <- mod_select_strategy_get_strategies()
3350

3451
# return the shiny module
3552
shiny::moduleServer(id, function(input, output, session) {
36-
shiny::req(strategies)
37-
38-
select_category <- shiny::reactive({
53+
selected_category <- shiny::reactive({
3954
shiny::req(input$strategy_category_select)
4055
input$strategy_category_select
4156
})
4257

4358
shiny::observe({
44-
shiny::req(select_category())
59+
category <- shiny::req(selected_category())
4560

46-
category_strategies <- strategies |>
47-
unlist() |>
48-
tibble::enframe("strategy", "name") |>
49-
dplyr::mutate(
50-
category = stringr::str_extract(
51-
.data$name,
52-
"(?<= \\()(IP|OP|AE)(?=-(AA|EF))" # e.g. 'IP' in 'IP-AA-001'
53-
) |>
54-
stringr::str_to_lower()
55-
) |>
56-
dplyr::filter(.data$category == select_category()) |>
57-
dplyr::select("strategy", "name") |>
61+
strategy_choices <- strategies[[category]] |>
62+
dplyr::select("name", "strategy") |>
5863
tibble::deframe()
5964

60-
strategy_choices <- purrr::set_names(
61-
names(category_strategies),
62-
category_strategies
63-
)
64-
6565
shiny::updateSelectInput(
6666
session,
6767
"strategy_select",

‎tests/testthat/_snaps/mod_select_strategy.md‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
# ui
2+
3+
Code
4+
ui
5+
Output
6+
<div class="form-group shiny-input-container">
7+
<label class="control-label" id="test-strategy_category_select-label" for="test-strategy_category_select">Filter by activity type:</label>
8+
<div>
9+
<select id="test-strategy_category_select" class="shiny-input-select"><option value="ip" selected>Inpatients</option>
10+
<option value="op">Outpatients</option>
11+
<option value="ae">Accident &amp; Emergency</option></select>
12+
<script type="application/json" data-for="test-strategy_category_select" data-nonempty="">{"plugins":["selectize-plugin-a11y"]}</script>
13+
</div>
14+
</div>
15+
<div class="form-group shiny-input-container">
16+
<label class="control-label" id="test-strategy_select-label" for="test-strategy_select">Choose a TPMA:</label>
17+
<div>
18+
<select id="test-strategy_select" class="shiny-input-select"></select>
19+
<script type="application/json" data-for="test-strategy_select" data-nonempty="">{"plugins":["selectize-plugin-a11y"]}</script>
20+
</div>
21+
</div>
22+

‎tests/testthat/test-mod_select_strategy.R‎

Lines changed: 166 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,166 @@
1+
library(mockery)
2+
library(testthat)
3+
4+
setup_mod_select_strategy_server <- function(.env = parent.frame()) {
5+
strategies <- list(
6+
ip = tibble::tibble(
7+
name = c("Strategy A", "Strategy B"),
8+
strategy = c("a", "b")
9+
),
10+
op = tibble::tibble(
11+
name = c("Strategy C", "Strategy D"),
12+
strategy = c("c", "d")
13+
),
14+
ae = tibble::tibble(
15+
name = c("Strategy E", "Strategy F"),
16+
strategy = c("e", "f")
17+
)
18+
)
19+
m <- mock(strategies)
20+
21+
local_mocked_bindings(
22+
"mod_select_strategy_get_strategies" = m,
23+
.env = .env
24+
)
25+
26+
m
27+
}
28+
29+
test_that("ui", {
30+
testthat::local_mocked_bindings(
31+
"p_randomInt" = \(...) "X",
32+
.package = "shiny"
33+
)
34+
35+
ui <- mod_select_strategy_ui("test")
36+
37+
expect_snapshot(ui)
38+
})
39+
40+
41+
test_that("mod_select_strategy_get_strategies works", {
42+
# arrange
43+
m <- mock(
44+
list(
45+
"a" = "Strategy A (IP-AA-001)",
46+
"b" = "Strategy B (IP-AA-002)",
47+
"c" = "Strategy C (IP-EF-001)",
48+
"d" = "Strategy D (OP-AA-001)",
49+
"e" = "Strategy E (OP-AA-002)"
50+
)
51+
)
52+
local_mocked_bindings(
53+
"read_json" = m,
54+
.package = "jsonlite"
55+
)
56+
expected <- list(
57+
"ip" = tibble::tribble(
58+
~strategy , ~name ,
59+
"a" , "Strategy A (IP-AA-001)" ,
60+
"b" , "Strategy B (IP-AA-002)" ,
61+
"c" , "Strategy C (IP-EF-001)"
62+
),
63+
op = tibble::tribble(
64+
~strategy , ~name ,
65+
"d" , "Strategy D (OP-AA-001)" ,
66+
"e" , "Strategy E (OP-AA-002)"
67+
)
68+
) |>
69+
dplyr::bind_rows(.id = "category") |>
70+
dplyr::group_nest(.data$category) |>
71+
tibble::deframe()
72+
73+
# act
74+
actual <- mod_select_strategy_get_strategies()
75+
76+
# assert
77+
expect_equal(actual, expected)
78+
expect_called(m, 1)
79+
expect_call(
80+
m,
81+
1,
82+
jsonlite::read_json(
83+
app_sys("app", "data", "mitigators.json"),
84+
simplify_vector = TRUE
85+
)
86+
)
87+
})
88+
89+
test_that("server returns reactive", {
90+
# arrange
91+
setup_mod_select_strategy_server()
92+
93+
test_server <- function(input, output, session) {
94+
selected_strategy <- mod_select_strategy_server("test")
95+
}
96+
97+
# act
98+
shiny::testServer(test_server, {
99+
session$setInputs("test-strategy_select" = "a")
100+
expect_equal(selected_strategy(), "a")
101+
102+
session$setInputs("test-strategy_select" = "b")
103+
expect_equal(selected_strategy(), "b")
104+
})
105+
})
106+
107+
test_that("it calls mod_select_strategy_get_strategies", {
108+
# arrange
109+
m <- setup_mod_select_strategy_server()
110+
111+
# act
112+
shiny::testServer(mod_select_strategy_server, {
113+
# assert
114+
expect_called(m, 1)
115+
expect_args(m, 1)
116+
})
117+
})
118+
119+
test_that("selected_category", {
120+
# arrange
121+
setup_mod_select_strategy_server()
122+
123+
# act
124+
shiny::testServer(mod_select_strategy_server, {
125+
session$setInputs("strategy_category_select" = "ip")
126+
actual <- selected_category()
127+
128+
# assert
129+
expect_equal(actual, "ip")
130+
})
131+
})
132+
133+
test_that("it updates the strategy_select choices", {
134+
# arrange
135+
setup_mod_select_strategy_server()
136+
m <- mock()
137+
local_mocked_bindings(
138+
"updateSelectInput" = m,
139+
.package = "shiny"
140+
)
141+
142+
# act
143+
shiny::testServer(mod_select_strategy_server, {
144+
# assert
145+
session$setInputs("strategy_category_select" = "ip")
146+
expect_called(m, 1)
147+
expect_args(
148+
m,
149+
1,
150+
session,
151+
"strategy_select",
152+
choices = c("Strategy A" = "a", "Strategy B" = "b")
153+
)
154+
155+
# assert
156+
session$setInputs("strategy_category_select" = "op")
157+
expect_called(m, 2)
158+
expect_args(
159+
m,
160+
2,
161+
session,
162+
"strategy_select",
163+
choices = c("Strategy C" = "c", "Strategy D" = "d")
164+
)
165+
})
166+
})

0 commit comments

Comments
 (0)