tests/testthat/test-rsc_grid.R

In rstudio/rscpages: Organize and Curate Your Content Within 'Posit Connect'

get_attribs <- function(widget) widget$x$tag$attribs

content_sample <- data.frame(
  guid = c(
    "991f16c5-dc7e-4403-89d0-c54d10968460",
    "4b5345cc-8dc5-46fa-80ed-1a389d80e21b",
    "100881c9-0162-4f3f-b973-6870085d48ff"
  ),
  url = c(
    "https://connect.tester.net/content/991f16c5-dc7e-4403-89d0-c54d10968460/",
    "https://connect.tester.net/content/4b5345cc-8dc5-46fa-80ed-1a389d80e21b/",
    "https://connect.tester.net/content/100881c9-0162-4f3f-b973-6870085d48ff/"
  ),
  title = c("One", "Two", "Three"),
  owner_username = c("bob", "jerry", "adam"),
  app_mode = c("api", "rmd-static", "shiny"),
  tags = c("blue", "green", "pale yellow"),
  updated_time = c(
    "Sat Oct 03 2020",
    "Sun Jan 24 2021",
    "Fri Oct 30 2020"
  )
)

test_that("rsc_grid handles invalid/missing args", {
  # missing content param
  expect_error(rsc_grid())

  # not a data frame or crosstalk object
  expect_error(rsc_grid("marshmallow"))

  # requires "guid", "url", "title", "app_mode", "owner_username"
  content <- data.frame(id = c("1", "2", "3"))
  expect_error(rsc_grid(content))

  guid <- c(
    "991f16c5-dc7e-4403-89d0-c54d10968460",
    "4b5345cc-8dc5-46fa-80ed-1a389d80e21b",
    "100881c9-0162-4f3f-b973-6870085d48ff"
  )
  content <- cbind(content, guid)
  expect_error(rsc_grid(content))

  title <- c("One", "Two", "Three")
  content <- cbind(content, title)
  expect_error(rsc_grid(content))

  url <- c(
    "https://connect.tester.net/content/991f16c5-dc7e-4403-89d0-c54d10968460/",
    "https://connect.tester.net/content/4b5345cc-8dc5-46fa-80ed-1a389d80e21b/",
    "https://connect.tester.net/content/100881c9-0162-4f3f-b973-6870085d48ff/"
  )
  content <- cbind(content, url)
  expect_error(rsc_grid(content))

  app_mode <- c("api", "rmd-static", "shiny")
  content <- cbind(content, app_mode)
  expect_error(rsc_grid(content))

  owner_username <- c("bob", "jerry", "adam")
  content <- cbind(content, owner_username)

  # warnings for missing "updated_time"
  expect_warning(rsc_grid(content))

  updated_time <- c(
    "Sat Oct 03 2020",
    "Sun Jan 24 2021",
    "Fri Oct 30 2020"
  )
  content <- cbind(content, updated_time)
  expect_warning(
    rsc_grid(content),
    NA
  )
})

test_that("should warn on large content", {
  over_max_size <- 501
  content <- data.frame(
    guid = rep("100881c9-0162-4f3f-b973-6870085d48ff", times = over_max_size),
    title = rep("Test", times = over_max_size),
    url = rep(
      "https://example.com/content/991f16c5-dc7e-4403-89d0-c54d10968460/",
      times = over_max_size
    ),
    app_mode = rep("api", times = over_max_size),
    owner_username = rep("bob", times = over_max_size),
    description = rep("Lorem ipsum", times = over_max_size),
    updated_time = rep("Sat Oct 03 2020", times = over_max_size)
  )

  expect_warning(
    rsc_grid(content),
    "exceeds maximum"
  )
})

test_that("rsc_grid container", {
  widget <- rsc_grid(content_sample)
  attrs <- get_attribs(widget)

  expect_equal(attrs$data$guid, content_sample$guid)
  expect_equal(attrs$data$url, content_sample$url)
  expect_equal(attrs$data$title, content_sample$title)
  expect_equal(length(attrs$crosstalkKey), 3)
  expect_true(length(attrs$crosstalkGroup) > 0)
})

test_that("rsc_grid supports crosstalk", {
  sh <- crosstalk::SharedData$new(
    content_sample,
    key = ~guid,
    group = "gridzzz"
  )

  widget <- rsc_grid(sh)
  attrs <- get_attribs(widget)

  expect_true("991f16c5-dc7e-4403-89d0-c54d10968460" %in% attrs$crosstalkKey)
  expect_true("4b5345cc-8dc5-46fa-80ed-1a389d80e21b" %in% attrs$crosstalkKey)
  expect_true("100881c9-0162-4f3f-b973-6870085d48ff" %in% attrs$crosstalkKey)
  expect_equal(attrs$crosstalkGroup, "gridzzz")
})

test_that("rscgridOutput", {
  output <- rscgridOutput("mygridz")

  # HTML dependencies should be intact
  deps <- htmltools::htmlDependencies(output)
  expect_true(length(deps) > 0)

  # Output container should have data-reactable-output ID set
  name <- output[[1]]$name
  id <- htmltools::tagGetAttribute(output[[1]], "id")
  cls <- htmltools::tagGetAttribute(output[[1]], "class")
  expect_equal(name, "div")
  expect_equal(id, "mygridz")
  expect_match(cls, "rsc_grid html-widget html-widget-output")
})