context("notebook") # expect that the default evaluate hook is restored after the notebook is # rendered and parsed hook_evaluate_get <- function() knitr::knit_hooks$get("evaluate") hook_evaluate <- hook_evaluate_get() expect_default_evaluate_hook <- function() { expect_identical(hook_evaluate_get(), hook_evaluate) } test_that("an example R Notebook document can be rendered and parsed", { # check initial status of hook expect_default_evaluate_hook() # generate the file path <- test_path("resources/r-notebook.Rmd") file <- tempfile(fileext = ".nb.html") on.exit(unlink(file), add = TRUE) rmarkdown::render(path, output_file = file, quiet = TRUE) # confirm the evaluate hook has been restored post-render expect_default_evaluate_hook() # if running interactively, try running the following code to open the # generated document -- in RStudio, you should see the source .Rmd opened, # with outputs populated in the editor view # # file.edit(file) # try parsing and validating the parse format parsed <- parse_html_notebook(file) expect_identical(parsed$rmd, read_utf8(path)) }) test_that("a custom output_source can be used on render", { # set up output_source hook png_path <- normalizePath(testthat::test_path("resources/tinyplot.png"), winslash = "/") output_options <- list(output_source = function(code, context, ...) { label <- context$label if (label == "chunk-one") { expect_true(context$chunk.index == 1) output <- summary(cars) return(list( html_notebook_output_code("summary(cars)"), output )) } if (label == "chunk-two") { expect_true(context$chunk.index == 2) return(html_notebook_output_img(png_path)) } if (label == "chunk-three") { expect_true(context$chunk.index == 3) if (requireNamespace("dygraphs", quietly = TRUE)) { library(dygraphs) widget <- dygraph(nhtemp, main = "New Haven Temperatures") %>% dyRangeSelector(dateWindow = c("1920-01-01", "1960-01-01")) return(list( html_notebook_output_code("# This is a fake comment!"), widget )) } return(html_notebook_output_html("")) } if (label == "chunk-four") { expect_true(context$chunk.index == 4) styles <- list( "background-color" = "#4AF", "width" = "100px", "height" = "100px", "border" = "1px solid black", "box-shadow" = "0 0 10px #ACE" ) pasted <- paste(names(styles), styles, sep = ": ", collapse = "; ") format <- '
Box!
' rendered <- sprintf(format, pasted) return(html_notebook_output_html(rendered)) } }) input_file <- testthat::test_path("resources/r-notebook.Rmd") # output_file <- "~/Desktop/output.nb.html" output_file <- tempfile(fileext = ".nb.html") on.exit(unlink(output_file), add = TRUE) # check initial status of hook expect_default_evaluate_hook() render(input_file, output_options = output_options, output_file = output_file, quiet = TRUE) # confirm the evaluate hook has been restored post-render expect_default_evaluate_hook() # parse notebook parsed <- parse_html_notebook(output_file) }) test_that("UFT8 character in html widget does not break notebook annotation", { # as of htmltools v0.5.1 we no longer use token based htmlPreserve skip_if(packageVersion("htmltools") >= "0.5.1") # from issue in https://github.com/rstudio/rmarkdown/issues/1762 # simulate html widget code html_dependency_dummy <- function() { htmltools::htmlDependency( name = "dummy", version = "0.0.0", src = "dummy_file", script = "dummy.js") } utf8_strings <- enc2utf8("éà") output <- htmltools::htmlPreserve(utf8_strings) output <- knitr::asis_output(output, meta = html_dependency_dummy()) reg_res <- paste0( "\n", utf8_strings,"\n", "\n" ) expect_match(notebook_render_html_widget(output), reg_res) })