Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

use_tidy_dependencies #2503

Open
wants to merge 21 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 6 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ Imports:
desc (>= 1.4.1),
ellipsis (>= 0.3.2),
fs (>= 1.5.2),
glue,
lifecycle (>= 1.0.1),
memoise (>= 2.0.1),
miniUI (>= 0.1.1.1),
Expand Down
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -80,9 +80,11 @@ export(uses_testthat)
export(wd)
export(with_debug)
import(fs)
import(rlang)
ateucher marked this conversation as resolved.
Show resolved Hide resolved
importFrom(cli,cat_bullet)
importFrom(cli,cat_rule)
importFrom(ellipsis,check_dots_used)
importFrom(glue,glue)
importFrom(lifecycle,deprecated)
importFrom(memoise,memoise)
importFrom(miniUI,miniPage)
Expand Down
2 changes: 1 addition & 1 deletion R/active.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ find_test_file <- function(path, call = parent.frame()) {
}

is_test <- type == "test"
path[!is_test] <- paste0("tests/testthat/test-", name_source(path[!is_test]), ".R")
path[!is_test] <- glue("tests/testthat/test-{name_source(path[!is_test])}.R")
path <- unique(path[file_exists(path)])

if (length(path) == 0) {
Expand Down
2 changes: 1 addition & 1 deletion R/build-manual.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ build_manual <- function(pkg = ".", path = NULL) {
name <- paste0(pkg$package, "_", pkg$version, ".pdf", collapse = " ")
ateucher marked this conversation as resolved.
Show resolved Hide resolved
tryCatch(msg <- callr::rcmd("Rd2pdf", cmdargs = c(
"--force",
paste0("--output=", path, "/", name),
glue("--output={path}/{name}"),
pkg$path
), fail_on_status = TRUE, stderr = "2>&1", spinner = FALSE),
error = function(e) {
Expand Down
2 changes: 1 addition & 1 deletion R/build-readme.R
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ build_rmd <- function(files, path = ".", output_options = list(), ..., quiet = T
build_readme <- function(path = ".", quiet = TRUE, ...) {
pkg <- as.package(path)

regexp <- paste0(path_file(pkg$path), "/(inst/)?readme[.]rmd")
regexp <- glue("{path_file(pkg$path)}/(inst/)?readme[.]rmd")
readme_path <- path_abs(dir_ls(pkg$path, ignore.case = TRUE, regexp = regexp, recurse = 1, type = "file"))

if (length(readme_path) == 0) {
Expand Down
10 changes: 5 additions & 5 deletions R/check-devtools.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
#' @export
release_checks <- function(pkg = ".", built_path = NULL) {
pkg <- as.package(pkg)
cat_rule(paste0("Running additional devtools checks for ", pkg$package))
cat_rule(glue("Running additional devtools checks for {pkg$package}"))

check_version(pkg)
check_dev_versions(pkg)
Expand All @@ -28,8 +28,8 @@ check_dev_versions <- function(pkg = ".") {

parsed <- lapply(deps$version, function(x) unlist(numeric_version(x)))
ateucher marked this conversation as resolved.
Show resolved Hide resolved

lengths <- vapply(parsed, length, integer(1))
last_ver <- vapply(parsed, function(x) x[[length(x)]], integer(1))
lengths <- map_int(parsed, length)
last_ver <- map_int(parsed, function(x) x[[length(x)]])

is_dev <- lengths == 4 & last_ver >= 9000

Expand All @@ -52,7 +52,7 @@ check_version <- function(pkg = ".") {
check_status(
length(ver) == 3,
"version number has three components",
paste0("version (", pkg$version, ") should have exactly three components")
glue("version ({pkg$version}) should have exactly three components")
)
}

Expand All @@ -66,7 +66,7 @@ check_vignette_titles <- function(pkg = ".") {
any(grepl("Vignette Title", h))
}
v <- stats::setNames(vigns$docs, path_file(vigns$docs))
has_vt <- vapply(v, has_vignette_title, logical(1), n = 30)
has_vt <- map_lgl(v, has_vignette_title, n = 30)

check_status(
!any(has_vt),
Expand Down
2 changes: 1 addition & 1 deletion R/check-git.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' @keywords internal
git_checks <- function(pkg = ".") {
pkg <- as.package(pkg)
cat_rule(paste0("Running Git checks for ", pkg$package))
cat_rule(glue("Running Git checks for {pkg$package}"))

git_report_branch(pkg)
git_check_uncommitted(pkg)
Expand Down
6 changes: 3 additions & 3 deletions R/check-win.R
Original file line number Diff line number Diff line change
Expand Up @@ -86,8 +86,8 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea
)
on.exit(file_delete(built_path), add = TRUE)

url <- paste0(
"ftp://win-builder.r-project.org/", version, "/",
url <- glue(
"ftp://win-builder.r-project.org/{version}/",
path_file(built_path)
)
ateucher marked this conversation as resolved.
Show resolved Hide resolved
lapply(url, upload_ftp, file = built_path)
Expand Down Expand Up @@ -127,7 +127,7 @@ change_maintainer_email <- function(path, email, call = parent.frame()) {
if (!is.list(roles)) {
roles <- list(roles)
}
is_maintainer <- vapply(roles, function(r) all("cre" %in% r), logical(1))
is_maintainer <- map_lgl(roles, function(r) all("cre" %in% r))
aut[is_maintainer]$email <- email
desc$set_authors(aut)

Expand Down
2 changes: 1 addition & 1 deletion R/check.R
Original file line number Diff line number Diff line change
Expand Up @@ -246,5 +246,5 @@ aspell_env_var <- function() {

show_env_vars <- function(env_vars) {
cli::cat_line("Setting env vars:", col = "darkgrey")
cat_bullet(paste0(format(names(env_vars)), ": ", unname(env_vars)), col = "darkgrey")
cat_bullet(glue("{format(names(env_vars))}: {unname(env_vars)}"), col = "darkgrey")
}
2 changes: 1 addition & 1 deletion R/dev-mode.R
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ is_library <- function(path) {
dirs <- dir_ls(path, type = "directory")

has_pkg_dir <- function(path) length(dir_ls(path, regexp = "Meta")) > 0
help_dirs <- vapply(dirs, has_pkg_dir, logical(1))
help_dirs <- map_lgl(dirs, has_pkg_dir)

all(help_dirs)
}
2 changes: 2 additions & 0 deletions R/devtools-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,8 @@
"_PACKAGE"

## usethis namespace: start
#' @import rlang
#' @importFrom glue glue
#' @importFrom lifecycle deprecated
#' @importFrom miniUI miniPage
#' @importFrom profvis profvis
Expand Down
239 changes: 239 additions & 0 deletions R/import-standalone-purrr.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,239 @@
# Standalone file: do not edit by hand
# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-purrr.R>
# ----------------------------------------------------------------------
#
# ---
# repo: r-lib/rlang
# file: standalone-purrr.R
# last-updated: 2023-02-23
# license: https://unlicense.org
# ---
#
# This file provides a minimal shim to provide a purrr-like API on top of
# base R functions. They are not drop-in replacements but allow a similar style
# of programming.
#
# ## Changelog
#
# 2023-02-23:
# * Added `list_c()`
#
# 2022-06-07:
# * `transpose()` is now more consistent with purrr when inner names
# are not congruent (#1346).
#
# 2021-12-15:
# * `transpose()` now supports empty lists.
#
# 2021-05-21:
# * Fixed "object `x` not found" error in `imap()` (@mgirlich)
#
# 2020-04-14:
# * Removed `pluck*()` functions
# * Removed `*_cpl()` functions
# * Used `as_function()` to allow use of `~`
# * Used `.` prefix for helpers
#
# nocov start

map <- function(.x, .f, ...) {
.f <- as_function(.f, env = global_env())
lapply(.x, .f, ...)
}
walk <- function(.x, .f, ...) {
map(.x, .f, ...)
invisible(.x)
}

map_lgl <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, logical(1), ...)
}
map_int <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, integer(1), ...)
}
map_dbl <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, double(1), ...)
}
map_chr <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, character(1), ...)
}
.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) {
.f <- as_function(.f, env = global_env())
out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE)
names(out) <- names(.x)
out
}

map2 <- function(.x, .y, .f, ...) {
.f <- as_function(.f, env = global_env())
out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE)
if (length(out) == length(.x)) {
set_names(out, names(.x))
} else {
set_names(out, NULL)
}
}
map2_lgl <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "logical")
}
map2_int <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "integer")
}
map2_dbl <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "double")
}
map2_chr <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "character")
}
imap <- function(.x, .f, ...) {
map2(.x, names(.x) %||% seq_along(.x), .f, ...)
}

