Use chained errors for scalar location checks

Author: lionel-

R/subscript-loc.R

@@ -207,10 +207,10 @@ vec_as_location2_result <- function(i,
   i <- result$ok
 
   if (length(i) != 1L) {
-    return(result(err = new_error_location2_type(
+    return(result(err = new_chained_error_location2_type(
       i = i,
       subscript_arg = arg,
-      body = cnd_bullets_location2_need_scalar,
+      header = cnd_header_location2_need_scalar,
       call = call
     )))
   }
@@ -222,10 +222,10 @@ vec_as_location2_result <- function(i,
 
   if (is.na(i)) {
     if (!allow_missing && is.na(i)) {
-      result <- result(err = new_error_location2_type(
+      result <- result(err = new_chained_error_location2_type(
         i = i,
         subscript_arg = arg,
-        body = cnd_bullets_location2_need_present,
+        header = cnd_header_location2_need_present,
         call = call
       ))
     } else {
@@ -235,19 +235,19 @@ vec_as_location2_result <- function(i,
   }
 
   if (identical(i, 0L)) {
-    return(result(err = new_error_location2_type(
+    return(result(err = new_chained_error_location2_type(
       i = i,
       subscript_arg = arg,
-      body = cnd_bullets_location2_need_positive,
+      header = cnd_header_location2_need_positive,
       call = call
     )))
   }
 
   if (!allow_negative && neg) {
-    return(result(err = new_error_location2_type(
+    return(result(err = new_chained_error_location2_type(
       i = i,
       subscript_arg = arg,
-      body = cnd_bullets_location2_need_positive,
+      header = cnd_header_location2_need_positive,
       call = call
     )))
   }
@@ -288,24 +288,37 @@ new_error_location2_type <- function(i,
     ...
   )
 }
+new_chained_error_location2_type <- function(i,
+                                             ...,
+                                             header = NULL,
+                                             call = caller_env()) {
+  causal <- error_cnd(
+    i = i,
+    header = header,
+    ...,
+    call = NULL,
+    use_cli_format = TRUE
+  )
+  new_error_location2_type(
+    i = i,
+    ...,
+    body = function(...) chr(),
+    call = call,
+    parent = causal
+  )
+}
 
-cnd_bullets_location2_need_scalar <- function(cnd, ...) {
-  cnd$subscript_arg <- append_arg("Subscript", cnd$subscript_arg)
-  format_error_bullets(c(
-    x = glue::glue_data(cnd, "{subscript_arg} must be size 1, not {length(i)}.")
-  ))
+cnd_header_location2_need_scalar <- function(cnd, ...) {
+  cnd$subscript_arg <- cnd_subscript_arg(cnd)
+  glue::glue_data(cnd, "{subscript_arg} must be size 1, not {length(i)}.")
 }
-cnd_bullets_location2_need_present <- function(cnd, ...) {
-  cnd$subscript_arg <- append_arg("Subscript", cnd$subscript_arg)
-  format_error_bullets(c(
-    x = glue::glue_data(cnd, "{subscript_arg} must be a location, not {obj_type_friendly(i)}.")
-  ))
+cnd_header_location2_need_present <- function(cnd, ...) {
+  cnd$subscript_arg <- cnd_subscript_arg(cnd)
+  glue::glue_data(cnd, "{subscript_arg} must be a location, not {obj_type_friendly(i)}.")
 }
-cnd_bullets_location2_need_positive <- function(cnd, ...) {
-  cnd$subscript_arg <- append_arg("Subscript", cnd$subscript_arg)
-  format_error_bullets(c(
-    x = glue::glue_data(cnd, "{subscript_arg} must be a positive location, not {i}.")
-  ))
+cnd_header_location2_need_positive <- function(cnd, ...) {
+  cnd$subscript_arg <- cnd_subscript_arg(cnd)
+  glue::glue_data(cnd, "{subscript_arg} must be a positive location, not {i}.")
 }
 
 stop_location_negative_missing <- function(i, ..., call = caller_env()) {

tests/testthat/_snaps/subscript-loc.md

@@ -224,15 +224,17 @@
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't extract element with `1:2`.
-      x Subscript `1:2` must be size 1, not 2.
+      Caused by error:
+      ! `1:2` must be size 1, not 2.
     Code
       (expect_error(vec_as_location2(c("foo", "bar"), 2L, c("foo", "bar")), class = "vctrs_error_subscript_type")
       )
     Output
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't extract element with `c("foo", "bar")`.
-      x Subscript `c("foo", "bar")` must be size 1, not 2.
+      Caused by error:
+      ! `c("foo", "bar")` must be size 1, not 2.
     Code
       # Idem with custom `arg`
       (expect_error(vec_as_location2(1:2, 2L, arg = "foo", call = call("my_function")),
@@ -241,7 +243,8 @@
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be size 1, not 2.
+      Caused by error:
+      ! `foo` must be size 1, not 2.
     Code
       (expect_error(vec_as_location2(mtcars, 10L, arg = "foo", call = call(
         "my_function")), class = "vctrs_error_subscript_type"))
@@ -257,7 +260,8 @@
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be size 1, not 2.
+      Caused by error:
+      ! `foo` must be size 1, not 2.
 
 # vec_as_location2() requires positive integers
 
@@ -267,14 +271,16 @@
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't extract element with `0`.
-      x Subscript `0` must be a positive location, not 0.
+      Caused by error:
+      ! `0` must be a positive location, not 0.
     Code
       (expect_error(vec_as_location2(-1, 2L), class = "vctrs_error_subscript_type"))
     Output
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't extract element with `-1`.
-      x Subscript `-1` must be a positive location, not -1.
+      Caused by error:
+      ! `-1` must be a positive location, not -1.
     Code
       # Idem with custom `arg`
       (expect_error(vec_as_location2(0, 2L, arg = "foo", call = call("my_function")),
@@ -283,7 +289,8 @@
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be a positive location, not 0.
+      Caused by error:
+      ! `foo` must be a positive location, not 0.
 
 # vec_as_location2() fails with NA
 
@@ -294,15 +301,17 @@
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't extract element with `na_int`.
-      x Subscript `na_int` must be a location, not an integer `NA`.
+      Caused by error:
+      ! `na_int` must be a location, not an integer `NA`.
     Code
       (expect_error(vec_as_location2(na_chr, 1L, names = "foo"), class = "vctrs_error_subscript_type")
       )
     Output
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't extract element with `na_chr`.
-      x Subscript `na_chr` must be a location, not a character `NA`.
+      Caused by error:
+      ! `na_chr` must be a location, not a character `NA`.
     Code
       # Idem with custom `arg`
       (expect_error(vec_as_location2(na_int, 2L, arg = "foo", call = call(
@@ -311,7 +320,8 @@
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be a location, not an integer `NA`.
+      Caused by error:
+      ! `foo` must be a location, not an integer `NA`.
 
 # num_as_location() optionally forbids negative indices
 
@@ -744,31 +754,35 @@
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be a positive location, not -1.
+      Caused by error:
+      ! `foo` must be a positive location, not -1.
     Code
       (expect_error(vec_as_location2(0, 2, arg = "foo", call = call("my_function")),
       class = "vctrs_error_subscript_type"))
     Output
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be a positive location, not 0.
+      Caused by error:
+      ! `foo` must be a positive location, not 0.
     Code
       (expect_error(vec_as_location2(na_dbl, 2, arg = "foo", call = call(
         "my_function")), class = "vctrs_error_subscript_type"))
     Output
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be a location, not an integer `NA`.
+      Caused by error:
+      ! `foo` must be a location, not an integer `NA`.
     Code
       (expect_error(vec_as_location2(c(1, 2), 2, arg = "foo", call = call(
         "my_function")), class = "vctrs_error_subscript_type"))
     Output
       <error/vctrs_error_subscript_type>
       Error in `my_function()`:
       ! Can't extract element with `foo`.
-      x Subscript `foo` must be size 1, not 2.
+      Caused by error:
+      ! `foo` must be size 1, not 2.
     Code
       (expect_error(vec_as_location(c(TRUE, FALSE), 3, arg = "foo", call = call(
         "my_function")), class = "vctrs_error_subscript_size"))
@@ -833,31 +847,35 @@
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't rename column with `foo(bar)`.
-      x Subscript `foo(bar)` must be a positive location, not -1.
+      Caused by error:
+      ! `foo(bar)` must be a positive location, not -1.
     Code
       (expect_error(with_tibble_cols(vec_as_location2(0, 2)), class = "vctrs_error_subscript_type")
       )
     Output
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't rename column with `foo(bar)`.
-      x Subscript `foo(bar)` must be a positive location, not 0.
+      Caused by error:
+      ! `foo(bar)` must be a positive location, not 0.
     Code
       (expect_error(with_tibble_cols(vec_as_location2(na_dbl, 2)), class = "vctrs_error_subscript_type")
       )
     Output
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't rename column with `foo(bar)`.
-      x Subscript `foo(bar)` must be a location, not an integer `NA`.
+      Caused by error:
+      ! `foo(bar)` must be a location, not an integer `NA`.
     Code
       (expect_error(with_tibble_cols(vec_as_location2(c(1, 2), 2)), class = "vctrs_error_subscript_type")
       )
     Output
       <error/vctrs_error_subscript_type>
       Error:
       ! Can't rename column with `foo(bar)`.
-      x Subscript `foo(bar)` must be size 1, not 2.
+      Caused by error:
+      ! `foo(bar)` must be size 1, not 2.
     Code
       (expect_error(with_tibble_cols(vec_as_location(c(TRUE, FALSE), 3)), class = "vctrs_error_subscript_size")
       )