Propagate call for error messages (#416)

Author: teunbrand

DESCRIPTION

@@ -39,4 +39,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 LazyLoad: yes
 Roxygen: list(markdown = TRUE, r6 = FALSE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2

R/range.R

@@ -18,9 +18,10 @@ DiscreteRange <- R6::R6Class(
   inherit = Range,
   list(
     factor = NULL,
-    train = function(x, drop = FALSE, na.rm = FALSE) {
+    train = function(x, drop = FALSE, na.rm = FALSE, call = caller_env()) {
       self$factor <- self$factor %||% is.factor(x)
-      self$range <- train_discrete(x, self$range, drop, na.rm, self$factor)
+      self$range <- train_discrete(x, self$range, drop, na.rm,
+                                   self$factor, call = call)
     },
     reset = function() {
       self$range <- NULL
@@ -35,7 +36,9 @@ ContinuousRange <- R6::R6Class(
   "ContinuousRange",
   inherit = Range,
   list(
-    train = function(x) self$range <- train_continuous(x, self$range),
+    train = function(x, call = caller_env()) {
+      self$range <- train_continuous(x, self$range, call = call)
+    },
     reset = function() self$range <- NULL
   )
 )

R/scale-continuous.R

@@ -37,13 +37,18 @@ cscale <- function(x, palette, na.value = NA_real_, trans = transform_identity()
 #'
 #' @inheritParams train_discrete
 #' @export
-train_continuous <- function(new, existing = NULL) {
+train_continuous <- function(new, existing = NULL, call = caller_env()) {
   if (is.null(new)) {
     return(existing)
   }
 
   if (is.factor(new) || !typeof(new) %in% c("integer", "double")) {
-    cli::cli_abort("Discrete value supplied to a continuous scale")
+    example <- unique(new)
+    example <- example[seq_len(pmin(length(example), 5))]
+    cli::cli_abort(c(
+      "Discrete value supplied to a continuous scale.",
+      i = "Example values: {.and {.val {example}}}."
+    ), call = call)
   }
 
   # Needs casting to numeric because some `new` vectors can misbehave when

R/scale-discrete.R

@@ -25,14 +25,20 @@ is.discrete <- function(x) {
 #' @param drop `TRUE`, will drop factor levels not associated with data
 #' @param na.rm If `TRUE`, will remove missing values
 #' @param fct Treat `existing` as if it came from a factor (ie. don't sort the range)
+#' @param call A call to display in error messages
 #' @export
-train_discrete <- function(new, existing = NULL, drop = FALSE, na.rm = FALSE, fct = NA) {
+train_discrete <- function(new, existing = NULL, drop = FALSE,
+                           na.rm = FALSE, fct = NA, call = caller_env()) {
   if (is.null(new)) {
     return(existing)
   }
-
   if (!is.discrete(new)) {
-    cli::cli_abort("Continuous value supplied to a discrete scale")
+    example <- unique(new)
+    example <- example[seq_len(pmin(length(example), 5))]
+    cli::cli_abort(c(
+      "Continuous value supplied to a discrete scale.",
+      i = "Example values: {.and {.val {example}}}."
+    ), call = call)
   }
   discrete_range(existing, new, drop = drop, na.rm = na.rm, fct = fct)
 }