library(shiny) library(reactable) library(shinytest2) library(mockery) library(purrr) library(dplyr) motor_trend_cars <- mtcars motor_trend_cars$make <- rownames(motor_trend_cars) rownames(motor_trend_cars) <- NULL test_that("get_data_on_page should return the correct subset of the data", { test_data <- data.frame( month_name = month.name, month_abbrev = month.abb ) page_1 <- head(test_data, 4) page_3 <- tail(test_data, 4) expect_error(get_data_on_page("test", 1, 3)) expect_error(get_data_on_page(2, 1, 3)) expect_error(get_data_on_page(test_data, "a", 3)) expect_error(get_data_on_page(test_data, "1", 3)) expect_error(get_data_on_page(test_data, 1.618, 3)) expect_error(get_data_on_page(test_data, 4, 3)) expect_error(get_data_on_page(test_data, 1, "a")) expect_error(get_data_on_page(test_data, 1, "3")) expect_error(get_data_on_page(test_data, 1, 3.141593)) expect_equal( get_data_on_page(test_data, 1, 3), page_1 ) expect_equal( get_data_on_page(test_data, 3, 3), page_3, # expected data returned with tail had rownames 9 to 12, but retrieved data had 1 to 4 ignore_attr = TRUE ) }) test_that("toggle_navigation_buttons should send the correct message to JS", { mock_session <- MockShinySession$new() class(mock_session) <- c("ShinySession", class(mock_session)) # Mock sendCustomMessage to test inputs are handled properly mock_session$sendCustomMessage <- function(type, message) { ( assign( message$id, sprintf( "type: %s; id: %s; disable: %s", type, message$id, message$disable ) ) ) } # Mock purrr::walk to return the message as a vector of strings stub( toggle_navigation_buttons, "purrr::walk", function(.x, .f) { map_chr(.x, .f) } ) expect_error(toggle_navigation_buttons(1, session = mock_session)) expect_error(toggle_navigation_buttons("test", session = mock_session)) expect_error( toggle_navigation_buttons( c( first_page = FALSE, previous_page = FALSE, next_page = FALSE, last_page = FALSE ), session = data.frame() ) ) expect_error( toggle_navigation_buttons( c( first_page = FALSE, previous_page = FALSE, next_page = FALSE, last_page = FALSE ), session = "session" ) ) expect_equal( toggle_navigation_buttons( c( first_page = FALSE, previous_page = FALSE, next_page = FALSE, last_page = FALSE ), session = mock_session ), c( "type: toggleDisable; id: #mock-session-first_page; disable: FALSE", "type: toggleDisable; id: #mock-session-previous_page; disable: FALSE", "type: toggleDisable; id: #mock-session-next_page; disable: FALSE", "type: toggleDisable; id: #mock-session-last_page; disable: FALSE" ) ) expect_equal( toggle_navigation_buttons( c( first_page = FALSE, previous_page = FALSE, next_page = TRUE, last_page = TRUE ), session = mock_session ), c( "type: toggleDisable; id: #mock-session-first_page; disable: FALSE", "type: toggleDisable; id: #mock-session-previous_page; disable: FALSE", "type: toggleDisable; id: #mock-session-next_page; disable: TRUE", "type: toggleDisable; id: #mock-session-last_page; disable: TRUE" ) ) expect_equal( toggle_navigation_buttons( c( first_page = TRUE, previous_page = TRUE, next_page = FALSE, last_page = FALSE ), session = mock_session ), c( "type: toggleDisable; id: #mock-session-first_page; disable: TRUE", "type: toggleDisable; id: #mock-session-previous_page; disable: TRUE", "type: toggleDisable; id: #mock-session-next_page; disable: FALSE", "type: toggleDisable; id: #mock-session-last_page; disable: FALSE" ) ) }) test_that("reactable_page_controls should return UI for page navigation and display", { expect_error(reactable_page_controls(1)) expect_error(reactable_page_controls(c("test1", "test2"))) expect_snapshot(reactable_page_controls("test")) }) test_that("return_reactable_page should return a reactive page value", { expect_error(return_reactable_page(1, 10)) expect_error(return_reactable_page(c("test1", "test2"), 10)) expect_error(return_reactable_page("test", "10")) expect_error(return_reactable_page("test", c(10, 20))) testServer( return_reactable_page, args = list(total_pages = 10), { session$setInputs(first_page = 0) expect_equal(page_number(), 1) expect_equal(output$page_text, "1 of 10") expect_equal(session$returned(), 1) session$setInputs(next_page = 1) expect_equal(page_number(), 2) expect_equal(output$page_text, "2 of 10") expect_equal(session$returned(), 2) session$setInputs(last_page = 1) expect_equal(page_number(), 10) expect_equal(output$page_text, "10 of 10") expect_equal(session$returned(), 10) session$setInputs(previous_page = 1) expect_equal(page_number(), 9) expect_equal(output$page_text, "9 of 10") expect_equal(session$returned(), 9) session$setInputs(first_page = 1) expect_equal(page_number(), 1) expect_equal(output$page_text, "1 of 10") expect_equal(session$returned(), 1) } ) }) test_that("reactable_extras_ui should return a widget of reactableOutput", { skip_on_os(c("windows", "mac")) expect_error(reactable_extras_ui(1)) expect_error(reactable_extras_ui(c("test1", "test2"))) expect_snapshot(reactable_extras_ui("test")) }) test_that("reactable_extras_server should return the correct data subset", { # Function should throw errors with invalid inputs expect_error(reactable_extras_server(1, mtcars)) expect_error(reactable_extras_server(c("test1", "test2"), mtcars)) expect_error(reactable_extras_server("test", 1)) expect_error(reactable_extras_server("test", mtcars, total_pages = "a")) expect_error(reactable_extras_server("test", mtcars, total_pages = 1.618)) expect_error(reactable_extras_server("test", mtcars, sortable = "a")) expect_error(reactable_extras_server("test", mtcars, not_a_valid_argument = TRUE)) testServer( reactable_extras_server, args = list( data = motor_trend_cars, columns = list( mpg = colDef(name = "Miles per Gallon"), cyl = colDef(name = "Cylinders"), disp = colDef(name = "Displacement"), hp = colDef(name = "Horsepower"), wt = colDef(name = "Weight"), gear = colDef(name = "Number of forward gears"), vs = colDef(name = "Engine"), am = colDef(name = "Transmission") ), striped = TRUE, compact = TRUE, total_pages = 4 ), { reactable_data_no_uuid <- reactive({ select(reactable_data(), -.internal_uuid) }) # Pagination should return the correct data subsets session$setInputs("page_controls-first_page" = 0) expect_equal(reactable_data_no_uuid(), head(motor_trend_cars, 8)) session$setInputs("page_controls-last_page" = 1) expect_equal(reactable_data_no_uuid(), tail(motor_trend_cars, 8), ignore_attr = TRUE) session$setInputs("page_controls-previous_page" = 1) expect_equal( reactable_data_no_uuid(), motor_trend_cars[seq(17, 24, by = 1), ], ignore_attr = TRUE ) session$setInputs("page_controls-first_page" = 1) expect_equal(reactable_data_no_uuid(), head(motor_trend_cars, 8)) session$setInputs("page_controls-next_page" = 1) expect_equal( reactable_data_no_uuid(), motor_trend_cars[seq(9, 16, by = 1), ], ignore_attr = TRUE ) # Reactable should be returned without error output$reactable } ) }) test_that("tables are sorted correctly according to direction", { mtcars_with_id <- mutate(mtcars, row_id = row_number()) expect_equal( sort_table(mtcars_with_id, "row_id", "asc")$row_id, 1:32 ) expect_equal( sort_table(mtcars_with_id, "row_id", "desc")$row_id, 32:1 ) })