Skip to content

Commit

Permalink
Cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
@Ilia-Kosenkov
Ilia-Kosenkov committed Aug 3, 2024
1 parent 3da0d06 commit 31a0f46
Show file tree
Hide file tree
Showing 4 changed files with 163 additions and 173 deletions.
205 changes: 106 additions & 99 deletions R/import-standalone-obj-type.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,6 @@
#' @param x Any R object.
#' @param value Whether to describe the value of `x`. Special values
#' like `NA` or `""` are always described.
#' @param length Whether to mention the length of vectors and lists.
#' @return A string describing the type. Starts with an indefinite
#' article, e.g. "an integer vector".
#' @noRd
Expand All @@ -83,92 +82,110 @@ obj_type_friendly <- function(x, value = TRUE) {
n_dim <- length(dim(x))

if (!n_dim) {
if (!rlang::is_list(x) && length(x) == 1) {
if (rlang::is_na(x)) {
return(switch(
typeof(x),
logical = "`NA`",
integer = "an integer `NA`",
double =
if (is.nan(x)) {
"`NaN`"
} else {
"a numeric `NA`"
},
complex = "a complex `NA`",
character = "a character `NA`",
.rlang_stop_unexpected_typeof(x)
))
}

show_infinites <- function(x) {
if (x > 0) {
"`Inf`"
} else {
"`-Inf`"
}
}
str_encode <- function(x, width = 30, ...) {
if (nchar(x) > width) {
x <- substr(x, 1, width - 3)
x <- paste0(x, "...")
}
encodeString(x, ...)
}

if (value) {
if (is.numeric(x) && is.infinite(x)) {
return(show_infinites(x))
}

if (is.numeric(x) || is.complex(x)) {
number <- as.character(round(x, 2))
what <- if (is.complex(x)) "the complex number" else "the number"
return(paste(what, number))
}

return(switch(
typeof(x),
logical = if (x) "`TRUE`" else "`FALSE`",
character = {
what <- if (nzchar(x)) "the string" else "the empty string"
paste(what, str_encode(x, quote = "\""))
},
raw = paste("the raw value", as.character(x)),
.rlang_stop_unexpected_typeof(x)
))
}

return(switch(
typeof(x),
logical = "a logical value",
integer = "an integer",
double = if (is.infinite(x)) show_infinites(x) else "a number",
complex = "a complex number",
character = if (nzchar(x)) "a string" else "\"\"",
raw = "a raw value",
.rlang_stop_unexpected_typeof(x)
))
return(vec_or_scalar_type_friendly(x, value))
}
vec_type_friendly(x)
}

vec_or_scalar_type_friendly <- function(x, value) {
if (!rlang::is_list(x) && length(x) == 1) {
if (rlang::is_na(x)) {
return(.match_na_scalar(x))
}

if (length(x) == 0) {
return(switch(
typeof(x),
logical = "an empty logical vector",
integer = "an empty integer vector",
double = "an empty numeric vector",
complex = "an empty complex vector",
character = "an empty character vector",
raw = "an empty raw vector",
list = "an empty list",
.rlang_stop_unexpected_typeof(x)
))
if (value) {
return(.make_description(x))
}

return(.match_default_scalar(x))
}

if (length(x) == 0) {
return(.match_empty_object(x))
}
vec_type_friendly(x)
}

.show_infinities <- function(x) {
if (x > 0) {
"`Inf`"
} else {
"`-Inf`"
}
}

.str_encode <- function(x, width = 30, ...) {
if (nchar(x) > width) {
x <- substr(x, 1, width - 3)
x <- paste0(x, "...")
}
encodeString(x, ...)
}

.make_description <- function(x) {
if (is.numeric(x) && is.infinite(x)) {
return(.show_infinities(x))
}

if (is.numeric(x) || is.complex(x)) {
number <- as.character(round(x, 2))
what <- if (is.complex(x)) "the complex number" else "the number"
return(paste(what, number))
}

switch(typeof(x),
logical = if (x) "`TRUE`" else "`FALSE`",
character = {
what <- if (nzchar(x)) "the string" else "the empty string"
paste(what, .str_encode(x, quote = "\""))
},
raw = paste("the raw value", as.character(x)),
.rlang_stop_unexpected_typeof(x)
)
}

.match_default_scalar <- function(x) {
switch(typeof(x),
logical = "a logical value",
integer = "an integer",
double = if (is.infinite(x)) .show_infinities(x) else "a number",
complex = "a complex number",
character = if (nzchar(x)) "a string" else "\"\"",
raw = "a raw value",
.rlang_stop_unexpected_typeof(x)
)
}

.match_na_scalar <- function(x) {
switch(typeof(x),
logical = "`NA`",
integer = "an integer `NA`",
double =
if (is.nan(x)) {
"`NaN`"
} else {
"a numeric `NA`"
},
complex = "a complex `NA`",
character = "a character `NA`",
.rlang_stop_unexpected_typeof(x)
)
}

.match_empty_object <- function(x) {
switch(typeof(x),
logical = "an empty logical vector",
integer = "an empty integer vector",
double = "an empty numeric vector",
complex = "an empty complex vector",
character = "an empty character vector",
raw = "an empty raw vector",
list = "an empty list",
.rlang_stop_unexpected_typeof(x)
)
}


vec_type_friendly <- function(x, length = FALSE) {
if (!rlang::is_vector(x)) {
rlang::abort("`x` must be a vector.")
Expand Down Expand Up @@ -196,8 +213,7 @@ vec_type_friendly <- function(x, length = FALSE) {
}
}

type <- switch(
type,
type <- switch(type,
logical = "a logical %s",
integer = "an integer %s",
numeric = ,
Expand Down Expand Up @@ -225,34 +241,27 @@ vec_type_friendly <- function(x, length = FALSE) {
}

.rlang_as_friendly_type <- function(type) {
switch(
type,

switch(type,
list = "a list",

NULL = "`NULL`",
environment = "an environment",
externalptr = "a pointer",
weakref = "a weak reference",
S4 = "an S4 object",

name = ,
symbol = "a symbol",
language = "a call",
pairlist = "a pairlist node",
expression = "an expression vector",

char = "an internal string",
promise = "an internal promise",
... = "an internal dots object",
any = "an internal `any` object",
bytecode = "an internal bytecode object",

primitive = ,
builtin = ,
special = "a primitive function",
closure = "a function",

type
)
}
Expand Down Expand Up @@ -296,16 +305,14 @@ obj_type_oo <- function(x) {
#' @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 = rlang::caller_arg(x),
call = rlang::caller_env()
) {
stop_input_type <- function(x,
what,
...,
allow_na = FALSE,
allow_null = FALSE,
show_value = TRUE,
arg = rlang::caller_arg(x),
call = rlang::caller_env()) {
# From standalone-cli.R
cli <- rlang::env_get_list(
nms = c("format_arg", "format_code"),
Expand Down
Loading

0 comments on commit 31a0f46

Please sign in to comment.