tests/testthat/test-serializer-htmlwidgets.R

context("htmlwidgets serializer")

# Render a simple HTML widget using the visNetwork package
renderWidget <- function(){
  skip_if_not_installed("visNetwork")

  nodes <- data.frame(id = 1:6, title = paste("node", 1:6),
                      shape = c("dot", "square"),
                      size = 10:15, color = c("blue", "red"))
  edges <- data.frame(from = 1:5, to = c(5, 4, 6, 3, 3))
  visNetwork::visNetwork(nodes, edges) %>%
    visNetwork::visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)

}

test_that("htmlwidgets serialize properly", {
  # Solaris doesn't have htmlwidgets available for some reason.
  skip_on_cran()
  # Too many moving parts on an inconsistent os
  skip_on_os("windows")

  w <- renderWidget()
  val <- serializer_htmlwidget()(w, list(), PlumberResponse$new(), stop)
  expect_equal(val$status, 200L)
  expect_equal(val$headers$`Content-Type`, "text/html; charset=UTF-8")
  # Check that content is encoded
  expect_match(val$body, "url\\(['\"]?data:image\\/png;base64")
})

test_that("Errors call error handler", {
  errors <- 0
  errHandler <- function(req, res, err){
    errors <<- errors + 1
  }

  expect_equal(errors, 0)
  suppressWarnings(
    serializer_htmlwidget()(parse(text="hi"), list(), PlumberResponse$new("htmlwidget"), errorHandler = errHandler)
  )
  expect_equal(errors, 1)
})
trestletech/plumber documentation built on March 16, 2024, 8:21 a.m.