mockSession <- function(namespace = NULL) { e <- new.env() e$input <- list() e$msgs <- list() e$sendCustomMessage <- function(type, message) { msg <- list(type = type, message = message) e$msgs[[length(e$msgs) + 1]] <- msg e$lastMsg <- msg msg } e$ns <- function(id) { shiny::NS(namespace, id) } e } test_that("updateReactable", { session <- mockSession() expect_error(updateReactable(123, session = session), "`outputId` must be a character string") expect_error(updateReactable("id", data = list(), session = session), "`data` must be a data frame or matrix") expect_error(updateReactable("id", selected = TRUE, session = session), "`selected` must be numeric") expect_error(updateReactable("id", expanded = 123, session = session), "`expanded` must be TRUE or FALSE") expect_error(updateReactable("id", page = TRUE, session = session), "`page` must be a single, positive integer") expect_error(updateReactable("id", page = c(1, 3), session = session), "`page` must be a single, positive integer") expect_error(updateReactable("id", page = 0, session = session), "`page` must be a single, positive integer") expect_null(updateReactable("id")) updateReactable("id", session = session) expect_null(session$lastMsg) # Update data updateReactable("mytbl", data = data.frame(x = 1), session = session) expected <- list( data = data.frame(x = 1), dataKey = digest::digest(data.frame(x = 1)), selected = list(), expanded = FALSE, page = 0 ) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = expected)) # Override state resets updateReactable("mytbl", data = matrix(4), selected = 3, expanded = TRUE, page = 2, session = session) expected <- list( data = matrix(4), dataKey = digest::digest(matrix(4)), selected = list(2), expanded = TRUE, page = 1 ) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = expected)) # Update selected rows updateReactable("mytbl", selected = 1, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(selected = list(0)))) updateReactable("mytbl", selected = c(1, 3, 5), session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(selected = list(0, 2, 4)))) updateReactable("mytbl", selected = integer(0), session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(selected = list()))) updateReactable("mytbl", selected = NA, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(selected = list()))) updateReactable("mytbl", selected = NA_real_, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(selected = list()))) updateReactable("mytbl", selected = c(3, 5, NA), session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(selected = list(2, 4)))) # Update expanded rows updateReactable("mytbl", expanded = TRUE, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(expanded = TRUE))) updateReactable("mytbl", expanded = FALSE, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(expanded = FALSE))) updateReactable("mytbl", selected = c(1, 3), expanded = FALSE, session = session) expect_equal(session$lastMsg, list( type = "__reactable__mytbl", message = list(selected = list(0, 2), expanded = FALSE) )) # Update current page updateReactable("mytbl", page = 2, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mytbl", message = list(page = 1))) # Update meta expect_error(updateReactable("mytbl", meta = TRUE, session = session), "`meta` must be a named list or NA") updateReactable("mytbl", meta = list(custom = 123, fn = JS("n => n > 30")), session = session) expect_equal(session$lastMsg, list( type = "__reactable__mytbl", message = list( meta = list(custom = 123, fn = JS("n => n > 30")), jsEvals = I("meta.fn") # Should be wrapped in I() so length-1 arrays serialize as arrays ) )) updateReactable("mytbl", meta = NA, session = session) expect_equal(session$lastMsg, list( type = "__reactable__mytbl", message = list(meta = NA) )) updateReactable("mytbl", meta = list(), page = 1, session = session) expect_equal(session$lastMsg, list( type = "__reactable__mytbl", message = list(page = 0) )) # JS evals should not include data updateReactable("mytbl", data = data.frame(x = I(list(fn = JS("() => {}")))), session = session) expect_equal(session$lastMsg$message$jsEvals, NULL) # Should work with Shiny modules session <- mockSession(namespace = "mod") updateReactable("mytbl", selected = 2, session = session) expect_equal(session$lastMsg, list(type = "__reactable__mod-mytbl", message = list(selected = list(1)))) }) test_that("getReactableState", { session <- mockSession() expect_error(getReactableState(123, session = session), "`outputId` must be a character string") expect_error(getReactableState("id", "x", session = session), '`name` values must be one of "page", "pageSize", "pages", "sorted", "selected"') expect_null(getReactableState("id")) updateReactable("id", session = session) expect_equal(getReactableState("mytbl", session = session), NULL) session$input[["mytbl__reactable__page"]] <- 3 expect_equal(getReactableState("mytbl", "page", session = session), 3) session$input[["mytbl__reactable__pageSize"]] <- 2 expect_equal(getReactableState("mytbl", "pageSize", session = session), 2) session$input[["mytbl__reactable__pages"]] <- 10 expect_equal(getReactableState("mytbl", "pages", session = session), 10) session$input[["mytbl__reactable__sorted"]] <- list(a = "asc", b = "desc") expect_equal(getReactableState("mytbl", "sorted", session = session), list(a = "asc", b = "desc")) session$input[["mytbl__reactable__selected"]] <- c(1, 5, 7) expect_equal(getReactableState("mytbl", "selected", session = session), c(1, 5, 7)) # Multiple values expect_equal(getReactableState("mytbl", c("page", "pageSize"), session = session), list(page = 3, pageSize = 2)) # All values expect_equal(getReactableState("mytbl", session = session), list( page = 3, pageSize = 2, pages = 10, sorted = list(a = "asc", b = "desc"), selected = c(1, 5, 7) )) })