1context("htmlwidgets serializer")
2
3# Render a simple HTML widget using the visNetwork package
4renderWidget <- function(){
5  nodes <- data.frame(id = 1:6, title = paste("node", 1:6),
6                      shape = c("dot", "square"),
7                      size = 10:15, color = c("blue", "red"))
8  edges <- data.frame(from = 1:5, to = c(5, 4, 6, 3, 3))
9  visNetwork::visNetwork(nodes, edges) %>%
10    visNetwork::visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)
11
12}
13
14test_that("htmlwidgets serialize properly", {
15  # Solaris doesn't have htmlwidgets available for some reason.
16  skip_on_cran()
17
18  w <- renderWidget()
19  val <- serializer_htmlwidget()(w, list(), PlumberResponse$new(), stop)
20  expect_equal(val$status, 200L)
21  expect_equal(val$headers$`Content-Type`, "text/html; charset=utf-8")
22  # Check that content is encoded
23  expect_match(val$body, "url(data:image/png;base64", fixed = TRUE)
24})
25
26test_that("Errors call error handler", {
27  errors <- 0
28  errHandler <- function(req, res, err){
29    errors <<- errors + 1
30  }
31
32  expect_equal(errors, 0)
33  suppressWarnings(
34    serializer_htmlwidget()(parse(text="hi"), list(), PlumberResponse$new("htmlwidget"), err = errHandler)
35  )
36  expect_equal(errors, 1)
37})
38