diff --git a/R/assignment-op.R b/R/assignment-op.R index 3571253..0a0c14b 100644 --- a/R/assignment-op.R +++ b/R/assignment-op.R @@ -180,18 +180,34 @@ return(invisible(value)) } - if (internals[1] == ':' && !(is.atomic(value) || is_Date(value))) { - stop('expecting vector of values, but found ', class(value), - call. = FALSE) - } + if (!all(internals == ":" | internals == "{")) { + name <- internals[which(!(internals == ":" | internals == "{"))][1] + stop( + "invalid `%<-%` left-hand side, unexpected call `", name, "`", + call. = FALSE + ) + } - # NULL as a value slips through here, bug or feature? - if (internals[1] == '{' && is.vector(value) && !is_list(value)) { - stop('expecting list of values, but found vector', call. = FALSE) - } + # + # only when unpacking an atomic or date are `{` and `}` not required + # + if (internals[1] == ":" && !(is.atomic(value) || is_Date(value))) { + stop( + "invalid `%<-%` right-hand side, expecting vector of values, ", + "but found ", class(value), + call. = FALSE + ) + } - } else { - stop('use `<-` for standard assignment', call. = FALSE) + # + # use `{`s only for non-vector values + # + if (internals[1] == "{" && is.vector(value) && !is_list(value)) { + stop( + "invalid `%<-%` right-hand side, expecting list of values, ", + "but found vector", + call. = FALSE + ) } lhs <- variables(ast) diff --git a/R/destructure.R b/R/destructure.R index 4e91801..db54055 100644 --- a/R/destructure.R +++ b/R/destructure.R @@ -135,12 +135,18 @@ destructure.summary.lm <- function(x) { #' @rdname destructure-methods #' @export destructure.default <- function(x) { - stop('cannot de-structure ', class(x), call. = FALSE) + stop( + "invalid `%<-%` right-hand side, incorrect number of values", + call. = FALSE + ) } assert_destruction <- function(x) { if (length(x) > 1) { - stop('cannot de-structure ', class(x), ' vector of length greater than 1', - call. = FALSE) + stop( + "invalid `destructure` argument, cannot de-structure ", class(x), + " vector of length greater than 1", + call. = FALSE + ) } } diff --git a/R/pair-off.R b/R/pair-off.R index 327e3a0..5a6418c 100644 --- a/R/pair-off.R +++ b/R/pair-off.R @@ -2,7 +2,7 @@ is_collector <- function(x) { if (!is.character(x)) { return(FALSE) } - grepl('^\\.\\.\\.', x) + grepl("^\\.\\.\\.", x) } has_collector <- function(x) { @@ -10,8 +10,8 @@ has_collector <- function(x) { } collect <- function(names, values) { - if (!any(grepl('^\\.\\.\\.', names))) { - stop('no collector variable specified', call. = FALSE) + if (!any(grepl("^\\.\\.\\.", names))) { + stop("no collector variable specified", call. = FALSE) } if (length(names) == length(values)) { @@ -26,14 +26,22 @@ collect <- function(names, values) { c_index <- which(grepl('^\\.\\.\\.', names)) if (length(c_index) != 1) { - stop('assignment ambiguity due to multiple collector variables at the same depth', - call. = FALSE) + stop( + "invalid `%<-%` left-hand side, multiple collector variables at the ", + "same depth", + call. = FALSE + ) } if (c_index == 1) { # ...firsts, a, b - post <- rev(seq.int(from = length(values), length.out = length(names) - 1, - by = -1)) + post <- rev( + seq.int( + from = length(values), + length.out = length(names) - 1, + by = -1 + ) + ) c(list(values[-post]), values[post]) } else if (c_index == length(names)) { @@ -44,8 +52,13 @@ collect <- function(names, values) { } else { # a, ...mid, b pre <- seq.int(1, c_index - 1) - post <- rev(seq.int(from = length(values), - length.out = length(names) - length(pre) - 1, by = -1)) + post <- rev( + seq.int( + from = length(values), + length.out = length(names) - length(pre) - 1, + by = -1 + ) + ) c(values[pre], list(values[-c(pre, post)]), values[post]) } @@ -53,7 +66,7 @@ collect <- function(names, values) { pair_off <- function(names, values) { if (is.character(names)) { - if (names == '.') { + if (names == ".") { return() }