diff --git a/R/build-articles.R b/R/build-articles.R index 1b56b752e..b4d0ae619 100644 --- a/R/build-articles.R +++ b/R/build-articles.R @@ -248,10 +248,8 @@ build_article <- function(name, front <- rmarkdown::yaml_front_matter(input_path) # Take opengraph from article's yaml front matter - front_opengraph <- check_open_graph(front$opengraph %||% list()) - data$opengraph <- utils::modifyList( - data$opengraph %||% list(), front_opengraph - ) + front_opengraph <- check_open_graph(front$opengraph, input) + data$opengraph <- modify_list(data$opengraph, front_opengraph) # Allow users to opt-in to their own template ext <- purrr::pluck(front, "pkgdown", "extension", .default = "html") diff --git a/R/config.R b/R/config.R index d167ecb7d..84ff9c635 100644 --- a/R/config.R +++ b/R/config.R @@ -129,6 +129,6 @@ config_abort <- function(pkg, config_path <- function(pkg) { # Not all projects necessary have a _pkgdown.yml (#2542) - config <- pkgdown_config_path(pkg$src_path) %||% "_pkgdown.yml" + config <- pkgdown_config_path(pkg) %||% "_pkgdown.yml" cli::style_hyperlink(path_file(config), paste0("file://", config)) } diff --git a/R/package.R b/R/package.R index 73214a06c..e02d3b8f0 100644 --- a/R/package.R +++ b/R/package.R @@ -168,6 +168,10 @@ check_bootstrap_version <- function(version, pkg) { # Metadata ---------------------------------------------------------------- pkgdown_config_path <- function(path) { + if (is_pkgdown(path)) { + path <- path$src_path + } + path_first_existing( path, c( diff --git a/R/render.R b/R/render.R index 3799a730b..122ecff6a 100644 --- a/R/render.R +++ b/R/render.R @@ -132,10 +132,10 @@ data_template <- function(pkg = ".", depth = 0L) { print_yaml(out) } -data_open_graph <- function(pkg = ".") { +data_open_graph <- function(pkg = ".", call = caller_env()) { pkg <- as_pkgdown(pkg) - og <- pkg$meta$template$opengraph %||% list() - og <- check_open_graph(og) + og <- pkg$meta$template$opengraph + og <- check_open_graph(og, pkgdown_config_path(pkg), call = call) if (is.null(og$image) && !is.null(find_logo(pkg$src_path))) { og$image <- list(src = path_file(find_logo(pkg$src_path))) } @@ -153,55 +153,47 @@ data_open_graph <- function(pkg = ".") { og } -check_open_graph <- function(og) { - if (!is.list(og)) { - fog <- friendly_type_of(og) - cli::cli_abort( - "{.var opengraph} must be a list, not {.val fog}.", - call = caller_env() - ) +check_open_graph <- function(og, path, call = caller_env()) { + if (is.null(og)) { + return() } + + is_yaml <- path_ext(path) %in% c("yml", "yaml") + base_path <- if (is_yaml) "template.opengraph" else "opengraph" + + check_open_graph_list( + og, + file_path = path, + error_path = base_path, + error_call = call + ) + supported_fields <- c("image", "twitter") unsupported_fields <- setdiff(names(og), supported_fields) if (length(unsupported_fields)) { cli::cli_warn( - "Unsupported {.var opengraph} field{?s}: {.val unsupported_fields}." + "{.file {path}}: Unsupported {.field {base_path}} {cli::qty(unsupported_fields)} field{?s}: {.val {unsupported_fields}}.", + call = call ) } - if ("twitter" %in% names(og)) { - if (is.character(og$twitter) && length(og$twitter) == 1 && grepl("^@", og$twitter)) { - cli::cli_abort( - "The {.var opengraph: twitter} option must be a list.", - call = caller_env() - ) - } - if (!is.list(og$twitter)) { - cli::cli_abort( - "The {.var opengraph: twitter} option must be a list.", - call = caller_env() - ) - } - if (is.null(og$twitter$creator) && is.null(og$twitter$site)) { - cli::cli_abort( - "{.var opengraph: twitter} must include either {.val creator} or {.val site}.", - call = caller_env() - ) - } - } - if ("image" %in% names(og)) { - if (is.character(og$image) && length(og$image) == 1) { - cli::cli_abort( - "The {.var opengraph: image} option must be a list.", - call = caller_env() - ) - } - if (!is.list(og$image)) { - cli::cli_abort( - "The {.var opengraph: image} option must be a list.", - call = caller_env() - ) - } + check_open_graph_list( + og$twitter, + file_path = path, + error_path = paste0(base_path, ".twitter"), + error_call = call + ) + if (!is.null(og$twitter) && is.null(og$twitter$creator) && is.null(og$twitter$site)) { + cli::cli_abort( + "{.file {path}}: {.field opengraph.twitter} must include either {.field creator} or {.field site}.", + call = call + ) } + check_open_graph_list( + og$image, + file_path = path, + error_path = paste0(base_path, ".image"), + error_call = call + ) og[intersect(supported_fields, names(og))] } @@ -213,6 +205,20 @@ render_template <- function(path, data) { whisker::whisker.render(template, data) } +check_open_graph_list <- function(x, + file_path, + error_path, + error_call = caller_env()) { + if (is.list(x) || is.null(x)) { + return() + } + not <- friendly_type_of(x) + cli::cli_abort( + "{.file {file_path}}: {.field {error_path}} must be a list, not {not}.", + call = error_call + ) +} + write_if_different <- function(pkg, contents, path, quiet = FALSE, check = TRUE) { # Almost all uses are relative to destination, except for rmarkdown templates full_path <- path_abs(path, start = pkg$dst_path) diff --git a/R/utils-fs.R b/R/utils-fs.R index ea1a12bc5..c0f864d6a 100644 --- a/R/utils-fs.R +++ b/R/utils-fs.R @@ -127,10 +127,3 @@ path_package_pkgdown <- function(path, path_pkgdown <- function(...) { system_file(..., package = "pkgdown") } - -pkgdown_config_relpath <- function(pkg) { - pkg <- as_pkgdown(pkg) - config_path <- pkgdown_config_path(pkg$src_path) - - path_rel(config_path, pkg$src_path) -} diff --git a/tests/testthat/_snaps/build-articles.md b/tests/testthat/_snaps/build-articles.md index d0ea7fcdb..0669621eb 100644 --- a/tests/testthat/_snaps/build-articles.md +++ b/tests/testthat/_snaps/build-articles.md @@ -54,3 +54,11 @@ Output ## [1] 0.080750138 0.834333037 0.600760886 0.157208442 0.007399441 +# reports on bad open graph meta-data + + Code + build_article(pkg = pkg, name = "bad-opengraph") + Condition + Error in `build_article()`: + ! 'vignettes/bad-opengraph.Rmd': opengraph.twitter must be a list, not an integer vector. + diff --git a/tests/testthat/_snaps/render.md b/tests/testthat/_snaps/render.md index 11d04eb82..7e4715fd0 100644 --- a/tests/testthat/_snaps/render.md +++ b/tests/testthat/_snaps/render.md @@ -39,7 +39,6 @@ toc: Table of contents site_nav: Site navigation has_favicons: no - opengraph: [] extra: css: ~ js: ~ @@ -63,3 +62,35 @@ right:
Site built with pkgdown {version}.
+# check_opengraph validates inputs + + Code + check_open_graph_(list(foo = list()), ) + Condition + Warning in `check_open_graph_()`: + '_pkgdown.yml': Unsupported template.opengraph field: "foo". + Output + named list() + Code + check_open_graph_(list(foo = list(), bar = list())) + Condition + Warning in `check_open_graph_()`: + '_pkgdown.yml': Unsupported template.opengraph fields: "foo" and "bar". + Output + named list() + Code + check_open_graph_(list(twitter = 1)) + Condition + Error in `check_open_graph_()`: + ! '_pkgdown.yml': template.opengraph.twitter must be a list, not a double vector. + Code + check_open_graph_(list(twitter = list())) + Condition + Error in `check_open_graph_()`: + ! '_pkgdown.yml': opengraph.twitter must include either creator or site. + Code + check_open_graph_(list(image = 1)) + Condition + Error in `check_open_graph_()`: + ! '_pkgdown.yml': template.opengraph.image must be a list, not a double vector. + diff --git a/tests/testthat/assets/articles/vignettes/bad-opengraph.Rmd b/tests/testthat/assets/articles/vignettes/bad-opengraph.Rmd new file mode 100644 index 000000000..f6f31e13f --- /dev/null +++ b/tests/testthat/assets/articles/vignettes/bad-opengraph.Rmd @@ -0,0 +1,7 @@ +--- +title: "Introduction to poolnoodlr" +description: "A brief introduction to pool noodles in R." +author: "Mara Averick" +opengraph: + twitter: 1 +--- \ No newline at end of file diff --git a/tests/testthat/test-build-articles.R b/tests/testthat/test-build-articles.R index 198382568..32f5b9c78 100644 --- a/tests/testthat/test-build-articles.R +++ b/tests/testthat/test-build-articles.R @@ -292,3 +292,9 @@ test_that("output is reproducible by default, i.e. 'seed' is respected", { expect_snapshot(cat(output)) }) + +test_that("reports on bad open graph meta-data", { + pkg <- local_pkgdown_site(test_path("assets/articles")) + suppressMessages(init_site(pkg)) + expect_snapshot(build_article(pkg = pkg, name = "bad-opengraph"), error = TRUE) +}) diff --git a/tests/testthat/test-render.R b/tests/testthat/test-render.R index 95cf03f4f..1b3cfcd7f 100644 --- a/tests/testthat/test-render.R +++ b/tests/testthat/test-render.R @@ -69,3 +69,17 @@ test_that("can include text in header, before body, and after body", { c("in header", "before body", "after body") ) }) + +test_that("check_opengraph validates inputs", { + check_open_graph_ <- function(...) { + check_open_graph(..., path = "_pkgdown.yml") + } + + expect_snapshot(error = TRUE, { + check_open_graph_(list(foo = list()), ) + check_open_graph_(list(foo = list(), bar = list())) + check_open_graph_(list(twitter = 1)) + check_open_graph_(list(twitter = list())) + check_open_graph_(list(image = 1)) + }) +})