From 8489b63f87e9f8691a4438fa3032b68f5d6419ff Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 25 Apr 2024 08:58:35 -0500 Subject: [PATCH] Automatically add redirects for topic aliases Fixes #1876 --- NEWS.md | 2 + R/build-redirects.R | 31 +++++++++++++++ R/package.R | 10 +++-- tests/testthat/_snaps/build-articles.md | 1 + tests/testthat/_snaps/build-redirects.md | 7 ++++ tests/testthat/test-build-redirects.R | 49 +++++++++++++++++++++++- 6 files changed, 96 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index a71218b68..80d110851 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # 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. * `as.pkgdown()` will no longer prompt you to install a missing template package from CRAN, since these are almost always found in GitHub (#2076). * `init_site()` once again describes one copy per line, and now uses a better prefix when copying assets from pkgdown itself (#2445). * Very wide words are now automatically broken across lines and hyphenated (when possible) when they'd otherwise create a horizontal scrollbar on mobile (#1888). diff --git a/R/build-redirects.R b/R/build-redirects.R index 9bd64871f..c2809499c 100644 --- a/R/build-redirects.R +++ b/R/build-redirects.R @@ -3,10 +3,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()) } @@ -48,6 +53,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) } @@ -64,3 +73,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)))) +} diff --git a/R/package.R b/R/package.R index 8878cf984..a0e605928 100644 --- a/R/package.R +++ b/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") diff --git a/tests/testthat/_snaps/build-articles.md b/tests/testthat/_snaps/build-articles.md index 30f177da6..7e18b9acc 100644 --- a/tests/testthat/_snaps/build-articles.md +++ b/tests/testthat/_snaps/build-articles.md @@ -115,6 +115,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 diff --git a/tests/testthat/_snaps/build-redirects.md b/tests/testthat/_snaps/build-redirects.md index be5850182..c1d750d55 100644 --- a/tests/testthat/_snaps/build-redirects.md +++ b/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 diff --git a/tests/testthat/test-build-redirects.R b/tests/testthat/test-build-redirects.R index 3e15f9067..2e89cfdc4 100644 --- a/tests/testthat/test-build-redirects.R +++ b/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()) +}) +