Give informative errors calls in apply_to_each() and apply_to_each_col()

Author: iofarm

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: qualifyr
 Type: Package
 Title: Validate Relational Data Structures
-Version: 0.1.0.9006
+Version: 0.1.0.9007
 Authors@R: c(
     person(
       "Ian", "Farm",

R/qf_constraint.R

@@ -255,26 +255,30 @@ NULL
 #'
 #' @export
 apply_to_each <- function(.cstr, ..., .args = list()) {
+  call <- sys.call()
   check_arg_type(.cstr, "function")
   check_arg_type(.args, "list")
   col_specs <- rlang::enquos(...)
-  constraint_specs <- purrr::map(col_specs, \(spec)
-    rlang::eval_tidy(rlang::expr(
-      (.cstr)(!!spec, !!!.args)
+  constraint_specs <- purrr::map(col_specs, \(col_spec) {
+    cstr_spec <- rlang::eval_tidy(rlang::expr(
+      (.cstr)(!!col_spec, !!!.args)
     ))
-  )
+    environment(cstr_spec)$call <- call
+    cstr_spec
+  })
   as_qf_constraint_list(constraint_specs)
 }
 
 #' @rdname apply_to_each
 #' @export
 apply_to_each_col <- function(.cstr, .cols, .args = list()) {
+  call <- sys.call()
   check_arg_type(.cstr, "function")
   check_arg_type(.args, "list")
   col_specs <- rlang::enquo(.cols)
 
   new_qf_constraint_specifier({
-    cols <- select_names(col_specs, .table)
+    cols <- select_names(col_specs, .table, error_call = call)
     constraint_objs <- purrr::map(cols, \(col) {
       f <- do.call(.cstr, c(list(col), .args))
       (f)(.table)

tests/testthat/test-qf_constraint.R

@@ -181,12 +181,22 @@ test_that("eval_select() errors have informative calls", {
       cstr_primary_key(tailnumber) # wrong column name
   })
 
-  expect_equal(
-    e$call[[1]],
-    quote(`constraints<-`)
-  )
-  expect_equal(
-    e$parent$call[[1]],
-    quote(cstr_primary_key)
-  )
+  expect_equal(e$call[[1]], quote(`constraints<-`))
+  expect_equal(e$parent$call[[1]], quote(cstr_primary_key))
+})
+
+test_that("apply_to_each() and apply_to_each_col() have informative error calls", {
+  dset1 <- example_dataset(constrained = FALSE)
+  e1 <- rlang::catch_cnd({
+    constraints(dset1$planes) <-
+      cstr_not_missing |> apply_to_each(year, type, mfr, model) # `mfr` is wrong
+  })
+  expect_equal(e1$parent$call[[1]], quote(apply_to_each))
+
+  dset2 <- example_dataset(constrained = FALSE)
+  e2 <- rlang::catch_cnd({
+    constraints(dset2$planes) <-
+      cstr_not_missing |> apply_to_each_col(c(year, type, mfr, model)) # `mfr` is wrong
+  })
+  expect_equal(e2$parent$call[[1]], quote(apply_to_each_col))
 })