pmap <- function(.l, .f, ...) {
.f <- as.function(.f)
args <- .rlang_purrr_args_recycle(.l)
do.call("mapply", c(
FUN = list(quote(.f)),
args, MoreArgs = quote(list(...)),
SIMPLIFY = FALSE, USE.NAMES = FALSE
))
}
.rlang_purrr_args_recycle <- function(args) {
lengths <- map_int(args, length)
n <- max(lengths)

stopifnot(all(lengths == 1L | lengths == n))
to_recycle <- lengths == 1L
args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n))

args
}

keep <- function(.x, .f, ...) {
.x[.rlang_purrr_probe(.x, .f, ...)]
}
discard <- function(.x, .p, ...) {
sel <- .rlang_purrr_probe(.x, .p, ...)
.x[is.na(sel) | !sel]
}
map_if <- function(.x, .p, .f, ...) {
matches <- .rlang_purrr_probe(.x, .p)
.x[matches] <- map(.x[matches], .f, ...)
.x
}
.rlang_purrr_probe <- function(.x, .p, ...) {
if (is_logical(.p)) {
stopifnot(length(.p) == length(.x))
.p
} else {
.p <- as_function(.p, env = global_env())
map_lgl(.x, .p, ...)
}
}

compact <- function(.x) {
Filter(length, .x)
}

