feat: add use_s7()

DESCRIPTION

@@ -53,6 +53,7 @@ Suggests:
     quarto (>= 1.5.1),
     rmarkdown,
     roxygen2 (>= 7.1.2),
+    S7,
     spelling (>= 1.2),
     testthat (>= 3.1.8)
 Config/Needs/website: r-lib/asciicast, tidyverse/tidytemplate, xml2

NAMESPACE

@@ -166,6 +166,7 @@ export(use_rmarkdown_template)
 export(use_roxygen_md)
 export(use_rstudio)
 export(use_rstudio_preferences)
+export(use_s7)
 export(use_spell_check)
 export(use_standalone)
 export(use_template)

NEWS.md

@@ -1,5 +1,6 @@
 # usethis (development version)
 
+* Adds `use_s7()` helper to add required S7 infrastructure (@josiahparry)
 * Removes deprecated `use_tidy_style()` from to-do's from upkeep (@edgararuiz)
 
 * `pr_resume()` (without a specific `branch`) and `pr_fetch()` (without a specific `number`) no longer error when a branch name contains curly braces (#2107, @jonthegeek).

R/s7.R

@@ -0,0 +1,107 @@
+#' Use S7
+#'
+#' Sets up a package to use [S7](https://rconsortium.github.io/S7/) classes.
+#'   * Adds S7 to `Imports` in `DESCRIPTION`
+#'   * Creates `R/zzz.R` with a call to `S7::methods_register()` in `.onLoad()`
+#'   * Optionally adds a `@rawNamespace` directive to enable the use of
+#'   `<S7_object>@name` syntax in package code for R versions prior to 4.3.0
+#'   (see [Using S7 in a Package](https://rconsortium.github.io/S7/articles/packages.html))
+#'
+#' @param backwards_compat If `TRUE` (the default), adds a `@rawNamespace`
+#'   directive to the package-level documentation that conditionally imports
+#'   the `@` operator from S7 for R versions prior to 4.3.0.
+#'
+#' @export
+#' @examples
+#' \dontrun{
+#' use_s7()
+#' }
+use_s7 <- function(backwards_compat = TRUE) {
+  check_is_package("use_s7()")
+  check_uses_roxygen("use_s7()")
+
+  use_dependency("S7", "Imports")
+
+  use_zzz()
+  ensure_s7_methods_register()
+
+  if (backwards_compat) {
+    check_has_package_doc("use_s7()")
+    changed <- roxygen_ns_append(
+      '@rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")'
+    )
+    if (changed) {
+      roxygen_remind()
+    }
+  }
+
+  ui_bullets(
+    c(
+      "_" = "Run {.run devtools::document()} to update {.path NAMESPACE}."
+    )
+  )
+
+  invisible(TRUE)
+}
+
+
+use_zzz <- function() {
+  check_is_package("use_zzz()")
+
+  zzz_path <- proj_path("R", "zzz.R")
+
+  if (file_exists(zzz_path)) {
+    return(invisible(FALSE))
+  }
+
+  msg <- c(
+    "!" = "{.path R/zzz.R} does not exist.",
+    " " = "Would you like to create it now?"
+  )
+
+  if (is_interactive() && ui_yep(msg)) {
+    use_template("zzz.R", path("R", "zzz.R"))
+    return(invisible(TRUE))
+  }
+
+  ui_abort(c(
+    "{.path R/zzz.R} does not exist.",
+    "Create it manually or run this function interactively."
+  ))
+}
+
+
+ensure_s7_methods_register <- function() {
+  zzz_path <- proj_path("R", "zzz.R")
+  lines <- read_utf8(zzz_path)
+
+  if (any(grepl("^\\s*S7::methods_register\\(\\)", lines))) {
+    return(invisible(TRUE))
+  }
+
+  template_lines <- render_template("zzz.R")
+  if (identical(lines, template_lines)) {
+    write_utf8(
+      zzz_path,
+      c(
+        ".onLoad <- function(libname, pkgname) {",
+        "  S7::methods_register()",
+        "}"
+      )
+    )
+    ui_bullets(
+      c(
+        "v" = "Added {.code S7::methods_register()} to {.path {pth(zzz_path)}}."
+      )
+    )
+    return(invisible(TRUE))
+  }
+
+  ui_bullets(
+    c(
+      "_" = "Ensure {.code S7::methods_register()} is called in {.code .onLoad()} in {.path {pth(zzz_path)}}."
+    )
+  )
+  edit_file(zzz_path)
+  invisible(FALSE)
+}

inst/templates/zzz.R

@@ -0,0 +1,4 @@
+.onLoad <- function(libname, pkgname) {
+  # Uncomment the below to add S7 support
+  # S7::methods_register()
+}

tests/testthat/test-s7.R

@@ -0,0 +1,98 @@
+test_that("use_s7() requires a package", {
+  create_local_project()
+  expect_usethis_error(use_s7(), "not an R package")
+})
+
+test_that("use_s7() edits zzz.R and DESCRIPTION", {
+  create_local_package()
+  use_roxygen_md()
+  use_package_doc()
+  use_template("zzz.R", "R/zzz.R")
+
+  use_s7()
+
+  expect_match(desc::desc_get("Imports"), "S7")
+  expect_proj_file("R", "zzz.R")
+
+  zzz_contents <- read_utf8(proj_path("R", "zzz.R"))
+  expect_true(any(grepl("S7::methods_register\\(\\)", zzz_contents)))
+  expect_false(any(grepl("^\\s*#\\s*S7::methods_register", zzz_contents)))
+})
+
+test_that("use_s7() adds rawNamespace directive when backwards_compat = TRUE", {
+  create_local_package()
+  use_roxygen_md()
+  use_package_doc()
+  use_template("zzz.R", "R/zzz.R")
+
+  use_s7(backwards_compat = TRUE)
+
+  ns_show <- roxygen_ns_show()
+  expect_true(any(grepl("@rawNamespace", ns_show)))
+  expect_true(any(grepl('importFrom\\("S7", "@"\\)', ns_show)))
+})
+
+test_that("use_s7() skips rawNamespace when backwards_compat = FALSE", {
+  create_local_package()
+  use_roxygen_md()
+  use_package_doc()
+  use_template("zzz.R", "R/zzz.R")
+
+  local_interactive(FALSE)
+  local_mocked_bindings(
+    ui_yep = function(...) TRUE
+  )
+
+  use_s7(backwards_compat = FALSE)
+
+  ns_show <- roxygen_ns_show()
+  expect_false(any(grepl("@rawNamespace", ns_show)))
+})
+
+test_that("use_s7() can be called twice without changing zzz.R", {
+  create_local_package()
+  use_roxygen_md()
+  use_package_doc()
+  use_template("zzz.R", "R/zzz.R")
+
+  local_interactive(FALSE)
+  local_mocked_bindings(
+    ui_yep = function(...) TRUE
+  )
+
+  use_s7()
+  zzz_before <- read_utf8(proj_path("R", "zzz.R"))
+
+  use_s7()
+  zzz_after <- read_utf8(proj_path("R", "zzz.R"))
+
+  expect_identical(zzz_before, zzz_after)
+})
+
+test_that("use_zzz() does nothing if zzz.R already exists", {
+  create_local_package()
+
+  write_utf8(
+    proj_path("R", "zzz.R"),
+    ".onLoad <- function(libname, pkgname) {}"
+  )
+
+  result <- use_zzz()
+  expect_false(result)
+})
+
+test_that("ensure_s7_methods_register() prompts if file differs from template", {
+  create_local_package()
+  local_interactive(FALSE)
+
+  # if the zzz.R differes from the template we need to promp
+  write_utf8(
+    proj_path("R", "zzz.R"),
+    c(
+      ".onLoad <- function(libname, pkgname) {",
+      "  cat('hello, world!')",
+      "}"
+    )
+  )
+  expect_error(use_s7())
+})