Improve text_*() error messages

.Rbuildignore

@@ -171,6 +171,8 @@ tests/testthat/test-table_parts.R
 tests/testthat/_snaps/table_parts.md
 
 tests/testthat/test-text_transform.R
+tests/testthat/_snaps/text_transform.md
+
 tests/testthat/test-util_functions.R
 tests/testthat/test-utils_formatters.R
 tests/testthat/test-utils_plots.R

NEWS.md

@@ -1,5 +1,7 @@
 # gt (development version)
 
+* Improved error messages for the `text_transform()` function if `locations` couldn't be resolved. (@olivroy, #1774)
+
 * `tab_row_group()` gives a more precise error message when `rows` can't be resolved correctly (#1535). (@olivroy, #1770)
 
 * Fixed an issue where `md("")` would fail in Quarto. (@olivroy, #1769)

R/dt_cols_merge.R

@@ -32,10 +32,6 @@ dt_col_merge_set <- function(data, col_merge) {
   dt__set(data, .dt_col_merge_key, col_merge)
 }
 
-dt_col_merge_init <- function(data) {
-  dt_col_merge_set(data = data, col_merge = list())
-}
-
 dt_col_merge_add <- function(data, col_merge) {
   added <- append(dt_col_merge_get(data = data), list(col_merge))
   dt_col_merge_set(data = data, col_merge = added)

R/location_methods.R

@@ -286,16 +286,19 @@ resolve_location.resolved <- function(loc, data) {
 #' @export
 resolve_location.cells_body <- function(loc, data) {
 
+  call <- call("cells_body")
   loc$colnames <-
     resolve_cols_c(
       expr = !!loc[["columns"]],
-      data = data
+      data = data,
+      call = call
     )
 
   loc$rows <-
     resolve_rows_i(
       expr = !!loc[["rows"]],
-      data = data
+      data = data,
+      call = call
     )
 
   class(loc) <- c("resolved", class(loc))
@@ -305,12 +308,14 @@ resolve_location.cells_body <- function(loc, data) {
 #' @export
 resolve_location.cells_column_labels <- function(loc, data) {
 
+  call <- call("cells_column_labels")
   if (!is.null(loc$columns)) {
 
     loc$colnames <-
       resolve_cols_c(
         expr = !!loc[["columns"]],
-        data = data
+        data = data,
+        call = call
       )
   }
 
@@ -326,7 +331,8 @@ resolve_location.cells_column_labels <- function(loc, data) {
 #' @export
 resolve_location.cells_column_spanners <- function(loc, data) {
 
-  resolved <- resolve_cells_column_spanners(data = data, object = loc)
+  call <- call("cells_column_spanners")
+  resolved <- resolve_cells_column_spanners(data = data, object = loc, call = call)
 
   loc$spanners <- resolved$spanners
 
@@ -338,7 +344,8 @@ resolve_location.cells_column_spanners <- function(loc, data) {
 #' @export
 resolve_location.cells_stub <- function(loc, data) {
 
-  resolved <- resolve_cells_stub(data = data, object = loc)
+  call <- call("cells_stub")
+  resolved <- resolve_cells_stub(data = data, object = loc, call = call)
 
   loc$rows <- resolved$rows
 
@@ -350,7 +357,8 @@ resolve_location.cells_stub <- function(loc, data) {
 #' @export
 resolve_location.cells_row_groups <- function(loc, data) {
 
-  resolved <- resolve_cells_row_groups(data = data, object = loc)
+  call <- call("cells_row_groups")
+  resolved <- resolve_cells_row_groups(data = data, object = loc, call = call)
 
   loc$groups <- resolved$groups
 

R/text_transform.R

@@ -32,13 +32,6 @@
 #' remaining two values to supply are for the regex pattern (`pattern`) and the
 #' replacement for all matched text (`replacement`).
 #'
-#' @param data *The gt table data object*
-#'
-#'   `obj:<gt_tbl>` // **required**
-#'
-#'   This is the **gt** table object that is commonly created through use of the
-#'   [gt()] function.
-#'
 #' @param pattern *Regex pattern to match with*
 #'
 #'   `scalar<character>` // **required**
@@ -108,7 +101,11 @@ text_replace <- function(
   # Perform input object validation
   stop_if_not_gt_tbl(data = data)
 
-  text_transform(
+  # Validate input
+  check_string(pattern, allow_empty = FALSE, allow_na = TRUE)
+  check_string(replacement, allow_empty = TRUE, allow_na = FALSE)
+
+  text_transform_impl(
     data = data,
     locations = locations,
     fn = function(x) {
@@ -130,13 +127,6 @@ text_replace <- function(
 #' (i.e., either `TRUE` or `FALSE`). To refer to the values undergoing
 #' transformation, you need to use the `x` variable.
 #'
-#' @param .data *The gt table data object*
-#'
-#'   `obj:<gt_tbl>` // **required**
-#'
-#'   This is the **gt** table object that is commonly created through use of the
-#'   [gt()] function.
-#'
 #' @param ... *Matching expressions*
 #'
 #'   `<multiple expressions>` // **required**
@@ -217,7 +207,7 @@ text_case_when <- function(
   # TODO: check that the modernized version of the `case_when()`
   # function is available in the user's version of dplyr
 
-  text_transform(
+  text_transform_impl(
     data = .data,
     locations = .locations,
     fn = function(x) {
@@ -383,10 +373,9 @@ text_case_match <- function(
   # TODO: perform some basic checking of `...` and stop function
   # should issues arise
 
-  # TODO: check that the `case_match()` function is available in
-  # the user's version of dplyr
+  # We rely on dplyr 1.1 (where case_match() was introduced)
 
-  text_transform(
+  text_transform_impl(
     data = .data,
     locations = .locations,
     fn = function(x) {
@@ -603,14 +592,30 @@ text_transform <- function(
 
   # Perform input object validation
   stop_if_not_gt_tbl(data = data)
+  rlang::check_required(fn)
+
+  text_transform_impl(
+    data,
+    fn,
+    locations
+  )
+}
+
+# Helper function to create text_*()
+text_transform_impl <- function(data, fn, locations, call = rlang::caller_env()) {
 
   # Resolve into a list of locations
   locations <- as_locations(locations = locations)
 
   # For all of the resolved locations, store the transforms
   # for later execution
   for (loc in locations) {
-    data <- dt_transforms_add(data = data, loc = loc, fn = fn)
+    withCallingHandlers(
+      # Personalize call if text_case_match() or other.
+      data <- dt_transforms_add(data = data, loc = loc, fn = fn),
+      error = function(e) {
+        cli::cli_abort("Failed to resolve location.", parent = e, call = call)
+      })
   }
 
   data

tests/testthat/_snaps/text_transform.md

@@ -0,0 +1,11 @@
+# text_case_match() works on the tab_spanner()
+
+    Code
+      gt_tbl %>% text_case_match("boring " ~ "awesome ", .replace = "partial",
+      .locations = cells_column_spanners(2))
+    Condition
+      Error in `text_case_match()`:
+      ! Failed to resolve location.
+      Caused by error in `cells_column_spanners()`:
+      ! Spanner 2 does not exist in the data.
+

tests/testthat/test-text_transform.R

@@ -318,6 +318,28 @@ test_that("text_transform() works on row labels in the stub", {
     )
 })
 
+test_that("text_case_match() works on the tab_spanner()", {
+  gt_tbl <- exibble %>% gt() %>% tab_spanner("the boring spanner", columns = c(num, date))
+  expect_snapshot(error = TRUE, {
+    gt_tbl %>%
+      text_case_match(
+        "boring " ~ "awesome ",
+        .replace = "partial",
+        .locations = cells_column_spanners(2)
+      )
+  })
+  expect_no_error(new_tb <- gt_tbl %>%
+    text_case_match(
+      "boring " ~ "awesome ",
+      .replace = "partial",
+      .locations = cells_column_spanners()
+    ))
+  expect_match_html(
+     new_tb,
+     "awesome spanner"
+  )
+})
+
 test_that("text_transform() works on row group labels", {
 
   # Create a gt table and modify the two different
@@ -414,3 +436,37 @@ test_that("text_transform() works on row group labels", {
     selection_text("[class='gt_group_heading']") %>%
     expect_equal(c("SUPER POWERFUL", "POWERFUL"))
 })
+
+
+# text_*() other functions -----------------------------------------------------
+
+test_that("text_case_when() + text_case_match() work", {
+  expect_no_error(
+    cw <- exibble %>%
+      gt() %>%
+      text_case_when(is.na(x) ~ "---")
+  )
+  # md is not really respected even if we use md("---")
+  expect_no_error(
+    cm <- exibble %>%
+      gt() %>%
+      text_case_match(NA ~ "---")
+  )
+  # they are not changing numeric NA
+  expect_equal(
+    render_as_html(cw),
+    render_as_html(cm)
+  )
+})
+
+test_that("text_replace() works", {
+  expect_no_error(
+    tr <- exibble %>%
+      gt() %>%
+      text_replace("NA", "---")
+  )
+  expect_match_html(
+    tr,
+    "---"
+  )
+})