transpose <- function(.l) {
if (!length(.l)) {
return(.l)
}

inner_names <- names(.l[[1]])

if (is.null(inner_names)) {
fields <- seq_along(.l[[1]])
} else {
fields <- set_names(inner_names)
.l <- map(.l, function(x) {
if (is.null(names(x))) {
set_names(x, inner_names)
} else {
x
}
})
}

# This way missing fields are subsetted as `NULL` instead of causing
# an error
.l <- map(.l, as.list)

map(fields, function(i) {
map(.l, .subset2, i)
})
}

every <- function(.x, .p, ...) {
.p <- as_function(.p, env = global_env())

for (i in seq_along(.x)) {
if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE)
}
TRUE
}
some <- function(.x, .p, ...) {
.p <- as_function(.p, env = global_env())

for (i in seq_along(.x)) {
if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE)
}
FALSE
}
negate <- function(.p) {
.p <- as_function(.p, env = global_env())
function(...) !.p(...)
}

reduce <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(x, y, ...)
Reduce(f, .x, init = .init)
}
reduce_right <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(y, x, ...)
Reduce(f, .x, init = .init, right = TRUE)
}
accumulate <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(x, y, ...)
Reduce(f, .x, init = .init, accumulate = TRUE)
}
accumulate_right <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(y, x, ...)
Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE)
}

detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
.p <- as_function(.p, env = global_env())
.f <- as_function(.f, env = global_env())

for (i in .rlang_purrr_index(.x, .right)) {
if (.p(.f(.x[[i]], ...))) {
return(.x[[i]])
}
}
NULL
}
detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
.p <- as_function(.p, env = global_env())
.f <- as_function(.f, env = global_env())

for (i in .rlang_purrr_index(.x, .right)) {
if (.p(.f(.x[[i]], ...))) {
return(i)
}
}
0L
}
.rlang_purrr_index <- function(x, right = FALSE) {
idx <- seq_along(x)
if (right) {
idx <- rev(idx)
}
idx
}

list_c <- function(x) {
inject(c(!!!x))
}

# nocov end
Loading