From f2b28d7d0feee09044cf5f8dc64012966ed3a856 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 3 Sep 2026 14:37:43 +0200 Subject: [PATCH] chore: update standalone files --- R/import-standalone-obj-type.R | 73 ++----- R/import-standalone-purrr.R | 20 +- R/import-standalone-types-check.R | 310 ++++-------------------------- 3 files changed, 59 insertions(+), 344 deletions(-) diff --git a/R/import-standalone-obj-type.R b/R/import-standalone-obj-type.R index c582ba0847d..140e601b53a 100644 --- a/R/import-standalone-obj-type.R +++ b/R/import-standalone-obj-type.R @@ -6,13 +6,16 @@ # --- # repo: r-lib/rlang # file: standalone-obj-type.R -# last-updated: 2024-02-14 +# last-updated: 2025-10-02 # license: https://unlicense.org # imports: rlang (>= 1.1.0) # --- # # ## Changelog # +# 2025-10-02: +# - `obj_type_friendly()` now shows the dimensionality of arrays. +# # 2024-02-14: # - `obj_type_friendly()` now works for S7 objects. # @@ -188,14 +191,16 @@ vec_type_friendly <- function(x, length = FALSE) { } if (type == "list") { - if (n_dim < 2) { + if (n_dim == 0) { return(add_length("a list")) - } else if (is.data.frame(x)) { - return("a data frame") } else if (n_dim == 2) { - return("a list matrix") + if (is.data.frame(x)) { + return("a data frame") + } else { + return("a list matrix") + } } else { - return("a list array") + return(sprintf("a list %sD array", n_dim)) } } @@ -211,12 +216,12 @@ vec_type_friendly <- function(x, length = FALSE) { type = paste0("a ", type, " %s") ) - if (n_dim < 2) { + if (n_dim == 0) { kind <- "vector" } else if (n_dim == 2) { kind <- "matrix" } else { - kind <- "array" + kind <- sprintf("%sD array", n_dim) } out <- sprintf(type, kind) @@ -290,58 +295,6 @@ obj_type_oo <- function(x) { } } -#' @param x The object type which does not conform to `what`. Its -#' `obj_type_friendly()` is taken and mentioned in the error message. -#' @param what The friendly expected type as a string. Can be a -#' character vector of expected types, in which case the error -#' message mentions all of them in an "or" enumeration. -#' @param show_value Passed to `value` argument of `obj_type_friendly()`. -#' @param ... Arguments passed to [abort()]. -#' @inheritParams args_error_context -#' @noRd -stop_input_type <- function( - x, - what, - ..., - allow_na = FALSE, - allow_null = FALSE, - show_value = TRUE, - arg = caller_arg(x), - call = caller_env() -) { - # From standalone-cli.R - cli <- env_get_list( - nms = c("format_arg", "format_code"), - last = topenv(), - default = function(x) sprintf("`%s`", x), - inherit = TRUE - ) - - if (allow_na) { - what <- c(what, cli$format_code("NA")) - } - if (allow_null) { - what <- c(what, cli$format_code("NULL")) - } - if (length(what)) { - what <- oxford_comma(what) - } - if (inherits(arg, "AsIs")) { - format_arg <- identity - } else { - format_arg <- cli$format_arg - } - - message <- sprintf( - "%s must be %s, not %s.", - format_arg(arg), - what, - obj_type_friendly(x, value = show_value) - ) - - abort(message, ..., call = call, arg = arg) -} - oxford_comma <- function(chr, sep = ", ", final = "or") { n <- length(chr) diff --git a/R/import-standalone-purrr.R b/R/import-standalone-purrr.R index 623142a0eb8..85a185f30ac 100644 --- a/R/import-standalone-purrr.R +++ b/R/import-standalone-purrr.R @@ -1,5 +1,6 @@ # Standalone file: do not edit by hand -# Source: +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-purrr.R +# Generated by: usethis::use_standalone("r-lib/rlang", "purrr") # ---------------------------------------------------------------------- # # --- @@ -93,11 +94,16 @@ imap <- function(.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 - )) + 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) @@ -133,7 +139,7 @@ map_if <- function(.x, .p, .f, ...) { } compact <- function(.x) { - Filter(length, .x) + .x[as.logical(lengths(.x))] } transpose <- function(.l) { diff --git a/R/import-standalone-types-check.R b/R/import-standalone-types-check.R index 5214a00eb39..886bb6f55e9 100644 --- a/R/import-standalone-types-check.R +++ b/R/import-standalone-types-check.R @@ -13,6 +13,20 @@ # --- # # ## Changelog +# 2026-03-30: +# - `check_name()` has been removed from the standalone file because of a +# conflict with `recipes::check_name()`. +# +# 2026-03-17: +# - `check_bool()`, `check_string()`, `check_number_decimal()`, +# `check_number_whole()`, and `check_data_frame()` are now exported +# from rlang. Language type checkers (`check_symbol()`, +# `check_call()`, etc.), column type checkers (`check_character()`, +# `check_logical()`), and `check_arg()` remain in the standalone file. +# - `check_formula()` now requires an evaluated formula, not a defused one. +# +# 2025-09-19: +# - `check_logical()` gains an `allow_na` argument (@jonthegeek, #1724) # # 2024-08-15: # - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724) @@ -61,255 +75,6 @@ # # nocov start -# Scalars ----------------------------------------------------------------- - -.standalone_types_check_dot_call <- .Call - -check_bool <- function( - x, - ..., - allow_na = FALSE, - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env() -) { - if ( - !missing(x) && - .standalone_types_check_dot_call( - ffi_standalone_is_bool_1.0.7, - x, - allow_na, - allow_null - ) - ) { - return(invisible(NULL)) - } - - stop_input_type( - x, - c("`TRUE`", "`FALSE`"), - ..., - allow_na = allow_na, - allow_null = allow_null, - arg = arg, - call = call - ) -} - -check_string <- function( - x, - ..., - allow_empty = TRUE, - allow_na = FALSE, - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env() -) { - if (!missing(x)) { - is_string <- .rlang_check_is_string( - x, - allow_empty = allow_empty, - allow_na = allow_na, - allow_null = allow_null - ) - if (is_string) { - return(invisible(NULL)) - } - } - - stop_input_type( - x, - "a single string", - ..., - allow_na = allow_na, - allow_null = allow_null, - arg = arg, - call = call - ) -} - -.rlang_check_is_string <- function(x, allow_empty, allow_na, allow_null) { - if (is_string(x)) { - if (allow_empty || !is_string(x, "")) { - return(TRUE) - } - } - - if (allow_null && is_null(x)) { - return(TRUE) - } - - if (allow_na && (identical(x, NA) || identical(x, na_chr))) { - return(TRUE) - } - - FALSE -} - -check_name <- function( - x, - ..., - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env() -) { - if (!missing(x)) { - is_string <- .rlang_check_is_string( - x, - allow_empty = FALSE, - allow_na = FALSE, - allow_null = allow_null - ) - if (is_string) { - return(invisible(NULL)) - } - } - - stop_input_type( - x, - "a valid name", - ..., - allow_na = FALSE, - allow_null = allow_null, - arg = arg, - call = call - ) -} - -IS_NUMBER_true <- 0 -IS_NUMBER_false <- 1 -IS_NUMBER_oob <- 2 - -check_number_decimal <- function( - x, - ..., - min = NULL, - max = NULL, - allow_infinite = TRUE, - allow_na = FALSE, - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env() -) { - if (missing(x)) { - exit_code <- IS_NUMBER_false - } else if ( - 0 == - (exit_code <- .standalone_types_check_dot_call( - ffi_standalone_check_number_1.0.7, - x, - allow_decimal = TRUE, - min, - max, - allow_infinite, - allow_na, - allow_null - )) - ) { - return(invisible(NULL)) - } - - .stop_not_number( - x, - ..., - exit_code = exit_code, - allow_decimal = TRUE, - min = min, - max = max, - allow_na = allow_na, - allow_null = allow_null, - arg = arg, - call = call - ) -} - -check_number_whole <- function( - x, - ..., - min = NULL, - max = NULL, - allow_infinite = FALSE, - allow_na = FALSE, - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env() -) { - if (missing(x)) { - exit_code <- IS_NUMBER_false - } else if ( - 0 == - (exit_code <- .standalone_types_check_dot_call( - ffi_standalone_check_number_1.0.7, - x, - allow_decimal = FALSE, - min, - max, - allow_infinite, - allow_na, - allow_null - )) - ) { - return(invisible(NULL)) - } - - .stop_not_number( - x, - ..., - exit_code = exit_code, - allow_decimal = FALSE, - min = min, - max = max, - allow_na = allow_na, - allow_null = allow_null, - arg = arg, - call = call - ) -} - -.stop_not_number <- function( - x, - ..., - exit_code, - allow_decimal, - min, - max, - allow_na, - allow_null, - arg, - call -) { - if (allow_decimal) { - what <- "a number" - } else { - what <- "a whole number" - } - - if (exit_code == IS_NUMBER_oob) { - min <- min %||% -Inf - max <- max %||% Inf - - if (min > -Inf && max < Inf) { - what <- sprintf("%s between %s and %s", what, min, max) - } else if (x < min) { - what <- sprintf("%s larger than or equal to %s", what, min) - } else if (x > max) { - what <- sprintf("%s smaller than or equal to %s", what, max) - } else { - abort("Unexpected state in OOB check", .internal = TRUE) - } - } - - stop_input_type( - x, - what, - ..., - allow_na = allow_na, - allow_null = allow_null, - arg = arg, - call = call - ) -} - check_symbol <- function( x, ..., @@ -476,16 +241,25 @@ check_formula <- function( x, ..., allow_null = FALSE, + allow_unevaluated = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { - if (is_formula(x)) { + if (allow_null && is_null(x)) { return(invisible(NULL)) } - if (allow_null && is_null(x)) { + scoped <- if (allow_unevaluated) NULL else TRUE + if (is_formula(x, scoped = scoped)) { return(invisible(NULL)) } + if (!allow_unevaluated && is_formula(x)) { + cli::cli_abort( + "{.arg {arg}} must be an evaluated formula, not a defused one.", + arg = arg, + call = call + ) + } } stop_input_type( @@ -543,12 +317,20 @@ check_character <- function( check_logical <- function( x, ..., + allow_na = TRUE, allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_logical(x)) { + if (!allow_na && any(is.na(x))) { + abort( + sprintf("`%s` can't contain NA values.", arg), + arg = arg, + call = call + ) + } return(invisible(NULL)) } if (allow_null && is_null(x)) { @@ -567,30 +349,4 @@ check_logical <- function( ) } -check_data_frame <- function( - x, - ..., - allow_null = FALSE, - arg = caller_arg(x), - call = caller_env() -) { - if (!missing(x)) { - if (is.data.frame(x)) { - return(invisible(NULL)) - } - if (allow_null && is_null(x)) { - return(invisible(NULL)) - } - } - - stop_input_type( - x, - "a data frame", - ..., - allow_null = allow_null, - arg = arg, - call = call - ) -} - # nocov end