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)
})