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