diff --git a/NEWS.md b/NEWS.md index 53e61e64..10ddeb9c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # htmltools (development version) +* `includeCSS()`, `includeHTML()`, `includeText()`, `includeMarkdown()`, and `includeScript()` now raise a clear error naming the missing file when `path` does not exist, instead of the vague "cannot open the connection" message from `readLines()`. (rstudio/shiny#1757) + + # htmltools 0.5.9 * Fix test for testthat 3.3.0. (#442) diff --git a/R/tags.R b/R/tags.R index f8421384..b8bb9aa6 100644 --- a/R/tags.R +++ b/R/tags.R @@ -1735,6 +1735,7 @@ knit_print.html_dependency <- knit_print.shiny.tag #' @aliases includeHTML #' @export includeHTML <- function(path) { + check_include_path(path, "HTML file") lines <- readLines(path, warn=FALSE, encoding='UTF-8') if (detect_html_document(lines)) { @@ -1783,6 +1784,7 @@ detect_html_document <- function(lines) { #' @rdname include #' @export includeText <- function(path) { + check_include_path(path, "Text file") lines <- readLines(path, warn=FALSE, encoding='UTF-8') return(paste8(lines, collapse='\n')) } @@ -1792,6 +1794,7 @@ includeText <- function(path) { #' @rdname include #' @export includeMarkdown <- function(path) { + check_include_path(path, "Markdown file") # markdown >= v1.3 switched from markdownToHTML() to mark() html <- if (packageVersion("markdown") < "1.3") { markdown::markdownToHTML(path, fragment.only = TRUE) @@ -1806,6 +1809,7 @@ includeMarkdown <- function(path) { #' @rdname include #' @export includeCSS <- function(path, ...) { + check_include_path(path, "CSS file") lines <- readLines(path, warn=FALSE, encoding='UTF-8') args <- dots_list(...) if (is.null(args$type)) @@ -1817,10 +1821,29 @@ includeCSS <- function(path, ...) { #' @rdname include #' @export includeScript <- function(path, ...) { + check_include_path(path, "Script file") lines <- readLines(path, warn=FALSE, encoding='UTF-8') return(tags$script(HTML(paste8(lines, collapse='\n')), ...)) } +check_include_path <- function(path, what = "File", call = rlang::caller_env()) { + if (!rlang::is_string(path) || !nzchar(path)) { + rlang::abort( + paste0(what, " path must be a single non-empty string."), + call = call + ) + } + if (!file.exists(path) || dir.exists(path)) { + rlang::abort( + c( + paste0(what, " does not exist."), + "x" = paste0("Path: ", path) + ), + call = call + ) + } +} + #' Include content only once #' #' Use `singleton` to wrap contents (tag, text, HTML, or lists) that should diff --git a/tests/testthat/test-tags.r b/tests/testthat/test-tags.r index 195c1f86..4fd3f8bf 100644 --- a/tests/testthat/test-tags.r +++ b/tests/testthat/test-tags.r @@ -1226,3 +1226,39 @@ test_that("includeHTML() warns if full document is detected", { save_html(p("test"), tmp_html) expect_warning(includeHTML(tmp_html)) }) + +test_that("include*() helpers raise a clear error when the file is missing", { + missing <- tempfile("does-not-exist-", fileext = ".txt") + expect_false(file.exists(missing)) + + expect_error(includeCSS(missing), "CSS file does not exist") + expect_error(includeHTML(missing), "HTML file does not exist") + expect_error(includeText(missing), "Text file does not exist") + expect_error(includeScript(missing), "Script file does not exist") +}) + +test_that("includeMarkdown() raises a clear error when the file is missing", { + skip_if_not_installed("markdown") + missing <- tempfile("does-not-exist-", fileext = ".txt") + expect_error(includeMarkdown(missing), "Markdown file does not exist") +}) + +test_that("include*() missing-file error is attributed to the public helper", { + missing <- tempfile("does-not-exist-", fileext = ".txt") + err <- rlang::catch_cnd(includeCSS(missing)) + expect_match(rlang::expr_deparse(err$call), "includeCSS") +}) + +test_that("include*() helpers reject invalid path inputs", { + expect_error(includeCSS(NULL), "must be a single non-empty string") + expect_error(includeCSS(character(0)), "must be a single non-empty string") + expect_error(includeCSS(c("a", "b")), "must be a single non-empty string") + expect_error(includeCSS(""), "must be a single non-empty string") + expect_error(includeCSS(NA_character_), "must be a single non-empty string") +}) + +test_that("include*() helpers reject a directory path", { + dir <- withr::local_tempdir() + expect_true(dir.exists(dir)) + expect_error(includeCSS(dir), "CSS file does not exist") +})