Merge pull request #1890 from olivroy/error-msg

improve cols_merge error message with bad pattern

R/utils_render_common.R

@@ -472,7 +472,17 @@ perform_col_merge <- function(data, context) {
         )
 
       glue_src_data <- stats::setNames(glue_src_data, seq_along(glue_src_data))
-
+
+      which_cols <- unique(unlist(str_complete_extract(pattern, "\\{\\d+\\}")))
+      which_cols <- gsub("\\{|\\}", "", which_cols)
+      if (!all(which_cols %in% names(glue_src_data))) {
+        missing <- base::setdiff(which_cols, names(glue_src_data))
+        cli::cli_abort(c(
+          "Can't perform column merging",
+          "Can't find reference {missing}.",
+          "i" = 'Review {.arg pattern} provided to {.fn cols_merge}.'
+        ))
+      }
       glued_cols <- as.character(glue_gt(glue_src_data, pattern))
 
       if (grepl("<<.*?>>", pattern)) {

tests/testthat/_snaps/cols_merge.md

@@ -96,3 +96,13 @@
     Output
       [1] "<table class=\"gt_table\" data-quarto-disable-processing=\"false\" data-quarto-bootstrap=\"false\">\n  <thead>\n    <tr class=\"gt_col_headings\">\n      <th class=\"gt_col_heading gt_columns_bottom_border gt_right\" rowspan=\"1\" colspan=\"1\" scope=\"col\" id=\"a\">a</th>\n    </tr>\n  </thead>\n  <tbody class=\"gt_table_body\">\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">1 (7.1%)</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">5</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">0</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">2 (14.3%)</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">NA</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">6</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">5</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">NA</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">0</td></tr>\n    <tr><td headers=\"a\" class=\"gt_row gt_right\">NA</td></tr>\n  </tbody>\n  \n  \n</table>"
 
+# cols_merge() errors well when pattern is wrong
+
+    Code
+      exibble %>% gt() %>% cols_merge(num, pattern = "{2}")
+    Condition
+      Error in `perform_col_merge()`:
+      ! Can't perform column merging
+      Can't find reference 2.
+      i Review `pattern` provided to `cols_merge()`.
+

tests/testthat/test-cols_merge.R

@@ -839,3 +839,11 @@ test_that("cols_merge_n_pct() works correctly", {
   # Perform snapshot test
   expect_snapshot_html(gt_tbl_2)
 })
+
+test_that("cols_merge() errors well when pattern is wrong", {
+  expect_snapshot(error = TRUE, {
+    exibble %>% 
+      gt() %>% 
+      cols_merge(num, pattern = "{2}")
+  })
+})