From fc531d4bf3599efd5943486ed913f54f5af86e1e Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 11 Jul 2024 22:03:12 -0400 Subject: [PATCH 1/6] Remove unused `dt_col_merge_init()` --- R/dt_cols_merge.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/dt_cols_merge.R b/R/dt_cols_merge.R index 822a02efb8..41a0f526c5 100644 --- a/R/dt_cols_merge.R +++ b/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) From 74a90e5aacbe7ed11297901dc8c80612ed7f553e Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 11 Jul 2024 22:41:31 -0400 Subject: [PATCH 2/6] Refactor all text transforming functions to use `text_transform_impl()` for better stack trace. --- R/text_transform.R | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/R/text_transform.R b/R/text_transform.R index 519c411163..c59a9ac11e 100644 --- a/R/text_transform.R +++ b/R/text_transform.R @@ -108,7 +108,7 @@ text_replace <- function( # Perform input object validation stop_if_not_gt_tbl(data = data) - text_transform( + text_transform_impl( data = data, locations = locations, fn = function(x) { @@ -217,7 +217,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 +383,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,6 +602,17 @@ 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) From b5e6972b05f226a61a8d3fc2f39af680d025d345 Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 11 Jul 2024 22:48:14 -0400 Subject: [PATCH 3/6] inherit docs from main function --- R/text_transform.R | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/R/text_transform.R b/R/text_transform.R index c59a9ac11e..dae816dc07 100644 --- a/R/text_transform.R +++ b/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:` // **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` // **required** @@ -130,13 +123,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:` // **required** -#' -#' This is the **gt** table object that is commonly created through use of the -#' [gt()] function. -#' #' @param ... *Matching expressions* #' #' `` // **required** From 2167c745b0f99a789b8e869315a7928f6304987c Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 11 Jul 2024 22:49:54 -0400 Subject: [PATCH 4/6] Improve stack trace + add test for `text_*()` functions `locations` error messages. --- .Rbuildignore | 2 ++ NEWS.md | 2 ++ R/location_methods.R | 20 ++++++++++++++------ R/text_transform.R | 7 ++++++- tests/testthat/_snaps/text_transform.md | 11 +++++++++++ tests/testthat/test-text_transform.R | 22 ++++++++++++++++++++++ 6 files changed, 57 insertions(+), 7 deletions(-) create mode 100644 tests/testthat/_snaps/text_transform.md diff --git a/.Rbuildignore b/.Rbuildignore index ce0c08d108..92cf250ba0 100644 --- a/.Rbuildignore +++ b/.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 diff --git a/NEWS.md b/NEWS.md index 497221b44e..35da89e042 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # gt (development version) +* Improved error messages for the `text_transform()` functions if `locations` couldn't be resolved (@olivroy, #1774). + # gt 0.11.0 ## New features diff --git a/R/location_methods.R b/R/location_methods.R index ac86ca486a..6ed8a5bc74 100644 --- a/R/location_methods.R +++ b/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 diff --git a/R/text_transform.R b/R/text_transform.R index dae816dc07..f4fe91a9ab 100644 --- a/R/text_transform.R +++ b/R/text_transform.R @@ -606,7 +606,12 @@ text_transform_impl <- function(data, fn, locations, call = rlang::caller_env()) # 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 diff --git a/tests/testthat/_snaps/text_transform.md b/tests/testthat/_snaps/text_transform.md new file mode 100644 index 0000000000..479c6f3bbb --- /dev/null +++ b/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. + diff --git a/tests/testthat/test-text_transform.R b/tests/testthat/test-text_transform.R index f290f7f108..9101142ffe 100644 --- a/tests/testthat/test-text_transform.R +++ b/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 From 41b6fcef9c174a78ac7529b547af06a88a55e771 Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 11 Jul 2024 22:50:25 -0400 Subject: [PATCH 5/6] Validate input with `check_string()` in `text_replace()` to avoid warnings. --- R/text_transform.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/text_transform.R b/R/text_transform.R index f4fe91a9ab..16a3276a65 100644 --- a/R/text_transform.R +++ b/R/text_transform.R @@ -101,6 +101,10 @@ text_replace <- function( # Perform input object validation stop_if_not_gt_tbl(data = data) + # 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, From 7298e16471226a36c041aaa085e7beab3cb21da9 Mon Sep 17 00:00:00 2001 From: olivroy Date: Thu, 11 Jul 2024 22:50:48 -0400 Subject: [PATCH 6/6] Add more tests to improve coverage. --- tests/testthat/test-text_transform.R | 34 ++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/testthat/test-text_transform.R b/tests/testthat/test-text_transform.R index 9101142ffe..0f2e31a879 100644 --- a/tests/testthat/test-text_transform.R +++ b/tests/testthat/test-text_transform.R @@ -436,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, + "---" + ) +})