Report errors on the table creation to the user (#982)

# Pull Request

<!--- Replace `#nnn` with your issue link for reference. -->

Fixes #980 

Errors are shown to the user:

<img width="881" height="480" alt="image"
src="https://github.com/user-attachments/assets/258a07f5-6234-45c0-b063-15cf3dfaa2ad"
/>

Previously no information was provided

<details>
<summary>Details</summary>

```r
data <- within(teal.data::teal_data(), {
  ADSL <- teal.data::rADSL
})
join_keys(data) <- default_cdisc_join_keys[names(data)]
app <- init(
  data = data,
  modules = modules(
    tm_gtsummary(
      by = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          choices = c("SEX", "COUNTRY", "SITEID", "ACTARM"),
          selected = "SEX",
          multiple = FALSE
        )
      ),
      include = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          choices = c("SITEID", "COUNTRY", "ACTARM"),
          selected = "SITEID",
          multiple = TRUE,
          fixed = FALSE
        )
      ),
      type = everything() ~ "continuous2"
    )
  )
) |> runApp()
```

</details>

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>

Author: llrs-roche

R/tm_a_regression.R

@@ -230,7 +230,7 @@ tm_a_regression <- function(label = "Regression Analysis",
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_choice(default_plot_type, seq.int(1L, length(plot_choices)))
   checkmate::assert_string(default_outlier_label)
-  checkmate::assert_list(decorators, "teal_transform_module")
+  assert_decorators(decorators)
 
   if (length(label_segment_threshold) == 1) {
     checkmate::assert_numeric(label_segment_threshold, any.missing = FALSE, finite = TRUE)

R/tm_gtsummary.R

@@ -230,10 +230,8 @@ srv_gtsummary <- function(id,
       if (length(include_variables)) {
         tbl_summary_args$include <- include_variables
       }
-      tbl_summary_args <- c(tbl_summary_args,
-        nonmissing = input$nonmissing,
-        percent = input$percent
-      )
+      tbl_summary_args$nonmissing <- input$nonmissing
+      tbl_summary_args$percent <- input$percent
       as.call(
         c(
           list(
@@ -254,9 +252,7 @@ srv_gtsummary <- function(id,
         },
         table_crane = table_call
       )
-      if (inherits(qq, "qenv.error")) {
-        validate(as.character(qq))
-      }
+      validate_qenv(qq)
       qq
     })
 

R/utils.R

@@ -361,3 +361,13 @@ set_chunk_dims <- function(pws, q_r, inner_classes = NULL) {
     q
   })
 }
+
+
+validate_qenv <- function(qenv) {
+  validate(
+    need(
+      inherits(qenv, "qenv"),
+      sub("when evaluating qenv", "when evaluating", qenv$message, fixed = TRUE)
+    )
+  )
+}

tests/testthat/test-tm_gtsummary.R

@@ -249,8 +249,9 @@ testthat::describe("tm_gtsummary module server behavior", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
+        session$flushReact()
 
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
         testthat::expect_true(inherits(table_r(), "gtsummary"))
       }
     )
@@ -277,8 +278,9 @@ testthat::describe("tm_gtsummary module server behavior", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = NULL
         )
+        session$flushReact()
 
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
         testthat::expect_true(inherits(table_r(), "gtsummary"))
         testthat::expect_gt(length(unique(table_r()$table_body$variable)), 3L)
       }
@@ -308,7 +310,9 @@ testthat::describe("tm_gtsummary module server behavior", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        session$flushReact()
+
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
         table <- table_r()
         testthat::expect_equal(table$inputs$label, col_label)
         testthat::expect_true(all(table$table_body$var_label %in% unlist(col_label)))
@@ -343,7 +347,7 @@ testthat::describe("tm_gtsummary module server behavior with decorators", {
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
         session$flushReact()
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
         testthat::expect_s3_class(table_r(), "gtsummary")
       }
     )
@@ -379,9 +383,10 @@ testthat::describe("tm_gtsummary module server behavior with decorators", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
-        testthat::expect_true(grepl("table2 <-", get_code(print_output_decorated()), fixed = TRUE))
-        testthat::expect_s3_class(print_output_decorated()$table2, "gtsummary")
+
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
+        testthat::expect_true(grepl("table2 <-", get_code(session$returned()), fixed = TRUE))
+        testthat::expect_s3_class(session$returned()$table2, "gtsummary")
       }
     )
   })

tests/testthat/test-utils.R

@@ -134,7 +134,8 @@ testthat::describe("Module with decorators:", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        session$flushReact()
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
       }
     )
   })
@@ -168,7 +169,8 @@ testthat::describe("Module with decorators:", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_is(tryCatch(print_output_decorated(), error = function(e) e), "shiny.silent.error")
+        session$flushReact()
+        testthat::expect_is(tryCatch(session$returned(), error = function(e) e), "shiny.silent.error")
       }
     )
   })
@@ -195,7 +197,8 @@ testthat::describe("Module with decorators:", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        session$flushReact()
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
       }
     )
   })
@@ -225,7 +228,8 @@ testthat::describe("Module with decorators:", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        session$flushReact()
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
       }
     )
   })
@@ -254,7 +258,8 @@ testthat::describe("Module with decorators:", {
           "by-dataset_test_data_singleextract-select" = "am",
           "include-dataset_test_data_singleextract-select" = c("carb", "cyl")
         )
-        testthat::expect_true(endsWith(get_code(print_output_decorated()), "table"))
+        session$flushReact()
+        testthat::expect_true(endsWith(get_code(session$returned()), "table"))
       }
     )
   })