Refactoring author/citation files (#2515)

* Combine build-home-authors with build-home-citations
* Use different strategy to evade R CMD check warning
* Don't capture unneeded message
* Refactor tests

Fixes #2509

.Rbuildignore

@@ -10,7 +10,6 @@
 ^codecov\.yml$
 ^CODE_OF_CONDUCT\.md$
 ^LICENSE\.md$
-^tests/testthat/assets/site-citation$
 ^tests/testthat/assets/site-dot-github/.github$
 ^cran-comments\.md$
 ^CRAN-RELEASE$

R/build-home-authors.R

@@ -1,3 +1,27 @@
+build_citation_authors <- function(pkg = ".") {
+  pkg <- as_pkgdown(pkg)
+
+  source <- if (has_citation(pkg$src_path)) {
+    repo_source(pkg, "inst/CITATION")
+  } else {
+    repo_source(pkg, "DESCRIPTION")
+  }
+
+  authors <- data_authors(pkg)
+  data <- list(
+    pagetitle = tr_("Authors and Citation"),
+    citations = data_citations(pkg),
+    authors = unname(authors$all),
+    inst = authors$inst,
+    source = source
+  )
+
+  data$before <- markdown_text_block(pkg$meta$authors$before)
+  data$after <- markdown_text_block(pkg$meta$authors$after)
+
+  render_page(pkg, "citation-authors", data, "authors.html")
+}
+
 data_authors <- function(pkg = ".", roles = default_roles()) {
   pkg <- as_pkgdown(pkg)
   author_info <- pkg$meta$authors %||% list()
@@ -116,7 +140,7 @@ author_list <- function(x, authors_info = NULL, comment = FALSE, pkg = ".") {
   substr(roles, 1, 1) <- toupper(substr(roles, 1, 1))
 
   orcid <- purrr::pluck(x$comment, "ORCID")
-  x$comment <- remove_name(x$comment, "ORCID")
+  x$comment <- remove_orcid(x$comment)
 
   list(
     name = name,
@@ -185,19 +209,96 @@ role_lookup <- function(abbr) {
   out
 }
 
-# helpers -----------------------------------------------------------------
+# citation ---------------------------------------------------------------------
+
+has_citation <- function(path = ".") {
+  file_exists(path(path, 'inst/CITATION'))
+}
+
+create_citation_meta <- function(path) {
+  path <- path(path, "DESCRIPTION")
+
+  dcf <- read.dcf(path)
+  meta <- as.list(dcf[1, ])
+
+  if (!is.null(meta$Encoding)) {
+    meta <- lapply(meta, iconv, from = meta$Encoding, to = "UTF-8")
+  } else {
+    meta$Encoding <- "UTF-8"
+  }
+
+  if (!is.null(meta$Title)) meta$Title <- str_squish(meta$Title)
+
+  meta
+}
+
+read_citation <- function(path = ".") {
+  if (!has_citation(path)) {
+    return(character())
+  }
+  meta <- create_citation_meta(path)
+  cit_path <- path(path, 'inst/CITATION')
 
-remove_name <- function(x, name) {
-  stopifnot(is.character(name), length(name) == 1)
+  utils::readCitationFile(cit_path, meta = meta)
+}
+
+data_home_sidebar_citation <- function(pkg = ".") {
+  pkg <- as_pkgdown(pkg)
+
+  sidebar_section(
+    heading = tr_("Citation"),
+    bullets = a(sprintf(tr_("Citing %s"), pkg$package), "authors.html#citation")
+  )
+}
 
-  nms <- names(x)
-  if (is.null(nms)) {
-    return(x)
+data_citations <- function(pkg = ".") {
+  pkg <- as_pkgdown(pkg)
+
+  if (has_citation(pkg$src_path)) {
+    return(citation_provided(pkg$src_path))
   }
 
-  out <- x[!(nms %in% name)]
+  citation_auto(pkg)
+}
+
+citation_provided <- function(src_path) {
+  provided_citation <- read_citation(src_path)
+
+  text_version <- format(provided_citation, style = "textVersion")
+  cit <- list(
+    html = ifelse(
+      text_version == "",
+      format(provided_citation, style = "html"),
+      paste0("<p>", escape_html(text_version), "</p>")
+    ),
+    bibtex = format(provided_citation, style = "bibtex")
+  )
+
+  purrr::transpose(cit)
+}
+
+citation_auto <- function(pkg) {
+  cit_info <- utils::packageDescription(
+    path_file(pkg$src_path),
+    lib.loc = path_dir(pkg$src_path)
+  )
+  cit_info$`Date/Publication` <- cit_info$`Date/Publication` %||% Sys.time()
+  if (!is.null(cit_info$Title)) cit_info$Title <- str_squish(cit_info$Title)
+
+  cit <- utils::citation(auto = cit_info)
+  list(
+    html = format(cit, style = "html"),
+    bibtex = format(cit, style = "bibtex")
+  )
+}
+
+# helpers -----------------------------------------------------------------
+
+# Not strictly necessary, but produces a simpler data structure testing
+remove_orcid <- function(x) {
+  out <- x[names2(x) != "ORCID"]
   if (all(names(out) == "")) {
     names(out) <- NULL
   }
   out
-}
+}

tests/testthat/_snaps/build-home-authors.md

@@ -1,4 +1,4 @@
-# data_home_sidebar_authors() works with text
+# sidebar can accept additional before and after text
 
     Code
       cat(data_home_sidebar_authors(pkg))
@@ -26,3 +26,22 @@
     Output
       [1] "unknown"
 
+# multiple citations all have HTML and BibTeX formats
+
+    [[1]]
+    [[1]]$html
+    [1] "<p>A &amp; B (2021): Proof of b &lt; a &gt; c.</p>"
+
+    [[1]]$bibtex
+    [1] "@Misc{,\n  title = {Proof of b < a > c},\n  author = {{A} and {B}},\n  year = {2021},\n}"
+
+
+    [[2]]
+    [[2]]$html
+    [1] "<p>Two A (2022).\n&ldquo;Title Two.&rdquo; \n</p>"
+
+    [[2]]$bibtex
+    [1] "@Misc{,\n  title = {Title Two},\n  author = {Author Two},\n  year = {2022},\n}"
+
+
+

tests/testthat/helper.R

@@ -0,0 +1,8 @@
+# A CITATION file anywhere except in `inst/CITATION` is an R CMD check note
+local_citation_activate <- function(path, envir = caller_env()) {
+  old <- path(path, "inst", "temp-citation")
+  new <- path(path, "inst", "CITATION")
+
+  file_move(old, new)
+  withr::defer(file_move(new, old), envir = envir)
+}