diff --git a/NEWS.md b/NEWS.md index f976a930d..485c69531 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,13 +2,17 @@ * `use_vignette()` and `use_article()` gain `type` to allow creating Quarto vignettes and articles (@olivroy, #1997). +* `use_tidy_upkeep_issue()` now records the year it is being run in the + `Config/usethis/upkeep` field in DESCRIPTION. If this value exists it is + furthermore used to filter the checklist when making the issue. + * `use_package()` now decreases a package minimum version required when `min_version` is lower than what is currently specified in the DESCRIPTION file (@jplecavalier, #1957). - + * `use_data()` now uses serialization version 3 by default. (@laurabrianna, #2044) -* Reverse dependency checks are only suggested if they exist +* Reverse dependency checks are only suggested if they exist (#1817, @seankross). # usethis 3.0.0 diff --git a/R/author.R b/R/author.R index 7e396e4ac..374423133 100644 --- a/R/author.R +++ b/R/author.R @@ -22,8 +22,7 @@ #' DESCRIPTION file and the user hasn't given any author information via the #' `fields` argument or the global option `"usethis.description"`. The #' placeholder looks something like `First Last [aut, -#' cre] (YOUR-ORCID-ID)` and `use_author()` offers to remove it in interactive -#' sessions. +#' cre]` and `use_author()` offers to remove it in interactive sessions. #' #' @inheritParams utils::person #' @inheritDotParams utils::person diff --git a/R/data.R b/R/data.R index e19cb04b7..b7d44165f 100644 --- a/R/data.R +++ b/R/data.R @@ -44,11 +44,13 @@ use_data <- function(..., objs <- get_objs_from_dots(dots(...)) - if (version < 3) { - use_dependency("R", "depends", "2.10") - } else { - use_dependency("R", "depends", "3.5") + original_minimum_r_version <- pkg_minimum_r_version() + serialization_minimum_r_version <- if (version < 3) "2.10" else "3.5" + if (is.na(original_minimum_r_version) || + original_minimum_r_version < serialization_minimum_r_version) { + use_dependency("R", "depends", serialization_minimum_r_version) } + if (internal) { use_directory("R") paths <- path("R", "sysdata.rda") @@ -92,7 +94,7 @@ get_objs_from_dots <- function(.dots) { } is_name <- vapply(.dots, is.symbol, logical(1)) - if (any(!is_name)) { + if (!all(is_name)) { ui_abort("Can only save existing named objects.") } diff --git a/R/description.R b/R/description.R index 4e15ef633..d98336eb1 100644 --- a/R/description.R +++ b/R/description.R @@ -124,7 +124,7 @@ usethis_description_defaults <- function(package = NULL) { Version = "0.0.0.9000", Title = "What the Package Does (One Line, Title Case)", Description = "What the package does (one paragraph).", - "Authors@R" = 'person("First", "Last", email = "first.last@example.com", role = c("aut", "cre"), comment = c(ORCID = "YOUR-ORCID-ID"))', + "Authors@R" = 'person("First", "Last", email = "first.last@example.com", role = c("aut", "cre"))', License = "`use_mit_license()`, `use_gpl3_license()` or friends to pick a license", Encoding = "UTF-8" ) diff --git a/R/git-default-branch.R b/R/git-default-branch.R index fdcaac79d..0154f4e6b 100644 --- a/R/git-default-branch.R +++ b/R/git-default-branch.R @@ -93,39 +93,18 @@ NULL #' git_default_branch() #' } git_default_branch <- function() { - repo <- git_repo() + git_default_branch_(github_remote_config()) +} - # TODO: often when we call git_default_branch(), we already have a GitHub - # configuration or target repo, as produced by github_remote_config() or - # target_repo(). In that case, we don't need to start from scratch as we do - # here. But I'm not sure it's worth adding complexity to allow passing this - # data in. - - # TODO: this critique feels somewhat mis-placed, i.e. it brings up a general - # concern about a repo's config (or the user's permissions and creds) - # related to whether github_remotes() should be as silent as it is about - # 404s - critique_remote <- function(remote) { - if (remote$is_configured && is.na(remote$default_branch)) { - ui_bullets(c( - "x" = "The {.val {remote$name}} remote is configured, but we can't - determine its default branch.", - " " = "Possible reasons:", - "*" = "The remote repo no longer exists, suggesting the local remote - should be deleted.", - "*" = "We are offline or that specific Git server is down.", - "*" = "You don't have the necessary permission or something is wrong - with your credentials." - )) - } - } +# If config is available, we can use it to avoid an additional lookup +# on the GitHub API +git_default_branch_ <- function(cfg) { + repo <- git_repo() - upstream <- git_default_branch_remote("upstream") + upstream <- git_default_branch_remote(cfg, "upstream") if (is.na(upstream$default_branch)) { - critique_remote(upstream) - origin <- git_default_branch_remote("origin") + origin <- git_default_branch_remote(cfg, "origin") if (is.na(origin$default_branch)) { - critique_remote(origin) db_source <- list() } else { db_source <- origin @@ -186,7 +165,7 @@ git_default_branch <- function() { # returns a whole data structure, because the caller needs the surrounding # context to produce a helpful error message -git_default_branch_remote <- function(remote = "origin") { +git_default_branch_remote <- function(cfg, remote = "origin") { repo <- git_repo() out <- list( name = remote, @@ -196,25 +175,22 @@ git_default_branch_remote <- function(remote = "origin") { default_branch = NA_character_ ) - url <- git_remotes()[[remote]] - if (length(url) == 0) { + cfg_remote <- cfg[[remote]] + if (!cfg_remote$is_configured) { out$is_configured <- FALSE return(out) } + out$is_configured <- TRUE - out$url <- url - - # TODO: generalize here for GHE hosts that don't include 'github' - parsed <- parse_github_remotes(url) - # if the protocol is ssh, I suppose we can't assume a PAT, i.e. it's better - # to use the Git approach vs. the GitHub API approach - if (grepl("github", parsed$host) && parsed$protocol == "https") { - remote_dat <- github_remotes(remote, github_get = NA) - out$repo_spec <- remote_dat$repo_spec - out$default_branch <- remote_dat$default_branch + out$url <- cfg_remote$url + + if (!is.na(cfg_remote$default_branch)) { + out$repo_spec <- cfg_remote$repo_spec + out$default_branch <- cfg_remote$default_branch return(out) } + # Fall back to pure git based approach out$default_branch <- tryCatch( { gert::git_fetch(remote = remote, repo = repo, verbose = FALSE) diff --git a/R/github.R b/R/github.R index c3eb0affb..34cc67392 100644 --- a/R/github.R +++ b/R/github.R @@ -61,7 +61,7 @@ use_github <- function(organisation = NULL, visibility <- match.arg(visibility) check_protocol(protocol) check_uses_git() - default_branch <- git_default_branch() + default_branch <- guess_local_default_branch() check_current_branch( is = default_branch, # glue-ing happens inside check_current_branch(), where `gb` gives the diff --git a/R/pr.R b/R/pr.R index c486d37b7..8f75fe85a 100644 --- a/R/pr.R +++ b/R/pr.R @@ -167,30 +167,41 @@ pr_init <- function(branch) { cfg <- github_remote_config(github_get = NA) check_for_bad_config(cfg) tr <- target_repo(cfg, ask = FALSE) + online <- is_online(tr$host) - maybe_good_configs <- c("maybe_ours_or_theirs", "maybe_fork") - if (cfg$type %in% maybe_good_configs) { + if (!online) { ui_bullets(c( - "x" = 'Unable to confirm the GitHub remote configuration is - "pull request ready".', - "i" = "You probably need to configure a personal access token for - {.val {tr$host}}.", - "i" = "See {.run usethis::gh_token_help()} for help with that.", - "i" = "(Or maybe we're just offline?)" + "x" = "You are not currently online.", + "i" = "You can still create a local branch, but we can't check that your + current branch is up-to-date or setup the remote branch." )) - if (ui_github_remote_config_wat(cfg)) { + if (ui_nah("Do you want to continue?")) { ui_bullets(c("x" = "Cancelling.")) return(invisible()) } + } else { + maybe_good_configs <- c("maybe_ours_or_theirs", "maybe_fork") + if (cfg$type %in% maybe_good_configs) { + ui_bullets(c( + "x" = 'Unable to confirm the GitHub remote configuration is + "pull request ready".', + "i" = "You probably need to configure a personal access token for + {.val {tr$host}}.", + "i" = "See {.run usethis::gh_token_help()} for help with that." + )) + if (ui_github_remote_config_wat(cfg)) { + ui_bullets(c("x" = "Cancelling.")) + return(invisible()) + } + } } - default_branch <- git_default_branch() + default_branch <- if (online) git_default_branch_(cfg) else guess_local_default_branch() challenge_non_default_branch( "Are you sure you want to create a PR branch based on a non-default branch?", default_branch = default_branch ) - online <- is_online(tr$host) if (online) { # this is not pr_pull_source_override() because: # a) we may NOT be on default branch (although we probably are) @@ -213,10 +224,6 @@ pr_init <- function(branch) { ui_bullets(c("v" = "Pulling changes from {.val {remref}}.")) git_pull(remref = remref, verbose = FALSE) } - } else { - ui_bullets(c( - "!" = "Unable to pull changes for current branch, since we are offline." - )) } ui_bullets(c("v" = "Creating and switching to local branch {.val {branch}}.")) @@ -237,7 +244,7 @@ pr_resume <- function(branch = NULL) { ui_bullets(c( "i" = "No branch specified ... looking up local branches and associated PRs." )) - default_branch <- git_default_branch() + default_branch <- guess_local_default_branch() branch <- choose_branch(exclude = default_branch) if (is.null(branch)) { ui_bullets(c("x" = "Repo doesn't seem to have any non-default branches.")) @@ -375,7 +382,7 @@ pr_push <- function() { repo <- git_repo() cfg <- github_remote_config(github_get = TRUE) check_for_config(cfg, ok_configs = c("ours", "fork")) - default_branch <- git_default_branch() + default_branch <- git_default_branch_(cfg) check_pr_branch(default_branch) challenge_uncommitted_changes() @@ -423,7 +430,7 @@ pr_push <- function() { pr_pull <- function() { cfg <- github_remote_config(github_get = TRUE) check_for_config(cfg) - default_branch <- git_default_branch() + default_branch <- git_default_branch_(cfg) check_pr_branch(default_branch) challenge_uncommitted_changes() @@ -449,11 +456,12 @@ pr_merge_main <- function() { #' @export #' @rdname pull-requests pr_view <- function(number = NULL, target = c("source", "primary")) { - tr <- target_repo(github_get = NA, role = target, ask = FALSE) + cfg <- github_remote_config(github_get = NA) + tr <- target_repo(cfg, github_get = NA, role = target, ask = FALSE) url <- NULL if (is.null(number)) { branch <- git_branch() - default_branch <- git_default_branch() + default_branch <- git_default_branch_(cfg) if (branch != default_branch) { url <- pr_url(branch = branch, tr = tr) if (is.null(url)) { @@ -491,11 +499,11 @@ pr_view <- function(number = NULL, target = c("source", "primary")) { #' @export #' @rdname pull-requests pr_pause <- function() { - # intentionally naive selection of target repo - tr <- target_repo(github_get = FALSE, ask = FALSE) + cfg <- github_remote_config(github_get = NA) + tr <- target_repo(cfg, github_get = NA, ask = FALSE) ui_bullets(c("v" = "Switching back to the default branch.")) - default_branch <- git_default_branch() + default_branch <- git_default_branch_(cfg) if (git_branch() == default_branch) { ui_bullets(c( "!" = "Already on this repo's default branch ({.val {default_branch}}), @@ -535,8 +543,10 @@ pr_clean <- function(number = NULL, withr::defer(rstudio_git_tickle()) mode <- match.arg(mode) repo <- git_repo() - tr <- target_repo(github_get = NA, role = target, ask = FALSE) - default_branch <- git_default_branch() + + cfg <- github_remote_config(github_get = NA) + tr <- target_repo(cfg, github_get = NA, role = target, ask = FALSE) + default_branch <- git_default_branch_(cfg) if (is.null(number)) { check_pr_branch(default_branch) @@ -629,14 +639,10 @@ pr_clean <- function(number = NULL, # we're in DEFAULT branch of a fork. I wish everyone set up DEFAULT to track the # DEFAULT branch in the source repo, but this protects us against sub-optimal # setup. -pr_pull_source_override <- function(tr = NULL, default_branch = NULL) { - # naive selection of target repo; calling function should analyse the config - tr <- tr %||% target_repo(github_get = FALSE, ask = FALSE) - +pr_pull_source_override <- function(tr, default_branch) { # TODO: why does this not use a check_*() function, i.e. shared helper? # I guess to issue a specific error message? current_branch <- git_branch() - default_branch <- default_branch %||% git_default_branch() if (current_branch != default_branch) { ui_abort(" Internal error: {.fun pr_pull_source_override} should only be used when on @@ -994,7 +1000,7 @@ pr_branch_delete <- function(pr) { invisible(TRUE) } -check_pr_branch <- function(default_branch = git_default_branch()) { +check_pr_branch <- function(default_branch) { # the glue-ing happens inside check_current_branch(), where `gb` gives the # current git branch check_current_branch( diff --git a/R/proj-desc.R b/R/proj-desc.R index d2e110a7e..aa962b5c4 100644 --- a/R/proj-desc.R +++ b/R/proj-desc.R @@ -41,7 +41,7 @@ proj_desc_field_update <- function(key, value, overwrite = TRUE, append = FALSE) return(invisible()) } - if (!overwrite && length(old > 0) && any(old != "")) { + if (!overwrite && length(old) > 0 && any(old != "")) { ui_abort(" {.field {key}} has a different value in DESCRIPTION. Use {.code overwrite = TRUE} to overwrite.") diff --git a/R/release.R b/R/release.R index 1748b3544..6f2196245 100644 --- a/R/release.R +++ b/R/release.R @@ -534,10 +534,11 @@ author_has_rstudio_email <- function() { pkg_minimum_r_version <- function() { deps <- proj_desc()$get_deps() r_dep <- deps[deps$package == "R" & deps$type == "Depends", "version"] - if (length(r_dep) == 0) { - return(numeric_version("0")) + if (length(r_dep) > 0) { + numeric_version(gsub("[^0-9.]", "", r_dep)) + } else { + NA_character_ } - numeric_version(gsub("[^0-9.]", "", r_dep)) } # Borrowed from pak, but modified also retain user's non-cran repos: diff --git a/R/tidyverse.R b/R/tidyverse.R index 0e101e413..f3a83389d 100644 --- a/R/tidyverse.R +++ b/R/tidyverse.R @@ -44,7 +44,9 @@ #' tidyverse conventions around GitHub issue label names and colours. #' #' * `use_tidy_upkeep_issue()` creates an issue containing a checklist of -#' actions to bring your package up to current tidyverse standards. +#' actions to bring your package up to current tidyverse standards. Also +#' records the current date in the `Config/usethis/last-upkeep` field in +#' `DESCRIPTION`. #' #' * `use_tidy_logo()` calls `use_logo()` on the appropriate hex sticker PNG #' file at . diff --git a/R/ui-legacy.R b/R/ui-legacy.R index 92473119e..58edd5eca 100644 --- a/R/ui-legacy.R +++ b/R/ui-legacy.R @@ -13,8 +13,8 @@ #' #' usethis itself now uses cli internally for its UI, but these new functions #' are not exported and presumably never will be. There is a developer-focused -#' article on the process of transitioning usethis's own UI to use cli (LINK -#' TO COME). +#' article on the process of transitioning usethis's own UI to use cli: +#' [Converting usethis's UI to use cli](https://usethis.r-lib.org/articles/ui-cli-conversion.html). #' @details #' diff --git a/R/upkeep.R b/R/upkeep.R index 0de6d48fb..6f93573c7 100644 --- a/R/upkeep.R +++ b/R/upkeep.R @@ -16,13 +16,13 @@ #' @export #' @examples #' \dontrun{ -#' use_upkeep_issue(2023) +#' use_upkeep_issue() #' } use_upkeep_issue <- function(year = NULL) { make_upkeep_issue(year = year, tidy = FALSE) } -make_upkeep_issue <- function(year, tidy) { +make_upkeep_issue <- function(year, last_upkeep, tidy) { who <- if (tidy) "use_tidy_upkeep_issue()" else "use_upkeep_issue()" check_is_package(who) @@ -41,7 +41,7 @@ make_upkeep_issue <- function(year, tidy) { gh <- gh_tr(tr) if (tidy) { - checklist <- tidy_upkeep_checklist(year, repo_spec = tr$repo_spec) + checklist <- tidy_upkeep_checklist(last_upkeep, repo_spec = tr$repo_spec) } else { checklist <- upkeep_checklist(tr) } @@ -118,22 +118,25 @@ upkeep_checklist <- function(target_repo = NULL) { #' @export #' @rdname tidyverse -#' @param year Approximate year when you last touched this package. If `NULL`, -#' the default, will give you a full set of actions to perform. -use_tidy_upkeep_issue <- function(year = NULL) { - make_upkeep_issue(year = year, tidy = TRUE) +#' @param last_upkeep Year of last upkeep. By default, the +#' `Config/usethis/last-upkeep` field in `DESCRIPTION` is consulted for this, if +#' it's defined. If there's no information on the last upkeep, the issue will +#' contain the full checklist. +use_tidy_upkeep_issue <- function(last_upkeep = last_upkeep_year()) { + make_upkeep_issue(year = NULL, last_upkeep = last_upkeep, tidy = TRUE) + record_upkeep_date(Sys.Date()) } # for mocking Sys.Date <- NULL -tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { +tidy_upkeep_checklist <- function(last_upkeep = last_upkeep_year(), + repo_spec = "OWNER/REPO") { + desc <- proj_desc() posit_pkg <- is_posit_pkg() posit_person_ok <- is_posit_person_canonical() - year <- year %||% 2000 - bullets <- c( "### To begin", "", @@ -141,7 +144,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { "" ) - if (year <= 2000) { + if (last_upkeep <= 2000) { bullets <- c( bullets, "### Pre-history", @@ -156,7 +159,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { "" ) } - if (year <= 2020) { + if (last_upkeep <= 2020) { bullets <- c( bullets, "### 2020", @@ -167,7 +170,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { "" ) } - if (year <= 2021) { + if (last_upkeep <= 2021) { bullets <- c( bullets, "### 2021", @@ -177,7 +180,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { "" ) } - if (year <= 2022) { + if (last_upkeep <= 2022) { bullets <- c( bullets, "### 2022", @@ -190,9 +193,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { ) } - if (year <= 2023) { - desc <- proj_desc() - + if (last_upkeep <= 2023) { bullets <- c( bullets, "### 2023", @@ -242,6 +243,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { ) } + minimum_r_version <- pkg_minimum_r_version() bullets <- c( bullets, "### To finish", @@ -249,7 +251,7 @@ tidy_upkeep_checklist <- function(year = NULL, repo_spec = "OWNER/REPO") { todo("`usethis::use_mit_license()`", grepl("MIT", desc$get_field("License"))), todo( '`usethis::use_package("R", "Depends", "{tidy_minimum_r_version()}")`', - tidy_minimum_r_version() > pkg_minimum_r_version() + is.na(minimum_r_version) || tidy_minimum_r_version() > minimum_r_version ), todo("`usethis::use_tidy_description()`"), todo("`usethis::use_tidy_github_actions()`"), @@ -327,3 +329,18 @@ has_old_cran_comments <- function() { file_exists(cc) && any(grepl("# test environment", readLines(cc), ignore.case = TRUE)) } + +last_upkeep_date <- function() { + as.Date( + proj_desc()$get_field("Config/usethis/last-upkeep", "2000-01-01"), + format = "%Y-%m-%d" + ) +} + +last_upkeep_year <- function() { + as.integer(format(last_upkeep_date(), "%Y")) +} + +record_upkeep_date <- function(date) { + proj_desc_field_update("Config/usethis/last-upkeep", format(date, "%Y-%m-%d")) +} diff --git a/R/use_standalone.R b/R/use_standalone.R index e23d1cba7..11ca47e12 100644 --- a/R/use_standalone.R +++ b/R/use_standalone.R @@ -247,7 +247,7 @@ as_version_info_row <- function(field, error_call = caller_env()) { ver <- strsplit(ver, " ")[[1]] - if (!is_character(ver, n = 2) || any(is.na(ver)) || !all(nzchar(ver))) { + if (!is_character(ver, n = 2) || anyNA(ver) || !all(nzchar(ver))) { cli::cli_abort( c( "Can't parse version `{field}` in `imports:` field.", diff --git a/R/utils-git.R b/R/utils-git.R index 810988d45..9a3a57cb5 100644 --- a/R/utils-git.R +++ b/R/utils-git.R @@ -83,7 +83,7 @@ git_user_get <- function(where = c("de_facto", "local", "global")) { # translate from "usethis" terminology to "git" terminology where_from_scope <- function(scope = c("user", "project")) { - scope = match.arg(scope) + scope <- match.arg(scope) where_scope <- c(user = "global", project = "de_facto") diff --git a/R/utils-github.R b/R/utils-github.R index 66fca74bd..abba6d408 100644 --- a/R/utils-github.R +++ b/R/utils-github.R @@ -193,7 +193,7 @@ github_remotes <- function(these = c("origin", "upstream"), # 1. Did we call the GitHub API? Means we know `is_fork` and the parent repo. # 2. If so, did we call it with auth? Means we know if we can push. grl$github_got <- map_lgl(repo_info, ~ length(.x) > 0) - if (isTRUE(github_get) && any(!grl$github_got)) { + if (isTRUE(github_get) && !all(grl$github_got)) { oops <- which(!grl$github_got) oops_remotes <- grl$remote[oops] oops_hosts <- unique(grl$host[oops]) diff --git a/README.Rmd b/README.Rmd index 35d75aa9b..6c92d55a9 100644 --- a/README.Rmd +++ b/README.Rmd @@ -66,7 +66,7 @@ proj_activate(path) # Modify the description ---------------------------------------------- use_mit_license("My Name") -use_package("ggplot2", "Suggests") +use_package("rmarkdown", "Suggests") # Set up other files ------------------------------------------------- use_readme_md() diff --git a/README.md b/README.md index 2dc670044..4defaa652 100644 --- a/README.md +++ b/README.md @@ -60,15 +60,15 @@ library(usethis) # Create a new package ------------------------------------------------- path <- file.path(tempdir(), "mypkg") create_package(path) -#> ✔ Creating '/tmp/RtmpCJHMlj/mypkg/'. -#> ✔ Setting active project to "/private/tmp/RtmpCJHMlj/mypkg". +#> ✔ Creating '/tmp/RtmpPZsquk/mypkg/'. +#> ✔ Setting active project to "/private/tmp/RtmpPZsquk/mypkg". #> ✔ Creating 'R/'. #> ✔ Writing 'DESCRIPTION'. #> Package: mypkg #> Title: What the Package Does (One Line, Title Case) #> Version: 0.0.0.9000 #> Authors@R (parsed): -#> * First Last [aut, cre] (YOUR-ORCID-ID) +#> * First Last [aut, cre] #> Description: What the package does (one paragraph). #> License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a #> license @@ -79,8 +79,8 @@ create_package(path) #> ✔ Setting active project to "". # only needed since this session isn't interactive proj_activate(path) -#> ✔ Setting active project to "/private/tmp/RtmpCJHMlj/mypkg". -#> ✔ Changing working directory to '/tmp/RtmpCJHMlj/mypkg/' +#> ✔ Setting active project to "/private/tmp/RtmpPZsquk/mypkg". +#> ✔ Changing working directory to '/tmp/RtmpPZsquk/mypkg/' # Modify the description ---------------------------------------------- use_mit_license("My Name") @@ -89,11 +89,11 @@ use_mit_license("My Name") #> ✔ Writing 'LICENSE.md'. #> ✔ Adding "^LICENSE\\.md$" to '.Rbuildignore'. -use_package("ggplot2", "Suggests") -#> ✔ Adding ggplot2 to 'Suggests' field in DESCRIPTION. -#> ☐ Use `requireNamespace("ggplot2", quietly = TRUE)` to test if ggplot2 is +use_package("rmarkdown", "Suggests") +#> ✔ Adding rmarkdown to 'Suggests' field in DESCRIPTION. +#> ☐ Use `requireNamespace("rmarkdown", quietly = TRUE)` to test if rmarkdown is #> installed. -#> ☐ Then directly refer to functions with `ggplot2::fun()`. +#> ☐ Then directly refer to functions with `rmarkdown::fun()`. # Set up other files ------------------------------------------------- use_readme_md() diff --git a/man/tidyverse.Rd b/man/tidyverse.Rd index 277a65452..fe1cd455f 100644 --- a/man/tidyverse.Rd +++ b/man/tidyverse.Rd @@ -38,7 +38,7 @@ use_tidy_style(strict = TRUE) use_tidy_logo(geometry = "240x278", retina = TRUE) -use_tidy_upkeep_issue(year = NULL) +use_tidy_upkeep_issue(last_upkeep = last_upkeep_year()) } \arguments{ \item{ref}{Desired Git reference, usually the name of a tag (\code{"v2"}) or @@ -64,8 +64,10 @@ assumes that you have a hex logo using spec from \item{retina}{\code{TRUE}, the default, scales the image on the README, assuming that geometry is double the desired size.} -\item{year}{Approximate year when you last touched this package. If \code{NULL}, -the default, will give you a full set of actions to perform.} +\item{last_upkeep}{Year of last upkeep. By default, the +\code{Config/usethis/last-upkeep} field in \code{DESCRIPTION} is consulted for this, if +it's defined. If there's no information on the last upkeep, the issue will +contain the full checklist.} } \description{ These helpers follow tidyverse conventions which are generally a little @@ -119,7 +121,9 @@ document in a \verb{.github/} subdirectory. \item \code{\link[=use_tidy_github_labels]{use_tidy_github_labels()}} calls \code{use_github_labels()} to implement tidyverse conventions around GitHub issue label names and colours. \item \code{use_tidy_upkeep_issue()} creates an issue containing a checklist of -actions to bring your package up to current tidyverse standards. +actions to bring your package up to current tidyverse standards. Also +records the current date in the \code{Config/usethis/last-upkeep} field in +\code{DESCRIPTION}. \item \code{use_tidy_logo()} calls \code{use_logo()} on the appropriate hex sticker PNG file at \url{https://github.com/rstudio/hex-stickers}. } diff --git a/man/ui-legacy-functions.Rd b/man/ui-legacy-functions.Rd index 1a1976122..d1df6d888 100644 --- a/man/ui-legacy-functions.Rd +++ b/man/ui-legacy-functions.Rd @@ -75,8 +75,8 @@ make this transition: \code{vignette("usethis-ui", package = "cli")}. usethis itself now uses cli internally for its UI, but these new functions are not exported and presumably never will be. There is a developer-focused -article on the process of transitioning usethis's own UI to use cli (LINK -TO COME). +article on the process of transitioning usethis's own UI to use cli: +\href{https://usethis.r-lib.org/articles/ui-cli-conversion.html}{Converting usethis's UI to use cli}. } \details{ The \code{ui_} functions can be broken down into four main categories: diff --git a/man/use_author.Rd b/man/use_author.Rd index ea4df4dc5..2be7571d0 100644 --- a/man/use_author.Rd +++ b/man/use_author.Rd @@ -52,8 +52,7 @@ processed to create \code{Author} and \code{Maintainer} fields, but only when th \code{\link[=use_description]{use_description()}}. This happens when \pkg{usethis} has to create a DESCRIPTION file and the user hasn't given any author information via the \code{fields} argument or the global option \code{"usethis.description"}. The -placeholder looks something like \verb{First Last [aut, cre] (YOUR-ORCID-ID)} and \code{use_author()} offers to remove it in interactive -sessions. +placeholder looks something like \verb{First Last [aut, cre]} and \code{use_author()} offers to remove it in interactive sessions. } } \examples{ diff --git a/man/use_upkeep_issue.Rd b/man/use_upkeep_issue.Rd index 704e258bf..a916dafa0 100644 --- a/man/use_upkeep_issue.Rd +++ b/man/use_upkeep_issue.Rd @@ -22,6 +22,6 @@ annual package Spring Cleaning. } \examples{ \dontrun{ -use_upkeep_issue(2023) +use_upkeep_issue() } } diff --git a/tests/manual/manual-use-github.R b/tests/manual/manual-use-github.R index aefde5e88..c98f02860 100644 --- a/tests/manual/manual-use-github.R +++ b/tests/manual/manual-use-github.R @@ -59,7 +59,7 @@ expect_match(desc::desc_get_field("BugReports"), BugReports) # remove the GitHub links desc::desc_del(c("BugReports", "URL")) -expect_true(all(!desc::desc_has_fields(c("BugReports", "URL")))) +expect_true(!any(desc::desc_has_fields(c("BugReports", "URL")))) # restore the GitHub links # should see a warning that `host` is deprecated and ignored diff --git a/tests/testthat/_snaps/author.md b/tests/testthat/_snaps/author.md index 48bbed63c..b49cc9a48 100644 --- a/tests/testthat/_snaps/author.md +++ b/tests/testthat/_snaps/author.md @@ -31,5 +31,5 @@ v Adding to 'Authors@R' in DESCRIPTION: Charlie Brown [ctb] i 'Authors@R' appears to include a placeholder author: - First Last [aut, cre] (YOUR-ORCID-ID) + First Last [aut, cre] diff --git a/tests/testthat/_snaps/upkeep.md b/tests/testthat/_snaps/upkeep.md index af2df5d58..46b4fade3 100644 --- a/tests/testthat/_snaps/upkeep.md +++ b/tests/testthat/_snaps/upkeep.md @@ -5,7 +5,7 @@ Output ### To begin - * [ ] `pr_init("upkeep-2023-01")` + * [ ] `pr_init("upkeep-2025-01")` ### Pre-history @@ -58,7 +58,41 @@ * [ ] `devtools::build_readme()` * [ ] [Re-publish released site](https://pkgdown.r-lib.org/dev/articles/how-to-update-released-site.html) if needed - Created on 2023-01-01 with `usethis::use_tidy_upkeep_issue()`, using [usethis v1.1.0](https://usethis.r-lib.org) + Created on 2025-01-01 with `usethis::use_tidy_upkeep_issue()`, using [usethis v1.1.0](https://usethis.r-lib.org) + +# tidy upkeep omits bullets present in last_upkeep + + Code + writeLines(tidy_upkeep_checklist()) + Output + ### To begin + + * [ ] `pr_init("upkeep-2025-01")` + + ### 2023 + + * [ ] Update email addresses *@rstudio.com -> *@posit.co + * [ ] Update copyright holder in DESCRIPTION: `person("Posit Software, PBC", role = c("cph", "fnd"))` + * [ ] Run `devtools::document()` to re-generate package-level help topic with DESCRIPTION changes + * [ ] `usethis::use_tidy_logo(); pkgdown::build_favicons(overwrite = TRUE)` + * [ ] `usethis::use_tidy_coc()` + * [ ] Use `pak::pak("OWNER/REPO")` in README + * [ ] Consider running `usethis::use_tidy_dependencies()` and/or replace compat files with `use_standalone()` + * [ ] Use cli errors or [file an issue](new) if you don't have time to do it now + * [ ] `usethis::use_standalone("r-lib/rlang", "types-check")` instead of home grown argument checkers; + or [file an issue](new) if you don't have time to do it now + * [ ] Add alt-text to pictures, plots, etc; see https://posit.co/blog/knitr-fig-alt/ for examples + + ### To finish + + * [ ] `usethis::use_mit_license()` + * [ ] `usethis::use_package("R", "Depends", "4.0")` + * [ ] `usethis::use_tidy_description()` + * [ ] `usethis::use_tidy_github_actions()` + * [ ] `devtools::build_readme()` + * [ ] [Re-publish released site](https://pkgdown.r-lib.org/dev/articles/how-to-update-released-site.html) if needed + + Created on 2025-01-01 with `usethis::use_tidy_upkeep_issue()`, using [usethis v1.1.0](https://usethis.r-lib.org) # upkeep bullets don't change accidentally diff --git a/tests/testthat/_snaps/use_import_from.md b/tests/testthat/_snaps/use_import_from.md index 857fe0ef3..0bb4cf57d 100644 --- a/tests/testthat/_snaps/use_import_from.md +++ b/tests/testthat/_snaps/use_import_from.md @@ -3,8 +3,8 @@ Code roxygen_ns_show() Output - [1] "#' @importFrom tibble deframe" "#' @importFrom tibble enframe" - [3] "#' @importFrom tibble tibble" + [1] "#' @importFrom lifecycle deprecate_stop" + [2] "#' @importFrom lifecycle deprecate_warn" # use_import_from() generates helpful errors @@ -14,15 +14,15 @@ Error in `use_import_from()`: x `package` must be a single string. Code - use_import_from(c("tibble", "rlang")) + use_import_from(c("desc", "rlang")) Condition Error in `use_import_from()`: x `package` must be a single string. Code - use_import_from("tibble", "pool_noodle") + use_import_from("desc", "pool_noodle") Condition Error in `map2()`: i In index: 1. Caused by error in `.f()`: - x Can't find `tibble::pool_noodle()`. + x Can't find `desc::pool_noodle()`. diff --git a/tests/testthat/helper-mocks.R b/tests/testthat/helper-mocks.R index d2dc19ef4..d9e9d5757 100644 --- a/tests/testthat/helper-mocks.R +++ b/tests/testthat/helper-mocks.R @@ -28,7 +28,7 @@ local_ui_yep <- function(.env = caller_env()) { local_git_default_branch_remote <- function(.env = caller_env()) { local_mocked_bindings( - git_default_branch_remote = function(remote) { + git_default_branch_remote = function(cfg, remote) { list( name = remote, is_configured = TRUE, diff --git a/tests/testthat/test-author.R b/tests/testthat/test-author.R index 987961334..f60acab86 100644 --- a/tests/testthat/test-author.R +++ b/tests/testthat/test-author.R @@ -72,9 +72,6 @@ test_that("Decline to tweak an existing author", { }) test_that("Placeholder author is challenged", { - # apparently the format method for `person` used to handle ORCIDs differently - skip_if(getRversion() < "4.0") - withr::local_options(usethis.description = NULL) create_local_package() diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index f2f893aee..9edde202e 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -95,3 +95,14 @@ test_that("use_data_raw() does setup", { expect_true(is_build_ignored("^data-raw$")) }) + +test_that("use_data() does not decrease minimum version of R itself", { + create_local_package() + + use_package("R", "depends", "4.1") + original_minimum_r_version <- pkg_minimum_r_version() + + use_data(letters) + + expect_true(pkg_minimum_r_version() >= original_minimum_r_version) +}) diff --git a/tests/testthat/test-proj.R b/tests/testthat/test-proj.R index c2bf4a20c..826e578b1 100644 --- a/tests/testthat/test-proj.R +++ b/tests/testthat/test-proj.R @@ -148,12 +148,12 @@ test_that("with_project() runs code in temp proj, restores (lack of) proj", { ) proj_set_(NULL) - expect_identical(proj_get_(), NULL) + expect_null(proj_get_()) res <- with_project(path = temp_proj, proj_get_()) expect_identical(res, temp_proj) - expect_identical(proj_get_(), NULL) + expect_null(proj_get_()) }) test_that("with_project() runs code in temp proj, restores original proj", { diff --git a/tests/testthat/test-tidyverse.R b/tests/testthat/test-tidyverse.R index 057480121..7a8c08665 100644 --- a/tests/testthat/test-tidyverse.R +++ b/tests/testthat/test-tidyverse.R @@ -16,7 +16,7 @@ test_that("use_tidy_dependencies() isn't overly informative", { skip_if_offline("github.com") create_local_package() - use_package_doc() + use_package_doc(open = FALSE) withr::local_options(usethis.quiet = FALSE, cli.width = Inf) expect_snapshot( diff --git a/tests/testthat/test-upkeep.R b/tests/testthat/test-upkeep.R index f0da07051..a53cbe877 100644 --- a/tests/testthat/test-upkeep.R +++ b/tests/testthat/test-upkeep.R @@ -1,9 +1,28 @@ test_that("tidy upkeep bullets don't change accidentally", { create_local_package() use_mit_license() + expect_equal(last_upkeep_year(), 2000L) local_mocked_bindings( - Sys.Date = function() as.Date("2023-01-01"), + Sys.Date = function() as.Date("2025-01-01"), + usethis_version = function() "1.1.0", + author_has_rstudio_email = function() TRUE, + is_posit_pkg = function() TRUE, + is_posit_person_canonical = function() FALSE + ) + + expect_snapshot(writeLines(tidy_upkeep_checklist())) +}) + +test_that("tidy upkeep omits bullets present in last_upkeep", { + create_local_package() + use_mit_license() + expect_equal(last_upkeep_year(), 2000L) + record_upkeep_date(as.Date("2023-04-04")) + expect_equal(last_upkeep_year(), 2023L) + + local_mocked_bindings( + Sys.Date = function() as.Date("2025-01-01"), usethis_version = function() "1.1.0", author_has_rstudio_email = function() TRUE, is_posit_pkg = function() TRUE, diff --git a/tests/testthat/test-use_import_from.R b/tests/testthat/test-use_import_from.R index 060159c3e..6a3266276 100644 --- a/tests/testthat/test-use_import_from.R +++ b/tests/testthat/test-use_import_from.R @@ -1,16 +1,16 @@ test_that("use_import_from() imports the related package & adds line to package doc", { create_local_package() use_package_doc() - use_import_from("tibble", "tibble") + use_import_from("lifecycle", "deprecated") - expect_equal(proj_desc()$get_field("Imports"), "tibble") - expect_equal(roxygen_ns_show(), "#' @importFrom tibble tibble") + expect_equal(proj_desc()$get_field("Imports"), "lifecycle") + expect_equal(roxygen_ns_show(), "#' @importFrom lifecycle deprecated") }) test_that("use_import_from() adds one line for each function", { create_local_package() use_package_doc() - use_import_from("tibble", c("tibble", "enframe", "deframe")) + use_import_from("lifecycle", c("deprecate_warn", "deprecate_stop")) expect_snapshot(roxygen_ns_show()) }) @@ -21,8 +21,8 @@ test_that("use_import_from() generates helpful errors", { expect_snapshot(error = TRUE, { use_import_from(1) - use_import_from(c("tibble", "rlang")) + use_import_from(c("desc", "rlang")) - use_import_from("tibble", "pool_noodle") + use_import_from("desc", "pool_noodle") }) })