From be8bb7dcc54262e4d2c7130bafc534b293bafb04 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 24 May 2024 08:38:56 -0500
Subject: [PATCH] Add support for "external" articles (#2576)

Fixes #2028
---
 NEWS.md                                       |   1 +
 R/build-articles.R                            | 143 ++++++++++++++----
 R/navbar.R                                    |  13 +-
 R/package.R                                   |   2 +-
 inst/BS3/templates/content-article-index.html |   2 +-
 inst/BS5/templates/content-article-index.html |   2 +-
 man/build_articles.Rd                         |  24 ++-
 tests/testthat/_snaps/build-articles.md       |  57 ++++++-
 tests/testthat/test-build-articles.R          |  37 ++++-
 9 files changed, 232 insertions(+), 49 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 292814230..c778abd70 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # pkgdown (development version)
 
+* `build_articles()` now recognises a new `external-articles` top-level field that allows you to define articles that live in other packages (#2028).
 * New light switch makes it easy for users to switch between light and dark themes for the website (based on work in bslib by @gadenbuie). For now this behaviour is opt-in with `template.light-switch: true` but in the future we may turn it on automatically. See the customization vignette for details (#1696).
 * The search dropdown has been tweaked to look more like the other navbar menu items (#2338).
 * `vignette("search")` has been removed since BS3 is deprecated and all the BS5 docs are also included in `build_search()` (#2564).
diff --git a/R/build-articles.R b/R/build-articles.R
index 6882d1c31..cc9f4570b 100644
--- a/R/build-articles.R
+++ b/R/build-articles.R
@@ -77,7 +77,7 @@
 #' the navbar, it will link directly to the articles index instead of
 #' providing a drop-down.
 #'
-#' # Get started
+#' ## Get started
 #' Note that a vignette with the same name as the package (e.g.,
 #' `vignettes/pkgdown.Rmd` or `vignettes/articles/pkgdown.Rmd`) automatically
 #' becomes a top-level "Get started" link, and will not appear in the articles
@@ -86,12 +86,29 @@
 #' (If your package name includes a `.`, e.g. `pack.down`, use a `-` in the
 #' vignette name, e.g. `pack-down.Rmd`.)
 #'
-#' ## Missing topics
+#' ## Missing articles
 #'
 #' pkgdown will warn if there are (non-internal) articles that aren't listed
 #' in the articles index. You can suppress such warnings by listing the
 #' affected articles in a section with `title: internal` (case sensitive);
 #' this section will not be displayed on the index page.
+#' 
+#' ## External articles
+#'
+#' You can link to arbitrary additional articles by adding an 
+#' `external-articles` entry to `_pkgdown.yml`. It should contain an array
+#' of objects with fields `name`, `title`, `href`, and `description`. 
+#'
+#' ```yaml
+#' external-articles:
+#' - name: subsampling
+#'   title: Subsampling for Class Imbalances
+#'   description: Improve model performance in imbalanced data sets through undersampling or oversampling.
+#'   href: https://www.tidymodels.org/learn/models/sub-sampling/
+#' ```
+#' 
+#' If you've defined a custom articles index, you'll need to include the name
+#' in one of the `contents` fields.
 #'
 #' # External files
 #' pkgdown differs from base R in its handling of external files. When building
@@ -378,16 +395,16 @@ build_articles_index <- function(pkg = ".") {
 data_articles_index <- function(pkg = ".", call = caller_env()) {
   pkg <- as_pkgdown(pkg)
 
-  meta <- config_pluck_list(
-    pkg,
-    "articles",
-    default = default_articles_index(pkg),
+  articles <- data_articles(pkg, is_index = TRUE, call = call)
+  index <- config_pluck_list(pkg, "articles", call = call) %||%
+    default_articles_index(pkg)
+  sections <- unwrap_purrr_error(purrr::imap(
+    index,
+    data_articles_index_section,
+    articles = articles,
+    pkg = pkg,
     call = call
-  )
-
-  sections <- unwrap_purrr_error(meta %>%
-    purrr::imap(data_articles_index_section, pkg = pkg, call = call) %>%
-    purrr::compact())
+  ))
 
   # Check for unlisted vignettes
   listed <- sections %>%
@@ -396,7 +413,7 @@ data_articles_index <- function(pkg = ".", call = caller_env()) {
     purrr::flatten_chr() %>%
     unique()
 
-  missing <- setdiff(pkg$vignettes$name, listed)
+  missing <- setdiff(articles$name, listed)
   # Exclude get started vignette or article #2150
   missing <- missing[!article_is_intro(missing, package = pkg$package)]
 
@@ -417,10 +434,89 @@ data_articles_index <- function(pkg = ".", call = caller_env()) {
   ))
 }
 
-data_articles_index_section <- function(section, index, pkg, call = caller_env()) {
+data_articles <- function(pkg = ".", is_index = FALSE, call = caller_env()) {
+  pkg <- as_pkgdown(pkg)
+
+  internal <- tibble::tibble(
+    name = pkg$vignettes$name,
+    title = pkg$vignettes$title,
+    href = pkg$vignettes$file_out,
+    description = pkg$vignettes$description,
+  )
+  if (is_index) {
+    internal$href <- path_rel(internal$href, "articles")
+  }
+
+  external <- config_pluck_external_articles(pkg, call = call)
+  articles <- rbind(internal, external)
+
+  articles$description <- lapply(articles$description, markdown_text_block)
+
+  # Hack data structure so we can use select_topics()
+  articles$alias <- as.list(articles$name)
+  articles$internal <- FALSE
+
+  articles
+}
+
+config_pluck_external_articles <- function(pkg, call = caller_env()) {
+  external <- config_pluck_list(pkg, "external-articles", call = call)
+  if (is.null(external)) {
+    return(tibble::tibble(
+      name = character(),
+      title = character(),
+      href = character(),
+      description = character()
+    ))
+  }
+
+  for (i in seq_along(external)) {
+    config_check_list(
+      external[[i]],
+      has_names = c("name", "title", "href", "description"),
+      error_path = paste0("external-articles[", i, "]"),
+      error_pkg = pkg,
+      error_call = call
+    )
+    config_check_string(
+      external[[i]]$name,
+      error_path = paste0("external-articles[", i, "].name"),
+      error_pkg = pkg,
+      error_call = call
+    )
+    config_check_string(
+      external[[i]]$title,
+      error_path = paste0("external-articles[", i, "].title"),
+      error_pkg = pkg,
+      error_call = call
+    )
+    config_check_string(
+      external[[i]]$href,
+      error_path = paste0("external-articles[", i, "].href"),
+      error_pkg = pkg,
+      error_call = call
+    )
+    config_check_string(
+      external[[i]]$description,
+      error_path = paste0("external-articles[", i, "].description"),
+      error_pkg = pkg,
+      error_call = call
+    )
+  }
+
+  tibble::tibble(
+    name = purrr::map_chr(external, "name"),
+    title = purrr::map_chr(external, "title"),
+    href = purrr::map_chr(external, "href"),
+    description = purrr::map_chr(external, "description")
+  )
+}
+
+data_articles_index_section <- function(section, index, articles, pkg, call = caller_env()) {
   config_check_list(
     section,
     error_path = paste0("articles[", index, "]"),
+    has_names = c("title", "contents"),
     error_pkg = pkg,
     error_call = call
   )
@@ -452,15 +548,7 @@ data_articles_index_section <- function(section, index, pkg, call = caller_env()
   )
 
   # Match topics against any aliases
-  in_section <- select_vignettes(section$contents, pkg$vignettes)
-  section_vignettes <- pkg$vignettes[in_section, ]
-  contents <- tibble::tibble(
-    name = section_vignettes$name,
-    path = path_rel(section_vignettes$file_out, "articles"),
-    title = section_vignettes$title,
-    description = lapply(section_vignettes$description, markdown_text_block),
-  )
-
+  contents <- articles[select_topics(section$contents, articles), ]
 
   list(
     title = title,
@@ -470,17 +558,6 @@ data_articles_index_section <- function(section, index, pkg, call = caller_env()
   )
 }
 
-# Quick hack: create the same structure as for topics so we can use
-# the existing select_topics()
-select_vignettes <- function(match_strings, vignettes) {
-  topics <- tibble::tibble(
-    name = vignettes$name,
-    alias = as.list(vignettes$name),
-    internal = FALSE
-  )
-  select_topics(match_strings, topics)
-}
-
 default_articles_index <- function(pkg = ".") {
   pkg <- as_pkgdown(pkg)
 
diff --git a/R/navbar.R b/R/navbar.R
index 217952459..16afedbb0 100644
--- a/R/navbar.R
+++ b/R/navbar.R
@@ -187,24 +187,25 @@ navbar_articles <- function(pkg = ".") {
       menu_links(vignettes$title, vignettes$file_out)
     )
   } else {
-    articles <- config_pluck(pkg, "articles")
+    articles_index <- config_pluck(pkg, "articles")
+    articles <- data_articles(pkg)
 
-    navbar <- purrr::keep(articles, ~ has_name(.x, "navbar"))
+    navbar <- purrr::keep(articles_index, ~ has_name(.x, "navbar"))
     if (length(navbar) == 0) {
       # No articles to be included in navbar so just link to index
       menu$articles <- menu_link(tr_("Articles"), "articles/index.html")
     } else {
       sections <- lapply(navbar, function(section) {
-        vig <- pkg$vignettes[select_vignettes(section$contents, pkg$vignettes), , drop = FALSE]
+        vig <- articles[select_topics(section$contents, articles), , drop = FALSE]
         vig <- vig[vig$name != pkg$package, , drop = FALSE]
         c(
           if (!is.null(section$navbar)) list(menu_separator(), menu_heading(section$navbar)),
-          menu_links(vig$title, vig$file_out)
+          menu_links(vig$title, vig$href)
         )
       })
       children <- unlist(sections, recursive = FALSE, use.names = FALSE)
 
-      if (length(navbar) != length(articles)) {
+      if (length(navbar) != length(articles_index)) {
         children <- c(
           children,
           list(
@@ -243,7 +244,7 @@ pkg_navbar_vignettes <- function(name = character(),
   title <- title %||% paste0("Title ", name)
   file_out <- file_out %||% paste0(name, ".html")
 
-  tibble::tibble(name = name, title = title, file_out)
+  tibble::tibble(name = name, title = title, file_out, description = "desc")
 }
 
 
diff --git a/R/package.R b/R/package.R
index 8fab37bda..a097aff57 100644
--- a/R/package.R
+++ b/R/package.R
@@ -316,7 +316,7 @@ package_vignettes <- function(path = ".") {
   check_unique_article_paths(file_in, file_out)
 
   out <- tibble::tibble(
-    name = path_ext_remove(vig_path),
+    name = as.character(path_ext_remove(vig_path)),
     file_in = file_in,
     file_out = file_out,
     title = title,
diff --git a/inst/BS3/templates/content-article-index.html b/inst/BS3/templates/content-article-index.html
index f559ae4a1..f725bab34 100644
--- a/inst/BS3/templates/content-article-index.html
+++ b/inst/BS3/templates/content-article-index.html
@@ -11,7 +11,7 @@ <h3>{{{title}}}</h3>
 
       <dl>
         {{#contents}}
-        <dt><a href="{{path}}">{{title}}</a></dt>
+        <dt><a href="{{href}}">{{title}}</a></dt>
         <dd>{{{description}}}</dt>
         {{/contents}}
       </dl>
diff --git a/inst/BS5/templates/content-article-index.html b/inst/BS5/templates/content-article-index.html
index 0ff27681d..284cf17a1 100644
--- a/inst/BS5/templates/content-article-index.html
+++ b/inst/BS5/templates/content-article-index.html
@@ -12,7 +12,7 @@ <h3>{{{title}}}</h3>
 
       <dl>
         {{#contents}}
-        <dt><a href="{{path}}">{{title}}</a></dt>
+        <dt><a href="{{href}}">{{title}}</a></dt>
         <dd>{{{description}}}</dt>
         {{/contents}}
       </dl>
diff --git a/man/build_articles.Rd b/man/build_articles.Rd
index f77c93555..2e8dc9431 100644
--- a/man/build_articles.Rd
+++ b/man/build_articles.Rd
@@ -127,9 +127,8 @@ in the navbar drop-down list and others do not, the list will automatically
 include a "More ..." link at the bottom; if no vignettes appear in the
 the navbar, it will link directly to the articles index instead of
 providing a drop-down.
-}
+\subsection{Get started}{
 
-\section{Get started}{
 Note that a vignette with the same name as the package (e.g.,
 \code{vignettes/pkgdown.Rmd} or \code{vignettes/articles/pkgdown.Rmd}) automatically
 becomes a top-level "Get started" link, and will not appear in the articles
@@ -137,13 +136,32 @@ drop-down.
 
 (If your package name includes a \code{.}, e.g. \code{pack.down}, use a \code{-} in the
 vignette name, e.g. \code{pack-down.Rmd}.)
-\subsection{Missing topics}{
+}
+
+\subsection{Missing articles}{
 
 pkgdown will warn if there are (non-internal) articles that aren't listed
 in the articles index. You can suppress such warnings by listing the
 affected articles in a section with \code{title: internal} (case sensitive);
 this section will not be displayed on the index page.
 }
+
+\subsection{External articles}{
+
+You can link to arbitrary additional articles by adding an
+\code{external-articles} entry to \verb{_pkgdown.yml}. It should contain an array
+of objects with fields \code{name}, \code{title}, \code{href}, and \code{description}.
+
+\if{html}{\out{<div class="sourceCode yaml">}}\preformatted{external-articles:
+- name: subsampling
+  title: Subsampling for Class Imbalances
+  description: Improve model performance in imbalanced data sets through undersampling or oversampling.
+  href: https://www.tidymodels.org/learn/models/sub-sampling/
+}\if{html}{\out{</div>}}
+
+If you've defined a custom articles index, you'll need to include the name
+in one of the \code{contents} fields.
+}
 }
 
 \section{External files}{
diff --git a/tests/testthat/_snaps/build-articles.md b/tests/testthat/_snaps/build-articles.md
index 7b999d56d..1d6155327 100644
--- a/tests/testthat/_snaps/build-articles.md
+++ b/tests/testthat/_snaps/build-articles.md
@@ -54,13 +54,20 @@
       ! articles[1] must be a list, not the number 1.
       i Edit _pkgdown.yml to fix the problem.
     Code
-      data_articles_index_(list(list(title = 1)))
+      data_articles_index_(list(list()))
+    Condition
+      Error in `data_articles_index_()`:
+      ! articles[1] must have components "title" and "contents".
+      2 missing components: "title" and "contents".
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_index_(list(list(title = 1, contents = 1)))
     Condition
       Error in `data_articles_index_()`:
       ! articles[1].title must be a string, not the number 1.
       i Edit _pkgdown.yml to fix the problem.
     Code
-      data_articles_index_(list(list(title = "a\n\nb")))
+      data_articles_index_(list(list(title = "a\n\nb", contents = 1)))
     Condition
       Error in `data_articles_index_()`:
       ! articles[1].title must be inline markdown.
@@ -73,6 +80,52 @@
       i You might need to add '' around special YAML values like 'N' or 'off'
       i Edit _pkgdown.yml to fix the problem.
 
+# validates external-articles
+
+    Code
+      data_articles_(1)
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles must be a list, not the number 1.
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_(list(1))
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles[1] must be a list, not the number 1.
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_(list(list(name = "x")))
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles[1] must have components "name", "title", "href", and "description".
+      3 missing components: "title", "href", and "description".
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_(list(list(name = 1, title = "x", href = "x", description = "x")))
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles[1].name must be a string, not the number 1.
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_(list(list(name = "x", title = 1, href = "x", description = "x")))
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles[1].title must be a string, not the number 1.
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_(list(list(name = "x", title = "x", href = 1, description = "x")))
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles[1].href must be a string, not the number 1.
+      i Edit _pkgdown.yml to fix the problem.
+    Code
+      data_articles_(list(list(name = "x", title = "x", href = "x", description = 1)))
+    Condition
+      Error in `data_articles_()`:
+      ! external-articles[1].description must be a string, not the number 1.
+      i Edit _pkgdown.yml to fix the problem.
+
 # articles in vignettes/articles/ are unnested into articles/
 
     Code
diff --git a/tests/testthat/test-build-articles.R b/tests/testthat/test-build-articles.R
index 92f0a171a..2c20935d4 100644
--- a/tests/testthat/test-build-articles.R
+++ b/tests/testthat/test-build-articles.R
@@ -134,12 +134,29 @@ test_that("validates articles yaml", {
   expect_snapshot(error = TRUE, {
     data_articles_index_(1)
     data_articles_index_(list(1))
-    data_articles_index_(list(list(title = 1)))
-    data_articles_index_(list(list(title = "a\n\nb")))
+    data_articles_index_(list(list()))
+    data_articles_index_(list(list(title = 1, contents = 1)))
+    data_articles_index_(list(list(title = "a\n\nb", contents = 1)))
     data_articles_index_(list(list(title = "a", contents = 1)))
   })
 })
 
+test_that("validates external-articles", {
+  data_articles_ <- function(x) {
+    pkg <- local_pkgdown_site(meta = list(`external-articles` = x))
+    data_articles(pkg)
+  }
+  expect_snapshot(error = TRUE, {
+    data_articles_(1)
+    data_articles_(list(1))
+    data_articles_(list(list(name = "x")))
+    data_articles_(list(list(name = 1, title = "x", href = "x", description = "x")))
+    data_articles_(list(list(name = "x", title = 1, href = "x", description = "x")))
+    data_articles_(list(list(name = "x", title = "x", href = 1, description = "x")))
+    data_articles_(list(list(name = "x", title = "x", href = "x", description = 1)))
+  })
+})
+
 test_that("finds external resources referenced by R code in the article html", {
   # weird path differences that I don't have the energy to dig into
   skip_on_cran()
@@ -181,6 +198,22 @@ test_that("BS5 article laid out correctly with and without TOC", {
   expect_equal(xpath_length(toc_false, ".//aside"), 0)
 })
 
+test_that("data_articles includes external articles", {
+  pkg <- local_pkgdown_site()
+  dir_create(path(pkg$src_path, "vignettes"))
+  file_create(path(pkg$src_path, "vignettes", paste0(letters[1:2], ".Rmd")))
+  pkg <- as_pkgdown(pkg$src_path, override = list(
+    `external-articles` = list(
+      list(name = "c", title = "c", href = "c", description = "*c*")
+    )
+  ))
+
+  articles <- data_articles(pkg)
+  expect_equal(articles$name, c("a", "b", "c"))
+  expect_equal(articles$internal, rep(FALSE, 3))
+  expect_equal(articles$description, list(NULL, NULL, "<p><em>c</em></p>"))
+})
+
 test_that("articles in vignettes/articles/ are unnested into articles/", {
   # weird path differences that I don't have the energy to dig into
   skip_on_cran()