|
1 | 1 | # Standalone file: do not edit by hand |
2 | | -# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-obj-type.R> |
| 2 | +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-obj-type.R |
| 3 | +# Generated by: usethis::use_standalone("r-lib/rlang", "obj-type") |
3 | 4 | # ---------------------------------------------------------------------- |
4 | 5 | # |
5 | 6 | # --- |
6 | 7 | # repo: r-lib/rlang |
7 | 8 | # file: standalone-obj-type.R |
8 | | -# last-updated: 2022-10-04 |
| 9 | +# last-updated: 2024-02-14 |
9 | 10 | # license: https://unlicense.org |
10 | 11 | # imports: rlang (>= 1.1.0) |
11 | 12 | # --- |
12 | 13 | # |
13 | 14 | # ## Changelog |
14 | 15 | # |
| 16 | +# 2024-02-14: |
| 17 | +# - `obj_type_friendly()` now works for S7 objects. |
| 18 | +# |
| 19 | +# 2023-05-01: |
| 20 | +# - `obj_type_friendly()` now only displays the first class of S3 objects. |
| 21 | +# |
| 22 | +# 2023-03-30: |
| 23 | +# - `stop_input_type()` now handles `I()` input literally in `arg`. |
| 24 | +# |
15 | 25 | # 2022-10-04: |
16 | 26 | # - `obj_type_friendly(value = TRUE)` now shows numeric scalars |
17 | 27 | # literally. |
@@ -65,7 +75,7 @@ obj_type_friendly <- function(x, value = TRUE) { |
65 | 75 | if (inherits(x, "quosure")) { |
66 | 76 | type <- "quosure" |
67 | 77 | } else { |
68 | | - type <- paste(class(x), collapse = "/") |
| 78 | + type <- class(x)[[1L]] |
69 | 79 | } |
70 | 80 | return(sprintf("a <%s> object", type)) |
71 | 81 | } |
@@ -261,19 +271,19 @@ vec_type_friendly <- function(x, length = FALSE) { |
261 | 271 | #' Return OO type |
262 | 272 | #' @param x Any R object. |
263 | 273 | #' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, |
264 | | -#' `"R6"`, or `"R7"`. |
| 274 | +#' `"R6"`, or `"S7"`. |
265 | 275 | #' @noRd |
266 | 276 | obj_type_oo <- function(x) { |
267 | 277 | if (!is.object(x)) { |
268 | 278 | return("bare") |
269 | 279 | } |
270 | 280 |
|
271 | | - class <- inherits(x, c("R6", "R7_object"), which = TRUE) |
| 281 | + class <- inherits(x, c("R6", "S7_object"), which = TRUE) |
272 | 282 |
|
273 | 283 | if (class[[1]]) { |
274 | 284 | "R6" |
275 | 285 | } else if (class[[2]]) { |
276 | | - "R7" |
| 286 | + "S7" |
277 | 287 | } else if (isS4(x)) { |
278 | 288 | "S4" |
279 | 289 | } else { |
@@ -315,10 +325,15 @@ stop_input_type <- function(x, |
315 | 325 | if (length(what)) { |
316 | 326 | what <- oxford_comma(what) |
317 | 327 | } |
| 328 | + if (inherits(arg, "AsIs")) { |
| 329 | + format_arg <- identity |
| 330 | + } else { |
| 331 | + format_arg <- cli$format_arg |
| 332 | + } |
318 | 333 |
|
319 | 334 | message <- sprintf( |
320 | 335 | "%s must be %s, not %s.", |
321 | | - cli$format_arg(arg), |
| 336 | + format_arg(arg), |
322 | 337 | what, |
323 | 338 | obj_type_friendly(x, value = show_value) |
324 | 339 | ) |
|
0 commit comments