Skip to content

Commit

Permalink
Clean up error messages
Browse files Browse the repository at this point in the history
  • Loading branch information
@alexpeters1208
alexpeters1208 committed Sep 20, 2023
1 parent 92d47de commit 0e60509
Show file tree
Hide file tree
Showing 8 changed files with 178 additions and 144 deletions.
2 changes: 1 addition & 1 deletion R/rdeephaven/DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,6 @@ License: Apache License (== 2.0)
Depends: R (>= 3.5.3), Rcpp (>= 1.0.10), arrow (>= 12.0.0), R6 (>= 2.5.0), dplyr (>= 1.1.0)
Imports: Rcpp (>= 1.0.10), R6 (>= 2.5.0), dplyr (>= 1.1.0)
LinkingTo: Rcpp
Suggests: testthat (>= 3.0.0)
Suggests: testthat (>= 3.0.0), lubridate (>= 1.9.0), zoo (>= 1.8-0)
Config/testthat/edition: 3
RoxygenNote: 7.2.3
2 changes: 1 addition & 1 deletion R/rdeephaven/R/client_wrapper.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ Client <- R6Class("Client",
#' Initializes a Client object using a pointer to an existing client connection.
#' @param xptr External pointer to an existing client connection.
initialize_for_xptr = function(xptr) {
verify_type("xptr", xptr, "externalptr", "XPtr", TRUE)
verify_type("xptr", xptr, TRUE, "externalptr", "an XPtr")
self$.internal_rcpp_object = new(INTERNAL_Client, xptr)
},

Expand Down
10 changes: 5 additions & 5 deletions R/rdeephaven/R/table_handle_wrapper.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ TableHandle <- R6Class("TableHandle",
if (length(table_list) == 0) {
return(self)
}
verify_type("table_list", table_list, "TableHandle", "Deephaven TableHandle", FALSE)
verify_type("table_list", table_list, FALSE, "TableHandle", "a Deephaven TableHandle")
unwrapped_table_list <- lapply(table_list, strip_r6_wrapping)
return(TableHandle$new(self$.internal_rcpp_object$merge(unwrapped_table_list)))
},
Expand Down Expand Up @@ -221,7 +221,7 @@ TableHandle <- R6Class("TableHandle",
#' @param by String or list of strings denoting the names of the columns to group by.
#' @return A TableHandle referencing the new table.
update_by = function(ops, by = character()) {
verify_type("ops", ops, "UpdateByOp", "Deephaven UpdateByOp", FALSE)
verify_type("ops", ops, FALSE, "UpdateByOp", "a Deephaven UpdateByOp")
verify_string("by", by, FALSE)
ops <- c(ops)
unwrapped_ops <- lapply(ops, strip_r6_wrapping)
Expand All @@ -235,7 +235,7 @@ TableHandle <- R6Class("TableHandle",
#' @param by String or list of strings denoting the names of the columns to group by.
#' @return A TableHandle referencing the new table.
agg_by = function(aggs, by = character()) {
verify_type("aggs", aggs, "AggOp", "Deephaven AggOp", FALSE)
verify_type("aggs", aggs, FALSE, "AggOp", "a Deephaven AggOp")
verify_string("by", by, FALSE)
aggs <- c(aggs)
for (i in 1:length(aggs)) {
Expand All @@ -256,7 +256,7 @@ TableHandle <- R6Class("TableHandle",
#' @param by String or list of strings denoting the names of the columns to group by.
#' @return A TableHandle referencing the new table.
agg_all_by = function(agg, by = character()) {
verify_type("agg", agg, "Aggregation", "Deephaven Aggregation", TRUE)
verify_type("agg", agg, TRUE, "AggOp", "a Deephaven AggOp")
return(TableHandle$new(self$.internal_rcpp_object$agg_all_by(agg$.internal_rcpp_object, by)))
},

Expand Down Expand Up @@ -507,7 +507,7 @@ merge_tables <- function(...) {
if (length(table_list) == 0) {
return(NULL)
}
verify_type("table_list", table_list, "TableHandle", "Deephaven TableHandle", FALSE)
verify_type("table_list", table_list, FALSE, "TableHandle", "Deephaven TableHandle")
if (length(table_list) == 1) {
return(table_list[[1]])
}
Expand Down
30 changes: 15 additions & 15 deletions R/rdeephaven/R/update_by_ops_wrapper.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,9 +104,9 @@ udb_delta <- function(cols = character(), delta_control = "null_dominates") {
#' @param operation_control OperationControl that defines how special cases will behave. See `?OperationControl` for more information.
#' @export
udb_ema_tick <- function(decay_ticks, cols = character(), operation_control = op_control()) {
verify_numeric("decay_ticks", decay_ticks, TRUE)
verify_real("decay_ticks", decay_ticks, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_ema_tick(decay_ticks, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -125,7 +125,7 @@ udb_ema_time <- function(ts_col, decay_time, cols = character(), operation_contr
verify_string("ts_col", ts_col, TRUE)
verify_string("decay_time", decay_time, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_ema_time(ts_col, decay_time, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -140,9 +140,9 @@ udb_ema_time <- function(ts_col, decay_time, cols = character(), operation_contr
#' @param operation_control OperationControl that defines how special cases will behave. See `?OperationControl` for more information.
#' @export
udb_ems_tick <- function(decay_ticks, cols = character(), operation_control = op_control()) {
verify_numeric("decay_ticks", decay_ticks, TRUE)
verify_real("decay_ticks", decay_ticks, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_ems_tick(decay_ticks, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -161,7 +161,7 @@ udb_ems_time <- function(ts_col, decay_time, cols = character(), operation_contr
verify_string("ts_col", ts_col, TRUE)
verify_string("decay_time", decay_time, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_ems_time(ts_col, decay_time, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -176,9 +176,9 @@ udb_ems_time <- function(ts_col, decay_time, cols = character(), operation_contr
#' @param operation_control OperationControl that defines how special cases will behave. See `?OperationControl` for more information.
#' @export
udb_emmin_tick <- function(decay_ticks, cols = character(), operation_control = op_control()) {
verify_numeric("decay_ticks", decay_ticks, TRUE)
verify_real("decay_ticks", decay_ticks, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_emmin_tick(decay_ticks, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -197,7 +197,7 @@ udb_emmin_time <- function(ts_col, decay_time, cols = character(), operation_con
verify_string("ts_col", ts_col, TRUE)
verify_string("decay_time", decay_time, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_emmin_time(ts_col, decay_time, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -212,9 +212,9 @@ udb_emmin_time <- function(ts_col, decay_time, cols = character(), operation_con
#' @param operation_control OperationControl that defines how special cases will behave. See `?OperationControl` for more information.
#' @export
udb_emmax_tick <- function(decay_ticks, cols = character(), operation_control = op_control()) {
verify_numeric("decay_ticks", decay_ticks, TRUE)
verify_real("decay_ticks", decay_ticks, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_emmax_tick(decay_ticks, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -233,7 +233,7 @@ udb_emmax_time <- function(ts_col, decay_time, cols = character(), operation_con
verify_string("ts_col", ts_col, TRUE)
verify_string("decay_time", decay_time, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_emmax_time(ts_col, decay_time, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -250,9 +250,9 @@ udb_emmax_time <- function(ts_col, decay_time, cols = character(), operation_con
#' @param operation_control OperationControl that defines how special cases will behave. See `?OperationControl` for more information.
#' @export
udb_emstd_tick <- function(decay_ticks, cols = character(), operation_control = op_control()) {
verify_numeric("decay_ticks", decay_ticks, TRUE)
verify_real("decay_ticks", decay_ticks, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_emstd_tick(decay_ticks, cols, operation_control$.internal_rcpp_object)))
}

Expand All @@ -273,7 +273,7 @@ udb_emstd_time <- function(ts_col, decay_time, cols = character(), operation_con
verify_string("ts_col", ts_col, TRUE)
verify_string("decay_time", decay_time, TRUE)
verify_string("cols", cols, FALSE)
verify_type("operation_control", operation_control, "OperationControl", "Deephaven OperationControl", TRUE)
verify_type("operation_control", operation_control, TRUE, "OperationControl", "a Deephaven OperationControl")
return(UpdateByOp$new(INTERNAL_emstd_time(ts_col, decay_time, cols, operation_control$.internal_rcpp_object)))
}

Expand Down
122 changes: 78 additions & 44 deletions R/rdeephaven/R/utility_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,62 +2,110 @@ first_class <- function(arg) {
return(class(arg)[[1]])
}

vector_wrong_element_type_or_value <- function(arg_name, candidate, type_message, stripped_type_message, descriptor_message) {
return(paste0("'", arg_name, "' must be ", type_message, ", or a vector of ", stripped_type_message, "s", descriptor_message, ". Got a vector with at least one element that is not ", type_message, descriptor_message, "."))
}
vector_wrong_type <- function(arg_name, candidate, type_message, stripped_type_message, descriptor_message) {
return(paste0("'", arg_name, "' must be ", type_message, " or a vector of ", stripped_type_message, "s", descriptor_message, ". Got an object of class ", first_class(candidate), "."))
}
vector_needed_scalar <- function(arg_name, candidate, type_message, stripped_type_message, descriptor_message) {
return(paste0("'", arg_name, "' must be a single ", stripped_type_message, descriptor_message, ". Got a vector of length ", length(candidate), "."))
}
scalar_wrong_type <- function(arg_name, candidate, type_message, stripped_type_message, descriptor_message) {
return(paste0("'", arg_name, "' must be a single ", stripped_type_message, descriptor_message, ". Got an object of class ", first_class(candidate), "."))
}
scalar_wrong_value <- function(arg_name, candidate, stripped_type_message, descriptor_message) {
return(paste0("'", arg_name, "' must be a single ", stripped_type_message, descriptor_message, ". Got '", arg_name, "' = ", candidate, "."))
}

# if required_type is a list, this will not behave correctly because of R's type coercion rules
verify_type <- function(arg_name, candidate, required_type, message_type_name, is_scalar) {
verify_type <- function(arg_name, candidate, is_scalar, required_type, type_message, descriptor_message = "") {

# first, strip article from type_message for use in error type_messages later
stripped_type_message = sub(".*? ", "", type_message)

if (!is_scalar && (first_class(candidate) == "list")) {
if (any(lapply(candidate, first_class) != required_type)) {
stop(paste0("'", arg_name, "' must be a ", message_type_name, ", or a vector of ", message_type_name, "s. Got a vector with at least one element that is not a ", message_type_name, "."))
stop(vector_wrong_element_type_or_value(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
}
} else if (is_scalar && (first_class(candidate) == "list")) {
if (first_class(candidate[[1]]) != required_type) {
stop(paste0("'", arg_name, "' must be a single ", message_type_name, ". Got an object of class ", first_class(candidate), "."))
stop(scalar_wrong_type(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
} else if (length(candidate) != 1) {
stop(paste0("'", arg_name, "' must be a single ", message_type_name, ". Got a vector of length ", length(candidate), "."))
stop(vector_needed_scalar(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
}
} else if (first_class(candidate) != required_type) {
if (!is_scalar) {
stop(paste0("'", arg_name, "' must be a ", message_type_name, " or a vector of ", message_type_name, "s. Got an object of class ", first_class(candidate), "."))
stop(vector_wrong_type(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
} else {
stop(paste0("'", arg_name, "' must be a single ", message_type_name, ". Got an object of class ", first_class(candidate), "."))
stop(scalar_wrong_type(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
}
} else if (is_scalar && (length(c(candidate)) != 1)) {
stop(paste0("'", arg_name, "' must be a single ", message_type_name, ". Got a vector of length ", length(candidate), "."))
stop(vector_needed_scalar(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
}
}

# does not attempt to verify that candidate is numeric
verify_in_range <- function(arg_name, candidate, message, lb, ub, lb_open, ub_open) {
if (((!is.null(lb)) && ((any(candidate <= lb) && (lb_open)) || (any(candidate < lb) && (!lb_open)))) ||
((!is.null(ub)) && ((any(candidate >= ub) && (ub_open)) || (any(candidate > ub) && (!ub_open))))) {
if (length(candidate) == 1) {
stop(paste0("'", arg_name, "' must be ", message, ". Got '", arg_name, "' = ", candidate, "."))
# does not attempt to verify that candidate is numeric, intended to be used after `verify_type()`
verify_int <- function(arg_name, candidate, is_scalar, type_message, descriptor_message = "") {

# first, strip article from type_message for use in error type_messages later
stripped_type_message = sub(".*? ", "", type_message)

if (is_scalar && (length(c(candidate)) != 1)) {
stop(vector_needed_scalar(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
} else if (candidate != as.integer(candidate)) {
if (!is_scalar) {
stop(vector_wrong_element_type_or_value(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
} else {
stop(paste0("Every element of '", arg_name, "' must be ", message, ". Got at least one element that is not ", message, "."))
stop(scalar_wrong_value(arg_name, candidate, stripped_type_message, descriptor_message))
}
}
}

# does not attempt to verify that candidate is numeric
verify_int <- function(arg_name, candidate) {
if (candidate != as.integer(candidate)) {
if (length(candidate == 1)) {
stop(paste0("'", arg_name, "' must be an integer. Got '", arg_name, "' = ", candidate, "."))
# does not attempt to verify that candidate is numeric, intended to be used after `verify_type()`
verify_in_range <- function(arg_name, candidate, is_scalar, type_message, descriptor_message, lb, ub, lb_open, ub_open) {

# first, strip article from message for use in error messages later
stripped_type_message = sub(".*? ", "", type_message)

if (is_scalar && (length(c(candidate)) != 1)) {
stop(paste0("Every element of '", arg_name, "' must be ", stripped_type_message, range_message, ". Got at least one element that is not ", stripped_type_message, range_message, "."))
}
else if (((!is.null(lb)) && ((any(candidate <= lb) && (lb_open)) || (any(candidate < lb) && (!lb_open)))) ||
((!is.null(ub)) && ((any(candidate >= ub) && (ub_open)) || (any(candidate > ub) && (!ub_open))))) {

if (!is_scalar) {
stop(vector_wrong_element_type_or_value(arg_name, candidate, type_message, stripped_type_message, descriptor_message))
} else {
stop(paste0("Every element of '", arg_name, "' must be an integer. Got at least one non-integer element."))
stop(scalar_wrong_value(arg_name, candidate, stripped_type_message, descriptor_message))
}
}
}

verify_string <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, "character", "string", is_scalar)
verify_real <- function(arg_name, candidate, is_scalar, descriptor_message = "") {
verify_type(arg_name, candidate, is_scalar, "numeric", "a real number", descriptor_message)
}

verify_bool <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, "logical", "boolean", is_scalar)
verify_any_int <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, is_scalar, "numeric", "an integer")
verify_int(arg_name, candidate, is_scalar, "an integer")
}

verify_nonnegative_int <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, is_scalar, "numeric", "a non-negative integer")
verify_int(arg_name, candidate, is_scalar, "a non-negative integer")
verify_in_range(arg_name, candidate, is_scalar, "a non-negative integer", "", lb = 0, ub = NULL, lb_open = FALSE, ub_open = TRUE)
}

verify_numeric <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, "numeric", "numeric", is_scalar)
verify_positive_int <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, is_scalar, "numeric", "a positive integer")
verify_int(arg_name, candidate, is_scalar, "a positive integer")
verify_in_range(arg_name, candidate, is_scalar, "a positive integer", "", lb = 0, ub = NULL, lb_open = TRUE, ub_open = TRUE)
}

verify_in_unit_interval <- function(arg_name, candidate, is_scalar) {
verify_real(arg_name, candidate, is_scalar, " between 0 and 1 inclusive")
verify_in_range(arg_name, candidate, is_scalar, "a real number", " between 0 and 1 inclusive", lb = 0, ub = 1, lb_open = FALSE, ub_open = FALSE)
}

verify_named_list <- function(arg_name, candidate) {
Expand All @@ -68,26 +116,12 @@ verify_named_list <- function(arg_name, candidate) {
}
}

verify_in_unit_interval <- function(arg_name, candidate, is_scalar) {
verify_numeric(arg_name, candidate, is_scalar)
verify_in_range(arg_name, candidate, message = "between 0 and 1 inclusive", lb = 0, ub = 1, lb_open = FALSE, ub_open = FALSE)
}

verify_any_int <- function(arg_name, candidate, is_scalar) {
verify_numeric(arg_name, candidate, is_scalar)
verify_int(arg_name, candidate)
}

verify_nonnegative_int <- function(arg_name, candidate, is_scalar) {
verify_numeric(arg_name, candidate, is_scalar)
verify_int(arg_name, candidate)
verify_in_range(arg_name, candidate, message = "a nonnegative integer", lb = 0, ub = NULL, lb_open = FALSE, ub_open = TRUE)
verify_string <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, is_scalar, "character", "a string")
}

verify_positive_int <- function(arg_name, candidate, is_scalar) {
verify_numeric(arg_name, candidate, is_scalar)
verify_int(arg_name, candidate)
verify_in_range(arg_name, candidate, message = "a positive integer", lb = 0, ub = NULL, lb_open = TRUE, ub_open = TRUE)
verify_bool <- function(arg_name, candidate, is_scalar) {
verify_type(arg_name, candidate, is_scalar, "logical", "a boolean")
}

strip_r6_wrapping <- function(r6_object) {
Expand Down
Loading

0 comments on commit 0e60509

Please sign in to comment.