Automatically add redirects for topic aliases (#2501)

Fixes #1876

NEWS.md

@@ -1,5 +1,8 @@
 # pkgdown (development version)
 
+* `build_redirects()` now automatically adds redirects for topic 
+aliases. This matches the behaviour of `?` and will help keep links stable in the long term (#1876).
+* `build_redirects()` now reports which redirects it is generating.
 * The addin now runs `build_site()` instead of `build_site_external()`, which generally should be more reliable (#2252).
 * Anchors are displayed when they're the target of a link.
 * `build_reference()` adds anchors to arguments making it possible to link directly to an argument, if desired. A subtle visual treatment makes it easy to see which argument is targeted (#2228).

R/build-redirects.R

@@ -28,10 +28,15 @@ build_redirects <- function(pkg = ".",
   pkg <- section_init(pkg, depth = 1L, override = override)
 
   redirects <- c(
+    reference_redirects(pkg),
     article_redirects(pkg),
     pkg$meta$redirects
   )
 
+  # Ensure user redirects override automatic ones
+  from <- purrr::map_chr(redirects, 1)
+  redirects <- redirects[!duplicated(from)]
+
   if (is.null(redirects)) {
     return(invisible())
   }
@@ -73,6 +78,10 @@ build_redirect <- function(entry, index, pkg) {
   url <- sprintf("%s/%s%s", pkg$meta$url, pkg$prefix, new)
   lines <- whisker::whisker.render(template, list(url = url))
   dir_create(path_dir(old))
+
+  if (!file_exists(old)) {
+    cli::cli_inform("Adding redirect from {entry[1]} to {entry[2]}.")
+  }
   write_lines(lines, old)
 }
 
@@ -89,3 +98,25 @@ article_redirects <- function(pkg) {
   articles <- pkg$vignettes$file_out[is_vig_in_articles]
   purrr::map(articles, ~ paste0(c("articles/", ""), .x))
 }
+
+reference_redirects <- function(pkg) {
+  if (is.null(pkg$meta$url)) {
+    return(NULL)
+  }
+
+  aliases <- unname(pkg$topics$alias)
+  aliases <- purrr::map2(aliases, pkg$topics$name, setdiff)
+  names(aliases) <- pkg$topics$file_out
+
+  redirects <- invert_index(aliases)
+  if (length(redirects) == 0) {
+    return(list())
+  }
+
+  names(redirects) <- paste0(names(redirects), ".html")
+
+  # Ensure we don't override an existing file
+  redirects <- redirects[setdiff(names(redirects), pkg$topics$file_out)]
+
+  unname(purrr::imap(redirects, function(to, from) paste0("reference/", c(from, to))))
+}

R/package.R

@@ -228,9 +228,7 @@ package_topics <- function(path = ".", package = "pkgdown") {
   source <- purrr::map(rd, extract_source)
 
   file_in <- names(rd)
-
-  file_out <- gsub("\\.Rd$", ".html", file_in)
-  file_out[file_out == "index.html"] <- "index-topic.html"
+  file_out <- rd_output_path(file_in)
 
   funs <- purrr::map(rd, topic_funs)
 
@@ -249,6 +247,12 @@ package_topics <- function(path = ".", package = "pkgdown") {
   )
 }
 
+rd_output_path <- function(x) {
+  x <- gsub("\\.Rd$", ".html", x)
+  x[x == "index.html"] <- "index-topic.html"
+  x
+}
+
 package_rd <- function(path = ".") {
   man_path <- path(path, "man")
 

tests/testthat/_snaps/build-articles.md

@@ -98,6 +98,7 @@
       build_redirects(pkg)
     Message
       -- Building redirects ----------------------------------------------------------
+      Adding redirect from articles/articles/nested.html to articles/nested.html.
 
 # pkgdown deps are included only once in articles
 

tests/testthat/_snaps/build-redirects.md

@@ -1,3 +1,10 @@
+# build_redirect() works
+
+    Code
+      build_redirect(c("old.html", "new.html#section"), 1, pkg = pkg)
+    Message
+      Adding redirect from old.html to new.html#section.
+
 # build_redirect() errors if one entry is not right.
 
     Code

tests/testthat/test-build-redirects.R

@@ -7,7 +7,9 @@ test_that("build_redirect() works", {
     bs_version = 5
   )
   pkg <- structure(pkg, class = "pkgdown")
-  build_redirect(c("old.html", "new.html#section"), 1, pkg = pkg)
+  expect_snapshot(
+    build_redirect(c("old.html", "new.html#section"), 1, pkg = pkg)
+  )
 
   html <- xml2::read_html(path(pkg$dst_path, "old.html"))
   expect_equal(
@@ -45,3 +47,48 @@ test_that("article_redirects() creates redirects for vignettes in vignettes/arti
     list(c("articles/articles/test.html", "articles/test.html"))
   )
 })
+
+# reference_redirects ----------------------------------------------------------
+
+test_that("generates redirects only for non-name aliases", {
+  pkg <- list(
+    meta = list(url = "http://foo.com"),
+    topics = list(
+      alias = list("foo", c("bar", "baz")),
+      name = c("foo", "bar"),
+      file_out = c("foo.html", "bar.html")
+    )
+  )
+  expect_equal(
+    reference_redirects(pkg),
+    list(c("reference/baz.html", "reference/bar.html"))
+  )
+})
+
+test_that("never redirects away from existing topic", {
+  pkg <- list(
+    meta = list(url = "http://foo.com"),
+    topics = list(
+      alias = list("foo", c("bar", "foo")),
+      name = c("foo", "bar"),
+      file_out = c("foo.html", "bar.html")
+    )
+  )
+  expect_equal(
+    reference_redirects(pkg),
+    list()
+  )
+})
+
+test_that("no redirects if no aliases", {
+  pkg <- list(
+    meta = list(url = "http://foo.com"),
+    topics = list(
+      alias = list(c("foo", "bar")),
+      name = c("foo", "bar"),
+      file_out = c("foo.html", "bar.html")
+    )
+  )
+  expect_equal(reference_redirects(pkg), list())
+})
+