Take CRAN-SUBMISSION or CRAN-RELEASE much more seriously (#1383)

* Consult CRAN-RELEASE for release sha

Closes #1380

* Create a helper to marshal data, from old or new CRAN-RELEASE files

PR to change what devtools writes:
r-lib/devtools#2379

* With old-style CRAN-RELEASE, the short SHA length isn't guaranteed

Apparently the meaning of `--short` in `git-rev-parse` varies. On my machine it's 8.

* Add tests

* Adapt to CRAN-SUBMISSION; get DESCRIPTION and NEWS.md from GitHub if necessary

* Add NEWS

* Update tests

Author: jennybc

NEWS.md

@@ -31,6 +31,12 @@ usethis has a more sophisticated understanding of the default branch and gains s
   arbitrary file on GitHub that the user has permission to read. It supports
   targeting a specific branch, tag, or commit and can follow a symlink (#1407).
   `use_github_file()` now powers `use_github_action()` and friends.
+  
+* `use_github_release()` is much more diligent about using any information left
+  behind by `devtools::submit_cran()` or `devtools::release()`. Specifically,
+  this applies to determining which SHA is to be tagged in the release. And this
+  SHA, in turn, determines the consulted versions of DESCRIPTION (for package
+  version) and NEWS.md (for release notes) (#1380).
 
 * `use_release_issue()` also takes bullets from `release_questions()`, 
   for compatibility with `devtools::release()`.

R/release.R

@@ -148,17 +148,28 @@ release_type <- function(version) {
 
 #' Draft a GitHub release
 #'
-#' Creates a __draft__ GitHub release for the current package using the current
-#' version and `NEWS.md`. If you are comfortable that it is correct, you will
-#' need to publish the release from GitHub. It also deletes `CRAN-RELEASE` and
-#' checks that you've pushed all commits to GitHub.
+#' @description
+#' Creates a __draft__ GitHub release for the current package. Once you are
+#' satisfied that it is correct, you will need to publish the release from
+#' GitHub. The key pieces of info are which commit / SHA to tag, the associated
+#' package version, and the relevant NEWS entries.
+#'
+#' If you use `devtools::release()` or `devtools::submit_cran()` to submit to
+#' CRAN, information about the submitted state is captured in a CRAN-SUBMISSION
+#' or CRAN-RELEASE file. `use_github_release()` uses this info to populate the
+#' draft GitHub release and, after success, deletes the CRAN-SUBMISSION or
+#' CRAN-RELEASE file.
+#'
+#' In the absence of such a file, we must fall back to assuming the current
+#' state (SHA of `HEAD`, package version, NEWS) is the submitted state.
 #'
-#' @param host,auth_token `r lifecycle::badge("deprecated")`: No longer consulted
-#'   now that usethis allows the gh package to lookup a token based on a URL
-#'   determined from the current project's GitHub remotes.
+#' @param host,auth_token `r lifecycle::badge("deprecated")`: No longer
+#'   consulted now that usethis allows the gh package to lookup a token based on
+#'   a URL determined from the current project's GitHub remotes.
 #' @export
 use_github_release <- function(host = deprecated(),
                                auth_token = deprecated()) {
+  check_is_package("use_github_release()")
   if (lifecycle::is_present(host)) {
     deprecate_warn_host("use_github_release")
   }
@@ -173,37 +184,129 @@ use_github_release <- function(host = deprecated(),
       is required to draft a release.")
   }
 
-  challenge_non_default_branch(
-    "Are you sure you want to create a release on a non-default branch?"
-  )
-  check_branch_pushed()
-
-  cran_release <- proj_path("CRAN-RELEASE")
-  if (file_exists(cran_release)) {
-    file_delete(cran_release)
-  }
-
-  path <- proj_path("NEWS.md")
-  if (file_exists(path)) {
-    news <- news_latest(read_utf8(path))
-  } else {
-    news <- "Initial release"
-  }
+  dat <- get_release_data(tr)
+  news <- get_release_news(SHA = dat$SHA, tr = tr)
 
-  package <- package_data()
+  release_name <- glue("{dat$Package} {dat$Version}")
+  tag_name <- glue("v{dat$Version}")
+  kv_line("Release name", release_name)
+  kv_line("Tag name", tag_name)
+  kv_line("SHA", dat$SHA)
 
   gh <- gh_tr(tr)
   release <- gh(
     "POST /repos/{owner}/{repo}/releases",
-    tag_name = paste0("v", package$Version),
-    target_commitish = gert::git_info(repo = git_repo())$commit,
-    name = paste0(package$Package, " ", package$Version),
-    body = news, draft = TRUE
+    name = release_name, tag_name = tag_name,
+    target_commitish = dat$SHA, body = news, draft = TRUE
   )
 
+  if (!is.null(dat$file)) {
+    ui_done("{ui_path(dat$file)} deleted")
+    file_delete(dat$file)
+  }
+
   view_url(release$html_url)
+  ui_todo("Publish the release via \"Edit draft\" > \"Publish release\"")
 }
 
+get_release_data <- function(tr = target_repo(github_get = TRUE)) {
+  package <- package_data()
+  cran_submission <-
+    path_first_existing(proj_path(c("CRAN-SUBMISSION", "CRAN-RELEASE")))
+
+  if (is.null(cran_submission)) {
+    ui_done("Using current HEAD commit for the release")
+    challenge_non_default_branch()
+    check_branch_pushed()
+    return(list(
+      Package = package$Package,
+      Version = package$Version,
+      SHA = gert::git_info(repo = git_repo())$commit
+    ))
+  }
+
+  if (path_file(cran_submission) == "CRAN-SUBMISSION") {
+    # new style ----
+    # Version: 2.4.2
+    # Date: 2021-10-13 20:40:36 UTC
+    # SHA: fbe18b5a22be8ebbb61fa7436e826ba8d7f485a9
+    out <- as.list(read.dcf(cran_submission)[1, ])
+  }
+
+  if (path_file(cran_submission) == "CRAN-RELEASE") {
+    gh <- gh_tr(tr)
+    # old style ----
+    # This package was submitted to CRAN on 2021-10-13.
+    # Once it is accepted, delete this file and tag the release (commit e10658f5).
+    lines <- read_utf8(cran_submission)
+    str_extract <- function(marker, pattern) {
+      re_match(grep(marker, lines, value = TRUE), pattern)$.match
+    }
+    date <- str_extract("submitted.*on", "[0-9]{4}-[0-9]{2}-[0-9]{2}")
+    sha <- str_extract("commit", "[[:xdigit:]]{7,40}")
+    if (nchar(sha) != 40) {
+      # the release endpoint requires the full sha
+      sha <-
+        gh("/repos/{owner}/{repo}/commits/{commit_sha}", commit_sha = sha)$sha
+    }
+
+    HEAD <- gert::git_info(repo = git_repo())$commit
+    if (HEAD == sha) {
+      version <- package$Version
+    } else {
+      tf <- glue("{package_data()$Package}-DESCRIPTION-{substr(sha, 1, 7)}-")
+      tf <- withr::local_tempfile(pattern = tf)
+      gh(
+        "/repos/{owner}/{repo}/contents/{path}",
+        path = "DESCRIPTION", ref = sha,
+        .destfile = tf,
+        .accept = "application/vnd.github.v3.raw"
+      )
+      version <- desc::desc(file = tf)$get_version()
+    }
+
+    out <- list(
+      Version = version,
+      Date = Sys.Date(),
+      SHA = sha
+    )
+  }
+
+  out$Package <- package$Package
+  out$file <- cran_submission
+  ui_done("
+    {ui_path(out$file)} file found, from a submission on {as.Date(out$Date)}")
+
+  out
+}
+
+get_release_news <- function(SHA = gert::git_info(repo = git_repo())$commit,
+                             tr = target_repo(github_get = TRUE)) {
+  package <- package_data()
+  HEAD <- gert::git_info(repo = git_repo())$commit
+
+  if (HEAD == SHA) {
+    news_path <- proj_path("NEWS.md")
+  } else {
+    news_path <- glue("{package_data()$Package}-NEWS-{substr(SHA, 1, 7)}-")
+    news_path <- withr::local_tempfile(pattern = news_path)
+    gh <- purrr::possibly(gh_tr(tr), otherwise = NULL)
+    gh(
+      "/repos/{owner}/{repo}/contents/{path}",
+      path = "NEWS.md", ref = SHA,
+      .destfile = news_path,
+      .accept = "application/vnd.github.v3.raw"
+    )
+  }
+
+  if (file_exists(news_path)) {
+    news <- news_latest(read_utf8(news_path))
+  } else {
+    news <- "Initial release"
+  }
+
+  news
+}
 
 cran_version <- function(package = project_name(),
                          available = utils::available.packages()) {

R/spelling.R

@@ -17,7 +17,7 @@
 use_spell_check <- function(vignettes = TRUE,
                             lang = "en-US",
                             error = FALSE) {
-  check_is_package("use_spell_check")
+  check_is_package("use_spell_check()")
   check_installed("spelling")
   use_dependency("spelling", "Suggests")
   use_description_field("Language", lang, overwrite = TRUE)

man/use_github_release.Rd

@@ -76,3 +76,65 @@ test_that("returns empty string if no bullets", {
   )
   expect_equal(news_latest(lines), "")
 })
+
+# draft release ----------------------------------------------------------------
+test_that("get_release_data() works if no file found", {
+  skip_if_no_git_user()
+
+  local_interactive(FALSE)
+  create_local_package()
+  use_git()
+  gert::git_add(".gitignore")
+  gert::git_commit("we need at least one commit")
+
+  res <- get_release_data()
+  expect_equal(res$Version, "0.0.0.9000")
+  expect_match(res$SHA, "[[:xdigit:]]{40}")
+})
+
+test_that("get_release_data() works for old-style CRAN-RELEASE", {
+  skip_if_no_git_user()
+
+  local_interactive(FALSE)
+  create_local_package()
+  use_git()
+  gert::git_add(".gitignore")
+  gert::git_commit("we need at least one commit")
+  HEAD <- gert::git_info(repo = git_repo())$commit
+
+  write_utf8(
+    proj_path("CRAN-RELEASE"),
+    glue("
+      This package was submitted to CRAN on YYYY-MM-DD.
+      Once it is accepted, delete this file and tag the release (commit {HEAD}).")
+  )
+
+  res <- get_release_data(tr = list(repo_spec = "OWNER/REPO"))
+  expect_equal(res$Version, "0.0.0.9000")
+  expect_equal(res$SHA, HEAD)
+  expect_equal(path_file(res$file), "CRAN-RELEASE")
+})
+
+test_that("get_release_data() works for new-style CRAN-RELEASE", {
+  skip_if_no_git_user()
+
+  local_interactive(FALSE)
+  create_local_package()
+  use_git()
+  gert::git_add(".gitignore")
+  gert::git_commit("we need at least one commit")
+  HEAD <- gert::git_info(repo = git_repo())$commit
+
+  write_utf8(
+    proj_path("CRAN-SUBMISSION"),
+    glue("
+      Version: 1.2.3
+      Date: 2021-10-14 23:57:41 UTC
+      SHA: {HEAD}")
+  )
+
+  res <- get_release_data(tr = list(repo_spec = "OWNER/REPO"))
+  expect_equal(res$Version, "1.2.3")
+  expect_equal(res$SHA, HEAD)
+  expect_equal(path_file(res$file), "CRAN-SUBMISSION")
+})