Nothing
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)
))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.